source: cprs/trunk/CPRS-Chart/Orders/fODText.pas@ 830

Last change on this file since 830 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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