'--------------------------- Custom functions -------------------------- 

'-- **************************************************************************' 
FUNCTION vidnum$ (Num, dig%) as string
'Andrew Shelkovenko dec 2003 
'A  function that returns the string representation of  of a rounded numeric expression. 
'Syntax: vidnum$ (numeric-expression, dig%)  
'Num$ = vidnum$ (999999.2366666666, 4) 
'Return  999999.2367  
'Num$ = vidnum$ (-0.236, 4) 
'Return  -0.236 
'Num$ =vidnum$ (-12389.236, -2) 
'Return -12400 
'Details: 
'dig% - number of significant digits  



Num$=str$(Num)

pntPos=instr(Num$,".")

if pntPos=0 then 
digMax=0
else
digMax=Len(Num$)-pntPos
end if
 
if dig%>digMax then dig%=digMax 

vidnum$ = STR$((  CLNG(  abs(Num) * 10 ^ dig%) / 10 ^ dig%)*sgn(Num))

END FUNCTION
' 
'-- **************************************************************************' 
function   Hex2Dec (HexStr as string) as string
  
  DEFdbl numb
  defdbl number
  DEFBYTE x,length, y
	number = 0
    length = LEN(HexStr)
    FOR x = 1 TO length
      y = length - x

      digit$ = UCASE$(MID$(HexStr,x,1))
      SELECT CASE digit$
        CASE "A"
          numb = 10 * 16^y
        CASE "B"
          numb = 11 * 16^y
        CASE "C"
          numb = 12 * 16^y
        CASE "D"
          numb = 13 * 16^y
        CASE "E"
         numb = 14 * 16^y
        CASE "F"
          numb = 15 * 16^y
        CASE ELSE
          numb = VAL(LCASE$(digit$)) * 16^y
      END SELECT
      number = number + numb
    qw:
    NEXT

if number>10^6 then 
n1=fix(number/1000000) 
n2=(number-n1*1000000)    
NumNul=6-len(str$(n2)) 
TrNul$=string$(NumNul, "0")

Dec$ = STR$(n1)+TrNul$+str$(n2)

else
Dec$ = STR$(number)
end if
Hex2Dec=Dec$

END function

'-- **************************************************************************' 
function dectoHex (Dec as string) as string
defdbl ost, ch
defstr HexVal$
HexVal$=""
ost=0: ch=0
Dec#=val(Dec)
sign=sgn(Dec#)
Dec#=abs(Dec#)
WHILE  Dec# >= 16#
ch=FIX(Dec# / 16#)
ost = Dec#-ch*16#

Dec#=ch
select case ost
case is <10
Hexdig$=str$(ost)
case 10
Hexdig$="A"
case 11
Hexdig$="B"
case 12
Hexdig$="C"
case 13
Hexdig$="D"
case 14
Hexdig$="E"
case 15
Hexdig$="F"
case 15
Hexdig$="10"

case else
end select

HexVal$ =Hexdig$  + HexVal$: 

wend

select case Dec#

case is <10
Hexdig$=str$(Dec#)
case 10
Hexdig$="A"
case 11
Hexdig$="B"
case 12
Hexdig$="C"
case 13
Hexdig$="D"
case 14
Hexdig$="E"
case 15
Hexdig$="F"
case 15
Hexdig$="10"

case else
end select

HexVal$ =Hexdig$  + HexVal$: 
if sign=-1 then signn$="-" else signn$=""
if HexVal$="0" then HexVal$="00"
dectoHex=signn$+ HexVal$
END function


'-- **************************************************************************' 
function AddStrBefore(NumStr as string , Dlina as int, AddStr as string) as string
'Andrew Shelkovenko dec 2003 
'A function that pre-padd string with 0's to required Length  
'print Add0Before("-387.35" , 8)   
'-0387.35 


diM kolvo as int
kolvo =Dlina-Len(NumStr)
if   kolvo<0 theN Add0Before="String too long"
if   kolvo=0 theN Add0Before=NumStr: exit function

Add0Before	= STRING$(kolvo, "0")+ NumStr

end function

'-- **************************************************************************' 
FUNCTION ByteReOrder (ByteStr$,ReOrder$ ) as string
'Andrew Shelkovenko dec 2003 
' A function that reorder bytes in string. 
'ByteStr$ - Sourse string 
'ReOrder$ - new byte order 

'ReOrder$="21342" 
'old position - 2, new position - 1 
'old position - 1, new position - 2 
'old position - 3, new position - 3 
'old position - 4, new position - 4 
'old position - 2, new position - 5 

LenB=Len(ByteStr$)
LenR=Len(ReOrder$)

for i=1 to LenB
poz$=ReOrder$[i]
if val(poz$)> LenB then ShowMessage( "ReOrder index outbound input string"):exit FUNCTION
if i<= LenR then
byt$=ByteStr$[val(poz$)]
else
byt$=ByteStr$[i]
end if
tmp$=tmp$+byt$
next
ByteReOrder=tmp$
end FUNCTION

'-- **************************************************************************' 
FUNCTION CByteNum (ByteStr$,Num_Type as short ) as variant
'Andrew Shelkovenko dec 2003 
'' converts   number of Num_Type type to bytes sequence. 
'Num_Type can be next value: 
'CONST Num_SHORT = 2 
'CONST Num_WORD = 3 
'CONST Num_LONG = 4 
'CONST Num_DWORD = 5 
'CONST Num_SINGLE = 6 
'CONST Num_DOUBLE = 8 


DIM M AS QMemoryStream
select case Num_Type
case Num_BYTE
ShowMessage "Can't to write BYTE.Wrong parameter type - Num_BYTE": exit funCTION
case  Num_SHORT: M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_SHORT)
case  Num_WORD:  M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_WORD)
case  Num_LONG:  M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_LONG)
case  Num_DWORD: M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_DWORD)
case  Num_SINGLE:M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_SINGLE)
case  Num_DOUBLE:M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_DOUBLE)

