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