Module

fOptionsSurrogate

Path

C:\CPRS\CPRS30\Options\fOptionsSurrogate.pas

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rCore -
rOptions -
uOptions -

Classes

Name Comments
TfrmOptionsSurrogate -

Procedures

Name Owner Declaration Scope Comments
btnOKClick TfrmOptionsSurrogate procedure btnOKClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmOptionsSurrogate procedure btnRemoveClick(Sender: TObject); Public/Published -
btnSurrogateDateRangeClick TfrmOptionsSurrogate procedure btnSurrogateDateRangeClick(Sender: TObject); Public/Published -
cboSurrogateChange TfrmOptionsSurrogate procedure cboSurrogateChange(Sender: TObject); Public/Published -
cboSurrogateKeyDown TfrmOptionsSurrogate procedure cboSurrogateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboSurrogateNeedData TfrmOptionsSurrogate procedure cboSurrogateNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
DialogOptionsSurrogate - procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string); Interfaced Create the form and make it modal
FormShow TfrmOptionsSurrogate procedure FormShow(Sender: TObject); Public/Published -
LabelInfo TfrmOptionsSurrogate procedure LabelInfo; Private Private declarations

Global Variables

Name Type Declaration Comments
frmOptionsSurrogate TfrmOptionsSurrogate frmOptionsSurrogate: TfrmOptionsSurrogate; -
Surrogate TSurrogate Surrogate, TempSurrogate: TSurrogate; -
TempSurrogate TSurrogate Surrogate, TempSurrogate: TSurrogate; -


Module Source