case else
M.Write (ByteStr$):m.Position=0:CByteNum=m.ReadNum(Num_DOUBLE)
end select

M.Close

end funCTION

'-- **************************************************************************' 
FUNCTION CNumByte (Num, Num_Type as short) as string
'Andrew Shelkovenko dec 2003 

'converts bytes sequence to  number of Num_Type type   
'Num_Type can be next value: 
'CONST Num_SHORT = 2 
'CONST Num_WORD = 3 
'CONST Num_LONG = 4 
'CONST Num_DWORD = 5 
'CONST Num_SINGLE = 6 
'CONST Num_DOUBLE = 8 


DIM M AS QMemoryStream

select case Num_Type
case Num_BYTE
dim N1 as BYTE 
ShowMessage "Can't to write BYTE.Wrong parameter type - Num_BYTE": exit funCTION

case  Num_SHORT: DEFSHORT N2:N2=Num:M.Write(N2):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N2))
case  Num_WORD:  DEFWORD  N3:N3=Num:M.Write(N3):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N3))
case  Num_LONG:  DEFLNG   N4:N4=Num:M.Write(N4):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N4))
case  Num_DWORD: DEFDWORD N5:N5=Num:M.Write(N5):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N5))
case  Num_SINGLE:DEFSNG   N6:N6=Num:M.Write(N6):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N6))
case  Num_DOUBLE:DEFDBL   N7:N7=Num:M.Write(N7):M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N7))

case else
dim N8 as DOUBLE:N8=Num:
M.Write(N8):
M.Position=0:CNumByte=M.ReadBinStr(sizeOf(N8)):M.Close                                         
end select
M.Close
end funCTION

'-- **************************************************************************' 

' LIKE Function - pattern matching routine for Rapid-Q by William Yu 
' This emulates the VB LIKE operator. 
' Thanks to Thomas Binder for the original C code 
' 
' ?   Any single character. 
' *   Zero or more characters. 
' #   Any single digit (0-9). 
' [charlist]  Any single character in charlist. 
' [!charlist] Any single character not in charlist. 
' 
' A group of one or more characters (charlist) enclosed in brackets ([ ]) 
' can be used to match any single character in string and can include almost 
' any character code, including digits. 
' 
' Note:   To match the special characters left bracket ([), question 
' mark (?), number sign (#), and asterisk (*), enclose them in brackets. 
' The right bracket (]) can't be used within a group to match itself, but 
' it can be used outside a group as an individual character. 
' 
' By using a hyphen (-) to separate the upper and lower bounds of the range, 
' charlist can specify a range of characters. For example, [A-Z] results in 
' a match if the corresponding character position in string contains any 
' uppercase letters in the range A-Z. Multiple ranges are included within 
' the brackets without delimiters. 


