hkselect.pas

Delphi 开发的的热键操作 很值得看的

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.