source: cprs/trunk/CPRS-Chart/uReports.pas@ 730

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

Initial Upload of Official WV CPRS 1.0.26.76

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