Module cHexLib.Pkg

     1//==============================================================================
     2// Contributions
     3// =============
     4//
     5// When       Who          What
     6// ========== ============ =====================================================
     7// 2009-01-09 Nick Wright  Original Implementation
     8//
     9//==============================================================================
    10
    11//From DAC Knowledge Base Article 2196
    12// Modified Nick Wright to include Function HexColour
    13
    14Class cHexLib is a cObject
    15    Function IsHex String sHex Returns Boolean
    16        Integer iCounter iLength
    17        String sChar
    18
    19        Move (Uppercase (sHex)) To sHex
    20        Move (Length (sHex)) To iLength
    21        
    22        For iCounter From 1 To iLength
    23            Move (Mid (sHex, 1, iCounter)) To sChar
    24            If (Pos (sChar, "0123456789ABCDEF") = 0) Begin
    25                Function_Return False
    26            End
    27        Loop
    28
    29        Function_Return True
    30    End_Function // IsHex
    31
    32    Function CharToHex Integer iChar Returns String
    33        String sHex
    34
    35        Move (Uppercase (iChar)) To iChar
    36        Move (Mid ("0123456789ABCDEF", 1, Integer (iChar / 16 + 1))) To sHex
    37        Move (sHex - Mid ("0123456789ABCDEF", 1, Mod (iChar, 16) + 1)) To sHex
    38        
    39        Function_Return sHex
    40    End_Function // CharToHex
    41
    42    Function HexToChar String sHex Returns Integer
    43        Integer iCounter iChar iValue iLength iMax
    44        String sChar
    45        
    46        Move (Uppercase (sHex)) To sHex
    47        Move (Length (sHex)) To iLength
    48        Move (iLength - 1) To iMax
    49
    50        For iCounter From 0 To iMax
    51            Move (Mid (sHex, 1, iLength - iCounter)) To sChar
    52            If (Pos (sChar, "ABCDEF") <> 0) Begin
    53                Move (Ascii (sChar) - 55) To iChar
    54            End
    55            Else Begin
    56                Move (Integer (sChar)) To iChar
    57            End
    58            If (iCounter = 0) Begin
    59                Move iChar To iValue
    60            End
    61            Else Begin
    62                Move (iValue + (iChar * (iCounter * 16))) To iValue
    63            End
    64        Loop
    65
    66        Function_Return iValue
    67    End_Function // HexToChar
    68
    69    Function StrToHex String sString Returns String
    70        Integer iCounter iLength iChar
    71        String sHex sChar sHexChar
    72
    73        Move (Length (sString)) To iLength
    74
    75        For iCounter From 1 To iLength
    76            Move (Mid (sString, 1, iCounter)) To sChar
    77            Move (Ascii (sChar)) To iChar
    78            Get CharToHex iChar To sHexChar
    79            Move (sHex + sHexChar) To sHex
    80        Loop
    81
    82        Function_Return sHex
    83    End_Function // StrToHex
    84
    85    Function HexToStr String sHex Returns String
    86        Integer iCounter iChar iLength
    87        String sString sHexValue sChar
    88
    89        Move (Length (sHex) / 2) To iLength
    90
    91        For iCounter From 1 To iLength
    92            Move (Mid (sHex, 2, iCounter * 2 - 1)) To sHexValue
    93            Get HexToChar sHexValue To iChar
    94            Move (Character (iChar)) To sChar
    95            Move (sString + sChar) To sString
    96        Loop
    97
    98        Function_Return sString
    99    End_Function // HexToStr
   100
   101    Function DecToHex Integer iDec Returns String
   102        String sHex
   103
   104        Move "" To sHex
   105        Repeat
   106            Move (Mid ("0123456789ABCDEF", 1, ((iDec iAnd |CI$0F) + 1)) + sHex) To sHex
   107            Move (iDec / |CI$10) To iDec
   108        Until (iDec = 0)
   109
   110        Function_Return sHex
   111    End_Function // DecToHex
   112
   113    Function HexToDec String sHex Returns Integer
   114        Integer iValue
   115
   116        Move ('$' + Trim (sHex)) To iValue
   117
   118        Function_Return iValue
   119    End_Function // HexToDec
   120    
   121    Function HexColor Integer rgbColor Returns String
   122        Integer iRed iGreen iBlue
   123        String sRet sRed sGreen sBlue
   124        
   125        Move (R_From_RGB(rgbColor)) to iRed
   126        Move (G_From_RGB(rgbColor)) to iGreen 
   127        Move (B_From_RGB(rgbColor)) to iBlue
   128    
   129        Get DecToHex iRed to sRed
   130        Get DecToHex iGreen to sGreen
   131        Get DecToHex iBlue to sBlue
   132        
   133        If (Length(sRed)=1)     Move ('0'+sRed) to sRed
   134        If (Length(sGreen)=1)   Move ('0'+sGreen) to sGreen
   135        If (Length(sBlue)=1)    Move ('0'+sBlue) to sBlue
   136        
   137        Move ("#"+sRed+sGreen+sBlue) to sRet
   138        
   139        Function_Return sRet
   140    End_Function
   141
   142End_Class // cHexLib