//kt -- Modified with SourceScanner on 8/8/2007 unit fOptionsSurrogate; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ORDtTmRng, ORFn, ExtCtrls, DKLang; type TfrmOptionsSurrogate = class(TForm) lblSurrogate: TLabel; cboSurrogate: TORComboBox; btnSurrogateDateRange: TButton; dlgSurrogateDateRange: TORDateRangeDlg; lblSurrogateText: TStaticText; btnRemove: TButton; lblStart: TStaticText; lblStop: TStaticText; pnlBottom: TPanel; bvlBottom: TBevel; btnCancel: TButton; btnOK: TButton; DKLanguageController1: TDKLanguageController; procedure FormShow(Sender: TObject); procedure btnSurrogateDateRangeClick(Sender: TObject); procedure cboSurrogateNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure btnOKClick(Sender: TObject); procedure btnRemoveClick(Sender: TObject); procedure cboSurrogateChange(Sender: TObject); procedure cboSurrogateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private declarations } procedure LabelInfo; public { Public declarations } end; var frmOptionsSurrogate: TfrmOptionsSurrogate; procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string); implementation uses rOptions, uOptions, rCore; var Surrogate, TempSurrogate: TSurrogate; {$R *.DFM} procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string); // create the form and make it modal var frmOptionsSurrogate: TfrmOptionsSurrogate; begin frmOptionsSurrogate := TfrmOptionsSurrogate.Create(Application); Surrogate := TSurrogate.Create; // saved settings TempSurrogate := TSurrogate.Create; // unsaved settings try with frmOptionsSurrogate do begin if (topvalue < 0) or (leftvalue < 0) then Position := poScreenCenter else begin Position := poDesigned; Top := topvalue; Left := leftvalue; end; ResizeAnchoredFormToFont(frmOptionsSurrogate); with Surrogate do begin IEN := StrToInt64Def(Piece(info, '^', 1), -1); Name := Piece(info, '^', 2); Start := MakeFMDateTime(Piece(info, '^', 3)); Stop := MakeFMDateTime(Piece(info, '^', 4)); end; with TempSurrogate do begin IEN := Surrogate.IEN; Name := Surrogate.Name; Start := Surrogate.Start; Stop := Surrogate.Stop; end; ShowModal; info := ''; info := info + IntToStr(Surrogate.IEN) + '^'; info := info + Surrogate.Name + '^'; info := info + FloatToStr(Surrogate.Start) + '^'; info := info + FloatToStr(Surrogate.Stop) + '^'; end; finally frmOptionsSurrogate.Release; Surrogate.Free; TempSurrogate.Free; end; end; procedure TfrmOptionsSurrogate.FormShow(Sender: TObject); begin cboSurrogate.InitLongList(Surrogate.Name); cboSurrogate.SelectByIEN(Surrogate.IEN); LabelInfo; end; procedure TfrmOptionsSurrogate.btnSurrogateDateRangeClick(Sender: TObject); var TempFMDate: TFMDateTime; ok : boolean; begin ok := false; with dlgSurrogateDateRange do while not ok do begin FMDateStart := TempSurrogate.Start; FMDateStop := TempSurrogate.Stop; if Execute then begin If (FMDateStop <> 0) and (FMDateStart > FMDateStop) then begin TempFMDate := FMDateStart; FMDateStart := FMDateStop; FMDateStop := TempFMDate; end; with TempSurrogate do begin Start := FMDateStart; Stop := FMDateStop; LabelInfo; if (Stop <> 0) and (Stop < DateTimeToFMDateTime(Now)) then begin beep; // InfoBox('Stop Date must be in the future.', 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsSurrogate_Stop_Date_must_be_in_the_futurex'), DKLangConstW('fOptionsSurrogate_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 Stop := 0; end else ok := true; end; end else ok := true; end; end; procedure TfrmOptionsSurrogate.cboSurrogateNeedData( Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin cboSurrogate.ForDataUse(SubSetOfPersons(StartFrom, Direction)); end; procedure TfrmOptionsSurrogate.btnOKClick(Sender: TObject); var info, msg: string; ok: boolean; begin rpcCheckSurrogate(TempSurrogate.IEN, ok, msg); if not ok then begin beep; // InfoBox(msg, 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(msg, DKLangConstW('fOptionsSurrogate_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 ModalResult := mrNone; end else begin ModalResult := mrOK; with Surrogate do begin IEN := TempSurrogate.IEN; Name := TempSurrogate.Name; Start := TempSurrogate.Start; Stop := TempSurrogate.Stop; end; info := ''; info := info + IntToStr(Surrogate.IEN) + '^'; info := info + FloatToStr(Surrogate.Start) + '^'; info := info + FloatToStr(Surrogate.Stop) + '^'; rpcSetSurrogateInfo(info); end; end; procedure TfrmOptionsSurrogate.btnRemoveClick(Sender: TObject); begin cboSurrogate.ItemIndex := -1; cboSurrogate.Text := ''; with TempSurrogate do begin IEN := -1; Name := ''; Start := 0; Stop := 0; end; LabelInfo; end; procedure TfrmOptionsSurrogate.LabelInfo; begin with TempSurrogate do begin btnRemove.Enabled := length(Name) > 0; btnSurrogateDateRange.Enabled := length(Name) > 0; if length(Name) > 0 then lblSurrogateText.Caption := Name else begin // lblSurrogateText.Caption := ''; <-- original line. //kt 8/8/2007 lblSurrogateText.Caption := DKLangConstW('fOptionsSurrogate_xno_surrogate_designatedx'); //kt added 8/8/2007 Start := 0; Stop := 0; end; if Start > 0 then // lblStart.Caption := 'from: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Start) <-- original line. //kt 8/8/2007 lblStart.Caption := DKLangConstW('fOptionsSurrogate_fromx')+' ' + FormatFMDateTime(DKLangConstW('fOptionsSurrogate_mmm_dxyyyyxhhxnn'), Start) //kt added 8/8/2007 else // lblStart.Caption := 'from: '; <-- original line. //kt 8/8/2007 lblStart.Caption := DKLangConstW('fOptionsSurrogate_fromx_xnowx'); //kt added 8/8/2007 if Stop > 0 then // lblStop.Caption := 'until: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Stop) <-- original line. //kt 8/8/2007 lblStop.Caption := DKLangConstW('fOptionsSurrogate_untilx')+' ' + FormatFMDateTime(DKLangConstW('fOptionsSurrogate_mmm_dxyyyyxhhxnn'), Stop) //kt added 8/8/2007 else // lblStop.Caption := 'until: '; <-- original line. //kt 8/8/2007 lblStop.Caption := DKLangConstW('fOptionsSurrogate_untilx_xchangedx'); //kt added 8/8/2007 end; end; procedure TfrmOptionsSurrogate.cboSurrogateChange(Sender: TObject); begin with cboSurrogate do if (ItemIndex = -1) or (Text = '') then begin TempSurrogate.IEN := -1; TempSurrogate.Name := ''; ItemIndex := -1; Text := ''; end else begin TempSurrogate.IEN := ItemIEN; TempSurrogate.Name := DisplayText[cboSurrogate.ItemIndex]; end; LabelInfo; end; procedure TfrmOptionsSurrogate.cboSurrogateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if cboSurrogate.ItemIndex = -1 then // allow typing to do change event Application.ProcessMessages; end; end.