1     unit fOptionsSurrogate;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORCtrls, ORDtTmRng, ORFn, ExtCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmOptionsSurrogate = class(TfrmBase508Form)
12        lblSurrogate: TLabel;
13        cboSurrogate: TORComboBox;
14        btnSurrogateDateRange: TButton;
15        dlgSurrogateDateRange: TORDateRangeDlg;
16        lblSurrogateText: TStaticText;
17        btnRemove: TButton;
18        lblStart: TStaticText;
19        lblStop: TStaticText;
20        pnlBottom: TPanel;
21        bvlBottom: TBevel;
22        btnCancel: TButton;
23        btnOK: TButton;
24        procedure FormShow(Sender: TObject);
25        procedure btnSurrogateDateRangeClick(Sender: TObject);
26        procedure cboSurrogateNeedData(Sender: TObject;
27          const StartFrom: String; Direction, InsertAt: Integer);
28        procedure btnOKClick(Sender: TObject);
29        procedure btnRemoveClick(Sender: TObject);
30        procedure cboSurrogateChange(Sender: TObject);
31        procedure cboSurrogateKeyDown(Sender: TObject; var Key: Word;
32          Shift: TShiftState);
33      private
34        { Private declarations }
35        procedure LabelInfo;
36      public
37        { Public declarations }
38      end;
39    
40    var
41      frmOptionsSurrogate: TfrmOptionsSurrogate;
42    
43    procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
44    
45    implementation
46    
47    uses rOptions, uOptions, rCore;
48    
49    var
50      Surrogate, TempSurrogate: TSurrogate;
51    
52    {$R *.DFM}
53    
54    procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
55    // create the form and make it modal
56    var
57      frmOptionsSurrogate: TfrmOptionsSurrogate;
58    begin
59      frmOptionsSurrogate := TfrmOptionsSurrogate.Create(Application);
60      Surrogate := TSurrogate.Create;           // saved settings
61      TempSurrogate := TSurrogate.Create;       // unsaved settings
62     try
63        with frmOptionsSurrogate do
64        begin
65          if (topvalue < 0) or (leftvalue < 0) then
66            Position := poScreenCenter
67          else
68          begin
69            Position := poDesigned;
70            Top := topvalue;
71            Left := leftvalue;
72          end;
73          ResizeAnchoredFormToFont(frmOptionsSurrogate);
74          with Surrogate do
75          begin
76            IEN := StrToInt64Def(Piece(info, '^', 1), -1);
77            Name := Piece(info, '^', 2);
78            Start := MakeFMDateTime(Piece(info, '^', 3));
79            Stop := MakeFMDateTime(Piece(info, '^', 4));
80          end;
81          with TempSurrogate do
82          begin
83            IEN := Surrogate.IEN;
84            Name := Surrogate.Name;
85            Start := Surrogate.Start;
86            Stop := Surrogate.Stop;
87          end;
88          ShowModal;
89          info := '';
90          info := info + IntToStr(Surrogate.IEN) + '^';
91          info := info + Surrogate.Name + '^';
92          info := info + FloatToStr(Surrogate.Start) + '^';
93          info := info + FloatToStr(Surrogate.Stop) + '^';
94        end;
95      finally
96        frmOptionsSurrogate.Release;
97        Surrogate.Free;
98        TempSurrogate.Free;
99      end;
100   end;
101   
102   procedure TfrmOptionsSurrogate.FormShow(Sender: TObject);
103   begin
104     cboSurrogate.InitLongList(Surrogate.Name);
105     cboSurrogate.SelectByIEN(Surrogate.IEN);
106     LabelInfo;
107   end;
108   
109   procedure TfrmOptionsSurrogate.btnSurrogateDateRangeClick(Sender: TObject);
110   var
111     TempFMDate: TFMDateTime;
112     ok : boolean;
113   begin
114     ok := false;
115     with dlgSurrogateDateRange do
116     while not ok do
117     begin
118       FMDateStart := TempSurrogate.Start;
119       FMDateStop := TempSurrogate.Stop;
120       if Execute then
121       begin
122         If (FMDateStop <> 0) and (FMDateStart > FMDateStop) then
123         begin
124           TempFMDate := FMDateStart;
125           FMDateStart := FMDateStop;
126           FMDateStop := TempFMDate;
127         end;
128         with TempSurrogate do
129         begin
130           Start := FMDateStart;
131           Stop := FMDateStop;
132           LabelInfo;
133           if (Stop <> 0) and (Stop < DateTimeToFMDateTime(Now)) then
134           begin
135             beep;
136             InfoBox('Stop Date must be in the future.', 'Warning', MB_OK or MB_ICONWARNING);
137             Stop := 0;
138           end
139           else
140             ok := true;
141         end;
142       end
143       else
144         ok := true;
145     end;
146   end;
147   
148   procedure TfrmOptionsSurrogate.cboSurrogateNeedData(
149     Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
150   begin
151     cboSurrogate.ForDataUse(SubSetOfPersons(StartFrom, Direction));
152   end;
153   
154   procedure TfrmOptionsSurrogate.btnOKClick(Sender: TObject);
155   var
156     info, msg: string;
157     ok: boolean;
158   begin
159     //rpcCheckSurrogate(TempSurrogate.IEN, ok, msg);   chack is now in rpcSetSurrogateInfo (v27.29 - RV)
160     ok := TRUE;
161     info := '';
162     info := info + IntToStr(TempSurrogate.IEN) + '^';
163     info := info + FloatToStr(TempSurrogate.Start) + '^';
164     info := info + FloatToStr(TempSurrogate.Stop) + '^';
165     rpcSetSurrogateInfo(info, ok, msg);
166     if not ok then
167     begin
168       beep;
169       InfoBox(msg, 'Warning', MB_OK or MB_ICONWARNING);
170       with cboSurrogate do ItemIndex := SetExactByIEN(Surrogate.IEN, Surrogate.Name);
171       cboSurrogateChange(Self);
172       ModalResult := mrNone;
173     end
174     else
175     begin
176       with Surrogate do
177       begin
178         IEN := TempSurrogate.IEN;
179         Name := TempSurrogate.Name;
180         Start := TempSurrogate.Start;
181         Stop := TempSurrogate.Stop;
182       end;
183       ModalResult := mrOK;
184     end;
185   end;
186   
187   procedure TfrmOptionsSurrogate.btnRemoveClick(Sender: TObject);
188   begin
189     cboSurrogate.ItemIndex := -1;
190     cboSurrogate.Text := '';
191     with TempSurrogate do
192     begin
193       IEN := -1;
194       Name := '';
195       Start := 0;
196       Stop := 0;
197     end;
198     LabelInfo;
199   end;
200   
201   procedure TfrmOptionsSurrogate.LabelInfo;
202   begin
203     with TempSurrogate do
204     begin
205       btnRemove.Enabled := length(Name) > 0;
206       btnSurrogateDateRange.Enabled := length(Name) > 0;
207       if length(Name) > 0 then
208         lblSurrogateText.Caption := Name
209       else
210       begin
211         lblSurrogateText.Caption := '<no surrogate designated>';
212         Start := 0;
213         Stop := 0;
214       end;
215       if Start > 0 then
216         lblStart.Caption := 'from: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Start)
217       else
218         lblStart.Caption := 'from: <now>';
219       if Stop > 0 then
220         lblStop.Caption := 'until: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Stop)
221       else
222         lblStop.Caption := 'until: <changed>';
223     end;
224   end;
225   
226   procedure TfrmOptionsSurrogate.cboSurrogateChange(Sender: TObject);
227   begin
228     with cboSurrogate do
229     if (ItemIndex = -1) or (Text = '') then
230     begin
231       TempSurrogate.IEN := -1;
232       TempSurrogate.Name := '';
233       ItemIndex := -1;
234       Text := '';
235     end
236     else
237     begin
238       TempSurrogate.IEN := ItemIEN;
239       TempSurrogate.Name := DisplayText[cboSurrogate.ItemIndex];
240     end;
241     LabelInfo;
242   end;
243   
244   procedure TfrmOptionsSurrogate.cboSurrogateKeyDown(Sender: TObject;
245     var Key: Word; Shift: TShiftState);
246   begin
247     if cboSurrogate.ItemIndex = -1 then       // allow typing to do change event
248       Application.ProcessMessages;
249   end;
250   
251   end.

Module Calls (2 levels)


fOptionsSurrogate
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 ├uOptions
 │ ├rCore...
 │ └fRptBox
 └rCore...

Module Called-By (2 levels)


fOptionsSurrogate
       fOptions┘ 
       fFrame┘