| [459] | 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;
 | 
|---|
 | 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;
 | 
|---|
 | 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 |     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;
 | 
|---|
 | 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.
 | 
|---|