source: cprs/branches/foia-cprs/CPRS-Chart/Options/fOptionsReportsCustom.pas@ 459

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

Adding foia-cprs branch
File size: 19.6 KB
Line 
1unit fOptionsReportsCustom;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, Spin, ORCtrls, fOptions, ComCtrls, ORFn, ORNet, Grids, uConst,
8 ORDtTm, rCore;
9
10type
11 TfrmOptionsReportsCustom = class(TForm)
12 Panel1: TPanel;
13 Bevel3: TBevel;
14 btnApply: TButton;
15 btnCancel: TButton;
16 Panel2: TPanel;
17 grdReport: TCaptionStringGrid;
18 edtMax: TCaptionEdit;
19 odbStop: TORDateBox;
20 odbStart: TORDateBox;
21 odbTool: TORDateBox;
22 btnOK: TButton;
23 Panel3: TPanel;
24 edtSearch: TCaptionEdit;
25 Label1: TLabel;
26 function ValFor(ACol, ARow: Integer): string;
27 procedure FormCreate(Sender: TObject);
28 procedure grdReportMouseDown(Sender: TObject; Button: TMouseButton;
29 Shift: TShiftState; X, Y: Integer);
30 procedure grdReportKeyPress(Sender: TObject; var Key: Char);
31 procedure grdReportDrawCell(Sender: TObject; ACol, ARow: Integer;
32 Rect: TRect; State: TGridDrawState);
33 procedure UMDelayEvent(var Message: TMessage); Message UM_DELAYEVENT;
34 procedure edtMaxExit(Sender: TObject);
35 procedure btnApplyClick(Sender: TObject);
36 procedure btnCancelClick(Sender: TObject);
37 procedure odbStartExit(Sender: TObject);
38 procedure odbStopExit(Sender: TObject);
39 procedure FormClose(Sender: TObject; var Action: TCloseAction);
40 procedure odbStartKeyPress(Sender: TObject; var Key: Char);
41 procedure odbStopKeyPress(Sender: TObject; var Key: Char);
42 procedure edtMaxKeyPress(Sender: TObject; var Key: Char);
43 procedure btnOKClick(Sender: TObject);
44 procedure edtSearchChange(Sender: TObject);
45 procedure edtSearchKeyPress(Sender: TObject; var Key: Char);
46 procedure FormShow(Sender: TObject);
47 procedure grdReportKeyDown(Sender: TObject; var Key: Word;
48 Shift: TShiftState);
49 procedure FormDestroy(Sender: TObject);
50 private
51 { Private declarations }
52 //startDate,endDate,
53 maxOcurs,signal: integer;
54 rptList: TStringList;
55 fDropColumn: Integer;
56 sDate,eDate: string;
57 procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
58 public
59 { Public declarations }
60 end;
61var
62 frmOptionsReportsCustom: TfrmOptionsReportsCustom;
63 const
64 Col_StartDate = 1;
65 Col_StopDate = 2;
66 Col_Max = 3;
67 TAB = #9;
68procedure DialogOptionsHSCustom(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
69
70implementation
71
72uses rOptions, uOptions, fReports, uCore, uAccessibleStringGrid;
73
74{$R *.DFM}
75
76procedure TfrmOptionsReportsCustom.UMDelayEvent(var Message: TMessage);
77{ after focusing events are completed for a combobox, set the key the user typed }
78begin
79 case Message.LParam of
80 Col_StartDate:
81 begin
82 odbStart.Visible := True;
83 odbStart.Text := Chr(Message.WParam);
84 end;
85 COL_StopDate :
86 begin
87 odbStop.Visible := True;
88 odbStop.Text := Chr(Message.WParam);
89 end;
90 COL_Max :
91 begin
92 edtMax.Visible := True;
93 edtMax.Text := Chr(Message.WParam);
94 end;
95 end;
96end;
97
98procedure DialogOptionsHSCustom(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
99var
100 frmOptionsReportsCustom: TfrmOptionsReportsCustom;
101begin
102 frmOptionsReportsCustom := TfrmOptionsReportsCustom.Create(Application);
103 actiontype := 0;
104 try
105 with frmOptionsReportsCustom do
106 begin
107 if (topvalue < 0) or (leftvalue < 0) then
108 Position := poScreenCenter
109 else
110 begin
111 Position := poDesigned;
112 Top := topvalue;
113 Left := leftvalue;
114 end;
115 ResizeAnchoredFormToFont(frmOptionsReportsCustom);
116 ShowModal;
117 actiontype := btnApply.Tag;
118 end;
119 finally
120 frmOptionsReportsCustom.Release;
121 end;
122end;
123
124procedure TfrmOptionsReportsCustom.FormCreate(Sender: TObject);
125begin
126 rptList := TStringList.Create;
127 TAccessibleStringGrid.WrapControl(grdReport);
128end;
129
130procedure TfrmOptionsReportsCustom.ShowEditor(ACol, ARow: Integer; AChar: Char);
131
132 procedure PlaceControl(AControl: TWinControl);
133 var
134 ARect: TRect;
135 begin
136 with AControl do
137 begin
138 ARect := grdReport.CellRect(ACol, ARow);
139 SetBounds(ARect.Left + grdReport.Left + 2, ARect.Top + grdReport.Top + 2,
140 ARect.Right - ARect.Left - 1 , ARect.Bottom-ARect.Top -1 );
141 Visible := True;
142 Tag := ARow;
143 BringToFront;
144 Show;
145 SetFocus;
146 end;
147 end;
148 procedure Synch(AEdit: TEdit; const edtText: string);
149 begin
150 AEdit.Text := edtText;
151 AEdit.SelectAll;
152 end;
153begin
154 inherited;
155 if ARow = 0 then Exit; //header row
156 with grdReport do if (ARow = Pred(RowCount)) and (ACol > 4 ) then Exit;
157 case ACol of
158 Col_StartDate: begin
159 if (ARow > 0 ) then
160 begin
161 PlaceControl(odbStart);
162 Synch(odbStart,ValFor(Col_StartDate,ARow));
163 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_StartDate);
164 end;
165 end;
166 Col_StopDate: begin
167 if (ARow > 0 ) then
168 begin
169 PlaceControl(odbStop);
170 Synch(odbStop, ValFor(Col_StopDate,ARow));
171 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_StopDate);
172 end;
173 end;
174 Col_Max: begin
175 if (ARow > 0 ) and (StrToInt(ValFor(Col_Max,ARow)) > 0) then
176 begin
177 PlaceControl(edtMax);
178 Synch(edtMax, ValFor(Col_Max,ARow));
179 fDropColumn := Col_Max;
180 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_Max);
181 end;
182 end;
183 end;
184end;
185
186function TfrmOptionsReportsCustom.ValFor(ACol, ARow: Integer): string;
187begin
188 Result := grdReport.Cells[ACol, ARow];
189end;
190
191procedure TfrmOptionsReportsCustom.grdReportKeyPress(Sender: TObject;
192 var Key: Char);
193begin
194 inherited;
195 if grdReport.Col = 1 then
196 sDate := grdReport.Cells[grdReport.Col,grdReport.Row];
197 if grdReport.Col = 2 then
198 eDate := grdReport.Cells[grdReport.Col,grdReport.Row];
199 if (grdReport.Col = 3) and (grdReport.Cells[grdReport.Col, grdReport.Row]='') then
200 Exit else if Length(grdReport.Cells[3, grdReport.Row]) > 0 then maxOcurs := StrToInt( grdReport.Cells[3,grdReport.Row]);
201 if Key = #13 then ShowEditor(grdReport.Col, grdReport.Row, #0);
202 if Key = #9 then
203 begin
204 odbStart.Visible := False;
205 odbStop.Visible := False;
206 edtMax.Visible := False;
207 end;
208 if Key in [#32..#127] then ShowEditor(grdReport.Col, grdReport.Row, Key);
209 signal := 0;
210end;
211
212procedure TfrmOptionsReportsCustom.grdReportMouseDown(Sender: TObject;
213 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
214var
215 ACol,ARow: integer;
216begin
217 inherited;
218 if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
219 begin
220 abort;
221 exit;
222 end;
223 grdReport.MouseToCell(X,Y,ACol,ARow);
224 if (ARow < 1) or (ACol < 1) then
225 begin
226 odbStop.Visible := False;
227 odbStart.Visible := False;
228 edtMax.Visible := False;
229 Exit;
230 end;
231 if ACol = 1 then
232 begin
233 odbStop.Visible := False;
234 edtMax.Visible := False;
235 sDate := grdReport.Cells[1,ARow];
236 ShowEditor(ACol, ARow, #0);
237 end;
238 if ACol = 2 then
239 begin
240 odbStart.Visible := False;
241 edtMax.Visible := False;
242 eDate := grdReport.Cells[2,ARow];
243 ShowEditor(ACol, ARow, #0);
244 end;
245 if (ACol = 3) and (grdReport.Cells[ACol,ARow]='') then
246 begin
247 odbStart.Visible := False;
248 odbStop.Visible := False;
249 Exit;
250 end
251 else if (ACol = 3) and (strtoint(grdReport.Cells[ACol,ARow])>0) then
252 begin
253 odbStart.Visible := False;
254 odbStop.Visible := False;
255 maxOcurs := strtoint(grdReport.Cells[ACol,ARow]);
256 ShowEditor(ACol, ARow, #0);
257 end
258 else
259 begin
260 grdReport.Col := 0;
261 grdReport.Row := ARow;
262 end;
263 signal := 0;
264end;
265
266procedure TfrmOptionsReportsCustom.grdReportDrawCell(Sender: TObject; ACol,
267 ARow: Integer; Rect: TRect; State: TGridDrawState);
268begin
269 inherited;
270 grdReport.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
271 Piece(grdReport.Cells[ACol, ARow], TAB, 1));
272
273end;
274
275procedure TfrmOptionsReportsCustom.edtMaxExit(Sender: TObject);
276var
277 newValue: String;
278 code, I: integer;
279begin
280 if edtMax.Modified then
281 begin
282 newValue := edtMax.Text;
283 if length(newValue) = 0 then
284 begin
285 InfoBox('Invalid value of max occurences', 'Warning', MB_OK or MB_ICONWARNING);
286 edtMax.Text := IntToStr(maxOcurs);
287 edtMax.SetFocus;
288 edtMax.SelectAll;
289 end;
290 if length(newValue) > 0 then
291 begin
292 Val(newValue, I, code);
293 if code <> 0 then
294 begin
295 InfoBox('Invalid value of max occurences', 'Warning', MB_OK or MB_ICONWARNING);
296 edtMax.Text := IntToStr(maxOcurs);
297 edtMax.SetFocus;
298 edtMax.SelectAll;
299 end;
300 if code = 0 then
301 begin
302 if strtoint(edtMax.Text) <= 0 then
303 begin
304 InfoBox('the value of max should be greater than 0', 'Warning', MB_OK or MB_ICONWARNING);
305 edtMax.Text := intToStr(maxOcurs);
306 edtMax.SetFocus;
307 edtMax.SelectAll;
308 exit;
309 end;
310 grdReport.Cells[Col_Max, edtMax.Tag] := edtMax.Text;
311 if compareStr(Piece(Piece(grdReport.Cells[0,edtMax.Tag],TAB,2),'^',2),'M')=0 then
312 begin
313 edtMax.Visible := False;
314 btnApply.Enabled := True;
315 Exit;
316 end;
317 grdReport.Cells[0,edtMax.Tag] := grdReport.Cells[0,edtMax.Tag] + '^M';
318 edtMax.Visible := False;
319 btnApply.Enabled := True;
320 end;
321 end;
322 end;
323end;
324
325procedure TfrmOptionsReportsCustom.btnApplyClick(Sender: TObject);
326var
327 valueStartdate, valueStopdate,valueMax, rpt, values,name: string;
328 i: integer;
329begin
330 for i := 1 to grdReport.RowCount do
331 begin
332 if CompareStr(Piece(Piece( grdReport.Cells[0,i],TAB,2),'^',2),'M')=0 then
333 begin
334 rpt := Piece(Piece( grdReport.Cells[0,i],TAB,2),'^',1);
335 name := Piece( grdReport.Cells[0,i],TAB,1);
336 odbTool.Text := grdReport.Cells[1,i];
337 valueStartDate := odbTool.RelativeTime;
338 odbTool.Text := grdReport.Cells[2,i];
339 valueStopDate := odbTool.RelativeTime;
340 valueMax := grdReport.Cells[3,i];
341 if Length(valueMax)<1 then
342 valueMax := '7';
343 values := valueStartdate + ';' + valueStopDate + ';' + valueMax;
344{ if CompareStr(name,'Imaging (local only)')=0 then // imaging report id is hard coded to be 10000
345 values := valueStartdate + ';' + valueStopDate + ';;;' + valueMax
346 else}
347 rpcSetIndividualReportSetting(rpt, values);
348 end;
349 end;
350 btnApply.Enabled := False;
351 odbStart.Visible := False;
352 odbStop.Visible := False;
353 edtMax.Visible := False;
354 frmReports.LoadTreeView;
355 with frmReports.tvReports do
356 begin
357 if Items.Count > 0 then
358 Selected := Items.GetFirstNode;
359 frmReports.tvReportsClick(Selected);
360 end;
361end;
362
363procedure TfrmOptionsReportsCustom.btnCancelClick(Sender: TObject);
364begin
365 rptList.Clear;
366 Close;
367end;
368
369
370procedure TfrmOptionsReportsCustom.odbStartExit(Sender: TObject);
371const
372 TX_BAD_START = 'The start date is not valid.';
373 TX_STOPSTART = 'The start date must not be after the stop date.';
374var
375 x,ErrMsg,datestart,datestop: String;
376begin
377 if odbStart.text = '' then
378 begin
379 InfoBox(TX_BAD_START, 'Warning', MB_OK or MB_ICONWARNING);
380 odbStart.Visible := True;
381 odbStart.Text := sDate;
382 odbStart.Setfocus;
383 odbStart.SelectAll;
384 exit;
385 end;
386 if odbStart.Text = sDate then
387 exit;
388 ErrMsg := '';
389 odbStart.Validate(x);
390 if Length(x) > 0 then
391 begin
392 ErrMsg := TX_BAD_START;
393 InfoBox(TX_BAD_START, 'Warning', MB_OK or MB_ICONWARNING);
394 odbStart.Visible := True;
395 odbStart.Text := sDate;
396 odbStart.Setfocus;
397 odbStart.SelectAll;
398 exit;
399 end;
400 datestart := odbStart.RelativeTime;
401 datestop := MakeRelativeDateTime(
402 StrToFMDateTime(grdReport.Cells[Col_StopDate,odbStart.Tag])
403 );
404 delete(datestart,1,1);
405 delete(datestop,1,1);
406 if StrToIntDef(datestart,0)> StrToIntDef(datestop,0) then
407 begin
408 InfoBox(TX_STOPSTART, 'Warning', MB_OK or MB_ICONWARNING);
409 odbStart.Text := grdReport.Cells[Col_StopDate,odbStart.Tag];
410 odbStart.SetFocus;
411 odbStart.SelectAll;
412 exit;
413 end;
414 grdReport.Cells[Col_StartDate, odbStart.Tag] := DateToStr(FMDateTimeToDateTime(odbStart.FMDateTime));
415 odbStart.Visible := False;
416 btnApply.Enabled := True;
417 if compareStr(Piece(Piece(grdReport.Cells[0,odbStart.Tag],TAB,2),'^',2),'M')=0 then
418 Exit;
419 grdReport.Cells[0,odbStart.Tag] := grdReport.Cells[0,odbStart.Tag] + '^M';
420end;
421
422procedure TfrmOptionsReportsCustom.odbStopExit(Sender: TObject);
423const
424 TX_BAD_STOP = 'The stop date is not valid.';
425 TX_BAD_ORDER = 'The stop date must not be earlier than start date.';
426var
427 x, ErrMsg,datestart,datestop: string;
428begin
429 if odbStop.text = '' then
430 begin
431 InfoBox(TX_BAD_STOP, 'Warning', MB_OK or MB_ICONWARNING);
432 odbStop.Visible := True;
433 odbStop.Text := eDate;
434 odbStop.Setfocus;
435 odbStop.SelectAll;
436 exit;
437 end;
438
439 if odbStop.Text = eDate then
440 exit;
441
442 ErrMsg := '';
443 odbStop.Validate(x);
444 if Length(x) > 0 then
445 begin
446 ErrMsg := TX_BAD_STOP;
447 InfoBox(TX_BAD_STOP, 'Warning', MB_OK or MB_ICONWARNING);
448 odbStop.Visible := True;
449 odbStop.Text := eDate;
450 odbStop.Setfocus;
451 odbStop.SelectAll;
452 exit;
453 end;
454
455 datestart := MakeRelativeDateTime(
456 StrToFMDateTime(grdReport.Cells[Col_StartDate,odbStop.Tag])
457 );
458 datestop := odbStop.RelativeTime;
459 delete(datestart,1,1);
460 delete(datestop,1,1);
461 if StrToIntDef(datestart,0)> StrToIntDef(datestop,0) then
462 begin
463 InfoBox(TX_BAD_ORDER, 'Warning', MB_OK or MB_ICONWARNING);
464 odbStop.Text := grdReport.Cells[Col_StartDate,odbStop.Tag];
465 odbStop.SetFocus;
466 odbStop.SelectAll;
467 exit;
468 end;
469 grdReport.Cells[Col_StopDate, odbStop.Tag] := DateToStr(FMDateTimeToDateTime(odbStop.FMDateTime));
470 odbStop.Visible := False;
471 btnApply.Enabled := True;
472 if compareStr(Piece(Piece(grdReport.Cells[0,odbStop.Tag],TAB,2),'^',2),'M')=0 then
473 Exit;
474 grdReport.Cells[0,odbStop.Tag] := grdReport.Cells[0,odbStop.Tag] + '^M';
475end;
476
477
478procedure TfrmOptionsReportsCustom.FormClose(Sender: TObject;
479 var Action: TCloseAction);
480begin
481 Close;
482 rptList.Clear;
483end;
484
485procedure TfrmOptionsReportsCustom.odbStartKeyPress(Sender: TObject;
486 var Key: Char);
487begin
488 if Key = #13 then
489 begin
490 odbStart.Visible := False;
491 Perform(WM_NextDlgCtl, 0, 0);
492 exit;
493 end;
494end;
495
496procedure TfrmOptionsReportsCustom.odbStopKeyPress(Sender: TObject;
497 var Key: Char);
498begin
499 if Key = #13 then
500 begin
501 odbStop.Visible := False;
502 Perform(WM_NextDlgCtl, 0, 0);
503 exit;
504 end;
505end;
506
507procedure TfrmOptionsReportsCustom.edtMaxKeyPress(Sender: TObject;
508 var Key: Char);
509begin
510 if Key = #13 then
511 begin
512 edtMax.Visible := False;
513 Perform(WM_NextDlgCtl, 0, 0);
514 exit;
515 end;
516end;
517
518procedure TfrmOptionsReportsCustom.btnOKClick(Sender: TObject);
519begin
520 if btnApply.Enabled then
521 btnApplyClick(self);
522 Close;
523end;
524
525procedure TfrmOptionsReportsCustom.edtSearchChange(Sender: TObject);
526var
527 i: integer;
528 needle,hay: String;
529 selRect: TGridRect;
530
531begin
532 if (edtSearch.Modified) and (signal=0) then
533 begin
534 needle := UpperCase(edtSearch.text);
535 if length(needle)=0 then
536 begin
537 selRect.Left := 0;
538 selRect.Top := 1;
539 selRect.Right := 0;
540 selRect.Bottom := 1;
541 grdReport.Selection := selRect;
542 grdReport.TopRow := 1;
543 exit;
544 end;
545 for i := 1 to grdReport.RowCount do
546 begin
547 hay := Piece(UpperCase(grdReport.Cells[0,i]),TAB,1);
548 hay := Copy(hay,0,length(needle));
549 if Pos(needle, hay) > 0 then
550 begin
551 selRect.Left := 0;
552 selRect.Top := i;
553 selRect.Right := 0;
554 selRect.Bottom := i;
555 grdReport.Selection := selRect;
556 grdReport.TopRow := i;
557 exit;
558 end;
559 end;
560 end;
561 if (edtSearch.Modified) and (signal=1) then
562 begin
563 signal := 0;
564 end;
565 Exit;
566end;
567
568procedure TfrmOptionsReportsCustom.edtSearchKeyPress(Sender: TObject;
569 var Key: Char);
570begin
571 if Key = #13 then
572 begin
573 Perform(WM_NextDlgCtl, 0, 0);
574 edtSearch.Text := '';
575 exit;
576 end;
577end;
578
579procedure TfrmOptionsReportsCustom.FormShow(Sender: TObject);
580var
581 i,rowNum: integer;
582 startOff,stopOff: string;
583 today: TFMDateTime;
584begin
585 today := FMToday;
586 signal := 0;
587 rptList := TStringList.Create;
588 CallV('ORWTPD GETSETS',[nil]);
589 MixedCaseList( RPCBrokerV.Results );
590 rptList := TStringList(RPCBrokerV.Results);
591 SortByPiece(rptList,'^',2);
592 rowNum := rptList.Count;
593 grdReport.RowCount := rowNum + 1;
594 grdReport.Cells[0,0] := 'Report Name';
595 grdReport.Cells[1,0] := 'Start Date';
596 grdReport.Cells[2,0] := 'Stop Date';
597 grdReport.Cells[3 ,0] := 'Max';
598
599 for i := 1 to grdReport.RowCount-1 do
600 begin
601 grdReport.Cells[0,i] := Piece(rptList[i-1],'^',2)+ TAB + Piece(rptList[i-1],'^',1);
602 startOff := Piece(Piece(rptList[i-1],'^',3),';',1);
603 stopOff := Piece(Piece(rptList[i-1],'^',3),';',2);
604 delete(startOff,1,1);
605 delete(stopOff,1,1);
606 grdReport.Cells[1,i] := DateToStr(FMDateTimeToDateTime(FMDateTimeOffsetBy(today, StrToIntDef(startOff,0))));
607 grdReport.Cells[2,i] := DateToStr(FMDateTimeToDateTime(FMDateTimeOffsetBy(today, StrToIntDef(stopOff,0))));
608 grdReport.Cells[3,i] := Piece(Piece(rptList[i-1],'^',3),';',3);
609 end;
610 if not edtSearch.Focused then
611 edtSearch.SetFocus;
612 btnCancel.Caption := 'Cancel';
613 if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
614 begin
615 grdReport.onKeyPress := nil;
616 grdReport.onMouseDown := nil;
617 odbStart.readOnly := true;
618 odbStart.onExit := nil;
619 odbStart.onKeyPress := nil;
620 odbStop.readOnly := true;
621 odbStop.onExit := nil;
622 odbStop.onKeyPress := nil;
623 edtMax.readOnly := true;
624 odbTool.readOnly := true;
625 btnOK.visible := false;
626 btnApply.visible := false;
627 btnCancel.Caption := 'Close';
628 end;
629end;
630
631procedure TfrmOptionsReportsCustom.grdReportKeyDown(Sender: TObject;
632 var Key: Word; Shift: TShiftState);
633begin
634 if (Key = VK_TAB) then
635 begin
636 if ssShift in Shift then
637 begin
638 EdtSearch.SetFocus;
639 Key := 0;
640 end
641 else if ssCtrl in Shift then
642 begin
643 if User.ToolsRptEdit then
644 btnApply.SetFocus
645 else
646 btnCancel.SetFocus;
647 Key := 0;
648 end;
649 end;
650 if Key = VK_ESCAPE then begin
651 EdtSearch.SetFocus;
652 Key := 0;
653 end;
654end;
655
656procedure TfrmOptionsReportsCustom.FormDestroy(Sender: TObject);
657begin
658 TAccessibleStringGrid.UnwrapControl(grdReport);
659end;
660
661end.
662
Note: See TracBrowser for help on using the repository browser.