2003-11-11 18:44

'===============================================
' Functions library
'===============================================
     CONST PI=ACOS(-1)
     CONST CRLF=CHR$(13)+CHR$(10)


'===============================================
' Return the short name of file
'===============================================
     FUNCTION GetFileName(file AS STRING) AS STRING
      result=RIGHT$(file,LEN(file)-RINSTR(file,"\"))
     END FUNCTION

'===============================================
' Return the path name of file
'===============================================
     FUNCTION GetPathName(file AS STRING) AS STRING
      result=LEFT$(file,RINSTR(file,"\")-1)
     END FUNCTION

'===============================================
' Return the extension of file
'===============================================
     FUNCTION GetFileExt(file AS STRING) AS STRING
      result=RIGHT$(file,LEN(file)-RINSTR(file,"."))
     END FUNCTION

'===============================================
' Return the n word in a string expression
'===============================================
     FUNCTION Word$(s AS STRING,index AS INTEGER) AS STRING
      DIM stemp AS STRING
      DIM i AS INTEGER
      DIM flagSpace AS INTEGER

      stemp=""
      FOR i=1 TO LEN(s)
       IF MID$(s,i,1)<>SPACE$(1) THEN
        stemp=stemp+MID$(s,i,1)
        flagSpace=0
       ELSE
        IF flagSpace=0 THEN stemp=stemp+SPACE$(1)
        flagSpace=1
       END IF
      NEXT i
      stemp=LTRIM$(RTRIM$(stemp))
      result=FIELD$(stemp," ",index)
     END FUNCTION

'==================================================
' Return the number of word in a string
'==================================================
     FUNCTION GetWordCount(s AS STRING) AS INTEGER
      DIM flagStop AS INTEGER
      DIM counter AS INTEGER

      counter=1
      flagStop=0
      WHILE flagStop=0
       IF Word$(s,counter)<>"" THEN
        counter=counter+1
       ELSE
        flagStop=1
       END IF
      WEND
      result=counter-1
     END FUNCTION

'====================================================
' Return a string with remove char
'====================================================
     FUNCTION RemoveChar$(s AS STRING,char AS STRING) AS STRING
      DIM source AS STRING

      IF s<>"" THEN
       source=s
       WHILE INSTR(source,char)<>0
        source=LEFT$(source,INSTR(source,char)-1)+MID$(source,INSTR(source,char)+LEN(char))
       WEND
       result=source
      END IF
     END FUNCTION

'====================================================
' Return a string without space to start and to end
'====================================================
     FUNCTION Trim$(s AS STRING) AS STRING
      Result=LTRIM$(RTRIM$(s))
     END FUNCTION

'====================================================
' Return a string with quote
'====================================================
     FUNCTION Quote(StringToQuote AS STRING) AS STRING
      StringToQuote=CHR$(34)+StringToQuote+CHR$(34)
      result=REPLACESUBSTR$(stringtoquote,CHR$(34)+CHR$(34),CHR$(34))
     END FUNCTION

'======================================================
' Return ratio
'======================================================
     FUNCTION Ratio(Value1 AS DOUBLE,Value2 AS DOUBLE) AS DOUBLE
      Result=((Value1-Value2)*100)/Value1
     END FUNCTION

'========================================
' Return radian value
'========================================
     FUNCTION GetRadian(degrees AS DOUBLE) AS DOUBLE
      Result=degrees*(Pi/180)
     END FUNCTION

'==========================================
' Return degrees value
'==========================================
     FUNCTION GetDegrees(radian AS DOUBLE) AS DOUBLE
      Result=radian*(180/Pi)
     END FUNCTION

'===================================
' Return distance
'===================================
     FUNCTION Distance(x AS DOUBLE,y AS DOUBLE) AS DOUBLE
      Result=SQR(x^2+y^2)
     END FUNCTION

'===================================
' Return surface
'===================================
     FUNCTION Surface(Width AS DOUBLE,Height AS DOUBLE) AS DOUBLE
      Result=Width*Height
     END FUNCTION

'===================================
' Return blue value of color
'===================================
     FUNCTION GetBlue(COLOR AS LONG) AS LONG
      Result=INT(COLOR/65536)
     END FUNCTION

'===================================
' Return red value of color
'===================================
     FUNCTION GetRed(COLOR AS LONG) AS LONG
      DIM blue AS LONG
      DIM green AS LONG

      blue=INT(COLOR/65536)
      green=INT((COLOR-(blue*65536))/256)
      Result=INT(COLOR-(blue*65536)-(green*256))
     END FUNCTION

'===================================
' Return green value of color
'===================================
     FUNCTION GetGreen(COLOR AS LONG) AS LONG
      DIM blue AS LONG

      blue=INT(COLOR/65536)
      Result=INT((COLOR-(blue*65536))/256)
     END FUNCTION

'==========================================
' Return Dec from bin
'==========================================
     FUNCTION BinToDec(bin AS STRING)AS LONG
      DIM bit AS INTEGER
      DIM i AS INTEGER
      DIM value AS INTEGER

      bin=REVERSE$(bin)
      bit=1
      value=0
      FOR i=1 TO LEN(bin)
       IF MID$(bin,i,1)="1" THEN value=value+bit
       bit=bit*2
      NEXT i
      result=value
     END FUNCTION

'=============================================
' Return Dec from hex
'=============================================
     FUNCTION HexToDec(hex AS STRING)AS LONG
      DIM bit AS LONG
      DIM valbit AS INTEGER
      DIM i AS INTEGER
      DIM value AS INTEGER

      hex=REVERSE$(hex)
      bit=1
      value=0
      FOR i=1 TO LEN(hex)
       IF MID$(hex,i,1)="A" THEN
        value=value+(10*bit)
       ELSEIF MID$(hex,i,1)="B" THEN
        value=value+(11*bit)
       ELSEIF MID$(hex,i,1)="C" THEN
        value=value+(12*bit)
       ELSEIF MID$(hex,i,1)="D" THEN
        value=value+(13*bit)
       ELSEIF MID$(hex,i,1)="E" THEN
        value=value+(14*bit)
       ELSEIF MID$(hex,i,1)="F" THEN
        value=value+(15*bit)
       ELSE
        value=value+(VAL(MID$(hex,i,1))*bit)
       END IF
       IF (bit*16)<2147483647 THEN bit=bit*16
      NEXT i
      result=value
     END FUNCTION

2003-11-11 18:44