source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOCSession.pas@ 1641

Last change on this file since 1641 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 10.1 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOCSession;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, DKLang;
9
10type
11 TfrmOCSession = class(TfrmAutoSz)
12 lstChecks: TCaptionListBox;
13 pnlBottom: TPanel;
14 lblJustify: TLabel;
15 txtJustify: TCaptionEdit;
16 cmdCancelOrder: TButton;
17 cmdContinue: TButton;
18 procedure cmdCancelOrderClick(Sender: TObject);
19 procedure cmdContinueClick(Sender: TObject);
20 procedure lstChecksMeasureItem(Control: TWinControl; Index: Integer;
21 var Height: Integer);
22 procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
23 Rect: TRect; State: TOwnerDrawState);
24 procedure FormClose(Sender: TObject; var Action: TCloseAction);
25 procedure FormShow(Sender: TObject);
26 procedure FormResize(Sender: TObject);
27 procedure txtJustifyKeyDown(Sender: TObject; var Key: Word;
28 Shift: TShiftState);
29 private
30 FCritical: Boolean;
31 FCheckList: TStringList;
32 FOrderList: TStringList;
33 procedure SetReqJustify;
34 public
35 { Public declarations }
36 end;
37
38procedure ExecuteReleaseOrderChecks(SelectList: TList);
39procedure ExecuteSessionOrderChecks(OrderList: TStringList);
40
41implementation
42
43{$R *.DFM}
44
45uses rOrders, uCore, rMisc;
46
47type
48 TOCRec = class
49 OrderID: string;
50 OrderText: string;
51 Checks: TStringList;
52 constructor Create(const AnID: string);
53 destructor Destroy; override;
54 end;
55
56var
57 uCheckedOrders: TList;
58 FOldHintHidePause: integer;
59
60constructor TOCRec.Create(const AnID: string);
61begin
62 OrderID := AnID;
63 Checks := TStringList.Create;
64 FOldHintHidePause := Application.HintHidePause;
65end;
66
67destructor TOCRec.Destroy;
68begin
69 Application.HintHidePause := FOldHintHidePause;
70 Checks.Free;
71 inherited Destroy;
72end;
73
74procedure ExecuteReleaseOrderChecks(SelectList: TList);
75var
76 i: Integer;
77 AnOrder: TOrder;
78 OrderIDList: TStringList;
79begin
80 OrderIDList := TStringList.Create;
81 try
82 for i := 0 to SelectList.Count - 1 do
83 begin
84 AnOrder := TOrder(SelectList.Items[i]);
85 OrderIDList.Add(AnOrder.ID + '^^1'); // 3rd pce = 1 means releasing order
86 end;
87 ExecuteSessionOrderChecks(OrderIDList);
88 for i := SelectList.Count - 1 downto 0 do
89 begin
90 AnOrder := TOrder(SelectList.Items[i]);
91 if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
92 begin
93 Changes.Remove(CH_ORD, AnOrder.ID);
94 SelectList.Delete(i);
95 end;
96 end;
97 finally
98 OrderIDList.Free;
99 end;
100end;
101
102procedure ExecuteSessionOrderChecks(OrderList: TStringList);
103var
104 i, j: Integer;
105 LastID, NewID: string;
106 CheckList: TStringList;
107 OCRec: TOCRec;
108 //AChangeItem: TChangeItem;
109 frmOCSession: TfrmOCSession;
110 x: string;
111begin
112 CheckList := TStringList.Create;
113 try
114// StatusText('Order Checking...'); <-- original line. //kt 8/8/2007
115 StatusText(DKLangConstW('fOCSession_Order_Checkingxxx')); //kt added 8/8/2007
116 OrderChecksForSession(CheckList, OrderList);
117 StatusText('');
118 if CheckList.Count > 0 then
119 begin
120 frmOCSession := TfrmOCSession.Create(Application);
121 try
122 ResizeFormToFont(TForm(frmOCSession));
123 uCheckedOrders := TList.Create;
124 LastID := '';
125 for i := 0 to CheckList.Count - 1 do
126 begin
127 NewID := Piece(CheckList[i], U, 1);
128 if NewID <> LastID then
129 begin
130 OCRec := TOCRec.Create(NewID);
131 uCheckedOrders.Add(OCRec);
132 LastID := NewID;
133 end; {if NewID}
134 end; {for i}
135 with uCheckedOrders do for i := 0 to Count - 1 do
136 begin
137 OCRec := TOCRec(Items[i]);
138 x := TextForOrder(OCRec.OrderID);
139 OCRec.OrderText := x;
140 for j := 0 to CheckList.Count - 1 do
141 if Piece(CheckList[j], U, 1) = OCRec.OrderID then
142 begin
143 OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
144 x := x + CRLF + Piece(CheckList[j], U, 4);
145 end;
146 //AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
147 //if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
148 frmOCSession.lstChecks.Items.Add(x);
149 end; {with...for i}
150 frmOCSession.FOrderList := OrderList;
151 frmOCSession.FCheckList := CheckList;
152 frmOCSession.SetReqJustify;
153 MessageBeep(MB_ICONASTERISK);
154 if frmOCSession.Visible then frmOCSession.SetFocus;
155 frmOCSession.ShowModal;
156 finally
157 with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
158 frmOCSession.Free;
159 end; {try}
160 end; {if CheckList}
161 finally
162 CheckList.Free;
163 end;
164end;
165
166procedure TfrmOCSession.SetReqJustify;
167var
168 i, j: Integer;
169 OCRec: TOCRec;
170begin
171 FCritical := False;
172 with uCheckedOrders do for i := 0 to Count - 1 do
173 begin
174 OCRec := TOCRec(Items[i]);
175 for j := 0 to OCRec.Checks.Count - 1 do
176 if Piece(OCRec.Checks[j], U, 2) = '1' then FCritical := True;
177 end;
178 lblJustify.Visible := FCritical;
179 txtJustify.Visible := FCritical;
180
181end;
182
183procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
184var
185 i, AHt, TotalHt: Integer;
186 x: string;
187 ARect: TRect;
188 OCRec: TOCRec;
189begin
190 inherited;
191
192 with lstChecks do
193 begin
194 if Index >= uCheckedOrders.Count then Exit;
195 OCRec := TOCRec(uCheckedOrders.Items[Index]);
196 ARect := ItemRect(Index);
197 ARect.Left := ARect.Left + 2;
198 AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
199 TotalHt := AHt;
200
201 for i := 0 to OCRec.Checks.Count - 1 do
202 begin
203 ARect := ItemRect(Index);
204 ARect.Left := ARect.Left + 10;
205 x := Piece(OCRec.Checks[i], U, 3);
206 AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
207 TotalHt := TotalHt + AHt;
208 end;
209 end;
210 Height := TotalHt + 2; // add 2 for focus rectangle
211 if Height > 255 then Height := 255; //CQ7178
212end;
213
214procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
215var
216 i, AHt: Integer;
217 x: string;
218 ARect: TRect;
219 OCRec: TOCRec;
220begin
221 inherited;
222
223 with lstChecks do
224 begin
225 if Index >= uCheckedOrders.Count then Exit;
226 OCRec := TOCRec(uCheckedOrders.Items[Index]);
227 ARect := ItemRect(Index);
228 AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
229 ARect.Left := ARect.Left + 10;
230 ARect.Top := ARect.Top + AHt;
231 for i := 0 to OCRec.Checks.Count - 1 do
232 begin
233 x := Piece(OCRec.Checks[i], U, 3);
234 if not (odSelected in State) then
235 begin
236 if (Piece(OCRec.Checks[i], U, 2) = '1') then
237 begin
238 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
239 Canvas.Font.Color := clBlue;
240 Canvas.Font.Style := [fsUnderline];
241 end
242 else Canvas.Font.Color := clWindowText;
243 end;
244 AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
245 ARect.Top := ARect.Top + AHt;
246 end;
247 end;
248
249end;
250
251procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
252var
253 i, j: Integer;
254 AnOrderID: string;
255 OCRec: TOCRec;
256begin
257 inherited;
258 for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then
259 begin
260 OCRec := TOCRec(uCheckedOrders.Items[i]);
261 AnOrderID := OCRec.OrderID;
262 if DeleteCheckedOrder(AnOrderID) then
263 begin
264 for j := FCheckList.Count - 1 downto 0 do
265 if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
266 for j := FOrderList.Count - 1 downto 0 do
267 if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
268 OCRec.Free;
269 uCheckedOrders.Delete(i);
270 lstChecks.Items.Delete(i);
271 end;
272 end;
273 if uCheckedOrders.Count = 0 then Close;
274end;
275
276procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
277begin
278 inherited;
279 if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
280 begin
281// InfoBox('A justification for overriding critical order checks is required.', <-- original line. //kt 8/8/2007
282 InfoBox(DKLangConstW('fOCSession_A_justification_for_overriding_critical_order_checks_is_requiredx'), //kt added 8/8/2007
283// 'Justification Required', MB_OK); <-- original line. //kt 8/8/2007
284 DKLangConstW('fOCSession_Justification_Required'), MB_OK); //kt added 8/8/2007
285 Exit;
286 end;
287//StatusText('Saving Order Checks...'); <-- original line. //kt 8/8/2007
288 StatusText(DKLangConstW('fOCSession_Saving_Order_Checksxxx')); //kt added 8/8/2007
289 SaveOrderChecksForSession(txtJustify.Text, FCheckList);
290 StatusText('');
291 Close;
292end;
293
294procedure TfrmOCSession.FormClose(Sender: TObject;
295 var Action: TCloseAction);
296begin
297 inherited;
298 SaveUserBounds(Self); //Save Position & Size of Form
299end;
300
301procedure TfrmOCSession.FormShow(Sender: TObject);
302begin
303 inherited;
304 SetFormPosition(Self); //Get Saved Position & Size of Form
305end;
306
307
308procedure TfrmOCSession.FormResize(Sender: TObject);
309begin
310 //TfrmAutoSz has defect must call inherited Resize for the resize to function.
311 inherited;
312end;
313
314procedure TfrmOCSession.txtJustifyKeyDown(Sender: TObject; var Key: Word;
315 Shift: TShiftState);
316begin
317 inherited;
318 //GE CQ9540 activate Return key, behave as "Continue" buttom clicked.
319 if Key = VK_RETURN then cmdContinueClick(self);
320end;
321
322end.
Note: See TracBrowser for help on using the repository browser.