* This function accepts 3 parameters * 1) The source value, ie the value to convert * 2) the source base, eg 10 (Decimal). Valid bases are 2 - 62 * 3) the destination base, eg 16 (Hex). Valid bases are 2 - 62 Function BaseX2Y(pSrcValue, pSrcBase, pDestBase) Local nCounter, cValArray, cSrcValue, nSrcBase, nDestBase, cDestValue, nDecValue, nPower cValArray = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" * We must have all 3 parameters If Parameters() < 3 Then Return "" Endif * Make sure the Source Base is the correct type and is a valid value If Type("pSrcBase") = "N" then nSrcBase = int(pSrcBase) Else nSrcBase = int(val(pSrcBase)) Endif If ! Between(nSrcBase, 2, 62) Then Return "" Endif * Make sure the Source Value is the correct type and contains valid data If Type("pSrcValue") = "N" then cSrcValue = alltrim(str(int(pSrcValue))) && Make sure there are no decimal points Else cSrcValue = alltrim(pSrcValue) Endif If len(cSrcValue) = 0 Then Return "" Endif * If the source base is <= Base 26 then convert the source value to uppercase If (nSrcBase <= 26) Then cSrcValue = Upper(cSrcValue) Endif * Make sure that all chars in the source value are valid chars and that they exist within * the range of chars allowed for the source base. For nCounter = 1 to len(cSrcValue) nTmpPosn = at(substr(cSrcValue, nCounter, 1), cValArray) If (nTmpPosn = 0) or (nTmpPosn > nSrcBase) Then Return "" Endif EndFor * Make sure the Destination Base is the correct type and is a valid value If Type("pDestBase") = "N" then nDestBase = int(pDestBase) Else nDestBase = int(val(pDestBase)) Endif If ! Between(nDestBase, 2, 62) Then Return "" Endif * Convert source value to decimal first nDecValue = 0 nPower = 0 For nCounter = len(cSrcValue) to 1 Step -1 nDecValue = nDecValue + (at(Substr(cSrcValue, nCounter, 1), cValArray)-1) * (nSrcBase ^ nPower ) nPower = nPower + 1 Endfor * Then convert to destination base cDestValue = "" Do While (nDecValue > 0) cDestValue = substr(cValArray, (nDecValue%nDestBase)+1, 1) + cDestValue nDecValue = Int(nDecValue/nDestBase) Enddo Return cDestValue EndFunc Function NewCode(lc_keyfield, lc_CodeWidth) Local ln_OldWorkArea, lc_OldReprocess, lc_NewCode If parameters() < 2 Then lc_CodeWidth = 10 Endif lc_OldWorkArea = Select() lc_OldReprocess = SET('REPROCESS') SET Reprocess To Automatic IF !Used("Codes") Use data\Codes in 0 Endif Select Codes IF Seek(upper(lc_Keyfield), "Codes", "Key") IF RLOCK() lc_NewCode = Codes.value REPLACE Codes.value with padl(alltrim(str(val(lc_NewCode)+1)), lc_CodeWidth, "0") UNLOCK Endif Else m.Key = upper(lc_Keyfield) lc_NewCode = Padl("1", lc_CodeWidth, "0") m.value = Padl("2", lc_CodeWidth, "0") Insert Into Codes from memvar Endif Select(lc_OldWorkArea) SET REPROCESS TO lc_OldReprocess Return lc_NewCode EndFunc