Module

fReportsAdhocSubItem1

Path

C:\CPRS\CPRS30\fReportsAdhocSubItem1.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
fReportsAdhocComponent1 -
rReports -

Classes

Name Comments
TfrmReportsAdhocSubItem1 -

Procedures

Name Owner Declaration Scope Comments
btnAddSelClick TfrmReportsAdhocSubItem1 procedure btnAddSelClick(Sender: TObject); Public/Published -
btnCancelClick TfrmReportsAdhocSubItem1 procedure btnCancelClick(Sender: TObject); Public/Published -
btnOKClick TfrmReportsAdhocSubItem1 procedure btnOKClick(Sender: TObject); Public/Published -
btnRemoveAllSelClick TfrmReportsAdhocSubItem1 procedure btnRemoveAllSelClick(Sender: TObject); Public/Published -
btnRemoveSelClick TfrmReportsAdhocSubItem1 procedure btnRemoveSelClick(Sender: TObject); Public/Published -
FormCreate TfrmReportsAdhocSubItem1 procedure FormCreate(Sender: TObject); Public/Published -
ORComboBox2KeyUp TfrmReportsAdhocSubItem1 procedure ORComboBox2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ORComboBox2NeedData TfrmReportsAdhocSubItem1 procedure ORComboBox2NeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
ORListBox1DragDrop TfrmReportsAdhocSubItem1 procedure ORListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); Public/Published -
ORListBox1DragOver TfrmReportsAdhocSubItem1 procedure ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Public/Published -
ORListBox1EndDrag TfrmReportsAdhocSubItem1 procedure ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer); Public/Published -
pnl7ButtonEnter TfrmReportsAdhocSubItem1 procedure pnl7ButtonEnter(Sender: TObject); Public/Published -
pnl7ButtonExit TfrmReportsAdhocSubItem1 procedure pnl7ButtonExit(Sender: TObject); Public/Published -
SpeedButton7Click TfrmReportsAdhocSubItem1 procedure SpeedButton7Click(Sender: TObject); Public/Published -
SpeedButton8Click TfrmReportsAdhocSubItem1 procedure SpeedButton8Click(Sender: TObject); Public/Published -
Timer2Timer TfrmReportsAdhocSubItem1 procedure Timer2Timer(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteForm2 - function ExecuteForm2: Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmReportsAdhocSubItem1 TfrmReportsAdhocSubItem1 frmReportsAdhocSubItem1: TfrmReportsAdhocSubItem1; -


Module Source

1     unit fReportsAdhocSubItem1;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, Buttons, ORfn, fAutoSz, VA508AccessibilityManager;
8     
9     type
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    
59    var
60      frmReportsAdhocSubItem1: TfrmReportsAdhocSubItem1;
61    
62    function ExecuteForm2: Boolean;
63    
64    implementation
65    
66    uses fReportsAdhocComponent1, rReports, VAUtils;
67    
68    {$R *.DFM}
69    
70    function ExecuteForm2: Boolean;
71    begin
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;
82    end;
83    
84    procedure TfrmReportsAdhocSubItem1.btnCancelClick(Sender: TObject);
85    begin
86      ORComboBox2.Clear;
87      ORListBox1.Clear;
88      close;
89    end;
90    
91    procedure TfrmReportsAdhocSubItem1.FormCreate(Sender: TObject);
92    var
93      i: integer;
94    begin
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));
115   end;
116   
117   procedure TfrmReportsAdhocSubItem1.ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
118   begin
119     if (Sender = ORListBox1) and (Target = ORComboBox2) then
120       btnRemoveSelClick(nil);
121     Timer2.Enabled := False;
122   end;
123   
124   procedure TfrmReportsAdhocSubItem1.ORListBox1DragDrop(Sender, Source: TObject; X,
125     Y: Integer);
126   var
127     NuPos: Integer;
128   begin
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;
136   end;
137   
138   procedure TfrmReportsAdhocSubItem1.ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
139     State: TDragState; var Accept: Boolean);
140   begin
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;
155   end;
156   
157   procedure TfrmReportsAdhocSubItem1.Timer2Timer(Sender: TObject);
158   begin
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;
166   end;
167   
168   procedure TfrmReportsAdhocSubItem1.SpeedButton8Click(Sender: TObject);
169   var
170     i : Integer;
171   begin
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;
180   end;
181   
182   procedure TfrmReportsAdhocSubItem1.SpeedButton7Click(Sender: TObject);
183   var
184     i:integer;
185   begin
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;
193   end;
194   
195   procedure TfrmReportsAdhocSubItem1.btnRemoveAllSelClick(Sender: TObject);
196   var
197     i: integer;
198   begin
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;
218   end;
219   
220   procedure TfrmReportsAdhocSubItem1.btnRemoveSelClick(Sender: TObject);
221   var
222     i: integer;
223     chk: integer;
224   begin
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;
253   end;
254   
255   procedure TfrmReportsAdhocSubItem1.btnOKClick(Sender: TObject);
256   var
257     i: integer;
258     uTestList: TStringList;
259   begin
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;
275   end;
276   
277   procedure TfrmReportsAdhocSubItem1.btnAddSelClick(Sender: TObject);
278   var
279     i: integer;
280     uHSSubItems: TStringList;
281   begin
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       ShowMsg(
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;
327   end;
328   
329   procedure TfrmReportsAdhocSubItem1.ORComboBox2KeyUp(Sender: TObject;
330     var Key: Word; Shift: TShiftState);
331   begin
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;
340   end;
341   
342   procedure TfrmReportsAdhocSubItem1.ORComboBox2NeedData(Sender: TObject;
343     const StartFrom: String; Direction, InsertAt: Integer);
344   begin
345     ORComboBox2.ForDataUse(HSFileLookup(uFile,StartFrom,Direction));
346   end;
347   
348   procedure TfrmReportsAdhocSubItem1.pnl7ButtonEnter(Sender: TObject);
349   begin
350     inherited;
351     (sender as TPanel).BevelOuter := bvRaised;
352   end;
353   
354   procedure TfrmReportsAdhocSubItem1.pnl7ButtonExit(Sender: TObject);
355   begin
356     inherited;
357     (sender as TPanel).BevelOuter := bvNone;
358   end;
359   
360   end.

Module Calls (2 levels)


fReportsAdhocSubItem1
 ├fAutoSz
 │ └fBase508Form
 ├fReportsAdhocComponent1
 │ ├fAutoSz...
 │ ├fReportsAdhocSubItem1...
 │ ├fReports
 │ └rReports
 └rReports...

Module Called-By (2 levels)


       fReportsAdhocSubItem1
   fReportsAdhocComponent1┘ 
                fReports┤   
fReportsAdhocSubItem1...┘