2010-12-07 21:18

     $TYPECHECK ON
'===============================================
' Functions library
'===============================================
     CONST PI=ACOS(-1)


'===============================================
' 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 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 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

2010-12-07 21:18