source: cprs/branches/foia-cprs/CPRS-Chart/fReportsAdhocSubItem1.pas@ 1099

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

Adding foia-cprs branch
File size: 10.3 KB
Line 
1unit fReportsAdhocSubItem1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORCtrls, Buttons, ORfn, fAutoSz;
8
9type
10 TfrmReportsAdhocSubItem1 = class(TfrmAutoSz)
11 GroupBox1: TGroupBox;
12 Splitter3: TSplitter;
13 pnl7Button: TKeyClickPanel;
14 SpeedButton7: TSpeedButton;
15 pnl8Button: TKeyClickPanel;
16 SpeedButton8: TSpeedButton;
17 ORComboBox2: TORComboBox;
18 ORListBox1: TORListBox;
19 Panel4: TPanel;
20 Label4: TLabel;
21 Label5: TLabel;
22 Panel5: TPanel;
23 btnCancel: TButton;
24 Panel8: TPanel;
25 btnAddSel: TButton;
26 btnRemoveSel: TButton;
27 btnRemoveAllSel: TButton;
28 btnOK: TButton;
29 Timer2: TTimer;
30 Label6: TStaticText;
31 lblLimit: TStaticText;
32 procedure btnCancelClick(Sender: TObject);
33 procedure FormCreate(Sender: TObject);
34 procedure ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
35 procedure ORListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
36 procedure ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
37 State: TDragState; var Accept: Boolean);
38 procedure Timer2Timer(Sender: TObject);
39 procedure SpeedButton8Click(Sender: TObject);
40 procedure SpeedButton7Click(Sender: TObject);
41 procedure btnRemoveAllSelClick(Sender: TObject);
42 procedure btnRemoveSelClick(Sender: TObject);
43 procedure btnOKClick(Sender: TObject);
44 procedure btnAddSelClick(Sender: TObject);
45 procedure ORComboBox2KeyUp(Sender: TObject; var Key: Word;
46 Shift: TShiftState);
47 procedure ORComboBox2NeedData(Sender: TObject; const StartFrom: String;
48 Direction, InsertAt: Integer);
49 procedure pnl7ButtonEnter(Sender: TObject);
50 procedure pnl7ButtonExit(Sender: TObject);
51 private
52 { Private declarations }
53 GoingUp: Boolean;
54 OKPressed: Boolean;
55 public
56 { Public declarations }
57 end;
58
59var
60 frmReportsAdhocSubItem1: TfrmReportsAdhocSubItem1;
61
62function ExecuteForm2: Boolean;
63
64implementation
65
66uses fReportsAdhocComponent1, rReports;
67
68{$R *.DFM}
69
70function ExecuteForm2: Boolean;
71begin
72 Result := False;
73 frmReportsAdhocSubItem1 := TfrmReportsAdhocSubItem1.Create(Application);
74 try
75 ResizeFormToFont(TForm(frmReportsAdhocSubItem1));
76 frmReportsAdhocSubItem1.ShowModal;
77 if frmReportsAdhocSubItem1.OKPressed then
78 Result := True;
79 finally
80 frmReportsAdhocSubItem1.Release;
81 end;
82end;
83
84procedure TfrmReportsAdhocSubItem1.btnCancelClick(Sender: TObject);
85begin
86 ORComboBox2.Clear;
87 ORListBox1.Clear;
88 close;
89end;
90
91procedure TfrmReportsAdhocSubItem1.FormCreate(Sender: TObject);
92var
93 i: integer;
94begin
95 uLimitCount := 1;
96 OKPressed := False;
97 Panel8.Left := Splitter3.Left + Splitter3.Width;
98 Panel8.Align := Splitter3.Align;
99 ORListBox1.Left := Panel8.Left + Panel8.Width;
100 ORListBox1.Align := Panel8.Align;
101 RedrawSuspend(ORComboBox2.Handle);
102 ORComboBox2.InitLongList('');
103 RedrawActivate(ORComboBox2.Handle);
104 If uLimit>0 then
105 lblLimit.Caption := IntToStr(uLimit)
106 else
107 lblLimit.Caption := 'No Limit';
108 ORListBox1.Caption := 'File Entries Selected ( Selections Allowed: ' +
109 lblLimit.Caption + ')';
110 Caption := Piece(frmReportsAdhocComponent1.ORComboBox1.Items
111 [frmReportsAdhocComponent1.ORComboBox1.ItemIndex],'^',2);
112 for i := 0 to uComponents.Count-1 do
113 if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then
114 ORListBox1.Items.Add(Pieces(uComponents[i],'^',3,10));
115end;
116
117procedure TfrmReportsAdhocSubItem1.ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
118begin
119 if (Sender = ORListBox1) and (Target = ORComboBox2) then
120 btnRemoveSelClick(nil);
121 Timer2.Enabled := False;
122end;
123
124procedure TfrmReportsAdhocSubItem1.ORListBox1DragDrop(Sender, Source: TObject; X,
125 Y: Integer);
126var
127 NuPos: Integer;
128begin
129 with Sender as TORListbox do
130 begin
131 NuPos := ItemAtPos(Point(X,Y),False);
132 If NuPos >= Items.Count then Dec(NuPos);
133 Items.Move(ItemIndex, NuPos);
134 ItemIndex := NuPos;
135 end;
136end;
137
138procedure TfrmReportsAdhocSubItem1.ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
139 State: TDragState; var Accept: Boolean);
140begin
141 Accept := (Sender = Source) and (TORListBox(Sender).ItemAtPos(Point(x,y), False) >= 0);
142 if Accept then
143 with Sender as TORListbox do
144 if Y > Height - ItemHeight then
145 begin
146 GoingUp := False;
147 Timer2.Enabled := True;
148 end
149 else if Y < ItemHeight then
150 begin
151 GoingUp := True;
152 Timer2.Enabled := True;
153 end
154 else Timer2.Enabled := False;
155end;
156
157procedure TfrmReportsAdhocSubItem1.Timer2Timer(Sender: TObject);
158begin
159 with ORListBox1 do
160 if GoingUp then
161 if TopIndex > 0 then TopIndex := TopIndex - 1
162 else Timer2.Enabled := False
163 else
164 if TopIndex < Items.Count - 1 then TopIndex := TopIndex + 1
165 else Timer2.Enabled := False;
166end;
167
168procedure TfrmReportsAdhocSubItem1.SpeedButton8Click(Sender: TObject);
169var
170 i : Integer;
171begin
172 with ORListbox1 do
173 if (ItemIndex < Items.Count-1) and
174 (ItemIndex <> -1) then
175 begin
176 i := ItemIndex;
177 Items.Move(i, i+1);
178 ItemIndex := i+1;
179 end;
180end;
181
182procedure TfrmReportsAdhocSubItem1.SpeedButton7Click(Sender: TObject);
183var
184 i:integer;
185begin
186 with ORListBox1 do
187 if ItemIndex > 0 then
188 begin
189 i := ItemIndex;
190 Items.Move(i, i-1);
191 ItemIndex := i-1;
192 end;
193end;
194
195procedure TfrmReportsAdhocSubItem1.btnRemoveAllSelClick(Sender: TObject);
196var
197 i: integer;
198begin
199 If ORListBox1.Items.Count < 1 then
200 begin
201 InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION);
202 Exit;
203 end;
204 if InfoBox('This button will remove all selected items. OK?',
205 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
206 begin
207 With ORListBox1 do
208 begin
209 for i := uComponents.Count-1 downto 0 do
210 uComponents.Delete(i);
211 for i := Items.Count-1 downto 0 do
212 Items.Delete(i);
213 end;
214 uLimitCount := 1;
215 SpeedButton7.Enabled := false;
216 SpeedButton8.Enabled := false;
217 end;
218end;
219
220procedure TfrmReportsAdhocSubItem1.btnRemoveSelClick(Sender: TObject);
221var
222 i: integer;
223 chk: integer;
224begin
225 chk := 0;
226 If ORListBox1.Items.Count < 1 then
227 begin
228 InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION);
229 Exit;
230 end
231 else
232 for i := 0 to ORListBox1.Items.Count - 1 do
233 if ORListBox1.Selected[i] then
234 chk := 1;
235 if chk = 0 then
236 begin
237 InfoBox('Please select the item you wish to remove', 'Information', MB_OK or MB_ICONINFORMATION);
238 Exit;
239 end;
240 With ORListBox1 do
241 begin
242 for i := uComponents.Count-1 downto 0 do
243 if piece(uComponents[i],'^',2) = Piece(Items[ItemIndex],'^',1) then
244 uComponents.Delete(i);
245 Items.Delete(ItemIndex);
246 uLimitCount := uLimitCount - 1;
247 if Items.Count < 1 then
248 begin
249 SpeedButton7.Enabled := false;
250 SpeedButton8.Enabled := false;
251 end;
252 end;
253end;
254
255procedure TfrmReportsAdhocSubItem1.btnOKClick(Sender: TObject);
256var
257 i: integer;
258 uTestList: TStringList;
259begin
260 uTestList := TStringList.Create;
261 uTestList.Clear;
262 for i := 0 to ORListBox1.Items.Count-1 do
263 uTestList.Add(ORListBox1.Items[i]);
264 for i := uComponents.Count-1 downto 0 do
265 if piece(uComponents[i],'^',1)=IntToStr(uCurrentComponent) then
266 uComponents.Delete(i);
267 for i := 0 to uTestList.Count-1 do
268 if (uLimit = 0) or (i < uLimit) then
269 uComponents.Add(IntToStr(uCurrentComponent)
270 + '^' + uFile + '^' + uTestList[i]);
271 OKPressed := True;
272 ORListBox1.Clear;
273 uTestList.Free;
274 Close;
275end;
276
277procedure TfrmReportsAdhocSubItem1.btnAddSelClick(Sender: TObject);
278var
279 i: integer;
280 uHSSubItems: TStringList;
281begin
282 If (uLimit <> 0) and (uLimitCount > uLimit) then
283 begin
284 Application.MessageBox(
285 'Sorry, you have reached the selection limit for this component',
286 'Selection Error',MB_OK + MB_DEFBUTTON1);
287 Exit;
288 end;
289 If ORComboBox2.ItemIndex < 0 then
290 begin
291 InfoBox('Please select an item to Add.', 'Information', MB_OK or MB_ICONINFORMATION);
292 Exit;
293 end;
294 If uFile = '60' then
295 begin
296 uHSSubItems := TStringList.Create;
297 HSSubItems(uHSSubItems,
298 Piece(ORComboBox2.Items[ORComboBox2.ItemIndex],'^',1));
299 If uHSSubItems.Count > 0 then
300 for i := 0 to uHSSubItems.Count-1 do
301 begin
302 ORListBox1.Items.Add(uHSSubItems[i]);
303 uLimitCount := uLimitCount + 1;
304 end
305 Else
306 begin
307 ORListBox1.Items.Add(ORComboBox2.Items[ORComboBox2.ItemIndex]);
308 uLimitCount := uLimitCount + 1;
309 end;
310 uHSSubItems.Free;
311 end
312 Else
313 begin
314 ORListBox1.Items.Add(ORComboBox2.Items[ORComboBox2.ItemIndex]);
315 uLimitCount := uLimitCount + 1;
316 end;
317 If (uLimit <> 0) and (uLimitCount > (uLimit+1)) then
318 ShowMessage(
319 'MAXIMUM SELECTION LIMIT EXCEEDED! Only the first '
320 + IntToStr(uLimit) + ' items in the list will be used');
321 If ORListBox1.Items.Count > 0 then
322 begin
323 SpeedButton7.Enabled := true;
324 SpeedButton8.Enabled := true;
325 end;
326 btnOK.SetFocus;
327end;
328
329procedure TfrmReportsAdhocSubItem1.ORComboBox2KeyUp(Sender: TObject;
330 var Key: Word; Shift: TShiftState);
331begin
332 If Key = 13 then
333 with ORComboBox2 do
334 if (Text <> '') and (Items.IndexOf (Text) >= 0) then
335 begin
336 ItemIndex := Items.IndexOf(Text);
337 btnAddSelClick(nil);
338 Key := 0;
339 end;
340end;
341
342procedure TfrmReportsAdhocSubItem1.ORComboBox2NeedData(Sender: TObject;
343 const StartFrom: String; Direction, InsertAt: Integer);
344begin
345 ORComboBox2.ForDataUse(HSFileLookup(uFile,StartFrom,Direction));
346end;
347
348procedure TfrmReportsAdhocSubItem1.pnl7ButtonEnter(Sender: TObject);
349begin
350 inherited;
351 (sender as TPanel).BevelOuter := bvRaised;
352end;
353
354procedure TfrmReportsAdhocSubItem1.pnl7ButtonExit(Sender: TObject);
355begin
356 inherited;
357 (sender as TPanel).BevelOuter := bvNone;
358end;
359
360end.
Note: See TracBrowser for help on using the repository browser.