unit fReportsAdhocSubItem1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ORCtrls, Buttons, ORfn, fAutoSz, VA508AccessibilityManager; type TfrmReportsAdhocSubItem1 = class(TfrmAutoSz) GroupBox1: TGroupBox; Splitter3: TSplitter; pnl7Button: TKeyClickPanel; SpeedButton7: TSpeedButton; pnl8Button: TKeyClickPanel; SpeedButton8: TSpeedButton; ORComboBox2: TORComboBox; ORListBox1: TORListBox; Panel4: TPanel; Label4: TLabel; Label5: TLabel; Panel5: TPanel; btnCancel: TButton; Panel8: TPanel; btnAddSel: TButton; btnRemoveSel: TButton; btnRemoveAllSel: TButton; btnOK: TButton; Timer2: TTimer; Label6: TStaticText; lblLimit: TStaticText; procedure btnCancelClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer); procedure ORListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Timer2Timer(Sender: TObject); procedure SpeedButton8Click(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); procedure btnRemoveAllSelClick(Sender: TObject); procedure btnRemoveSelClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure btnAddSelClick(Sender: TObject); procedure ORComboBox2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ORComboBox2NeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure pnl7ButtonEnter(Sender: TObject); procedure pnl7ButtonExit(Sender: TObject); private { Private declarations } GoingUp: Boolean; OKPressed: Boolean; public { Public declarations } end; var frmReportsAdhocSubItem1: TfrmReportsAdhocSubItem1; function ExecuteForm2: Boolean; implementation uses fReportsAdhocComponent1, rReports, VAUtils; {$R *.DFM} function ExecuteForm2: Boolean; begin Result := False; frmReportsAdhocSubItem1 := TfrmReportsAdhocSubItem1.Create(Application); try ResizeFormToFont(TForm(frmReportsAdhocSubItem1)); frmReportsAdhocSubItem1.ShowModal; if frmReportsAdhocSubItem1.OKPressed then Result := True; finally frmReportsAdhocSubItem1.Release; end; end; procedure TfrmReportsAdhocSubItem1.btnCancelClick(Sender: TObject); begin ORComboBox2.Clear; ORListBox1.Clear; close; end; procedure TfrmReportsAdhocSubItem1.FormCreate(Sender: TObject); var i: integer; begin uLimitCount := 1; OKPressed := False; Panel8.Left := Splitter3.Left + Splitter3.Width; Panel8.Align := Splitter3.Align; ORListBox1.Left := Panel8.Left + Panel8.Width; ORListBox1.Align := Panel8.Align; RedrawSuspend(ORComboBox2.Handle); ORComboBox2.InitLongList(''); RedrawActivate(ORComboBox2.Handle); If uLimit>0 then lblLimit.Caption := IntToStr(uLimit) else lblLimit.Caption := 'No Limit'; ORListBox1.Caption := 'File Entries Selected ( Selections Allowed: ' + lblLimit.Caption + ')'; Caption := Piece(frmReportsAdhocComponent1.ORComboBox1.Items [frmReportsAdhocComponent1.ORComboBox1.ItemIndex],'^',2); for i := 0 to uComponents.Count-1 do if piece(uComponents[i],'^',1) = IntToStr(uCurrentComponent) then ORListBox1.Items.Add(Pieces(uComponents[i],'^',3,10)); end; procedure TfrmReportsAdhocSubItem1.ORListBox1EndDrag(Sender, Target: TObject; X, Y: Integer); begin if (Sender = ORListBox1) and (Target = ORComboBox2) then btnRemoveSelClick(nil); Timer2.Enabled := False; end; procedure TfrmReportsAdhocSubItem1.ORListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); var NuPos: Integer; begin with Sender as TORListbox do begin NuPos := ItemAtPos(Point(X,Y),False); If NuPos >= Items.Count then Dec(NuPos); Items.Move(ItemIndex, NuPos); ItemIndex := NuPos; end; end; procedure TfrmReportsAdhocSubItem1.ORListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := (Sender = Source) and (TORListBox(Sender).ItemAtPos(Point(x,y), False) >= 0); if Accept then with Sender as TORListbox do if Y > Height - ItemHeight then begin GoingUp := False; Timer2.Enabled := True; end else if Y < ItemHeight then begin GoingUp := True; Timer2.Enabled := True; end else Timer2.Enabled := False; end; procedure TfrmReportsAdhocSubItem1.Timer2Timer(Sender: TObject); begin with ORListBox1 do if GoingUp then if TopIndex > 0 then TopIndex := TopIndex - 1 else Timer2.Enabled := False else if TopIndex < Items.Count - 1 then TopIndex := TopIndex + 1 else Timer2.Enabled := False; end; procedure TfrmReportsAdhocSubItem1.SpeedButton8Click(Sender: TObject); var i : Integer; begin with ORListbox1 do if (ItemIndex < Items.Count-1) and (ItemIndex <> -1) then begin i := ItemIndex; Items.Move(i, i+1); ItemIndex := i+1; end; end; procedure TfrmReportsAdhocSubItem1.SpeedButton7Click(Sender: TObject); var i:integer; begin with ORListBox1 do if ItemIndex > 0 then begin i := ItemIndex; Items.Move(i, i-1); ItemIndex := i-1; end; end; procedure TfrmReportsAdhocSubItem1.btnRemoveAllSelClick(Sender: TObject); var i: integer; begin If ORListBox1.Items.Count < 1 then begin InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION); Exit; end; if InfoBox('This button will remove all selected items. OK?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then begin With ORListBox1 do begin for i := uComponents.Count-1 downto 0 do uComponents.Delete(i); for i := Items.Count-1 downto 0 do Items.Delete(i); end; uLimitCount := 1; SpeedButton7.Enabled := false; SpeedButton8.Enabled := false; end; end; procedure TfrmReportsAdhocSubItem1.btnRemoveSelClick(Sender: TObject); var i: integer; chk: integer; begin chk := 0; If ORListBox1.Items.Count < 1 then begin InfoBox('There are no items to remove.', 'Information', MB_OK or MB_ICONINFORMATION); Exit; end else for i := 0 to ORListBox1.Items.Count - 1 do if ORListBox1.Selected[i] then chk := 1; if chk = 0 then begin InfoBox('Please select the item you wish to remove', 'Information', MB_OK or MB_ICONINFORMATION); Exit; end; With ORListBox1 do begin for i := uComponents.Count-1 downto 0 do if piece(uComponents[i],'^',2) = Piece(Items[ItemIndex],'^',1) then uComponents.Delete(i); Items.Delete(ItemIndex); uLimitCount := uLimitCount - 1; if Items.Count < 1 then begin SpeedButton7.Enabled := false; SpeedButton8.Enabled := false; end; end; end; procedure TfrmReportsAdhocSubItem1.btnOKClick(Sender: TObject); var i: integer; uTestList: TStringList; begin uTestList := TStringList.Create; uTestList.Clear; for i := 0 to ORListBox1.Items.Count-1 do uTestList.Add(ORListBox1.Items[i]); for i := uComponents.Count-1 downto 0 do if piece(uComponents[i],'^',1)=IntToStr(uCurrentComponent) then uComponents.Delete(i); for i := 0 to uTestList.Count-1 do if (uLimit = 0) or (i < uLimit) then uComponents.Add(IntToStr(uCurrentComponent) + '^' + uFile + '^' + uTestList[i]); OKPressed := True; ORListBox1.Clear; uTestList.Free; Close; end; procedure TfrmReportsAdhocSubItem1.btnAddSelClick(Sender: TObject); var i: integer; uHSSubItems: TStringList; begin If (uLimit <> 0) and (uLimitCount > uLimit) then begin Application.MessageBox( 'Sorry, you have reached the selection limit for this component', 'Selection Error',MB_OK + MB_DEFBUTTON1); Exit; end; If ORComboBox2.ItemIndex < 0 then begin InfoBox('Please select an item to Add.', 'Information', MB_OK or MB_ICONINFORMATION); Exit; end; If uFile = '60' then begin uHSSubItems := TStringList.Create; HSSubItems(uHSSubItems, Piece(ORComboBox2.Items[ORComboBox2.ItemIndex],'^',1)); If uHSSubItems.Count > 0 then for i := 0 to uHSSubItems.Count-1 do begin ORListBox1.Items.Add(uHSSubItems[i]); uLimitCount := uLimitCount + 1; end Else begin ORListBox1.Items.Add(ORComboBox2.Items[ORComboBox2.ItemIndex]); uLimitCount := uLimitCount + 1; end; uHSSubItems.Free; end Else begin ORListBox1.Items.Add(ORComboBox2.Items[ORComboBox2.ItemIndex]); uLimitCount := uLimitCount + 1; end; If (uLimit <> 0) and (uLimitCount > (uLimit+1)) then ShowMsg( 'MAXIMUM SELECTION LIMIT EXCEEDED! Only the first ' + IntToStr(uLimit) + ' items in the list will be used'); If ORListBox1.Items.Count > 0 then begin SpeedButton7.Enabled := true; SpeedButton8.Enabled := true; end; btnOK.SetFocus; end; procedure TfrmReportsAdhocSubItem1.ORComboBox2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin If Key = 13 then with ORComboBox2 do if (Text <> '') and (Items.IndexOf (Text) >= 0) then begin ItemIndex := Items.IndexOf(Text); btnAddSelClick(nil); Key := 0; end; end; procedure TfrmReportsAdhocSubItem1.ORComboBox2NeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin ORComboBox2.ForDataUse(HSFileLookup(uFile,StartFrom,Direction)); end; procedure TfrmReportsAdhocSubItem1.pnl7ButtonEnter(Sender: TObject); begin inherited; (sender as TPanel).BevelOuter := bvRaised; end; procedure TfrmReportsAdhocSubItem1.pnl7ButtonExit(Sender: TObject); begin inherited; (sender as TPanel).BevelOuter := bvNone; end; end.