source: cprs/branches/tmg-cprs/CPRS-Chart/fReportsAdhocSubItem1.pas@ 1800

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

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