source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODText.pas@ 1083

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

Adding foia-cprs branch

File size: 3.6 KB
Line 
1unit fODText;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm;
8
9type
10 TfrmODText = class(TfrmODBase)
11 memText: TMemo;
12 lblText: TLabel;
13 txtStart: TORDateBox;
14 txtStop: TORDateBox;
15 lblStart: TLabel;
16 lblStop: TLabel;
17 procedure FormCreate(Sender: TObject);
18 procedure ControlChange(Sender: TObject);
19 public
20 procedure InitDialog; override;
21 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
22 procedure Validate(var AnErrMsg: string); override;
23 end;
24
25var
26 frmODText: TfrmODText;
27
28implementation
29
30{$R *.DFM}
31
32uses rCore;
33
34const
35 TX_NO_TEXT = 'Some text must be entered.';
36 TX_STARTDT = 'Unable to interpret start date.';
37 TX_STOPDT = 'Unable to interpret stop date.';
38 TX_GREATER = 'Stop date must be greater than start date.';
39
40{ TfrmODBase common methods }
41
42procedure TfrmODText.FormCreate(Sender: TObject);
43begin
44 inherited;
45 FillerID := 'OR'; // does 'on Display' order check **KCM**
46 StatusText('Loading Dialog Definition');
47 Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDE'; // loads formatting info
48 //StatusText('Loading Default Values'); // there are no defaults for text only
49 //CtrlInits.LoadDefaults(ODForText);
50 InitDialog;
51 StatusText('');
52end;
53
54procedure TfrmODText.InitDialog;
55begin
56 inherited; // inherited clears dialog controls and responses
57 ActiveControl := memText; //SetFocusedControl(memText);
58end;
59
60procedure TfrmODText.SetupDialog(OrderAction: Integer; const ID: string);
61begin
62 inherited;
63 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
64 begin
65 SetControl(memText, 'COMMENT', 1);
66 SetControl(txtStart, 'START', 1);
67 SetControl(txtStop, 'STOP', 1);
68 end
69 else txtStart.Text := 'NOW';
70end;
71
72procedure TfrmODText.Validate(var AnErrMsg: string);
73const
74 SPACE_CHAR = 32;
75var
76 ContainsPrintable: Boolean;
77 i: Integer;
78 StartTime, StopTime: TFMDateTime;
79
80 procedure SetError(const x: string);
81 begin
82 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
83 AnErrMsg := AnErrMsg + x;
84 end;
85
86begin
87 inherited;
88 ContainsPrintable := False;
89 for i := 1 to Length(memText.Text) do if Ord(memText.Text[i]) > SPACE_CHAR then
90 begin
91 ContainsPrintable := True;
92 break;
93 end;
94 if not ContainsPrintable then SetError(TX_NO_TEXT);
95 with txtStart do if Length(Text) > 0
96 then StartTime := StrToFMDateTime(Text)
97 else StartTime := 0;
98 with txtStop do if Length(Text) > 0
99 then StopTime := StrToFMDateTime(Text)
100 else StopTime := 0;
101 if StartTime = -1 then SetError(TX_STARTDT);
102 if StopTime = -1 then SetError(TX_STARTDT);
103 if (StopTime > 0) and (StopTime < StartTime) then SetError(TX_GREATER);
104 //the following is commented out because should be using relative times
105 //if AnErrMsg = '' then
106 //begin
107 // Responses.Update('START', 1, FloatToStr(StartTime), txtStart.Text);
108 // Responses.Update('STOP', 1, FloatToStr(StopTime), txtStop.Text);
109 //end;
110end;
111
112procedure TfrmODText.ControlChange(Sender: TObject);
113begin
114 inherited;
115 if Changing then Exit;
116 with memText do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
117 with txtStart do if Length(Text) > 0 then Responses.Update('START', 1, Text, Text);
118 with txtStop do if Length(Text) > 0 then Responses.Update('STOP', 1, Text, Text);
119 memOrder.Text := Responses.OrderText;
120end;
121
122end.
123
124
Note: See TracBrowser for help on using the repository browser.