Delphi控件源码

开发平台：
C++ Builder

am2000shortcut.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       Shortcut editor                                 }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000shortcut;
{$I am2000.inc}
interface
uses
  SysUtils, ComCtrls, StdCtrls, Controls, ExtCtrls, Classes, Forms,
  DsgnIntf;
type
  // shortcut property
  T_AM2000_ShortCutProperty = class(TPropertyEditor)
  public
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
    function AllEqual: Boolean; override;
    procedure Edit; override;
  end;
  // shortcut editor
  T_AM2000_ShortCutEditor = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    StatusBar1: TStatusBar;
    PrefC: TCheckBox;
    PrefSC: TCheckBox;
    PrefCA: TCheckBox;
    PrefSCA: TCheckBox;
    Button3: TButton;
    PrefS: TCheckBox;
    PrefFn: TCheckBox;
    PrefA: TCheckBox;
    PrefSA: TCheckBox;
    procedure RebuildShortCuts(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FShortCuts: String;
    procedure SetShortCuts(AShortCuts: String);
    function GetShortCuts: String;
  protected
    procedure Loaded; override;
  public
    function EditShortCuts(var AShortCuts: String): Boolean;
  end;
implementation
uses
  Registry,
  am2000const;
const
  SHORTCUT_REGISTRY_KEY : String = 'SoftwareAnimatedMenus.comAnimatedMenus/2000ShortCutEditor';
{$R *.DFM}
procedure T_AM2000_ShortCutEditor.Loaded;
var
  R: TRegistry;
begin
  R:= TRegistry.Create;
  R.OpenKey(SHORTCUT_REGISTRY_KEY, True);
  try PrefA.Checked:= R.ReadBool('Alt');
  except end;
  try PrefC.Checked:= R.ReadBool('Ctrl');
  except end;
  try PrefS.Checked:= R.ReadBool('Shift');
  except end;
  try PrefCA.Checked:= R.ReadBool('CtrlAlt');
  except end;
  try PrefSA.Checked:= R.ReadBool('ShiftAlt');
  except end;
  try PrefSC.Checked:= R.ReadBool('ShiftCtrl');
  except end;
  try PrefSCA.Checked:= R.ReadBool('ShiftCtrlAlt');
  except end;
  try PrefFn.Checked:= R.ReadBool('Func');
  except end;
  R.Free;
  RebuildShortCuts(nil);
end;
procedure T_AM2000_ShortCutEditor.SetShortCuts(AShortCuts: String);
var
  I, P, E: Integer;
  T: TListItem;
  S: String;
begin
  FShortCuts:= AShortCuts;
  // add visible shortcuts
  for I:= 0 to ListView1.Items.Count -1 do begin
    T:= ListView1.Items[I];
    P:= Pos(T.Caption, AShortCuts);
    E:= P + Length(T.Caption);
    if (P <> 0)
    and ((P = 1) or (AShortCuts[P -1] = ';'))
    and ((E > Length(AShortCuts)) or (AShortCuts[E] = ';'))
    then begin
      T.Checked:= True;
      Delete(AShortCuts, P, E -P);
    end
    else
      if T.Checked
      then T.Checked:= False;
  end;
  // add other shortcuts
  while AShortCuts <> '' do begin
    P:= Pos(';', AShortCuts);
    if P = 0 then P:= Length(AShortCuts) +1;
    S:= Copy(AShortCuts, 1, P -1);
    Delete(AShortCuts, 1, P);
    if S <> '' then
      with ListView1.Items.Add do begin
        Caption:= S;
        Checked:= True;
      end;
  end;
end;
function T_AM2000_ShortCutEditor.GetShortCuts: String;
var
  I: Integer;
  T: TListItem;
begin
  Result:= '';
  for I:= 0 to ListView1.Items.Count -1 do begin
    T:= ListView1.Items[I];
    if T.Checked then begin
      if Result <> '' then AppendStr(Result, ';');
      AppendStr(Result, T.Caption);
    end;
  end;
end;
procedure T_AM2000_ShortCutEditor.RebuildShortCuts(Sender: TObject);
const
  nMaxPref = 8;
  Prefixes : array [0..nMaxPref -1] of String =
    ('',
     SAlt + '+' ,
     SCtrl + '+',
     SShift + '+',
     SCtrl + '+' + SAlt + '+',
     SShift + '+' + SAlt + '+',
     SShift + '+' + SCtrl + '+',
     SShift + '+' + SCtrl + '+' + SAlt  + '+');
var
  I, J: Integer;
  C: Char;
  PrefCheck : array [0..nMaxPref -1] of TCheckBox;
  procedure AddCustomShortCut(SC: String);
  var
    I: Integer;
  begin
    ListView1.Items.Add.Caption:= SC;
//    ListView1.Items.Add.Caption:= 'Shift+' + SC;
    for I:= 1 to nMaxPref -1 do
      if PrefCheck[I].Checked then
        ListView1.Items.Add.Caption:= Prefixes[I] + SC;
  end;
begin
  PrefCheck[0]:= nil;
  PrefCheck[1]:= PrefA;
  PrefCheck[2]:= PrefC;
  PrefCheck[3]:= PrefS;
  PrefCheck[4]:= PrefCA;
  PrefCheck[5]:= PrefSA;
  PrefCheck[6]:= PrefSC;
  PrefCheck[7]:= PrefSCA;
  with ListView1.Items do begin
    BeginUpdate;
    Clear;
    for I:= 1 to nMaxPref -1 do
      if PrefCheck[I].Checked
      and (I <> 3)
      then
        for C:= 'A' to 'Z' do
          Add.Caption:= Prefixes[I] + C;
    if PrefFn.Checked then
      for I:= 0 to nMaxPref -1 do
        if (PrefCheck[I] = nil)
        or PrefCheck[I].Checked
        then
          for J:= 1 to 12 do
            Add.Caption:= Prefixes[I] + 'F' + IntToStr(J);
    // custom shortcuts
    AddCustomShortCut('Esc');
    AddCustomShortCut(SIns);
    AddCustomShortCut(SDel);
    AddCustomShortCut('BkSp');
    EndUpdate;
  end;
  SetShortCuts(FShortCuts);
end;
procedure T_AM2000_ShortCutEditor.Button2Click(Sender: TObject);
begin
  SetShortCuts('');
end;
function T_AM2000_ShortCutEditor.EditShortCuts(
  var AShortCuts: String): Boolean;
begin
  SetShortCuts(AShortCuts);
  Result:= ShowModal = mrOk;
  if Result then AShortCuts:= GetShortCuts;
end;
{ T_AM2000_ShortCutProperty }
procedure T_AM2000_ShortCutProperty.Edit;
var
  ShortCutEditor: T_AM2000_ShortCutEditor;
  S: String;
begin
  ShortCutEditor:= T_AM2000_ShortCutEditor.Create(Application);
  S:= GetStrValue;
  if ShortCutEditor.EditShortCuts(S) then begin
    SetStrValue(S);
    Modified;
  end;
  ShortCutEditor.Free;
end;
function T_AM2000_ShortCutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog];
end;
function T_AM2000_ShortCutProperty.GetValue: string;
begin
  Result:= GetStrValue;
  if Result = '' then Result:= '(None)';
