// ********************************************************************** // Use Strings.nui // String manipulation for VDF and 3.2 (No User Interface) // // By Sture Andersen // // The file contains a number of global functions for manipulating // strings and converting numbers to strings. The package may be used // with DataFlex 3.2 and Visual DataFlex. This package is public domain. // // // Create: Fri 23-05-1997 - Merger of s_utl002, 006. // Update: Tue 25-08-1997 - Fixes by Magnus Bergh // Sun 14-12-1997 - Added the following functions: // ExtractWord ExtractInteger // HowManyWords HowManyIntegers // ExtractItemNeg IsIntegerPresent // Tue 31-03-1998 - Added the following functions: // Text_RemoveTrailingCr Text_CompressSubstCr // Text_RTrim Text_Format.sii // Text_Trim Text_FormattedLine.i // Text_Compress // Fri 06-11-1998 - Added function InsertThousandsSep // Sun 14-02-1999 - Added function Byte_ToHex // Wed 27-04-1999 - Added function CurrentDecimalSeparator // Mon 08-11-1999 - Added procedure Text_SetEditObjectValue and // function Text_EditObjectValue // Mon 22-11-1999 - Function Text_RemoveTrailingCr strengthened // Wed 01-12-1999 - Function StringFieldType added // Wed 12-01-2000 - Functions StringOemToAnsi and StringAnsiToOem // added when compiled using the Windows compiler // Wed 17-05-2000 - Function NumToStr fixed for use with VDF 6.0. // Mon 29-05-2000 - Attempt to fix function Text_EditObjectValue // Fri 21-07-2000 - InsertThousandsSep fixed for use with negative // numbers. // - Functions IntToStrRTS, NumToStrRTS and NumToStrTS // added. // Fri 25-08-2000 - Function NumToStrRzf added // Wed 28-02-2001 - Add function HexToByte, renamed existing function // Byte_ToHex to ByteToHex // Mon 19-03-2001 - Functions StringBeginsWith and StringEndsWith // added // Thu 19-07-2001 - StringIsInteger added // Sat 05-04-2002 - Global strings str.Chr10 and str.Chr1013 added. // Tue 04-06-2002 - Oem to ANSI and vice versa for DF3.2 UNIX/DOS/LINUX // Tue 09-09-2003 - Function StringFieldText added // Tue 18-01-2005 - Function String_NegateSortOrder added // Mon 14-03-2005 - Functions StringHead and StringTail added // // *********************************************************************** use ui Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes // Returns the string of length len# inside which src# is right justified: Function RightShift global string src# integer len# returns string trim src# to src# if (length(src#)) lt len# insert (left(pad("",len#),len#-length(src#))) in src# at 1 function_return (left(src#,len#)) End_Function // Returns the string of length len# inside which src# is centered: Function CenterString global string src# integer len# returns string trim src# to src# if (length(src#)) lt len# insert (left(pad("",len#),len#-length(src#)/2)) in src# at 1 function_return (left(src#,len#)) End_Function // Returns all characters to the right of position pos# (including the character at // posistion pos#) Function RightFromPos global string str# integer pos# returns string function_return (right(str#,length(str#)-pos#+1)) End_Function // Number converting functions: #REPLACE NUMTOSTR_THOUSANDS_SEPARATOR_OFF 0 #REPLACE NUMTOSTR_THOUSANDS_SEPARATOR_ON 1 integer NumToStringConversionMode# string str.Chr10 1 string str.Chr13 1 string str.Chr1013 2 move (character(13)) to str.Chr13 move (character(10)) to str.Chr10 move (character(10)+character(13)) to str.Chr1013 move NUMTOSTR_THOUSANDS_SEPARATOR_OFF to NumToStringConversionMode# procedure set pNumToStringConversionMode global integer value# move value# to NumToStringConversionMode# end_procedure function pNumToStringConversionMode global returns integer function_return NumToStringConversionMode# end_function function InsertThousandsSep global string str# returns string local integer pos# tmp# neg# local string sep# trim str# to str# move (left(str#,1)="-") to neg# if neg# get StringRightBut str# 1 to str# get_attribute DF_DECIMAL_SEPARATOR to pos# character pos# to sep# move (pos(sep#,str#)) to pos# ifnot pos# move (length(str#)+1) to pos# get_attribute DF_THOUSANDS_SEPARATOR to tmp# character tmp# to sep# while pos# gt 4 move (pos#-3) to pos# insert sep# in str# at pos# loop if neg# move ("-"+str#) to str# function_return str# end_function // Calling the function below will convert the number stored in src# to a // string containing dcp# decimals rounding excess decimals. Parameter dcp# // may be negative. The expression (NumToStr(1789,-3)) will evaluate to "2000". // The functions in this package all respects the value of global attribute // DF_DECIMAL_SEPARATOR. Function NumToStr global number src# integer dcp# returns string local integer pos# local number correction# local string rval# radix# if dcp# lt 0 function_return (NumToStr(src#*(10^dcp#),0)+left("00000000",-dcp#)) move (0.5/(10^dcp#)) to correction# // move (0.5/(10^dcp#)+src#) to src# // This does not always work with VDF 6.x!!! if src# ge 0 move (correction#+src#) to src# else move (src#-correction#) to src# get_attribute DF_DECIMAL_SEPARATOR to pos# // Overload character pos# to radix# // End overload move src# to rval# ifnot (pos(radix#,rval#)) append rval# radix# append rval# "00000000" move (pos(radix#,rval#)) to pos# if dcp# eq 0 decrement pos# move (left(rval#,pos#+dcp#)) to rval# if NumToStringConversionMode# move (InsertThousandsSep(rval#)) to rval# function_return rval# End_Function // This function is the same as NumToStr except that you have to specify // the length of the target string (len#). The number will be right // justified accordingly. Post-fix `R' means right justify: Function NumToStrR global number src# integer dcp# integer len# returns string function_return (RightShift(NumToStr(src#,dcp#),len#)) End_Function // Function NumToStrTS is the same as NumToStr except that thousand // separators are inserted. (TS=Thousand Separator) Function NumToStrTS global number src# integer dcp# returns string local integer Org# local string rval# move NumToStringConversionMode# to org# move NUMTOSTR_THOUSANDS_SEPARATOR_ON to NumToStringConversionMode# move (NumToStr(src#,dcp#)) to rval# move org# to NumToStringConversionMode# function_return rval# End_Function Function IntToStrTS global number src# returns string function_return (NumToStrTS(src#,0)) End_Function Function NumToStrRTS global number src# integer dcp# integer len# returns string function_return (RightShift(NumToStrTS(src#,dcp#),len#)) End_Function // This function is the same as NumToStrR except that you do not specify // the number of decimals: Function IntToStrR global number src# integer len# returns string function_return (NumToStrR(src#,0,len#)) // Fixed, Magnus Bergh End_Function // Same as IntToStrR (TS=Thousand Separator) Function IntToStrRTS global number src# integer len# returns string function_return (NumToStrRTS(src#,0,len#)) End_Function // Is the same as IntToStrR, except that leading blanks are substituted // for leading zeros (zf=zero fill): Function IntToStrRzf global number src# integer len# returns string function_return (replaces(" ",NumToStrR(src#,0,len#),"0")) // Fixed, Magnus Bergh End_Function Function NumToStrRzf global number src# integer dcp# integer len# returns string function_return (replaces(" ",NumToStrR(src#,dcp#,len#),"0")) End_Function // Use this to obtain the number of the least significant "non zero // decimal in src#. 0.702 will return 3 while 100 will return -2: Function NumberOfDecs global number src# returns integer local integer count# local string tmp# radix# if src# eq 0 function_return 0 // Special case move src# to tmp# // This removes superflous decimals get_attribute DF_DECIMAL_SEPARATOR to count# // Overload character count# to radix# // End overload if radix# in src# function_return (length(tmp#)-pos(radix#,tmp#)) move 0 to count# while (right(tmp#,1)="0") move (left(tmp#,length(tmp#)-1)) to tmp# decrement count# end function_return count# End_Function Function CurrentDecimalSeparator global returns string local integer rval# get_attribute DF_DECIMAL_SEPARATOR to rval# function_return (character(rval#)) End_Function Procedure Set CurrentDecimalSeparator global string value# set_attribute DF_DECIMAL_SEPARATOR to (ascii(value#)) End_Procedure // StripFromLastOccurance takes two strings (src# and val#) as // arguments. src# is scanned backwards for occurrances of substring // val#. If found, the function will return a string equal to src# // truncated at the first character of the right most occurance of substring // val#. // // StripFromLastOccurance("To be or not to be...","be") = "To be or not to " // StripFromLastOccurance("Mary had a little lamb","white") = "" // StripFromLastOccurance("Mary had a little lamb","") = "Mary had a little lamb" // Function StripFromLastOccurance global string src# string val# returns string local integer len# search_len# local string tmp# length val# to search_len# if search_len# eq 0 function_return src# repeat length src# to len# if len# le search_len# function_return "" move (right(src#,search_len#)) to tmp# if tmp# eq val# function_return (left(src#,len#-search_len#)) move (left(src#,len#-1)) to src# loop End_Function Function GetFromLastOccurance global string src# string val# returns string function_return (replace(StripFromLastOccurance(src#,val#),src#,"")) End_Function // (ExtractWord("item1 item2"," ",0)) = "" // (ExtractWord("item1 item2"," ",1)) = "item1" // (ExtractWord("item1 item2"," ",2)) = "item2" // (ExtractWord("item1 item2"," ",3)) = "" // (ExtractWord(" item1 item2 "," ",x)) = // (ExtractWord("item1 item2"," ",x)) // // source delimiters item number Function ExtractWord global string src# string dlm# integer itm# returns string local integer count# pos# in_item# len# local string rval# atom# move "" to rval# move 0 to count# move 0 to in_item# move (length(src#)) to len# for pos# from 1 to len# mid src# to atom# 1 pos# if in_item# begin if atom# in dlm# move 0 to in_item# else if count# eq itm# append rval# atom# end else begin ifnot atom# in dlm# begin increment count# move 1 to in_item# if count# eq itm# move atom# to rval# end end loop function_return rval# End_Function Function ExtractItem global string src# string dlm# integer itm# returns string Function_Return (ExtractWord(src#,dlm#,itm#)) End_Function // source delimiters Function HowManyWords global string src# string dlm# returns integer local integer count# pos# in_item# len# local string atom# move 0 to count# move 0 to in_item# move (length(src#)) to len# for pos# from 1 to len# mid src# to atom# 1 pos# if in_item# begin if atom# in dlm# move 0 to in_item# end else begin ifnot atom# in dlm# begin increment count# move 1 to in_item# end end loop function_return count# end_function Function HowManyItems global string src# string dlm# returns integer function_return (HowManyWords(src#,dlm#)) end_function Function ExtractWord2 global string src# string dlm# integer itm# returns string local integer count# pos# len# local string rval# char# move "" to rval# move 1 to count# move (length(src#)) to len# for pos# from 1 to len# mid src# to char# 1 pos# if char# in dlm# begin if itm# eq count# function_return rval# increment count# end else if itm# eq count# move (rval#+char#) to rval# loop function_return rval# End_Function // source delimiters Function HowManyWords2 global string src# string dlm# returns integer local integer count# pos# len# local string char# move 1 to count# move (length(src#)) to len# for pos# from 1 to len# mid src# to char# 1 pos# if char# in dlm# increment count# loop function_return count# end_function // source legal char item number Function ExtractItemNeg global string src# string lch# integer itm# returns string local integer count# pos# in_item# len# local string rval# atom# move "" to rval# move 0 to count# move 0 to in_item# move (length(src#)) to len# for pos# from 1 to len# mid src# to atom# 1 pos# if in_item# begin ifnot atom# in lch# move 0 to in_item# else if count# eq itm# append rval# atom# end else begin if atom# in lch# begin increment count# move 1 to in_item# if count# eq itm# move atom# to rval# end end loop function_return rval# end_function // ExtractInteger("123 456 789",0) = 0 // ExtractInteger("123 456 789",2) = 456 // ExtractInteger("123 456 789",4) = 0 function ExtractInteger global string str# integer itm# returns integer function_return (integer(ExtractItemNeg(str#,"0123456789",itm#))) end_function function HowManyIntegers global string str# returns integer local integer rval# pos# len# in_int# move 0 to in_int# //in integer? move 0 to rval# move (length(str#)) to len# for pos# from 1 to len# if (mid(str#,1,pos#)) in "0123456789" begin ifnot in_int# begin increment rval# move 1 to in_int# end end else if in_int# move 0 to in_int# loop function_return rval# end_function function IsIntegerPresent global string str# integer int# returns integer local integer max# itm# if str# eq "" function_return 0 move (HowManyIntegers(str#)) to max# for itm# from 1 to max# if (ExtractInteger(str#,itm#)=int#) function_return 1 loop function_return 0 end_function function AddIntegerToString global string str# integer int# returns string function_return (trim(str#+" "+string(int#))) end_function // This function is used to compose a new string from an existing string. This // is similar to the way Windows 95 generates 8.3 file names. // For example: StringIncrementId("STURE",8) = "STURE ~1" // StringIncrementId("STURE ~1",8) = "STURE ~2" // StringIncrementId("STURE ~2",8) = "STURE ~3" // etc... function StringIncrementId global string id# integer len# returns string local string char# if (mid(id#,1,len#-1)) eq "~" begin move (mid(id#,1,len#)) to char# if (ascii(char#)) lt 93 function_return (overstrike(character(ascii(char#)+1),id#,len#)) else function_return "" end function_return (overstrike("~1",id#,len#-1)) end_function function StringUppercaseFirstLetters global string str# returns string local integer len# pos# in_word# local string rval# char# move (lowercase(str#)) to str# move (length(str#)) to len# move 0 to in_word# for pos# from 1 to len# move (mid(str#,1,pos#)) to char# if char# eq "" move 0 to in_word# else begin ifnot in_word# begin uppercase char# to char# move 1 to in_word# end end move (rval#+char#) to rval# loop function_return rval# end_function function StringLeftBut global string str# integer but# returns string function_return (left(str#,length(str#)-but# max 0)) end_function function StringRightBut global string str# integer but# returns string function_return (right(str#,length(str#)-but# max 0)) end_function //> This function returns 1 if lsString is an integer and 2 if it //> is a number (the function does not currently handle thousand seps) function StringIsNumber global string lsString integer liDecSep returns integer local integer liLen liPos liDecSepFound liRval local string lsChar move 1 to liRval move 0 to liDecSepFound move (trim(lsString)) to lsString if (left(lsString,1)="-") move (replace("-",lsString,"")) to lsString move (length(lsString)) to liLen for liPos from 1 to liLen move (mid(lsString,1,liPos)) to lsChar if (ascii(lsChar)) eq liDecSep begin if liDecSepFound function_return 0 move 1 to liDecSepFound end else ifnot ("0123456789" contains lsChar) function_return 0 loop function_return liRval end_function function StringIsInteger global string lsString returns integer local integer liPos liLen move (trim(lsString)) to lsString if (left(lsString,1)="-") move (replace("-",lsString,"")) to lsString move (length(lsString)) to liLen for liPos from 1 to liLen ifnot (pos(mid(lsString,1,liPos),"0123456789")) function_return DFFALSE loop function_return DFTRUE end_function function StringFieldType global integer liType returns string if liType eq DF_ASCII function_return "ASCII" if liType eq DF_BCD function_return "Number" if liType eq DF_DATE function_return "Date" if liType eq DF_OVERLAP function_return "Overlap" if liType eq DF_TEXT function_return "Text" if liType eq DF_BINARY function_return "Binary" function_return "Un-defined" end_function function StringFieldLenText global integer liType integer liLen integer liDec returns string if liType eq DF_BCD function_return (NumToStr(liLen+(liDec/10.0),1)) else function_return (string(liLen)) end_function function StringFieldText global integer liType integer liLen integer liDec returns string local string lsRval move "# (#)" to lsRval replace "#" in lsRval with (StringFieldType(liType)) replace "#" in lsRval with (StringFieldLenText(liType,liLen,liDec)) function_return lsRval end_function function StringConsistsOf global string src# string tpl# returns integer local integer count# len# trim src# to src# move (length(src#)) to len# for count# from 1 to len# ifnot (mid(src#,1,count#)) in tpl# function_return 0 loop function_return 1 end_function function StringBeginsWith global string lsHostString string lsLeadInCharacters returns integer function_return (left(lsHostString,length(lsLeadInCharacters))=lsLeadInCharacters) end_function function StringEndsWith global string lsHostString string lsTrailingCharacters returns integer function_return (right(lsHostString,length(lsTrailingCharacters))=lsTrailingCharacters) end_function function StringReverse global string lsValue returns string local integer liLen liPos local string lsRval lsChar move "" to lsRval move (length(lsValue)) to liLen for_ex liPos from liLen down_to 1 move (lsRval+mid(lsValue,1,liPos)) to lsRval loop function_return lsRval end_function function StringHead global string lsValue string lsDlm returns string local integer liLen liPos move (length(lsValue)) to liLen for liPos from 1 to liLen if (lsDlm contains mid(lsValue,1,liPos)) function_return (left(lsValue,liPos-1)) loop function_return lsValue end_function function StringTail global string lsValue string lsDlm returns string local integer liLen liPos move (length(lsValue)) to liLen for liPos from 1 to liLen if (lsDlm contains mid(lsValue,1,liPos)) function_return (right(lsValue,liLen-liPos)) loop function_return "" end_function #IFDEF IS$WINDOWS // If function ConvertChar is not already defined we define it here: #IFDEF get_ConvertChar #ELSE use WinBase Function ConvertChar Global integer bToAnsi String sString Returns String Local Pointer psString Local Integer iVoid bIsCString Move (ascii(Right(sString,1))=0) to bIsCString If Not bISCString Append sString (character(0)) GetAddress Of sString To psString if bToAnsi Move (OEMToANSI(psString,psString)) To iVoid else Move (ANSItoOEM(psString,psString)) To iVoid Function_Return (if(bIsCString, sString, cstring(sString))) End_Function #ENDIF #ELSE // Only if UNIX or DOS class cNonWindowsCharConverter is a cArray procedure set CharConversion integer liChar integer liTo set value item liChar to (character(liTo)) end_procedure function sConvertString string lsValue returns string local integer liPos liLen local string lsRval lsChar lsNewChar move "" to lsRval move (length(lsValue)) to liLen for liPos from 1 to liLen move (mid(lsValue,1,liPos)) to lsChar get value item (ascii(lsChar)) to lsNewChar if (lsNewChar<>"") move (lsRval+lsNewChar) to lsRval else move (lsRval+lsChar) to lsRval loop function_return lsRval end_function end_class // cNonWindowsCharConverter desktop_section // This is a danish version: object oCharConvOemToAnsi is a cNonWindowsCharConverter NO_IMAGE set CharConversion 15 to 164 set CharConversion 20 to 182 set CharConversion 21 to 167 set CharConversion 128 to 199 set CharConversion 129 to 252 set CharConversion 130 to 233 set CharConversion 131 to 226 set CharConversion 132 to 228 set CharConversion 133 to 224 set CharConversion 134 to 229 set CharConversion 135 to 231 set CharConversion 136 to 234 set CharConversion 137 to 235 set CharConversion 138 to 232 set CharConversion 139 to 239 set CharConversion 140 to 238 set CharConversion 141 to 236 set CharConversion 142 to 196 set CharConversion 143 to 197 set CharConversion 144 to 201 set CharConversion 145 to 230 set CharConversion 146 to 198 set CharConversion 147 to 244 set CharConversion 148 to 246 set CharConversion 149 to 242 set CharConversion 150 to 251 set CharConversion 151 to 249 set CharConversion 152 to 255 set CharConversion 153 to 214 set CharConversion 154 to 220 set CharConversion 155 to 248 set CharConversion 156 to 163 set CharConversion 157 to 216 set CharConversion 158 to 215 set CharConversion 159 to 131 set CharConversion 160 to 225 set CharConversion 161 to 237 set CharConversion 162 to 243 set CharConversion 163 to 250 set CharConversion 164 to 241 set CharConversion 165 to 209 set CharConversion 166 to 170 set CharConversion 167 to 186 set CharConversion 168 to 191 set CharConversion 169 to 174 set CharConversion 170 to 172 set CharConversion 171 to 189 set CharConversion 172 to 188 set CharConversion 173 to 161 set CharConversion 174 to 171 set CharConversion 175 to 187 set CharConversion 176 to 166 set CharConversion 177 to 166 set CharConversion 178 to 166 set CharConversion 179 to 166 set CharConversion 180 to 166 set CharConversion 181 to 193 set CharConversion 182 to 194 set CharConversion 183 to 192 set CharConversion 184 to 169 set CharConversion 185 to 166 set CharConversion 186 to 166 set CharConversion 187 to 43 set CharConversion 188 to 43 set CharConversion 189 to 162 set CharConversion 190 to 165 set CharConversion 191 to 43 set CharConversion 192 to 43 set CharConversion 193 to 45 set CharConversion 194 to 45 set CharConversion 195 to 43 set CharConversion 196 to 45 set CharConversion 197 to 43 set CharConversion 198 to 227 set CharConversion 199 to 195 set CharConversion 200 to 43 set CharConversion 201 to 43 set CharConversion 202 to 45 set CharConversion 203 to 45 set CharConversion 204 to 166 set CharConversion 205 to 45 set CharConversion 206 to 43 set CharConversion 207 to 164 set CharConversion 208 to 240 set CharConversion 209 to 208 set CharConversion 210 to 202 set CharConversion 211 to 203 set CharConversion 212 to 200 set CharConversion 213 to 105 set CharConversion 214 to 205 set CharConversion 215 to 206 set CharConversion 216 to 207 set CharConversion 217 to 43 set CharConversion 218 to 43 set CharConversion 219 to 166 set CharConversion 220 to 95 set CharConversion 221 to 166 set CharConversion 222 to 204 set CharConversion 223 to 175 set CharConversion 224 to 211 set CharConversion 225 to 223 set CharConversion 226 to 212 set CharConversion 227 to 210 set CharConversion 228 to 245 set CharConversion 229 to 213 set CharConversion 230 to 181 set CharConversion 231 to 254 set CharConversion 232 to 222 set CharConversion 233 to 218 set CharConversion 234 to 219 set CharConversion 235 to 217 set CharConversion 236 to 253 set CharConversion 237 to 221 set CharConversion 238 to 175 set CharConversion 239 to 180 set CharConversion 240 to 173 set CharConversion 241 to 177 set CharConversion 242 to 61 set CharConversion 243 to 190 set CharConversion 244 to 182 set CharConversion 245 to 167 set CharConversion 246 to 247 set CharConversion 247 to 184 set CharConversion 248 to 176 set CharConversion 249 to 168 set CharConversion 250 to 183 set CharConversion 251 to 185 set CharConversion 252 to 179 set CharConversion 253 to 178 set CharConversion 254 to 166 set CharConversion 255 to 160 end_object // oCharConvOemToAnsi // This is a danish version: object oCharConvAnsiToOem is a cNonWindowsCharConverter NO_IMAGE set CharConversion 128 to 63 set CharConversion 129 to 63 set CharConversion 130 to 39 set CharConversion 131 to 159 set CharConversion 132 to 34 set CharConversion 133 to 46 set CharConversion 134 to 197 set CharConversion 135 to 206 set CharConversion 136 to 94 set CharConversion 137 to 37 set CharConversion 138 to 83 set CharConversion 139 to 60 set CharConversion 140 to 79 set CharConversion 141 to 63 set CharConversion 142 to 90 set CharConversion 143 to 63 set CharConversion 144 to 63 set CharConversion 145 to 39 set CharConversion 146 to 39 set CharConversion 147 to 34 set CharConversion 148 to 34 set CharConversion 149 to 7 set CharConversion 150 to 45 set CharConversion 151 to 45 set CharConversion 152 to 126 set CharConversion 153 to 84 set CharConversion 154 to 115 set CharConversion 155 to 62 set CharConversion 156 to 111 set CharConversion 157 to 63 set CharConversion 158 to 122 set CharConversion 159 to 89 set CharConversion 160 to 255 set CharConversion 161 to 173 set CharConversion 162 to 189 set CharConversion 163 to 156 set CharConversion 164 to 207 set CharConversion 165 to 190 set CharConversion 166 to 221 set CharConversion 167 to 245 set CharConversion 168 to 249 set CharConversion 169 to 184 set CharConversion 170 to 166 set CharConversion 171 to 174 set CharConversion 172 to 170 set CharConversion 173 to 240 set CharConversion 174 to 169 set CharConversion 175 to 238 set CharConversion 176 to 248 set CharConversion 177 to 241 set CharConversion 178 to 253 set CharConversion 179 to 252 set CharConversion 180 to 239 set CharConversion 181 to 230 set CharConversion 182 to 244 set CharConversion 183 to 250 set CharConversion 184 to 247 set CharConversion 185 to 251 set CharConversion 186 to 167 set CharConversion 187 to 175 set CharConversion 188 to 172 set CharConversion 189 to 171 set CharConversion 190 to 243 set CharConversion 191 to 168 set CharConversion 192 to 183 set CharConversion 193 to 181 set CharConversion 194 to 182 set CharConversion 195 to 199 set CharConversion 196 to 142 set CharConversion 197 to 143 set CharConversion 198 to 146 set CharConversion 199 to 128 set CharConversion 200 to 212 set CharConversion 201 to 144 set CharConversion 202 to 210 set CharConversion 203 to 211 set CharConversion 204 to 222 set CharConversion 205 to 214 set CharConversion 206 to 215 set CharConversion 207 to 216 set CharConversion 208 to 209 set CharConversion 209 to 165 set CharConversion 210 to 227 set CharConversion 211 to 224 set CharConversion 212 to 226 set CharConversion 213 to 229 set CharConversion 214 to 153 set CharConversion 215 to 158 set CharConversion 216 to 157 set CharConversion 217 to 235 set CharConversion 218 to 233 set CharConversion 219 to 234 set CharConversion 220 to 154 set CharConversion 221 to 237 set CharConversion 222 to 232 set CharConversion 223 to 225 set CharConversion 224 to 133 set CharConversion 225 to 160 set CharConversion 226 to 131 set CharConversion 227 to 198 set CharConversion 228 to 132 set CharConversion 229 to 134 set CharConversion 230 to 145 set CharConversion 231 to 135 set CharConversion 232 to 138 set CharConversion 233 to 130 set CharConversion 234 to 136 set CharConversion 235 to 137 set CharConversion 236 to 141 set CharConversion 237 to 161 set CharConversion 238 to 140 set CharConversion 239 to 139 set CharConversion 240 to 208 set CharConversion 241 to 164 set CharConversion 242 to 149 set CharConversion 243 to 162 set CharConversion 244 to 147 set CharConversion 245 to 228 set CharConversion 246 to 148 set CharConversion 247 to 246 set CharConversion 248 to 155 set CharConversion 249 to 151 set CharConversion 250 to 163 set CharConversion 251 to 150 set CharConversion 252 to 129 set CharConversion 253 to 236 set CharConversion 254 to 231 set CharConversion 255 to 152 end_object // oCharConvAnsiToOem end_desktop_section #ENDIF function StringAnsiToOem global string str# returns string #IFDEF IS$WINDOWS function_return (ConvertChar(0,str#)) #ELSE function_return (sConvertString(oCharConvAnsiToOem(self),str#)) #ENDIF end_function function StringOemToAnsi global string str# returns string #IFDEF IS$WINDOWS function_return (ConvertChar(1,str#)) #ELSE function_return (sConvertString(oCharConvOemToAnsi(self),str#)) #ENDIF end_function function RemoveDblBlanks global string lsValue returns string local integer fin# move 0 to fin# repeat move (replaces(" ",lsValue," ")) to lsValue ifnot " " in lsValue move 1 to fin# until fin# function_return lsValue end_function function ByteToHex global integer byte# returns string function_return (mid("0123456789ABCDEF",1,byte#/16+1)+mid("0123456789ABCDEF",1,(byte# iand 15)+1)) end_function function HexToByte global string lsHex returns integer function_return (pos(left(lsHex,1),"0123456789ABCDEF")-1*16+pos(right(lsHex,1),"0123456789ABCDEF")-1) end_function function Text_RemoveTrailingCr global string lsValue returns string local integer fin# local string char# char10# char255# char13# move 0 to fin# move (character(10)) to char10# move (character(13)) to char13# move (character(255)) to char255# repeat ifnot (length(lsValue)) function_return "" move (right(lsValue,1)) to char# if (char#=char10# or char#=" " or char#=char13# or char#=char255#) move (left(lsValue,(length(lsValue)-1))) to lsValue else move 1 to fin# until fin# function_return lsValue end_function function Text_RTrim global string lsValue returns string move (rtrim(replaces(character(255),lsValue," "))) to lsValue function_return (Text_RemoveTrailingCr(lsValue)) end_function function Text_Trim global string lsValue returns string move (trim(replaces(character(255),lsValue," "))) to lsValue function_return (Text_RemoveTrailingCr(lsValue)) end_function function Text_Compress global string lsValue returns string move (replaces(character(10),lsValue," ")) to lsValue trim lsValue to lsValue move (RemoveDblBlanks(lsValue)) to lsValue function_return lsValue end_function function Text_CompressSubstCr global string lsValue string new_line# returns string move (replaces(character(13),lsValue,"")) to lsValue function_return (RemoveDblBlanks(trim(replaces(character(10),Text_RemoveTrailingCr(lsValue),new_line#)))) end_function class cText_Formatter is an array procedure construct_object integer img# forward send construct_object img# property integer pRmargin public 40 property integer pCompress_state public 0 property integer pTrim_state public 1 // 0=no trim, 1=trim, 2=rtrim property integer pSubst_below_32_state public 0 end_procedure procedure add_item.s string lsValue local integer char# if (pSubst_below_32_state(self)) begin for char# from 0 to 31 move (replaces(character(char#),lsValue," ")) to lsValue loop end set array_value item (item_count(self)) to lsValue end_procedure function split_word string lsValue integer len# returns string local integer pos# local string rval# move (pos("-",lsValue)) to pos# if (pos# and pos#<=len#) move (replace("-",lsValue," ")) to rval# else begin move (left(lsValue,len#)) to rval# move (rval#+" "+replace(rval#,lsValue,"")) to rval# end function_return rval# // The space in the return value indicates end_function // where to split the word procedure format.s string lsValue local integer Trim_state# done# pRmargin# word_done# pos# max# len# local string word# line# lf# left# char# //pre-format: get pTrim_state to Trim_state# if Trim_state# eq 1 move (Text_Trim(lsValue)) to lsValue else if Trim_state# eq 2 move (Text_RTrim(lsValue)) to lsValue if (pCompress_state(self)) move (Text_Compress(lsValue)) to lsValue move (character(10)) to lf# get pRmargin to pRmargin# if pRmargin# gt 1 begin // Otherwise nothing makes sense! move 0 to done# move "" to line# move 1 to pos# move (length(lsValue)) to max# repeat move "" to word# move 0 to word_done# repeat if pos# gt max# move 1 to word_done# else begin mid lsValue to char# 1 pos# if char# eq lf# begin // Line feed if word# eq "" begin move lf# to word# increment pos# end move 1 to word_done# end else begin if char# eq "" begin if word# eq "" increment pos# else move 1 to word_done# end else begin move (word#+char#) to word# increment pos# end end end until word_done# if word# eq "" move 1 to done# // We're done! else begin if word# eq lf# begin // If hard return: send add_item.s line# move "" to line# end else begin // if (length(line#)+length(word#)+1) gt pRmargin# begin // Soft new line if line# ne "" begin send add_item.s line# // Could be that word is longer that pRmargin move "" to line# end if (length(word#)) gt pRmargin# begin // Word IS longer that line! repeat if line# eq "" move (pRmargin#-1) to len# else move (pRmargin#-length(line#)-2) to len# move (split_word(self,word#,len#)) to word# move (ExtractItem(word#," ",1)) to left# move (ExtractItem(word#," ",2)) to word# if word# eq "" move left# to line# else send add_item.s (left#+"-") until word# eq "" end else move word# to line# end else begin if line# ne "" move (line#+" "+word#) to line# // add word to line else move word# to line# end end end until done# if line# ne "" send add_item.s line# end end_procedure end_class // cText_Formatter desktop_section object oText_Formatter is a cText_Formatter no_image set pSubst_below_32_state to DFTRUE end_object end_desktop_section procedure Text_Format_Reset global send delete_data to (oText_Formatter(self)) end_procedure function Text_Format_LineCount global returns integer function_return (item_count(oText_Formatter(self))) end_function function Text_Format.sii global string lsValue integer liWidth integer lbReset returns integer local integer lhObj if lbReset send Text_Format_Reset move (oText_Formatter(self)) to lhObj set pRmargin of lhObj to liWidth send format.s to lhObj lsValue function_return (item_count(lhObj)) end_function function Text_FormattedLine.i global integer liLine returns string function_return (string_value(oText_Formatter(self),liLine)) end_function function Text_FormattedText global returns string local integer liItem liMax liObj local string lsRval move "" to lsRval move (oText_Formatter(self)) to liObj get item_count of liObj to liMax get Text_Format_LineCount to liMax decrement liMax for liItem from 0 to liMax move (lsRval+value(liObj,liItem)) to lsRval if liItem ne liMax move (lsRval+character(10)) to lsRval loop function_return lsRval end_function string gs$CollateString 255 // Here's the string object oCollateStringBuilder is an Array procedure MakeCollateString local integer liCharacter liMax liItem local string lsRval for liCharacter from 32 to 255 set value item (liCharacter-32) to (character(liCharacter)) loop send sort_items DESCENDING // We need them backwards get item_count to liMax decrement liMax move "" to lsRval for liItem from 0 to liMax move (lsRval+value(self,liItem)) to lsRval loop move (repeat(" ",31)+lsRval) to gs$CollateString send delete_data end_procedure send MakeCollateString end_object function String_NegateSortOrder global string lsValue returns string local integer liPos liLen local string lsRval lsChar move (length(lsValue)) to liLen move "" to lsRval for liPos from 1 to liLen move (mid(lsValue,1,liPos)) to lsChar move (lsRval+mid(gs$CollateString,1,ascii(lsChar))) to lsRval loop function_return lsRval end_function