Module cFormatter.pkg
1//****************************************************************************//
2// //
3// $File name : cFormatter.pkg //
4// $File title : cFormatter class (private class) //
5// $Author(s) : John Tuohy //
6// //
7// Confidential Trade Secret. //
8// Copyright 1999 Data Access Corporation, Miami FL, USA //
9// All Rights reserved //
10// DataFlex is a registered trademark of Data Access Corporation. //
11// //
12// $Rev History //
13// //
14// 25.08.99 Created //
15//****************************************************************************//
16use VDFBase.pkg
17
18{ Visibility=Private ClassLibrary=Common }
19Class cFormatter is an cObject
20
21 Procedure Construct_object
22 Integer iCh
23 forward send construct_object
24 Property String psCurrencySymbol
25 Set psCurrencySymbol to (Default_Currency_Symbol())
26
27 Property string psLeft
28 Property string psright
29 Property integer pbThousandsSep
30 Property integer piPoints
31
32 Property string psCurPosLeft
33 Property string psCurPosright
34 Property integer pbCurPosThousandsSep
35 Property integer piCurPosPoints
36
37 Property string psCurNegLeft
38 Property string psCurNegright
39 Property integer pbCurNegThousandsSep
40 Property integer piCurNegPoints
41
42 Property string psNumPosLeft
43 Property string psNumPosright
44 Property integer pbNumPosThousandsSep
45 Property integer piNumPosPoints
46
47 Property string psNumNegLeft
48 Property string psNumNegright
49 Property integer pbNumNegThousandsSep
50 Property integer piNumNegPoints
51
52 Send SetFormat "$,#.##;($,#.##)" true // currency
53 Send SetFormat ",#.*" false // numeric
54
55 end_procedure
56
57 // internal
58 // parse passed format string and set temporary properties with result
59 //
60 Procedure ParseFormat string sFmt
61
62 string sLeft sRight sDigit
63 integer bSep iPos i iDigits
64
65 // replace any literals. A "/" followed by anything.
66 // some literals are special. $ . , / #
67 Move (Replaces("/$",sFmt,Character(1))) to sFmt
68 Move (Replaces("/.",sFmt,Character(2))) to sFmt
69 Move (Replaces("/,",sFmt,Character(3))) to sFmt
70 Move (Replaces("/"+"/",sFmt,Character(4))) to sFmt
71 Move (Replaces("/#",sFmt,Character(5))) to sFmt
72 Move (Character(9)) to sDigit
73 Move (Replaces("#",sFmt,sDigit)) to sFmt
74 Move (Replaces("/",sFmt,"")) to sFmt // replace all others
75
76 Move (Pos(",",sFmt)) to bSep // if we have any , we use thousand seps
77 If bSep Move (Replaces(",",sFmt,"")) to sFmt // remove all ,
78
79 Move (Replaces("$",sFmt,psCurrencySymbol(self))) to sFmt // replace any $ with currency symbol
80
81 Move (Pos(".",sFmt)) to iPos // position of decimal
82
83 // Move all the special literals back into place before parsing
84 Move (Replaces(Character(1),sFmt,"$")) to sFmt
85 Move (Replaces(Character(2),sFmt,".")) to sFmt
86 Move (Replaces(Character(3),sFmt,",")) to sFmt
87 Move (Replaces(Character(4),sFmt,"/")) to sFmt
88 Move (Replaces(Character(5),sFmt,"#")) to sFmt
89
90 If (iPos>0) Begin // if we have a decimanl point
91 Move 1 to i // look for first non # to right and count the #s
92 If (mid(sFmt,1,iPos+i)="*") Begin // the "*" is special. It means as many as you want
93 Move -2 to iDigits
94 increment i
95 end
96 While (mid(sFmt,1,iPos+i)=sDigit)
97 Increment i
98 end
99 Move (Mid(sFmt,255,iPos+i)) to sRight // everything to the right of the last # is format stuff
100 If (iDigits=0) Move (i-1) to iDigits
101 //
102 Move 1 to i // find the first non-# to the left of the point
103 While (mid(sFmt,1,iPos-i)=sDigit) // everything to the left is format stuff
104 increment i
105 end
106 Move (left(sFmt,iPos-i)) to sLeft
107 end
108 else begin // we have no decinal
109 Move 0 to iDigits // so points is none
110 Move (Pos(sDigit,sFmt)) to iPos // find first #.
111 If (iPos=0) Begin // if none, entire string is left format stuff..wierd!
112 Move sFmt to sLeft
113 Move "" to sRight
114 end
115 else begin
116 Move (left(sFmt,iPos-1)) to sLeft // all char to left of first # is left format stuff
117 Move 1 to i
118 While (mid(sFmt,1,iPos+i)=sDigit) // find last #, all char to right is right format
119 Increment i
120 end
121 Move (Mid(sFmt,255,i+iPos)) to sRight
122 end
123 end
124 // set temporary format properties and exit
125 Set pbThousandsSep to bSep
126 set psLeft to sLeft
127 set psRight to sRight
128 Set piPoints to iDigits
129 End_procedure
130
131 // Public: Sets a format string. Pass full format for Positve and negative in sFmt. Pass
132 // bCurrency true is this is a currency format, false if a numeric format
133 //
134 // e.g. Send SetFormat "$,#.##;($,#.##)" True
135 //
136 Procedure SetFormat string sFmt integer bCurrency
137 string sPos sNeg
138 integer iPos
139
140 Move (Pos(";",sFmt)) to iPos
141 If iPos begin
142 Move (left(sFmt,iPos-1)) to sPos
143 Move (mid(sFmt,255,iPos+1)) to sNeg
144 end
145 else Begin
146 Move sFmt to sPos
147 Move ("-" + sFmt) to sNeg
148 end
149 Send ParseFormat sPos
150 If bCurrency begin
151 Set pbCurPosThousandsSep to (pbThousandsSep(self))
152 set psCurPosLeft to (psLeft(self))
153 set psCurPosRight to (psRight(self))
154 Set piCurPosPoints to (piPoints(self))
155 End
156 else Begin
157 Set pbNumPosThousandsSep to (pbThousandsSep(self))
158 set psNumPosLeft to (psLeft(self))
159 set psNumPosRight to (psRight(self))
160 Set piNumPosPoints to (piPoints(self))
161 end
162
163 Send ParseFormat sNeg
164 If bCurrency begin
165 Set pbCurNegThousandsSep to (pbThousandsSep(self))
166 set psCurNegLeft to (psLeft(self))
167 set psCurNegRight to (psRight(self))
168 Set piCurNegPoints to (piPoints(self))
169 End
170 else Begin
171 Set pbNumNegThousandsSep to (pbThousandsSep(self))
172 set psNumNegLeft to (psLeft(self))
173 set psNumNegRight to (psRight(self))
174 Set piNumNegPoints to (piPoints(self))
175 end
176 End_procedure
177
178 // low level formatting. Pass parameters
179 Function Format_Num number nNumber integer iPoints integer bSep ;
180 string sPrefix string sSuffix returns string
181 string sLeft sRight sNumber sSep sDec
182 integer bIsNegative iDec iLen iCh
183
184 Get_Attribute DF_DECIMAL_SEPARATOR to iCh
185 Move (Character(iCh)) to sDec
186
187 Move (abs(nNumber)) to sNumber
188 Move (Pos(sDec,sNumber)) to iDec
189 Move (If(iDec=0, sNumber, left(sNumber,iDec-1))) to sLeft
190 Move (If(iDec=0, "", mid(sNumber,255,iDec+1))) to sRight
191 // format for decimal separator
192 If (iPoints>=0) ; // if -2, leave it alone, it should not be -1
193 Move (left(sRight+repeat("0",iPoints),iPoints)) to sRight
194
195 // format for thousand sep.
196 If bSep Begin
197 Get_Attribute DF_THOUSANDS_SEPARATOR to iCh
198 Move (Character(iCh)) to sSep
199 Move (Length(sLeft)) to iLen
200 While (iLen>3)
201 Move (insert(sSep,sLeft,iLen-2)) to sLeft
202 Move (iLen-3) to iLen
203 End
204 End
205 // if decimal points or -2 (allow anything) and there are points to show
206 If (iPoints>0 OR (iPoints=-2 AND sRight<>"")) ;
207 Move (sLeft + sDec + sright) to sLeft
208 Function_return (sPrefix + sLeft+ sSuffix)
209 End_Function
210
211 // Public: Format for currency
212 //
213 Function FormatCur number nNumber integer iPoints returns string
214 string sLeft sRight
215 integer bSep
216 If (nNumber<0) Begin
217 get pbCurNegThousandsSep to bSep
218 get psCurNegLeft to sLeft
219 get psCurNegRight to sRight
220 If (iPoints=-1) get piCurNegPoints to iPoints
221 end
222 Else Begin
223 get pbCurPosThousandsSep to bSep
224 get psCurPosLeft to sLeft
225 get psCurPosRight to sRight
226 If (iPoints=-1) get piCurPosPoints to iPoints
227 end
228 Function_return (Format_Num(self, nNumber,iPoints,bSep,sLeft,sRight))
229 End_function
230
231 // Public: Format for numeric
232 //
233 Function FormatNum number nNumber integer iPoints returns string
234 string sLeft sRight
235 integer bSep
236 If (nNumber<0) Begin
237 get pbNumNegThousandsSep to bSep
238 get psNumNegLeft to sLeft
239 get psNumNegRight to sRight
240 If (iPoints=-1) get piNumNegPoints to iPoints
241 end
242 Else Begin
243 get pbNumPosThousandsSep to bSep
244 get psNumPosLeft to sLeft
245 get psNumPosRight to sRight
246 If (iPoints=-1) get piNumPosPoints to iPoints
247 end
248 Function_return (Format_Num(self, nNumber,iPoints,bSep,sLeft,sRight))
249 End_function
250
251
252 // Public: Format passing format string
253 //
254 Function FormatVal number nNumber string sFmt returns string
255 integer iPos bIsNeg
256 string sLeft sRight
257 integer iPoints bSep
258 Move (nNumber<0) to bIsNeg
259 Move (Pos(";",sFmt)) to iPos
260 Case Begin
261 Case (iPos and Not(bIsNeg)) Move (left(sFmt,iPos-1)) to sFmt
262 Case (iPos and bIsNeg) Move (mid(sFmt,255,iPos+1)) to sFmt
263 Case (not(iPos) and not(bIsNeg)) Move sFmt to sFmt
264 Case else Move ("-" + sFmt) to sFmt
265 case end
266 Send ParseFormat sFmt
267 get pbThousandsSep to bSep
268 get psLeft to sLeft
269 get psRight to sRight
270 get piPoints to iPoints
271 Function_return (Format_Num(self, nNumber,iPoints,bSep,sLeft,sRight))
272 end_function
273
274End_Class
275