::namespace eval ::qw::number {} /* { ::proc ::qw::number::scan_count {String SubString} { ::set Count 0; ::set First [::string first $SubString $String]; ::while {$First>=0} { ::incr Count; ::set First [::expr {$First+[::string length $SubString]}]; ::set First [::string first $SubString $String $First]; } ::return $Count; } */ } ::proc ::qw::number::abs {Arg} { ::if {$Arg>=0.0} { ::return $Arg; } ::return [::qw::number::negative $Arg]; } ::proc ::qw::number::scan {Arg} { ::return [::qw::real::scan $Arg]; } ::proc ::qw::number::sum {args} { ::set Result 0.0; ::foreach Number $args { ::qw::number::var::add Result $Number; } ::return $Result; } ::proc ::qw::number::round_to_cents {Amount} { ::set Amount [::qw::number::round2 $Amount]; ::return [::format %.2f $Amount]; } ::proc ::qw::number::cents {Amount} { ::set Amount [::qw::number::round2 $Amount]; ::return [::format %.2f $Amount]; } ::set ::qw::number::formats() { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 0 .maximum -1 } /null { } /zero { } /positive { } /negative { .left { .text "-" } } } ::set ::qw::number::formats(none) { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 0 .maximum -1 } /null { } /zero { } /positive { } /negative { .left { .text "-" } } } #2.28.3 ::set ::qw::number::formats(none_empty_zero) { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 0 .maximum -1 } /null { } /zero { .left { .minimum 0 } } /positive { } /negative { .left { .text "-" } } } #2.29.0 ::set ::qw::number::formats(none_zero_empty) { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 0 .maximum -1 } /null { } /zero { .left { .minimum 0 } } /positive { } /negative { .left { .text "-" } } } ::set ::qw::number::formats(none_minus_trailing) { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 0 .maximum -1 } /null { } /zero { } /positive { } /negative { .right { .text "-" } } } ::set ::qw::number::formats(none_minus_parentheses) { .decimal "." .group "" .group_size 0 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 0 .maximum -1 } /null { } /zero { } /positive { } /negative { .left { .text "( " } .right { .text " )" } } } ::set ::qw::number::formats(integer) { .decimal "" .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 0 .maximum 0 } /null { } /zero { } /positive { } /negative { .left { .text "-" } } } #2.29.0 ::set ::qw::number::formats(integer_zero_empty) { .decimal "" .group , .group_size 3 .left { .text " " .minimum 1 .maximum -1 } .right { .text " " .minimum 0 .maximum 0 } /null { } /zero { .left { .minimum 0 } .right { } } /positive { } /negative { .left { .text "(" } .right { .text ")" } } } ::set ::qw::number::formats(integer_minus_trailing) { .decimal "" .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 0 .maximum 0 } /null { } /zero { } /positive { } /negative { .right { .text "-" } } } ::set ::qw::number::formats(integer_minus_parentheses) { .decimal "" .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 0 .maximum 0 } /null { } /zero { } /positive { } /negative { .left { .text "( " } .right { .text " )" } } } ::set ::qw::number::formats(dollar) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 2 .maximum 2 } /null { } /zero { } /positive { } /negative { .left { .text "-" } } } ::set ::qw::number::formats(dollar_minus_trailing) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 2 .maximum 2 } /null { } /zero { } /positive { } /negative { .right { .text "-" } } } ::set ::qw::number::formats(dollar_minus_parentheses) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 2 .maximum 2 } /null { } /zero { } /positive { } /negative { .left { .text "( " } .right { .text " )" } } } #2.28.3 # - do we need /zero.right.maximum ? ::set ::qw::number::formats(dollar_minus_parentheses_zero_empty) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 2 .maximum 2 } /null { } /zero { .left { .minimum 0 } .right { .text "" .minimum 0 } } /positive { } /negative { .left { .text "( " } .right { .text " )" } } } ::set ::qw::number::formats(rate) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text "" .minimum 4 .maximum 4 } /null { } /zero { } /positive { } /negative { .left { .text "-" } } } ::set ::qw::number::formats(rate_minus_trailing) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 4 .maximum 4 } /null { } /zero { } /positive { } /negative { .right { .text "-" } } } ::set ::qw::number::formats(rate_minus_parentheses) { .decimal . .group , .group_size 3 .left { .text "" .minimum 1 .maximum -1 } .right { .text " " .minimum 4 .maximum 4 } /null { } /zero { } /positive { } /negative { .left { .text "(" } .right { .text ")" } } } /* { ::set ::qw::number::formats(test) { .decimal , .group " " .group_size 2 .left { .text "***** " .minimum 1 .maximum -1 } .right { .text " *****" .minimum 2 .maximum 2 } /null { } /zero { } /positive { } /negative { .left { .text "*****(" } .right { .text ")*****" } } } */ } /* { NV1 Date Formats 0 12/31/92 1 12/31 2 31-12-92 3 31-12 4 Dec 31,92 5 Dec 31 6 31 Dec 92 7 31 Dec 8 123192 9 1231 10 311292 11 3112 12 Dec3192 13 Dec31 14 31Dec92 15 31Dec 16 31Dec1992 NV2 ::qw::date::formats 1st group of 17 map to the NV1 date formats 2nd group of 7 are any NV1 formats with a 2-digit year extended to 4 digits The remainder are other various formats */} ::proc ::qw::number::format_whole_number {sargs} { /* { Hard-wired insertion of commas. Number must be integer and cannot be negative. Designed to format an integer, n0 matter how big. That is, we do not rely on "::string is integer" or "::string is wideint" and therefore we also don't care is we're in tcl 8.4 or 8.6, for example. We will do one thing, however. We'll take out any commas before proceeding, and we'll also return "0" for and empty source number. */ } ::set Number [::sargs::get $sargs .value]; ::set Number [::string trim $Number]; ::set Number [::string map [::list "," ""] $Number]; ::if {$Number eq ""} { ::return "0"; } ::set Size [::string length $Number]; ::set Result ""; /* { Didn't want to use string is wideinteger because tcl 8.4 doesn't have it. */ } ::for {::set i 0} {$i<$Size} {::incr i 1} { ::set Char [::string index $Number $i]; ::switch -- $Char { "0" - "1" - "2" - "3" - "4" - "5" - "6" - "7" - "8" - "9" { } default { ::qw::throw "[::qw::procname] - expected a whole number but encountered \"$Number\"."; } } ::append Result $Char; ::if {$i!=$Size-1&&($Size-$i-1)%3==0} { /* { Add a comma on every third digit unless the first digit (don't want a "leading comma"). */ } ::append Result ","; } } ::return $Result; } ::proc ::qw::number::format_integer {sargs} { /* { Hard-wired insertion of commas. Number must be integer (can be negative). See format_whole_number for more. */ } ::set Number [::sargs::get $sargs .value]; ::set Number [::string trim $Number]; ::set Number [::string map [::list "," ""] $Number]; ::if {$Number eq ""} { ::return "0"; } ::if {[::string index $Number 0] eq "-"} { /* { If we are given a negative number (leading hyphen) then format the positive part using format_whole_number and negate the result. */ } ::set Number [::string range $Number 1 end]; ::set Number [::qw::number::format_whole_number .value $Number]; ::return "-$Number"; } ::return [::qw::number::format_whole_number $sargs]; } ::namespace eval ::qw::dollar {} ::proc ::qw::dollar::scan {Arg} { ::set Result [::qw::number::scan $Arg]; ::if {$Result eq ""} {::return $Result;} ::set Result [::expr round($Result*100.0)/100.0]; ::return $Result; } #// ------------------------------------------------------------ #// ::qw::bob namespace #// ------------------------------------------------------------ ::namespace eval ::qw::bob {}; /* { NumberToWords Src: Any number up to 999 trillion (at present) May have decimal place and any number of digits after May be negative or positive Returns a list of 1 or 2 items If number is an integer, the return value is one item, the number converted to words If number has a decimal component, the 2nd element is the decimals converted to words DollarsToWords Src: Any number acceptable to NumberToWords Returns a 2 item list: The dollar part of the number in words The cents as "[#]# cent[s]" */} ::proc ::qw::bob::DollarsToWords {Src} { ::set Dollars $Src; ::set Cents "00"; ::set Decimal [::string first "." $Src]; ::set Result ""; ::if {$Decimal>=0} { ::set Cents [::string range $Dollars [::incr Decimal] end]; ::append Cents "00"; ::set Cents [::string range $Cents 0 1]; ::set Dollars [::string range $Dollars 0 [::incr Decimal -2]]; } ::set Words ""; ::if {$Dollars ne ""} { ::eval ::set Words [::qw::bob::NumberToWords $Dollars]; ::append Words " dollar"; ::if {$Dollars!=1} {::append Words "s";} } ::lappend Result $Words; ::if {[::string index $Cents 0] eq "0"} {::set Cents [::string index $Cents 1];} ::set Words "$Cents cent"; ::if {$Cents != 1} {::append Words "s";} ::lappend Result $Words; ::return $Result; } /* { proc forceInteger { x } { set count [scan $x %d%s n rest] if { $count <= 0 || ( $count == 2 && ![string is space $rest] ) } { return -code error "not an integer: \"$x\"" } return $n } */ } ::proc ::qw::bob::integer_force {Number} { /* { 2.34.4 Original Code borrowed from: https://wiki.tcl-lang.org/page/Tcl+and+octal+numbers See orginal above. */ } ::set Number [::string map [::list "," ""] $Number]; ::set Count [::scan $Number %d%s Result Rest] ::if { $Count <= 0 || ( $Count == 2 && ![string is space $Rest] ) } { ::qw::throw "Expected an integer but encountered \"$Number\"." } ::return $Result } ::proc ::qw::bob::NumberToWords {Src} { /* { # 2.35.4 Next line, call to integer_force added to avoid error when invalid octal encountered, i.e. when 08 or 09 encountered. Actually whenever the digit 8 or 9 appears in a number prefixed by 0. This occurs, for example, in the cents part of a dollar amount, we get an error like: expected boolean value but got "09" (looks like invalid octal number) Note that this error did not come up in tcl 8.4 but started in tcl 8.6. So there is a low-level change that has occurred after tcl 8.4. */ } ::set Src [::qw::bob::integer_force $Src]; # 2.35.4 ::set Src [::regsub -all \[^0-9.-\] $Src ""]; ::set Negative 0; ::if {[::regsub -all \[-\] $Src "" Temp]} { ::set Src $Temp; ::set Negative 1; } ::array set Place {1 "" 2 " thousand " 3 " million " 4 " billion " 5 " trillion "}; #// source: http://www.jimloy.com/math/billion.htm ::array set Place {6 " quadrillion " 7 " quintillion " 8 " sextillion " 9 " septillion "}; ::array set Place {10 " octillion " 11 " nonillion " 12 " decillion " 13 " undecillion "}; ::array set Place {14 " duodecillion " 15 " tredecillion " 16 " quattuordecillion "}; ::array set Place {17 " quindecillion " 18 " sexdecillion " 19 " septendecillion "}; ::array set Place {20 " octodecillion " 21 " novemdecillion " 22 " vigintillion "}; ::set Number ""; ::set Decimals "0"; ::set Decimal [::string first "." $Src]; ::if {$Decimal>=0} { ::set Decimals [::string range $Src [::incr Decimal] end]; ::set Src [::string range $Src 0 [::incr Decimal -2]]; } ::if {$Src} { /* { This is where we failed with an invalid octal number when we had a cheque with 08 or 09 cents. Tcl846 did not fail and Tcl869 reported an error. Therefore there is a subtle difference between 846 and 869. The call to the new integer_force proc above resolves to problem in tcl869. */ } ::set Count 1; ::while {$Src ne ""} { ::set Temp [::qw::bob::HundredsToWords [::string range $Src end-2 end]]; ::if {$Temp ne ""} {::set Number "$Temp$Place($Count)$Number";} ::if {[::string length $Src] > 3} { ::set Src [::string range $Src 0 end-3]; } else { ::set Src ""; } ::incr Count; } ::if {$Negative} {::set Number "minus $Number";} } else { ::set Number "zero"; } ::set Result ""; ::lappend Result $Number; # ::if {$Decimals == 0} {::return $Result;} # ::set DecimalWords ""; ::foreach Digit [::split $Decimals ""] { ::append DecimalWords "[::qw::bob::DigitToWords $Digit] "; } ::lappend Result [::string trimright $DecimalWords]; ::return $Result; } ::proc ::qw::bob::HundredsToWords {Src} { # Converts a number from 100-999 into text ::set Result ""; ::set Src [::string range "000$Src" end-2 end]; ::foreach {Hundreds Tens Ones} [::split $Src ""] {} # Convert the hundreds place ::if {$Hundreds} { ::set Result "[::qw::bob::DigitToWords $Hundreds] hundred"; } # Convert the tens place ::if {$Tens} { ::append Result " [::qw::bob::TensToWords $Tens$Ones]"; } else { # Convert the ones place ::if {$Ones} { ::append Result " [::qw::bob::DigitToWords $Ones]"; } } ::return [::string trimleft $Result]; } ::proc ::qw::bob::TensToWords {Src} { # Converts a number from 10 to 99 into text. ::set Src [::string range "00$Src" end-1 end]; ::switch -- $Src { "10" {::return "ten";} "11" {::return "eleven";} "12" {::return "twelve";} "13" {::return "thirteen";} "14" {::return "fourteen";} "15" {::return "fifteen";} "16" {::return "sixteen";} "17" {::return "seventeen";} "18" {::return "eighteen";} "19" {::return "nineteen";} default { ::switch -- [::string index $Src 0] { "2" {::set Result "twenty";} "3" {::set Result "thirty";} "4" {::set Result "forty";} "5" {::set Result "fifty";} "6" {::set Result "sixty";} "7" {::set Result "seventy";} "8" {::set Result "eighty";} "9" {::set Result "ninety";} default {::qw::bug "907020031003075903" "Bad number \"$Src\", first character must be a number from 2 to 9";} } ::set Src [::string index $Src end]; ::if {$Src} {::append Result " [::qw::bob::DigitToWords $Src]";} ::return $Result; } } } ::proc ::qw::bob::DigitToWords {Src} { # Converts a number from 1 to 9 into text. ::switch -- $Src { "" {::return "";} "0" {::return "zero";} "1" {::return "one";} "2" {::return "two";} "3" {::return "three";} "4" {::return "four";} "5" {::return "five";} "6" {::return "six";} "7" {::return "seven";} "8" {::return "eight";} "9" {::return "nine";} default {::qw::bug "907020031003080030" "Bad digit \"$Src\", should be digit from 0 to 9";} } } ::proc ::qw::bob::MakeTextAmount {s_args} { # s_args: # .amount The amount to convert # .font Font information in the form returned by [font configure] # .size The width in points to fill # .case "U" upper case, "L" lower case, "W" each word capitalized (default "L") # return: # .result The amount converted to words with # .size The resulting size in points. *** May be greater than args(-size) *** # # Validate/default the case arg ::set Case [::sargs::get $s_args ".case"]; ::if {$Case eq ""} {::set Case "L";} ::set Case [::string toupper $Case]; ::if {[::string first $Case "ULW"]<0} {::qw::throw "Invalid .case arg \"$Case\"";} # ::set TextAmount [::qw::bob::DollarsToWords [::sargs::get $s_args ".amount"]]; ::set TextAmount "[::lindex $TextAmount 0] and [::lindex $TextAmount 1]"; ::switch -- $Case { "U" {::set TextAmount [::string toupper $TextAmount];} "L" {::set TextAmount [::string tolower $TextAmount];} "W" { ::set Words ""; ::foreach Word [::split $TextAmount " "] {::lappend Words [::string totitle $Word]; ::set TextAmount [::join $Words " "];} } } ::set Font [::sargs::get $s_args ".font"]; ::set Size [::sargs::get $s_args ".size"]; ::return [::qw::bob::PadText [::list ".text" $TextAmount ".font" $Font ".size" $Size ".side" "B" ".character1" " " ".character2" "-"]]; } ::proc ::qw::bob::PadText {s_args} { # s_args: # .text The text to pad # .font Font information in the form returned by [font configure] # .size The width in points to fill # .character1 The character to add once to the end(s) of the text. (default " ") # .character2 The character used for remaining padding. (default "-") # .side Which sides to pad; L[EFT], R[IGHT], or B[OTH] (default "BOTH") # return ::qw::struture: # .result The padded text # .size The resulting size in points. *** May be greater than args(-size) if args(-text) without any padding is already to big *** # # Validate/default the pad characters ::set Character1 [::sargs::get $s_args ".character1"];::if {$Character1 eq ""} {::set Character1 " ";} ::set Character2 [::sargs::get $s_args ".character2"];::if {$Character2 eq ""} {::set Character2 "-";} # Validate/default the -side arg ::set Side [::sargs::get $s_args ".side"];::if {$Side eq ""} {::set Side "B";} ::set Side [::string toupper $Side]; ::if {[::string first $Side "LRB"]<0} {::qw::throw "Invalid -side arg \"$Side\"";} # Get the font info we need ::array set FontArray [::sargs::get $s_args ".font"]; ::set FontInfo [::list $FontArray(-family) $FontArray(-size) $FontArray(-weight) $FontArray(-slant)]; ::set Size [::sargs::get $s_args ".size"]; # ::set Text [::sargs::get $s_args ".text"]; ::set Target [::expr $Size*[tk scaling]]; ::set NewSize [::font measure $FontInfo $Text]; ::set Size $NewSize; ::set Char $Character1; ::while {1} { ::if {$NewSize>$Target} {::break;} ::if {$Side ne "L"} { ::set Test "$Text$Char"; ::set NewSize [::font measure $FontInfo $Test]; ::if {$NewSize>$Target} {::break;} ::set Text $Test; ::set Size $NewSize; } ::if {$Side ne "R"} { ::set Test "$Char$Text"; ::set NewSize [::font measure $FontInfo $Test]; ::if {$NewSize>$Target} {::break;} ::set Text $Test; ::set Size $NewSize; } ::set Char $Character2; } ::set Result [::sargs ".result" $Text]; ::set Result [::sargs::var::set Result ".size" [::expr int($Size/[tk scaling])]]; ::return $Result; } ::proc ::qw::bob::WrapText {s_args} { # s_args: # .text The text to word wrap # Character sequences of \n (the characters \ and n, not a newline char) # are considered unconditional line breaks. # .font Font information in the form returned by [font configure] # .size The width in points to fill # return: The 'wrapped' text as a list; each list item is a section of the # source text that fits within the size specified. # ::array set FontArray [::sargs::get $s_args ".font"]; ::set FontInfo [::list $FontArray(-family) $FontArray(-size) $FontArray(-weight) $FontArray(-slant)]; ::set Size [::sargs::get $s_args ".size"]; # ::set Src [::sargs::get $s_args ".text"]; ::set Target [::expr $Size*[tk scaling]]; ::set MaximumSize 0; # #//::set Target 90; #//::set Src "The quick brown fox, jumps over the lazy dog."; #//::set FontInfo {Courier 12 normal}; #//::puts "s_args==\"$s_args\""; #//::puts "Target==$Target"; ::set Result ""; ::foreach Sentence [::split [::string map {\\n \n} $Src] \n] { ::set Chunk ""; ::foreach Word [::split [::string trim $Sentence] " "] { ::if {$Chunk eq ""} { ::set Chunk $Word; ::continue; } ::set Test "$Chunk $Word"; ::set Size [::font measure $FontInfo $Test]; #//::puts "Test==\"$Test\" Size==$Size"; ::if {$Size<$Target} { ::set Chunk $Test; ::continue; } ::lappend Result $Chunk; ::set Size [::font measure $FontInfo $Chunk]; #//::puts "Chunk==\"$Chunk\" Size==$Size"; ::if {$Size>$MaximumSize} {::set MaximumSize $Size;} ::set Chunk $Word; } ::if {$Chunk ne ""} { ::lappend Result $Chunk; ::set Size [::font measure $FontInfo $Chunk]; ::if {$Size>$MaximumSize} {::set MaximumSize $Size;} } } #//::puts "Result==\"$Result\""; #//::foreach Line $Result {::puts "\"$Line\" [::font measure $FontInfo $Line]";} ::return $Result; } /* { ::proc ::qw::bob::FormatCheckAmount {Amount Format} args: Amount - The amount to be formatted. Format - A qw::structure that defines the format Sample: { .font {-family Arial -size 10 -weight normal -slant roman -underline 0 -overstrike 0} .size -1 .fill { .left "*" .right "*" .middle "" } .text "%Units% %Unit% and %decimals% %decimal%" .currency { .unit { .symbol {$} .singular "dollar" .plural "dollars" } .decimal { .singular "cent" .plural "cents" } } } Format Structure Fields: .font Font information used when padding the text to specified .size Format is same as result of Tk font configure. Required if .size>=0 .size Desired size (in points) after padding. Result will as close to .size as possible without exceeding .size .fill The characters used to fill/pad the text to .size .fill.left Character(s) to prepend to result .fill.right Character(s) to append to result .fill.middle Character(s) insert at position specified by %p% in .text At least one of the three must be non-null if .size>=0 .text The base string to be formatted and returned. % substitutions are used to complete the value. .currency .unit .symbol The currency sybmol to be substituted for %S% .singular The currency name to be substituted for %UNIT% when the amount is 1 .plural The currency name to be substituted for %UNIT% when the amount is <> 1 .decimal .singular The fractional currency name to be substituted for %DECIMAL% when decimal component is .01 .plural The fractional currency name to be substituted for %DECIMAL% when decimal component is <> .01 returns: ::qw::structure .result - The formatted text .size - The resulting size Note: The result .size *can* exceed the requested size if the text without any padding is larger then the requested size. % substitution performed on .text %UNITS% ONE THOUSAND %Units% One Thousand %units% one thousand %u% 1000 %U% 1,000 %DECIMALS% THREE %Decimals% Three %decimals% three %d% 3 %D% 03 %UNIT% DOLLAR (or DOLLARS) %Unit% Dollar (or Dollars) %unit% dollar (or dollars) %DECIMAL% CENT (or CENTS) %Decimal% Cent (or Cents) %decimal% cent (or cent) %S% .currency.unit.symbol %s% .currency.decimal.symbol %p% Position to fill with .fill.middle characters Known/Possible Bugs: - Only tested with .fill characters that are 1 character in length. Definately will be a problem is .fill.middle > 1 char. - Will likely croak if the Amount arg is non-numeric. Sample results: .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {-}{ }{-} Result=="------ One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents -----" .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {-}{ }{} Result=="----------- One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents " .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {}{ }{-} Result==" One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents -----------" .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {*}{ }{*} Result=="**** One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents ****" .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {*}{ }{} Result=="******** One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents " .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {}{ }{*} Result==" One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents ********" Note: The above examples are all to .size 330. The difference in the results apparent lengths is due to the fact that you are not viewing the result in the font specified for the test (which is a variable-width font). .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {}{ }{} Result==" One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents " .size 330 .text " %Units% %Unit% and %Decimals% %Decimal% " .fill {}{-}{} Result==" One Thousand Two Hundred Thirty Four Dollars and Fifty Six Cents " .size 330 .text " %Units% and %d%/100 " .fill {-}{ }{-} Result=="----------------- One Thousand Two Hundred Thirty Four and 56/100 ----------------" .size 330 .text " %Units% and %d%/100 " .fill {-}{ }{} Result=="--------------------------------- One Thousand Two Hundred Thirty Four and 56/100 " .size 330 .text " %Units% and %d%/100 " .fill {}{ }{-} Result==" One Thousand Two Hundred Thirty Four and 56/100 ---------------------------------" .size 330 .text " %Units% and %d%/100 " .fill {*}{ }{*} Result=="************** One Thousand Two Hundred Thirty Four and 56/100 *************" .size 330 .text " %Units% and %d%/100 " .fill {*}{ }{} Result=="*************************** One Thousand Two Hundred Thirty Four and 56/100 " .size 330 .text " %Units% and %d%/100 " .fill {}{ }{*} Result==" One Thousand Two Hundred Thirty Four and 56/100 ***************************" .size 330 .text " %Units% and %d%/100 " .fill {}{ }{} Result==" One Thousand Two Hundred Thirty Four and 56/100 " .size 330 .text " %Units% and %d%/100 " .fill {}{-}{} Result==" One Thousand Two Hundred Thirty Four and 56/100 " .size 330 .text " %Units%%p%%d%/100 " .fill {-}{ }{-} Result=="-------------- One Thousand Two Hundred Thirty Four 56/100 -------------" .size 330 .text " %Units%%p%%d%/100 " .fill {-}{ }{} Result=="--------------------- One Thousand Two Hundred Thirty Four 56/100 " .size 330 .text " %Units%%p%%d%/100 " .fill {}{ }{-} Result==" One Thousand Two Hundred Thirty Four 56/100 --------------------" .size 330 .text " %Units%%p%%d%/100 " .fill {*}{ }{*} Result=="************ One Thousand Two Hundred Thirty Four 56/100 ***********" .size 330 .text " %Units%%p%%d%/100 " .fill {*}{ }{} Result=="****************** One Thousand Two Hundred Thirty Four 56/100 " .size 330 .text " %Units%%p%%d%/100 " .fill {}{ }{*} Result==" One Thousand Two Hundred Thirty Four 56/100 ******************" .size 330 .text " %Units%%p%%d%/100 " .fill {}{ }{} Result==" One Thousand Two Hundred Thirty Four 56/100 " .size 330 .text " %Units%%p%%d%/100 " .fill {}{-}{} Result==" One Thousand Two Hundred Thirty Four-----------------------------------------56/100 " .size 330 .text " %Units% and %d%/100 %Unit% " .fill {-}{ }{-} Result=="----------- One Thousand Two Hundred Thirty Four and 56/100 Dollars -----------" .size 330 .text " %Units% and %d%/100 %Unit% " .fill {-}{ }{} Result=="---------------------- One Thousand Two Hundred Thirty Four and 56/100 Dollars " .size 330 .text " %Units% and %d%/100 %Unit% " .fill {}{ }{-} Result==" One Thousand Two Hundred Thirty Four and 56/100 Dollars ----------------------" .size 330 .text " %Units% and %d%/100 %Unit% " .fill {*}{ }{*} Result=="********* One Thousand Two Hundred Thirty Four and 56/100 Dollars *********" .size 330 .text " %Units% and %d%/100 %Unit% " .fill {*}{ }{} Result=="****************** One Thousand Two Hundred Thirty Four and 56/100 Dollars " .size 330 .text " %Units% and %d%/100 %Unit% " .fill {}{ }{*} Result==" One Thousand Two Hundred Thirty Four and 56/100 Dollars ******************" .size 330 .text " %Units% and %d%/100 %Unit% " .fill {}{ }{} Result==" One Thousand Two Hundred Thirty Four and 56/100 Dollars " .size 330 .text " %Units% and %d%/100 %Unit% " .fill {}{-}{} Result==" One Thousand Two Hundred Thirty Four and 56/100 Dollars " .size 330 .text " %Units% %Unit% " .fill {-}{}{-} Result=="-------------------- One Thousand Two Hundred Thirty Four Dollars -------------------" .size 330 .text " %Units% %Unit% " .fill {-}{}{} Result=="--------------------------------------- One Thousand Two Hundred Thirty Four Dollars " .size 330 .text " %Units% %Unit% " .fill {}{}{-} Result==" One Thousand Two Hundred Thirty Four Dollars ---------------------------------------" .size 330 .text " %Units% %Unit% " .fill {*}{}{*} Result=="**************** One Thousand Two Hundred Thirty Four Dollars ***************" .size 330 .text " %Units% %Unit% " .fill {*}{}{} Result=="******************************* One Thousand Two Hundred Thirty Four Dollars " .size 330 .text " %Units% %Unit% " .fill {}{}{*} Result==" One Thousand Two Hundred Thirty Four Dollars *******************************" .size 330 .text " %Units% " .fill {-}{}{-} Result=="------------------------- One Thousand Two Hundred Thirty Four -------------------------" .size 330 .text " %Units% " .fill {-}{}{} Result=="-------------------------------------------------- One Thousand Two Hundred Thirty Four " .size 330 .text " %Units% " .fill {}{}{-} Result==" One Thousand Two Hundred Thirty Four --------------------------------------------------" .size 330 .text " %Units% " .fill {*}{}{*} Result=="******************** One Thousand Two Hundred Thirty Four ********************" .size 330 .text " %Units% " .fill {*}{}{} Result=="**************************************** One Thousand Two Hundred Thirty Four " .size 330 .text " %Units% " .fill {}{}{*} Result==" One Thousand Two Hundred Thirty Four ****************************************" .size -1 .text "%d%" .fill {-}{}{-} Result=="56" .size -1 .text "%d%" .fill {-}{}{} Result=="56" .size -1 .text "%d%" .fill {}{}{-} Result=="56" .size -1 .text "%d%" .fill {*}{}{*} Result=="56" .size -1 .text "%d%" .fill {*}{}{} Result=="56" .size -1 .text "%d%" .fill {}{}{*} Result=="56" .size -1 .text "%d%/100" .fill {-}{}{-} Result=="56/100" .size -1 .text "%d%/100" .fill {-}{}{} Result=="56/100" .size -1 .text "%d%/100" .fill {}{}{-} Result=="56/100" .size -1 .text "%d%/100" .fill {*}{}{*} Result=="56/100" .size -1 .text "%d%/100" .fill {*}{}{} Result=="56/100" .size -1 .text "%d%/100" .fill {}{}{*} Result=="56/100" .size 80 .text "%U%.%D%" .fill {-}{*}{-} Result=="-------1,234.56-------" .size 80 .text "%U%.%D%" .fill {-}{*}{} Result=="--------------1,234.56" .size 80 .text "%U%.%D%" .fill {}{*}{-} Result=="1,234.56--------------" .size 80 .text "%U%.%D%" .fill {*}{*}{*} Result=="******1,234.56*****" .size 80 .text "%U%.%D%" .fill {*}{*}{} Result=="***********1,234.56" .size 80 .text "%U%.%D%" .fill {}{*}{*} Result=="1,234.56***********" .size 80 .text "%U%.%D%" .fill {}{*}{} Result=="1,234.56" .size 80 .text "%S%%U%.%D%" .fill {-}{*}{-} Result=="------$1,234.56------" .size 80 .text "%S%%U%.%D%" .fill {-}{*}{} Result=="------------$1,234.56" .size 80 .text "%S%%U%.%D%" .fill {}{*}{-} Result=="$1,234.56------------" .size 80 .text "%S%%U%.%D%" .fill {*}{*}{*} Result=="*****$1,234.56****" .size 80 .text "%S%%U%.%D%" .fill {*}{*}{} Result=="*********$1,234.56" .size 80 .text "%S%%U%.%D%" .fill {}{*}{*} Result=="$1,234.56*********" .size 80 .text "%S%%U%.%D%" .fill {}{*}{} Result=="$1,234.56" .size 80 .text "%U%.%D%%S%" .fill {-}{*}{-} Result=="------1,234.56$------" .size 80 .text "%U%.%D%%S%" .fill {-}{*}{} Result=="------------1,234.56$" .size 80 .text "%U%.%D%%S%" .fill {}{*}{-} Result=="1,234.56$------------" .size 80 .text "%U%.%D%%S%" .fill {*}{*}{*} Result=="*****1,234.56$****" .size 80 .text "%U%.%D%%S%" .fill {*}{*}{} Result=="*********1,234.56$" .size 80 .text "%U%.%D%%S%" .fill {}{*}{*} Result=="1,234.56$*********" .size 80 .text "%U%.%D%%S%" .fill {}{*}{} Result=="1,234.56$" .size 80 .text "%S%%p%%u%.%D%" .fill {-}{*}{-} Result=="----$****1234.56----" .size 80 .text "%S%%p%%u%.%D%" .fill {-}{*}{} Result=="------$*****1234.56" .size 80 .text "%S%%p%%u%.%D%" .fill {}{*}{-} Result=="$******1234.56-----" .size 80 .text "%S%%p%%u%.%D%" .fill {*}{*}{*} Result=="****$***1234.56***" .size 80 .text "%S%%p%%u%.%D%" .fill {*}{*}{} Result=="*****$*****1234.56" .size 80 .text "%S%%p%%u%.%D%" .fill {}{*}{*} Result=="$*****1234.56*****" .size 80 .text "%S%%p%%u%.%D%" .fill {}{*}{} Result=="$**********1234.56" */} ::proc ::qw::bob::FormatCheckAmount {Amount Format} { ::set Units $Amount; ::set Decimals "00"; ::set Index [::string first "." $Amount]; ::if {$Index>=0} { ::set Decimals [::string range $Units [::incr Index] end]; ::append Decimals "00"; ::set Decimals [::string range $Decimals 0 1]; ::set Units [::string range $Units 0 [::incr Index -2]]; } ::set Result [::sargs::get $Format ".text"]; # #// Currency Symbol ::regsub -all %S% $Result [::sargs::get $Format ".currency.unit.symbol"] Result; ::regsub -all %s% $Result [::sargs::get $Format ".currency.decimal.symbol"] Result; # #// Units (dollars) ::set UnitWords [::lindex [::qw::bob::NumberToWords $Units] 0]; ::regsub -all %units% $Result [::string tolower $UnitWords] Result; ::regsub -all %units% $Result [::string toupper $UnitWords] Result; ::if {[::string first %Units% $Result]>=0} { ::set Text ""; ::foreach Word $UnitWords { ::append Text " [::string totitle $Word]"; } ::regsub -all %Units% $Result [::string trimleft $Text] Result; } ::regsub -all %u% $Result $Units Result; ::regsub -all %U% $Result [::qw::number::format $Units $::qw::number::formats(integer)] Result; # #// Decimals (cents) ::set DecimalWords [::lindex [::qw::bob::NumberToWords $Decimals] 0]; ::regsub -all %decimals% $Result [::string tolower $DecimalWords] Result; ::regsub -all %DECIMALS% $Result [::string toupper $DecimalWords] Result; ::if {[::string first %Decimals% $Result]>=0} { ::set Text ""; ::foreach Word $DecimalWords { ::append Text " [::string totitle $Word]"; } ::regsub -all %Decimals% $Result [::string trimleft $Text] Result; } ::regsub -all %D% $Result $Decimals Result; ::if {[::string index $Decimals 0] eq "0"} {::set Decimals [::string index $Decimals 1];} ::if {[::string first %d% $Result]>=0} { ::regsub -all %d% $Result $Decimals Result; } # #// Unit (Currency unit) ::if {[::string first %UNIT% [::string toupper $Result]]>=0} { #20050927_build_change_1.b # ::if {$Units!=1||$Decimals!=1} {} ::if {$Units!=1} { ::set UnitWord [::sargs::get $Format ".currency.unit.plural"]; } else { ::set UnitWord [::sargs::get $Format ".currency.unit.singular"]; } ::regsub -all %unit% $Result [::string tolower $UnitWord] Result; ::regsub -all %UNIT% $Result [::string toupper $UnitWord] Result; ::if {[::string first %Unit% $Result]>=0} { ::set Text ""; ::foreach Word $UnitWord { ::append Text " [::string totitle $Word]"; } ::regsub -all %Unit% $Result [::string trimleft $Text] Result; } } # #// Decimal (Currency decimal unit) ::if {[::string first %DECIMAL% [::string toupper $Result]]>=0} { ::if {$Decimals!=1} { ::set DecimalWord [::sargs::get $Format ".currency.decimal.plural"]; } else { ::set DecimalWord [::sargs::get $Format ".currency.decimal.singular"]; } ::regsub -all %decimal% $Result [::string tolower $DecimalWord] Result; ::regsub -all %DECIMAL% $Result [::string toupper $DecimalWord] Result; ::if {[::string first %Decimal% $Result]>=0} { ::set Text ""; ::foreach Word $DecimalWord { ::append Text " [::string totitle $Word]"; } ::regsub -all %Decimal% $Result [::string trimleft $Text] Result; } } ::set Size [::sargs::get $Format ".size"]; ::if {$Size eq ""||$Size<=0} {::return $Result;} # #// Size ::set LeftFill [::sargs::get $Format ".fill.left"]; ::set RightFill [::sargs::get $Format ".fill.right"]; ::set MiddleFill [::sargs::get $Format ".fill.middle"]; ::if {$LeftFill eq ""&&$RightFill eq ""} { ::if {$MiddleFill eq ""} { ::qw::throw "No .fill characters specified."; } } ::set Index [::string first %p% $Result]; ::if {$MiddleFill eq ""} { ::if {$Index>=0} { ::qw::throw ".text contains %p% but .fill.middle is empty."; } } ::array set FontArray [::sargs::get $Format ".font"]; ::set FontInfo [::list $FontArray(-family) $FontArray(-size) $FontArray(-weight) $FontArray(-slant)]; # ::set Target [::expr $Size*[tk scaling]]; ::set NewSize [::font measure $FontInfo $Result]; ::set Size $NewSize; ::set OldSize $NewSize; # ::if {$Index>=0} { ::set Result [::string replace $Result $Index [::expr $Index+2]]; ::incr Index -1; } else { ::set MiddleFill ""; } ::while {1} { ::if {$LeftFill ne ""} { ::set Test "$LeftFill$Result"; ::set NewSize [::font measure $FontInfo $Test]; ::if {$NewSize>$Target} {::break;} ::set Result $Test; ::set Size $NewSize; ::incr Index; } ::if {$MiddleFill ne ""} { ::set Test [::string replace $Result $Index $Index "[::string index $Result $Index]$MiddleFill"]; ::set NewSize [::font measure $FontInfo $Test]; ::if {$NewSize>$Target} {::break;} ::set Result $Test; ::set Size $NewSize; ::incr Index; } ::if {$RightFill ne ""} { ::set Test "$Result$RightFill"; ::set NewSize [::font measure $FontInfo $Test]; ::if {$NewSize>$Target} {::break;} ::set Result $Test; ::set Size $NewSize; } ::if {$Size==$OldSize} {::break;} } #//::return $Result; ::return [::sargs ".result" $Result ".size" [::expr int($Size/[tk scaling])]]; } #20050927_build_change_1.b /* { ::proc ::qw::bob::check_ocr_date_formats_list {} { ::return { "DDMMYYYY" "D D M M Y Y Y Y" "MMDDYYYY" "M M D D Y Y Y Y" "YYYYMMDD" "Y Y Y Y M M D D" } } */ } ::proc ::qw::bob::check_ocr_date_formats_list {} { ::return { "DDMMYYYY" "MMDDYYYY" "YYYYMMDD" "DD MM YYYY" "MM DD YYYY" "YYYY MM DD" "DD-MM-YYYY" "MM-DD-YYYY" "YYYY-MM-DD" "DD.MM.YYYY" "MM.DD.YYYY" "YYYY.MM.DD" "D D M M Y Y Y Y" "M M D D Y Y Y Y" "Y Y Y Y M M D D" "Mmm dd,yy" "Mmm dd,yyyy" "Month dd,yyyy" } } ::proc ::qw::bob::check_asterisk_amount_formats {} { ::return { {.sample {**********1,234.56} .format {.text "%U%.%D%" .fill {.left {*} .middle {*} .right {}}}} {.sample {*********$1,234.56} .format {.text "%S%%U%.%D%" .fill {.left {*} .middle {*} .right {}}}} {.sample {$*********1,234.56} .format {.text "%S%%p%%u%.%D%" .fill {.left {} .middle {*} .right {}}}} } } ::proc ::qw::bob::check_asterisk_amount_formats_list {} { ::set Result ""; ::foreach Structure [check_asterisk_amount_formats] { ::lappend Result [::sargs::get $Structure ".sample"]; } ::return $Result; } ::proc ::qw::bob::check_text_amount_formats {} { ::return { {.sample {Five Dollars and Six Cents----------} .format {.text { %Units% %Unit% and %Decimals% %Decimal%} .fill {.left {} .middle { } .right {-}}}} {.sample {---- Five Dollars and Six Cents ----} .format {.text { %Units% %Unit% and %Decimals% %Decimal% } .fill {.left {-} .middle { } .right {-}}}} {.sample {--------- Five Dollars and Six Cents} .format {.text { %Units% %Unit% and %Decimals% %Decimal%} .fill {.left {-} .middle { } .right {}}}} {.sample {--------- Five and 6/100 -----------} .format {.text { %Units% and %d%/100 } .fill {.left {-} .middle { } .right {-}}}} {.sample {--------------------- Five and 6/100} .format {.text { %Units% and %d%/100} .fill {.left {-} .middle { } .right {}}}} {.sample {Five---------------------------6/100} .format {.text {%Units%%p%%d%/100} .fill {.left {} .middle {-} .right {}}}} {.sample {Five and 6/100 ---------------------} .format {.text {%Units% and %d%/100 } .fill {.left {} .middle { } .right {-}}}} {.sample {----- Five and 6/100 Dollars -------} .format {.text { %Units% and %d%/100 %Unit% } .fill {.left {-} .middle { } .right {-}}}} {.sample {------------- Five and 6/100 Dollars} .format {.text { %Units% and %d%/100 %Unit%} .fill {.left {-} .middle { } .right {}}}} {.sample {Five and 6/100 Dollars -------------} .format {.text {%Units% and %d%/100 %Unit% } .fill {.left {} .middle { } .right {-}}}} {.sample {Five Dollars and Six Cents**********} .format {.text { %Units% %Unit% and %Decimals% %Decimal%} .fill {.left {} .middle { } .right {*}}}} {.sample {**** Five Dollars and Six Cents ****} .format {.text { %Units% %Unit% and %Decimals% %Decimal% } .fill {.left {*} .middle { } .right {*}}}} {.sample {********* Five Dollars and Six Cents} .format {.text { %Units% %Unit% and %Decimals% %Decimal%} .fill {.left {*} .middle { } .right {}}}} {.sample {********* Five and 6/100 ***********} .format {.text { %Units% and %d%/100 } .fill {.left {*} .middle { } .right {*}}}} {.sample {********************* Five and 6/100} .format {.text { %Units% and %d%/100} .fill {.left {*} .middle { } .right {}}}} {.sample {Five***************************6/100} .format {.text {%Units%%p%%d%/100} .fill {.left {} .middle {*} .right {}}}} {.sample {Five and 6/100 *********************} .format {.text {%Units% and %d%/100 } .fill {.left {} .middle { } .right {*}}}} {.sample {***** Five and 6/100 Dollars *******} .format {.text { %Units% and %d%/100 %Unit% } .fill {.left {*} .middle { } .right {*}}}} {.sample {************* Five and 6/100 Dollars} .format {.text { %Units% and %d%/100 %Unit%} .fill {.left {*} .middle { } .right {}}}} {.sample {Five and 6/100 Dollars *************} .format {.text {%Units% and %d%/100 %Unit% } .fill {.left {} .middle { } .right {*}}}} } } ::proc ::qw::bob::check_text_amount_formats_list {} { ::set Result ""; ::foreach Structure [check_text_amount_formats] { ::lappend Result [::sargs::get $Structure ".sample"]; } ::return $Result; } ::proc ::qw::bob::format_list {Src {Word {or}}} { ::if {[::llength $Src]==1} {::return "\"$Src\"";} ::foreach Item [::lrange $Src 0 end-1] { ::append Result " \"$Item\""; } ::return "$Result $Word \"[::lindex $Src end]\""; } ::proc ::qw::incr_safe {Src {Step {1}}} { ::regexp {([^0-9]*)(0*)([0-9]*)(\.*)([0-9]*)(.*)} $Src match Text1 Zeros Number Dot Decimals Text2; ::set Value $Number$Dot$Decimals; ::if {$Value eq ""} { ::if {$Zeros eq ""} { ::return ${Text1}1$Text2; } else { ::set Zeros [::string replace end end 1]; ::return $Text1$Zeros$Text2; } } #::set NewValue [::expr $Value+1]; ::qw::try { ::set NewValue [::qw::number::add $Value $Step]; } catch Exception { ::qw::throw [::sargs \ .text "Encountered an unexpected error attempting to increment the value $Src" \ .help_id 907020050328135130 \ .value $Src \ ]; } ::set NewValue [::qw::integer::scan $NewValue]; ::if {$Zeros ne ""} { ::if {[::string length $NewValue]>[::string length $Value]} { ::set Zeros [::string range $Zeros 1 end]; } else { ::if {[::string length $NewValue]<[::string length $Value]} { ::set Zeros 0$Zeros; } } } ::return $Text1$Zeros$NewValue$Text2; } ::proc ::qw::incr_safe2 {Src {Step "1"}} { /* { Incrments an alphanumeric. A1 -> A2 */ } ::if {$Src eq ""} { ::return $Step; } ::if {[::string is integer $Src]} { /* { WARNING: string is integer returns 0 on integers greater than 2**32-1. Found this in 2.15.0 when testing on large reference numbers while testing the new unique reference numbers feature. In this case the integer reference did not increment and we ended up attempting to create a transaction with a duplicate reference. */ } ::return [::incr Src $Step]; } ::if {[::regexp {(.*)([^0-9])(0*)([0-9]+)$} $Src match All NonNumeric LeadingZeros Number]} { ::set NewNumber $Number; ::incr NewNumber $Step; ::set Result $All$NonNumeric$LeadingZeros$NewNumber; ::set SizeChange [::expr [::string length $NewNumber]-[::string length $Number]]; ::if {!$SizeChange||$LeadingZeros eq ""} { ::return $Result; } ::if {$SizeChange>0} { ::set LeadingZeros [::string range $LeadingZeros $SizeChange end]; } else { ::set LeadingZeros $LeadingZeros[::string repeat 0 $SizeChange]; } ::return $All$NonNumeric$LeadingZeros$NewNumber } ::return $Src }