source: cprs/trunk/CPRS-Chart/fReportsAdhocSubItem1.pas@ 1531

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.