home *** CD-ROM | disk | FTP | other *** search
- unit hkSelect;
-
- interface
-
- uses Windows, SysUtils, ComCtrls, Classes, Graphics, Forms, Controls, StdCtrls,
- Buttons;
-
- type
- TfrmSelect = class(TForm)
- btnOk: TButton;
- btnCancel: TButton;
- SrcLabel: TLabel;
- DstLabel: TLabel;
- btnInclude: TButton;
- btnInclAll: TButton;
- btnExclude: TButton;
- btnExclAll: TButton;
- lvSource: TListView;
- lvDestination: TListView;
- Label1: TLabel;
- edtDelay: TEdit;
- btnAddDelay: TButton;
- lblMilliseconds: TLabel;
- udDelay: TUpDown;
- btnUp: TSpeedButton;
- btnDown: TSpeedButton;
- procedure btnIncludeClick(Sender: TObject);
- procedure btnExcludeClick(Sender: TObject);
- procedure btnInclAllClick(Sender: TObject);
- procedure btnExclAllClick(Sender: TObject);
- procedure lvSourceClick(Sender: TObject);
- procedure lvDestinationChange(Sender: TObject; Item: TListItem;
- Change: TItemChange);
- procedure lvDestinationClick(Sender: TObject);
- procedure edtDelayExit(Sender: TObject);
- procedure btnAddDelayClick(Sender: TObject);
- procedure btnUpClick(Sender: TObject);
- procedure btnDownClick(Sender: TObject);
- private
- procedure GetDelay(var Sel: String);
- procedure DeleteFromSource(Item: TListItem);
- function NextItem(var Commands: String): String;
- procedure SelectAll(List: TListView);
- procedure MoveSelected(Source, Destination: TListView);
- procedure SetButtons;
- function GetSelection: String;
- public
- function Execute(List: TListView; InitialSelection: String): Boolean;
- property Selection: String read GetSelection;
- { Public declarations }
- end;
-
- var
- frmSelect: TfrmSelect;
-
- implementation
-
- {$R *.DFM}
-
- uses
- hkEdit;
-
- procedure TfrmSelect.btnIncludeClick(Sender: TObject);
- begin
- MoveSelected(lvSource, lvDestination);
- end;
-
- procedure TfrmSelect.btnExcludeClick(Sender: TObject);
- begin
- MoveSelected(lvDestination, lvSource);
- lvDestinationClick(Self);
- end;
-
- procedure TfrmSelect.btnInclAllClick(Sender: TObject);
- begin
- SelectAll(lvSource);
- MoveSelected(lvSource, lvDestination);
- end;
-
- procedure TfrmSelect.btnExclAllClick(Sender: TObject);
- begin
- SelectAll(lvDestination);
- MoveSelected(lvDestination, lvSource);
- lvDestinationClick(Self);
- end;
-
- procedure TfrmSelect.SelectAll(List: TListView);
- var
- i : integer;
- begin
- for i:=0 to List.Items.Count-1 do List.Items[i].Selected := True;
- end;
-
- procedure TfrmSelect.MoveSelected(Source, Destination: TListView);
- var
- i : integer;
- begin
- i := 0;
- while i<Source.Items.Count do
- begin
- if Source.Items[i].Selected then
- begin
- if Source.Items[i].SubItems.Count>0 then
- with Destination.Items.Add do
- begin
- Caption := Source.Items[i].Caption;
- SubItems.Assign(Source.Items[i].SubItems);
- Selected := True;
- end;
- Source.Items.Delete(i);
- end
- else
- inc(i);
- end;
- SetButtons;
- end;
-
- procedure TfrmSelect.SetButtons;
- var
- bUpEnabled,
- bFirst : Boolean;
- i,
- iLastSelect: Integer;
-
- begin
- btnInclude.Enabled := lvSource.SelCount>0;
- btnInclAll.Enabled := lvSource.Items.Count>0;
- btnExclude.Enabled := lvDestination.SelCount>0;
- btnExclAll.Enabled := lvDestination.Items.Count>0;
- btnOk.Enabled := btnExclAll.Enabled;
-
- bFirst := True;
- bUpEnabled := False;
- iLastSelect := -1;
- for i:=0 to lvDestination.Items.Count-1 do
- if lvDestination.Items[i].Selected then
- begin
- if bFirst and (i>0) then bUpEnabled := True;
- bFirst := False;
- iLastSelect := i;
- end;
- btnUp.Enabled := bUpEnabled;
- btnDown.Enabled := (iLastSelect<>-1) and (iLastSelect<lvDestination.Items.Count-1);
- end;
-
- function TfrmSelect.GetSelection: String;
- var
- i : integer;
- sItem: String;
- begin
- for i:=0 to lvDestination.Items.Count-1 do
- begin
- if lvDestination.Items[i].SubItems.Count=0 then
- begin
- sItem := lvDestination.Items[i].Caption;
- sItem := 'D='+Copy(sItem, Pos('=', sItem)+1, Length(sItem));
- end
- else
- sItem := lvDestination.Items[i].SubItems[0];
- Result := Result + sItem + ';';
- end;
- if Result<>'' then Delete(Result, Length(Result), 1);
- end;
-
- procedure TfrmSelect.GetDelay(var Sel: String);
- var
- P : Integer;
- begin
- P := Pos('D=', Sel);
- if P=1 then
- begin
- Delete(Sel, 1, P+1);
- P := Pos(';', Sel);
- lvDestination.Items.Add.Caption := 'Delay='+Copy(Sel, 1, P-1);
- Delete(Sel, 1, P);
- end;
- end;
-
- function TfrmSelect.NextItem(var Commands: String): String;
- var
- P : Integer;
- begin
- P := Pos(';', Commands);
- if P>0 then
- begin
- Result := Copy(Commands, 1, P-1);
- Delete(Commands, 1, P);
- end
- else
- begin
- Result := Commands;
- Commands := '';
- end;
- end;
-
- procedure TfrmSelect.DeleteFromSource(Item: TListItem);
- var
- i : integer;
- begin
- for i:=0 to lvSource.Items.Count-1 do
- with lvSource.Items[i] do
- if (Caption = Item.Caption) and (SubItems[ITEM_ID]= Item.SubItems[ITEM_ID]) then
- begin
- lvSource.Items.Delete(i);
- Exit;
- end;
- end;
-
- function TfrmSelect.Execute(List: TListView; InitialSelection: String): Boolean;
- var
- i : Integer;
- sItemID: String;
- begin
- lvSource.Items.Clear;
- lvDestination.Items.Clear;
- GetDelay(InitialSelection);
- lvSource.Items.Assign(List.Items);
- i := 0;
- while i<lvSource.Items.Count-1 do
- if frmHotkeyEdit.cboActions.Items.IndexOf(lvSource.Items[i].SubItems[ITEM_ACTION])=2 then
- lvSource.Items.Delete(i)
- else
- inc(i);
-
- while InitialSelection<>'' do
- begin
- GetDelay(InitialSelection);
- sItemID := NextItem(InitialSelection);
- while (sItemID<>'') do
- begin
- i := 0;
- while (i<List.Items.Count) do
- if List.Items[i].SubItems[ITEM_ID]=sItemID then
- begin
- lvDestination.Items.Add.Assign(List.Items[i]);
- DeleteFromSource(List.Items[i]);
- i := List.Items.Count;
- end
- else
- inc(i);
- GetDelay(InitialSelection);
- sItemID := NextItem(InitialSelection);
- end;
- end;
- Result := ShowModal = mrOk;
- end;
-
- procedure TfrmSelect.lvSourceClick(Sender: TObject);
- begin
- SetButtons;
- end;
-
- procedure TfrmSelect.lvDestinationChange(Sender: TObject; Item: TListItem;
- Change: TItemChange);
- begin
- if Change=ctState then lvDestinationClick(Sender);
- end;
-
- procedure TfrmSelect.lvDestinationClick(Sender: TObject);
- begin
- if (lvDestination.Selected<>nil) and (lvDestination.Selected.SubItems.Count=0) then
- btnAddDelay.Caption := '&Edit'
- else
- btnAddDelay.Caption := '&Add';
- if btnAddDelay.Caption = '&Edit' then
- with lvDestination.Selected do
- if SubItems.Count=0 then
- begin
- udDelay.Position := StrToIntDef(Copy(Caption, Pos('=', Caption)+1, Length(Caption)), 0);
- edtDelay.Text := IntToStr(udDelay.Position);
- end;
- SetButtons;
- end;
-
- procedure TfrmSelect.edtDelayExit(Sender: TObject);
- begin
- edtDelay.Text := IntToStr(udDelay.Position);
- end;
-
- procedure TfrmSelect.btnAddDelayClick(Sender: TObject);
- begin
- if btnAddDelay.Caption = '&Add' then
- lvDestination.Items.Add.Caption := 'Delay='+edtDelay.Text
- else
- lvDestination.Selected.Caption := 'Delay='+edtDelay.Text;
- end;
-
- procedure TfrmSelect.btnUpClick(Sender: TObject);
- var
- i: Integer;
- OldItem: TListItem;
- begin
- i := 1;
- while i<=lvDestination.Items.Count-1 do
- begin
- if lvDestination.Items[i].Selected then
- begin
- OldItem := lvDestination.Items[i];
- with lvDestination.Items.Insert(i-1) do
- begin
- Assign(OldItem);
- Selected := True;
- end;
- OldItem.Free;
- end;
- inc(i);
- end;
- end;
-
- procedure TfrmSelect.btnDownClick(Sender: TObject);
- var
- i : integer;
- OldItem: TListItem;
- begin
- i := lvDestination.Items.Count-2;
- while i>=0 do
- begin
- if lvDestination.Items[i].Selected then
- begin
- OldItem := lvDestination.Items[i];
- with lvDestination.Items.Insert(i+2) do
- begin
- Assign(OldItem);
- Selected := True;
- end;
- OldItem.Free;
- end;
- dec(i);
- end;
- end;
-
- end.
-