unit fODText; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm; type TfrmODText = class(TfrmODBase) memText: TMemo; lblText: TLabel; txtStart: TORDateBox; txtStop: TORDateBox; lblStart: TLabel; lblStop: TLabel; procedure FormCreate(Sender: TObject); procedure ControlChange(Sender: TObject); public procedure InitDialog; override; procedure SetupDialog(OrderAction: Integer; const ID: string); override; procedure Validate(var AnErrMsg: string); override; end; var frmODText: TfrmODText; implementation {$R *.DFM} uses rCore; const TX_NO_TEXT = 'Some text must be entered.'; TX_STARTDT = 'Unable to interpret start date.'; TX_STOPDT = 'Unable to interpret stop date.'; TX_GREATER = 'Stop date must be greater than start date.'; { TfrmODBase common methods } procedure TfrmODText.FormCreate(Sender: TObject); begin inherited; FillerID := 'OR'; // does 'on Display' order check **KCM** StatusText('Loading Dialog Definition'); Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDE'; // loads formatting info //StatusText('Loading Default Values'); // there are no defaults for text only //CtrlInits.LoadDefaults(ODForText); InitDialog; StatusText(''); end; procedure TfrmODText.InitDialog; begin inherited; // inherited clears dialog controls and responses ActiveControl := memText; //SetFocusedControl(memText); end; procedure TfrmODText.SetupDialog(OrderAction: Integer; const ID: string); begin inherited; if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do begin SetControl(memText, 'COMMENT', 1); SetControl(txtStart, 'START', 1); SetControl(txtStop, 'STOP', 1); end else txtStart.Text := 'NOW'; end; procedure TfrmODText.Validate(var AnErrMsg: string); const SPACE_CHAR = 32; var ContainsPrintable: Boolean; i: Integer; StartTime, StopTime: TFMDateTime; procedure SetError(const x: string); begin if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF; AnErrMsg := AnErrMsg + x; end; begin inherited; ContainsPrintable := False; for i := 1 to Length(memText.Text) do if Ord(memText.Text[i]) > SPACE_CHAR then begin ContainsPrintable := True; break; end; if not ContainsPrintable then SetError(TX_NO_TEXT); with txtStart do if Length(Text) > 0 then StartTime := StrToFMDateTime(Text) else StartTime := 0; with txtStop do if Length(Text) > 0 then StopTime := StrToFMDateTime(Text) else StopTime := 0; if StartTime = -1 then SetError(TX_STARTDT); if StopTime = -1 then SetError(TX_STARTDT); if (StopTime > 0) and (StopTime < StartTime) then SetError(TX_GREATER); //the following is commented out because should be using relative times //if AnErrMsg = '' then //begin // Responses.Update('START', 1, FloatToStr(StartTime), txtStart.Text); // Responses.Update('STOP', 1, FloatToStr(StopTime), txtStop.Text); //end; end; procedure TfrmODText.ControlChange(Sender: TObject); begin inherited; if Changing then Exit; with memText do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text); with txtStart do if Length(Text) > 0 then Responses.Update('START', 1, Text, Text); with txtStop do if Length(Text) > 0 then Responses.Update('STOP', 1, Text, Text); memOrder.Text := Responses.OrderText; end; end.