GFA Library
Posted: Sat Feb 11, 2006 9:05 am
Thanks einander!
I added it to my library, which will shall help me to "understand" the PB wording...
Michael
;{ PureBasic 4.0-Library including useful GFA-16Bit-Functions }
; 2006/02/09 started by Michael Vogel
; ..... everyone can help!
;}
;{ Mathematics }
; V0.0.1
;}
Procedure Max(a,b)
; Function: returns smaller of two numbers
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure Min(a,b)
; Function: returns bigger of two numbers
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure Div(a,b)
; Function: returns a div b
ProcedureReturn a/b
EndProcedure
Procedure Mod(a,b)
; Function: returns a mod b
ProcedureReturn a%b
EndProcedure
Procedure Succ(a)
; Function: returns increment of a
ProcedureReturn a+1
EndProcedure
Procedure Pred(a)
; Function: returns decrement of a
ProcedureReturn a-1
EndProcedure
Procedure Scale(a,b,c)
; Function: returns a*b/c
ProcedureReturn a*b/c
EndProcedure
;{ Logic }
; V0.0.1
;}
Procedure No(a)
; Function: returns not a
ProcedureReturn ~a
EndProcedure
Procedure BTst(a,b)
; Function: check, if bit is set
; Return: true, If bit b is set in number a, otherwise false
If a&(1<<b)<>0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure BClr(a,b)
; Function: clear bit b in number a
ProcedureReturn a&~(1<<b)
EndProcedure
Procedure BSet(a,b)
; Function: set bit b in number a
ProcedureReturn a|(1<<b)
EndProcedure
Procedure IsEqual(a,b)
; Function: return -1 if a equals b, otherwise 0
If a=b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure IsGreater(a,b)
; Function: return -1 if a is greater than b, otherwise 0
If a>b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure IsLess(a,b)
; Function: return -1 if a is less than b, otherwise 0
If a<b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
;{ Strings & Arrays}
; V0.0.1
;}
Procedure Rinstr(x$,search$,start=#MAXSHORT)
; Function: returns the rightmost position of the search text within the string s, begin with searching at position start
start=min(start,Len(x$))-Len(search$)
While start>0
If Mid(x$,start,Len(search$))=search$
Break
EndIf
start-1
Wend
ProcedureReturn start
EndProcedure
Procedure.s BinS(value,length)
; Function: returns a strings of the given length with the binary equivalent of the value
ProcedureReturn RSet(Bin(value),length,"0")
EndProcedure
Procedure.s HexS(value,length)
; Function: returns a strings of the given length with hex equivalent of the value
ProcedureReturn RSet(Hex(value),length,"0")
EndProcedure
Procedure DimX(x())
; Function: returns the number of elements of the given array
ProcedureReturn 0
; UNSOLVED
EndProcedure
Procedure Arrayfill(x(),y)
; Function: fills array x() with value y
; UNSOLVED
EndProcedure
;{ Graphics }
; V0.0.1
;}
Procedure Cls(color)
EndProcedure
Procedure Get(x,y,w,h)
EndProcedure
Procedure Put(x,y,w,h)
EndProcedure
Procedure Stretch(x,y,w,h)
EndProcedure
;{ Windows }
; V0.0.1
;}
Procedure OpenW(n,x,y,w,h,mode)
EndProcedure
Procedure CloseW(n)
EndProcedure
;{ File System }
; V0.01
;}
Procedure Exist(file$)
; Function: checks, if the given filename exists
; Return: True if the file exists, otherwise False
If FileSize(file$)>=0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure _Drive()
; Function: returns ordinal number of actual drive
ProcedureReturn Asc(ProgramName())-64
EndProcedure
Procedure.s DIR(dummy)
; Function: returns actual directory path, where program has been started from
; thanks to einander...
Protected Buff$=Space(256)
GetCurrentDirectory_(256,@buff$)
ProcedureReturn buff$;
; my "solution"...
;Protected path.s=ProgramName()
;Protected pos=rinstr(path,"\")
;ProcedureReturn Mid(path,3,pos-3)
EndProcedure
;{ Extras }
; V0.0.2
;}
Procedure ShiftKey()
; Function: returns True, when the Shift key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_SHIFT) & 128
EndProcedure
Procedure ControlKey()
; Function: returns True, when the Control key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_CONTROL) & 128
EndProcedure
Procedure AltKey()
; Function: returns True, when the Alt key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_MENU) & 128
EndProcedure
;{ Debugging & Testing }
;}
Procedure Test(what)
Dim x(10)
Select what
Case 1
Debug "File handling"
Debug Exist("\boot.ini")
Debug Exist("c:\Win")
Debug Exist("c:\autoexec.bat")
Case 2
Debug "Actual drive & directory"
Debug _drive()
Debug dir(0)
Case 3
Debug "Mathematics"
Debug min(9,2)
Debug div(19,5)
Debug 59%50
Case 4
Debug "Logic"
Debug No(0)
Debug No(1)
Debug BTst(%1011,2)
Debug BSet(%1011,2)
Debug BClr(%1011,3)
Case 5
Debug "Strings & Arrays"
Debug Rinstr("Hallo PureBasic","Pure")
Debug BinS(999,8)
Debug HexS(45054,8)
;Debug DimX(x())
Case 6
Debug "Shift-Key..."
Debug shiftkey()
EndSelect
EndProcedure
test(2);{ change number for testing... }
test(5);{ change number for testing... }
; IDE Options = PureBasic v4.00 - Beta 2 (Windows - x86)
; CursorPosition = 162
; FirstLine = 32
; Folding = AAAAAAA+
I added it to my library, which will shall help me to "understand" the PB wording...
Michael
;{ PureBasic 4.0-Library including useful GFA-16Bit-Functions }
; 2006/02/09 started by Michael Vogel
; ..... everyone can help!
;}
;{ Mathematics }
; V0.0.1
;}
Procedure Max(a,b)
; Function: returns smaller of two numbers
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure Min(a,b)
; Function: returns bigger of two numbers
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure Div(a,b)
; Function: returns a div b
ProcedureReturn a/b
EndProcedure
Procedure Mod(a,b)
; Function: returns a mod b
ProcedureReturn a%b
EndProcedure
Procedure Succ(a)
; Function: returns increment of a
ProcedureReturn a+1
EndProcedure
Procedure Pred(a)
; Function: returns decrement of a
ProcedureReturn a-1
EndProcedure
Procedure Scale(a,b,c)
; Function: returns a*b/c
ProcedureReturn a*b/c
EndProcedure
;{ Logic }
; V0.0.1
;}
Procedure No(a)
; Function: returns not a
ProcedureReturn ~a
EndProcedure
Procedure BTst(a,b)
; Function: check, if bit is set
; Return: true, If bit b is set in number a, otherwise false
If a&(1<<b)<>0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure BClr(a,b)
; Function: clear bit b in number a
ProcedureReturn a&~(1<<b)
EndProcedure
Procedure BSet(a,b)
; Function: set bit b in number a
ProcedureReturn a|(1<<b)
EndProcedure
Procedure IsEqual(a,b)
; Function: return -1 if a equals b, otherwise 0
If a=b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure IsGreater(a,b)
; Function: return -1 if a is greater than b, otherwise 0
If a>b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure IsLess(a,b)
; Function: return -1 if a is less than b, otherwise 0
If a<b
ProcedureReturn -#True
Else
ProcedureReturn #False
EndIf
EndProcedure
;{ Strings & Arrays}
; V0.0.1
;}
Procedure Rinstr(x$,search$,start=#MAXSHORT)
; Function: returns the rightmost position of the search text within the string s, begin with searching at position start
start=min(start,Len(x$))-Len(search$)
While start>0
If Mid(x$,start,Len(search$))=search$
Break
EndIf
start-1
Wend
ProcedureReturn start
EndProcedure
Procedure.s BinS(value,length)
; Function: returns a strings of the given length with the binary equivalent of the value
ProcedureReturn RSet(Bin(value),length,"0")
EndProcedure
Procedure.s HexS(value,length)
; Function: returns a strings of the given length with hex equivalent of the value
ProcedureReturn RSet(Hex(value),length,"0")
EndProcedure
Procedure DimX(x())
; Function: returns the number of elements of the given array
ProcedureReturn 0
; UNSOLVED
EndProcedure
Procedure Arrayfill(x(),y)
; Function: fills array x() with value y
; UNSOLVED
EndProcedure
;{ Graphics }
; V0.0.1
;}
Procedure Cls(color)
EndProcedure
Procedure Get(x,y,w,h)
EndProcedure
Procedure Put(x,y,w,h)
EndProcedure
Procedure Stretch(x,y,w,h)
EndProcedure
;{ Windows }
; V0.0.1
;}
Procedure OpenW(n,x,y,w,h,mode)
EndProcedure
Procedure CloseW(n)
EndProcedure
;{ File System }
; V0.01
;}
Procedure Exist(file$)
; Function: checks, if the given filename exists
; Return: True if the file exists, otherwise False
If FileSize(file$)>=0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure _Drive()
; Function: returns ordinal number of actual drive
ProcedureReturn Asc(ProgramName())-64
EndProcedure
Procedure.s DIR(dummy)
; Function: returns actual directory path, where program has been started from
; thanks to einander...
Protected Buff$=Space(256)
GetCurrentDirectory_(256,@buff$)
ProcedureReturn buff$;
; my "solution"...
;Protected path.s=ProgramName()
;Protected pos=rinstr(path,"\")
;ProcedureReturn Mid(path,3,pos-3)
EndProcedure
;{ Extras }
; V0.0.2
;}
Procedure ShiftKey()
; Function: returns True, when the Shift key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_SHIFT) & 128
EndProcedure
Procedure ControlKey()
; Function: returns True, when the Control key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_CONTROL) & 128
EndProcedure
Procedure AltKey()
; Function: returns True, when the Alt key is actually pressed, otherwise False
ProcedureReturn GetKeyState_(#VK_MENU) & 128
EndProcedure
;{ Debugging & Testing }
;}
Procedure Test(what)
Dim x(10)
Select what
Case 1
Debug "File handling"
Debug Exist("\boot.ini")
Debug Exist("c:\Win")
Debug Exist("c:\autoexec.bat")
Case 2
Debug "Actual drive & directory"
Debug _drive()
Debug dir(0)
Case 3
Debug "Mathematics"
Debug min(9,2)
Debug div(19,5)
Debug 59%50
Case 4
Debug "Logic"
Debug No(0)
Debug No(1)
Debug BTst(%1011,2)
Debug BSet(%1011,2)
Debug BClr(%1011,3)
Case 5
Debug "Strings & Arrays"
Debug Rinstr("Hallo PureBasic","Pure")
Debug BinS(999,8)
Debug HexS(45054,8)
;Debug DimX(x())
Case 6
Debug "Shift-Key..."
Debug shiftkey()
EndSelect
EndProcedure
test(2);{ change number for testing... }
test(5);{ change number for testing... }
; IDE Options = PureBasic v4.00 - Beta 2 (Windows - x86)
; CursorPosition = 162
; FirstLine = 32
; Folding = AAAAAAA+