source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCSession.pas@ 1083

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

Uploading from OR_30_258

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