source: cprs/branches/tmg-cprs/CPRS-Chart/uReports.pas@ 893

Last change on this file since 893 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 9.2 KB
Line 
1//kt -- Modified with SourceScanner on 8/7/2007
2unit uReports;
3
4interface
5
6uses sysutils, classes, ORFN;
7
8type
9
10TCellObject = class //Data Object for each Cell in ListView
11 private
12 FName : string; //Column Name
13 FSite : string; //Site (#;name)
14 FInclude : string; //Set if data is to be included in detailed report
15 FTextType : string; //Type of data (WP)
16 FVisible : string; //Set if column property is visible
17 FHandle : string; //Row:Col identifier
18 FDataType : string; //Data Type of data in column (null or 0:freetext, 1:integer, 2:datetime)
19 FData : TStringList; //Data for this field (could be WP)
20 FCount : integer;
21
22 public
23 constructor Create;
24 destructor Destroy; override;
25 procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList);
26 property Name :string read FName write FName;
27 property Site :string read FSite write FSite;
28 property Include :string read FInclude write FInclude;
29 property TextType :string read FTextType write FTextType;
30 property Visible :string read FVisible write FVisible;
31 property Handle :string read FHandle write FHandle;
32 property DataType :string read FDataType write FDatatype;
33 property Data :TStringList read FData write FData;
34 property Count :integer read FCount write FCount;
35 end;
36
37TRowObject = class //List of Row objects for ListView
38 private
39 FCount :integer;
40 FColumnList:TList;
41 public
42 constructor Create;
43 destructor Destroy; override;
44 procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList);
45 procedure Clear;
46 property Count :integer read FCount;
47 property ColumnList :TList read FColumnList;
48 end;
49
50type
51 PReportTreeObject = ^TReportTreeObject;
52 TReportTreeObject = Record
53 ID : String; //Report ID ID:Text => when passed to broker add: ;Remote~uHState
54 Heading : String; //Report Heading
55 Qualifier : String; //Report Qualifier
56 Remote : String; //Remote Data Capable
57 RptType : String; //Report Type
58 Category : String; //Report Category
59 RPCName : String; //Associated RPC
60 IFN : String; //IFN of report in file 101.24
61 HSTAG : String; //Report extract tag;routine;component #
62 SortOrder : String; //#:# of columns to use in a multi-column sort
63 MaxDaysBack: String; //Maximum number of Days allowed for report
64 Direct : String; //Direct Remote Call flag
65 HDR : String; //HDR is data source if = 1
66end;
67
68type
69 PProcTreeObj = ^TProcedureTreeObject;
70 TProcedureTreeObject = Record
71 ParentName : String; //Parent procedure name for exam/print sets
72 ProcedureName: String; //Same as ParentName for stand-alone procedures
73 MemberOfSet : String; //1 = descendant procedures have individual reports
74 //2 = descendant procedures have one shared report
75 ExamDtTm : String; //Exam Date Time
76 Associate : Integer; //Index of the associated TListItem in the lvReports
77end;
78
79var
80 RowObjects: TRowObject;
81
82//procedures & functions for Report Tree & ListView objects
83
84function MakeReportTreeObject(x: string): PReportTreeObject;
85function IsValidNumber(S: string; var V: extended): boolean;
86function StringToFMDateTime(Str: string): TFMDateTime;
87function ShortDateStrToDate(shortdate: string): string ;
88function StripSpace(str:string):string;
89function MakeProcedureTreeObject(x: string): PProcTreeObj;
90function MakePrntProcTreeObject(x: string): PProcTreeObj;
91
92implementation
93
94const
95 Months: array[1..12] of string[3] = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
96
97constructor TCellObject.Create;
98
99begin
100 FData := TStringList.Create;
101end;
102
103destructor TCellObject.Destroy;
104begin
105 FData.Free;
106end;
107
108
109procedure TCellObject.Add(ASite, AHandle, AColumnData: string; AData: TStringList);
110
111begin
112 FName := piece(AColumnData,'^',1);
113 FSite := ASite;
114 FInclude := piece(AColumnData,'^',5);
115 FTextType := piece(AColumnData,'^',4);
116 FVisible := piece(AColumnData,'^',2);
117 FDataType := piece(AColumnData,'^',9);
118 FHandle := AHandle;
119 FCount := AData.Count;
120 FData.Assign(AData);
121end;
122
123function MakeReportTreeObject(x: string): PReportTreeObject;
124var
125 AnObject: PReportTreeObject;
126begin
127 //x=id^Name^Qualifier^HSTag;Routine^Entry^Routine^Remote^Type^Category^RPC^ifn^SortOrder^MaxDaysBack
128 New(AnObject);
129 with AnObject^ do
130 begin
131 ID := UpperCase(Piece(x, U, 1)) + ':' + UpperCase(Piece(x, U, 2));
132 Heading := Piece(x, U, 2);
133 Qualifier := Piece(x, U, 3);
134 Remote := Piece(x, U, 7);
135 RptType := Piece(x, U, 8);
136 Category := Piece(x, U, 9);
137 RPCName := UpperCase(Piece(x, U, 10));
138 IFN := Piece(x, U, 11);
139 HSTag := UpperCase(Piece(x, U, 4));
140 SortOrder := Piece(x, U, 12);
141 MaxDaysBack := Piece(x, U, 13);
142 Direct := Piece(x, U, 14);
143 HDR := Piece(x, U, 15);
144 end;
145 Result := AnObject;
146end;
147
148constructor TRowObject.Create;
149begin
150 FColumnList := TList.Create;
151 FCount := 0;
152end;
153
154destructor TRowObject.Destroy;
155begin
156 //Clear;
157 FColumnList.Free;
158 inherited Destroy;
159end;
160
161procedure TRowObject.Add(ASite, AHandle, AColumnData: string; AData: TStringList);
162var
163 ACell: TCellObject;
164begin
165 ACell := TCellObject.Create;
166 ACell.Add(ASite,AHandle,AColumnData,AData);
167 FColumnList.Add(ACell);
168 FCount := FColumnList.Count;
169end;
170
171procedure TRowObject.Clear;
172var
173 i: Integer;
174begin
175 with FColumnList do
176 for i := 0 to Count - 1 do
177 with TCellObject(Items[i]) do Free;
178 FColumnList.Clear;
179 FCount := 0;
180end;
181
182function IsValidNumber(S: string; var V: extended): boolean;
183var
184 NumCode: integer;
185 FirstSpace: integer;
186begin
187 FirstSpace := Pos(' ', S);
188 if FirstSpace > 0 then
189 S := Copy(S, 1, FirstSpace - 1);
190 Val(S, V, NumCode);
191 Result := (NumCode = 0);
192 if not Result then
193 begin
194 // Remove thousands seperators
195 S := StringReplace(S, ThousandSeparator, '', [rfReplaceAll]);
196 // change DecimalSeperator to '.' because Val only recognizes that, not
197 // the locale specific decimal char... then try again. Stupid Val.
198 S := StringReplace(S, DecimalSeparator, '.', [rfReplaceAll]);
199 Val(S, V, NumCode);
200 Result := (NumCode = 0);
201 end;
202end;
203
204function StringToFMDateTime(Str: string): TFMDateTime;
205var
206 mm,dd,yy,hh: integer;
207 day,time,hr,min: string;
208begin
209 day := piece(str,' ',1);
210 time := piece(str,' ',2);
211 hh := 0;
212 if length(time) > 0 then
213 begin
214 hr := piece(time,':',1);
215 if Copy(hr,1,1) = '0' then hr := Copy(hr,2,1);
216 if Copy(hr,1,1) = '0' then hr := '';
217 min := piece(time,':',2);
218 if Copy(min,1,1) = '0' then min := Copy(min,2,1);
219 if Copy(min,1,1) = '0' then min := '';
220 hh := StrToIntDef(hr + min,0);
221 end;
222 mm := StrToIntDef(piece(day,'/',1),0);
223 dd := StrToIntDef(piece(day,'/',2),0);
224 yy := StrToIntDef(piece(day,'/',3),0) - 1700;
225 Result := (yy * 10000) + (mm * 100) + dd + (hh/10000);
226end;
227
228function ShortDateStrToDate(shortdate: string): string ;
229{Converts date in format 'mmm dd,yy' or 'mmm dd,yyyy' to standard 'mm/dd/yy'}
230var
231 month,day,year: string ;
232 i: integer ;
233begin
234 result := 'ERROR' ;
235 if (Pos(' ',shortdate) <> 4) or ((Pos(',',shortdate) <> 7) and (Pos(',',shortdate) <> 6)) then exit ; {no spaces or comma}
236 for i := 1 to 12 do
237 if Months[i] = UpperCase(Copy(shortdate,1,3)) then month := IntToStr(i);
238 if month = '' then exit ; {invalid month name}
239 if length(month) = 1 then month := '0' + month;
240 if Pos(',',shortdate) = 7 then
241 begin
242 day := IntToStr(StrToInt(Copy(shortdate,5,2))) ;
243 year := IntToStr(StrToInt(Copy(shortdate,8,99))) ;
244 end;
245 if Pos(',',shortdate) = 6 then
246 begin
247 day := '0' + IntToStr(StrToInt(Copy(shortdate,5,1))) ;
248 year := IntToStr(StrToInt(Copy(shortdate,7,99))) ;
249 end;
250 result := month+'/'+day+'/'+year ;
251end ;
252
253function StripSpace(str: string): string;
254var
255 i,j: integer;
256begin
257 i := 1;
258 j := length(str);
259 while str[i] = #32 do inc(i);
260 while str[j] = #32 do dec(j);
261 result := copy(str, i, j-i+1);
262end;
263
264function MakeProcedureTreeObject(x: string): PProcTreeObj;
265var
266 AnObject: PProcTreeObj;
267begin
268 New(AnObject);
269 with AnObject^ do
270 begin
271 ParentName := Piece(x, U, 11);
272 ProcedureName := Piece(x, U, 4);
273 MemberOfSet := Piece(x, U, 10);
274 ExamDtTm := Piece(x, U, 2);
275 Associate := -1;
276 end;
277 Result := AnObject;
278end;
279
280function MakePrntProcTreeObject(x: string): PProcTreeObj;
281var
282 AnObject: PProcTreeObj;
283begin
284 New(AnObject);
285 with AnObject^ do
286 begin
287 ParentName := Piece(x, U, 11);
288 ExamDtTm := Piece(x, U, 2);
289 Associate := -1;
290 end;
291 Result := AnObject;
292end;
293
294end.
Note: See TracBrowser for help on using the repository browser.