DECLARE FUNCTION Like(ParseString AS STRING, Pattern AS STRING) AS INTEGER
DECLARE FUNCTION IsDigit(S AS STRING) AS INTEGER

CONST INVERT = "!"       '-- Some like ^ or ~ instead, whatever you want 

'-- **************************************************************************' 
FUNCTION IsDigit(S AS STRING) AS INTEGER
  IF S >= "0" AND S <= "9" THEN
    IsDigit = 1
  ELSE
    IsDigit = 0
  END IF
END FUNCTION


'-- **************************************************************************' 
FUNCTION Like(ParseString AS STRING, Pattern AS STRING) AS INTEGER
  DIM prev AS INTEGER, matched AS INTEGER, reverse AS INTEGER

  WHILE Pattern <> ""
    SELECT CASE MID$(Pattern, 1, 1)
      CASE "?"
        IF ParseString = "" THEN
           Like = 0
           EXIT FUNCTION
        END IF
      CASE "#"
        IF IsDigit(MID$(ParseString, 1, 1)) = 0 THEN
           Like = 0
           EXIT FUNCTION
        END IF
      CASE "*"
        DO
          Pattern = MID$(Pattern, 2, LEN(Pattern)-1)
        LOOP UNTIL MID$(Pattern, 1, 1) <> "*"
        IF Pattern = "" THEN
           Like = 1
           EXIT FUNCTION
        END IF
        WHILE ParseString <> ""
           IF Like(ParseString, Pattern) THEN
              Like = 1
              EXIT FUNCTION
           END IF
           IF ParseString <> "" THEN
              ParseString = MID$(ParseString, 2, LEN(ParseString)-1)
           END IF
        WEND
        Like = 0
        EXIT FUNCTION
      CASE "["
        reverse = (MID$(Pattern, 2, 1) = INVERT)
        IF reverse THEN
           Pattern = MID$(Pattern, 2, LEN(Pattern)-1)
        END IF
        prev = 256: matched = 0
        DO
           Pattern = MID$(Pattern, 2, LEN(Pattern)-1)
           IF (Pattern <> "") AND (esc <> 0 OR MID$(Pattern, 1, 1) <> "]") THEN
              IF MID$(Pattern, 1, 1) = "-" THEN
                 Pattern = MID$(Pattern, 2, LEN(Pattern)-1)
                 IF Pattern = "" THEN
                    Like = 0
                    EXIT FUNCTION
                 END IF
                 matched = matched OR (MID$(ParseString, 1, 1) <= MID$(Pattern, 1, 1) AND ASC(MID$(ParseString, 1, 1)) >= prev)
              ELSE
                 matched = matched OR (MID$(ParseString, 1, 1) = MID$(Pattern, 1, 1))
              END IF
              prev = ASC(MID$(Pattern, 1, 1))
           ELSE
              EXIT DO
           END IF
           esc = 0
        LOOP
        IF (prev = 256 OR MID$(Pattern, 1, 1) <> "]" OR ABS(matched) = ABS(reverse)) THEN
           Like = 0
           EXIT FUNCTION
        END IF
      CASE ELSE
        IF MID$(ParseString, 1, 1) <> MID$(Pattern, 1, 1) THEN
           Like = 0
           EXIT FUNCTION
        END IF
    END SELECT
    ParseString = MID$(ParseString, 2, LEN(ParseString)-1)
    Pattern = MID$(Pattern, 2, LEN(Pattern)-1)
  WEND

  Like = ABS(LEN(ParseString) = 0)
END FUNCTION


'-- Test code 

'print "Like('24','##')=", Like("24","##") 

'?"Like(aBBBa, a*a)=", Like("aBBBa","a*a") 
'?Like("F","[!A-Z]") 
'?Like("a2a","a#a") 
'?Like("aM5b","a[A-GL-P]#[!c-e]") 
'?Like("BAT123khg","B?T*") 
'?Like("CAT123khg","B?T*") 

'?Like("Combine(10, 20) = 30", "*(*?,*?)*=*#")