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