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