end;
function T_AM2000_ShortCutProperty.AllEqual: Boolean;
var
  I: Integer;
  S: String;
begin
  Result:= False;
  if PropCount > 1 then
  begin
    S:= GetStrValue;
    for I:= 1 to PropCount - 1 do
      if GetStrValueAt(I) <> S then Exit;
  end;
  Result:= True;
end;
procedure T_AM2000_ShortCutEditor.FormShow(Sender: TObject);
begin
  PrefA.Caption:=  SAlt + '+...';
  PrefC.Caption:=  SCtrl + '+...';
  PrefS.Caption:= SShift + '+...';
  PrefCA.Caption:= SCtrl + '+' + SAlt + '+...';
  PrefSA.Caption:= SShift + '+' + SAlt + '+...';
  PrefSC.Caption:= SShift + '+' + SCtrl + '+...';
  PrefSCA.Caption:= SShift + '+' + SCtrl + '+' + SAlt + '+...';
end;
procedure T_AM2000_ShortCutEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  R: TRegistry;
begin
  R:= TRegistry.Create;
  R.OpenKey(SHORTCUT_REGISTRY_KEY, True);
  try R.WriteBool('Alt', PrefA.Checked);
  except end;
  try R.WriteBool('Ctrl', PrefC.Checked);
  except end;
  try R.WriteBool('Shift', PrefS.Checked);
  except end;
  try R.WriteBool('CtrlAlt', PrefCA.Checked);
  except end;
  try R.WriteBool('ShiftAlt', PrefSA.Checked);
  except end;
  try R.WriteBool('ShiftCtrl', PrefSC.Checked);
  except end;
  try R.WriteBool('ShiftCtrlAlt', PrefSCA.Checked);
  except end;
  try R.WriteBool('Func', PrefFn.Checked);
  except end;
  R.Free;
end;
end.

						