shenhotkeys.pas

来自「向程序发送热键的单元源程序」· PAS 代码 · 共 732 行 · 第 1/2 页

    case W of
      0: temphotkey := keylabels[0];
      Ord('A'): temphotkey := keylabels[1];
      Ord('B'): temphotkey := keylabels[2];
      Ord('C'): temphotkey := keylabels[3];
      Ord('D'): temphotkey := keylabels[4];
      Ord('E'): temphotkey := keylabels[5];
      Ord('F'): temphotkey := keylabels[6];
      Ord('G'): temphotkey := keylabels[7];
      Ord('H'): temphotkey := keylabels[8];
      Ord('I'): temphotkey := keylabels[9];
      Ord('J'): temphotkey := keylabels[10];
      Ord('K'): temphotkey := keylabels[11];
      Ord('L'): temphotkey := keylabels[12];
      Ord('M'): temphotkey := keylabels[13];
      Ord('N'): temphotkey := keylabels[14];
      Ord('O'): temphotkey := keylabels[15];
      Ord('P'): temphotkey := keylabels[16];
      Ord('Q'): temphotkey := keylabels[17];
      Ord('R'): temphotkey := keylabels[18];
      Ord('S'): temphotkey := keylabels[19];
      Ord('T'): temphotkey := keylabels[20];
      Ord('U'): temphotkey := keylabels[21];
      Ord('V'): temphotkey := keylabels[22];
      Ord('W'): temphotkey := keylabels[23];
      Ord('X'): temphotkey := keylabels[24];
      Ord('Y'): temphotkey := keylabels[25];
      Ord('Z'): temphotkey := keylabels[26];
      Ord('1'): temphotkey := keylabels[27];
      Ord('2'): temphotkey := keylabels[28];
      Ord('3'): temphotkey := keylabels[29];
      Ord('4'): temphotkey := keylabels[30];
      Ord('5'): temphotkey := keylabels[31];
      Ord('6'): temphotkey := keylabels[32];
      Ord('7'): temphotkey := keylabels[33];
      Ord('8'): temphotkey := keylabels[34];
      Ord('9'): temphotkey := keylabels[35];
      Ord('0'): temphotkey := keylabels[36];
      VK_F1: temphotkey := keylabels[37];
      VK_F2: temphotkey := keylabels[38];
      VK_F3: temphotkey := keylabels[39];
      VK_F4: temphotkey := keylabels[40];
      VK_F5: temphotkey := keylabels[41];
      VK_F6: temphotkey := keylabels[42];
      VK_F7: temphotkey := keylabels[43];
      VK_F8: temphotkey := keylabels[44];
      VK_F9: temphotkey := keylabels[45];
      VK_F10: temphotkey := keylabels[46];
      VK_F11: temphotkey := keylabels[47];
      VK_F12: temphotkey := keylabels[48];
      VK_UP: temphotkey := keylabels[49];
      VK_DOWN: temphotkey := keylabels[50];
      VK_LEFT: temphotkey := keylabels[51];
      VK_RIGHT: temphotkey := keylabels[52];
      VK_ESCAPE: temphotkey := keylabels[53];
      VK_TAB: temphotkey := keylabels[54];
      VK_INSERT: temphotkey := keylabels[55];
      VK_DELETE: temphotkey := keylabels[56];
      VK_HOME: temphotkey := keylabels[57];
      VK_END: temphotkey := keylabels[58];
      VK_PRIOR: temphotkey := keylabels[59];
      VK_NEXT: temphotkey := keylabels[60];
      VK_NumPad0: temphotkey := keylabels[61];
      VK_NumPad1: temphotkey := keylabels[62];
      VK_NumPad2: temphotkey := keylabels[63];
      VK_NumPad3: temphotkey := keylabels[64];
      VK_NumPad4: temphotkey := keylabels[65];
      VK_NumPad5: temphotkey := keylabels[66];
      VK_NumPad6: temphotkey := keylabels[67];
      VK_NumPad7: temphotkey := keylabels[68];
      VK_NumPad8: temphotkey := keylabels[69];
      VK_NumPad9: temphotkey := keylabels[70];
      VK_ADD: temphotkey := keylabels[71];
      VK_SUBTRACT: temphotkey := keylabels[72];
      VK_MULTIPLY: temphotkey := keylabels[73];
      VK_DIVIDE: temphotkey := keylabels[74];
      VK_DECIMAL: temphotkey := keylabels[75];
      VK_NUMLOCK: temphotkey := keylabels[76];
      VK_SCROLL: temphotkey := keylabels[77];
    else begin
        Result := False;
        Exit;
      end;
    end;
    ShiftState := tempshift;
    HotKey := temphotkey;
    Result := True;
  except
    ShiftState := tempshiftold;
    HotKey := temphotkeyold;
    Result := False;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.Assign
  Author:    slq
  Date:      08-三月-2002
  Arguments: Item: TPersistent
  Result:    None
  Purpose:   安置
-----------------------------------------------------------------------------}

procedure TShenHotKeyItem.Assign(Item: TPersistent);
begin
  if Item is TShenHotKeyItem then
  begin
    HotKey := TShenHotKeyItem(Item).HotKey;
    ShiftState := TShenHotKeyItem(Item).ShiftState;
  end else
    inherited Assign(Item);
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.GetDisplayName
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    string
  Purpose:   设计期的显示名字
-----------------------------------------------------------------------------}

function TShenHotKeyItem.GetDisplayName: string;
  procedure AddShift(const S: string);
  begin
    if Result <> '' then
      Result := Result + ' + ';
    Result := Result + S;
  end;
begin
  if HotKey = '' then
    Result := inherited GetDisplayName
  else if Name <> '' then
    Result := Name
  else begin
    if ssAlt in ShiftState then
      AddShift('Alt');
    if ssCtrl in ShiftState then
      AddShift('Ctrl');
    if ssShift in ShiftState then
      AddShift('Shift');
    AddShift(HotKey);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.GetNamePath
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    string
  Purpose:   可能存在BUG，导致超过10个的时候出现小问题，
             因为绝对不影响使用，也不会造成内存泄漏等，所以暂时不修正
-----------------------------------------------------------------------------}

function TShenHotKeyItem.GetNamePath: string;
  function NameToSymbol(Name: string): string;
  var i: Integer;
  begin
    Result := '';
    for i := 1 to Length(Name) do
      if Name[i] in ['A'..'Z', 'a'..'z', '0'..'9'] then
        Result := Result + Name[i];
  end;
var S: string;
begin
  if Collection <> nil then
  begin
    S := Name;
    if (S = '') and (HotKey <> '') then
      S := GetDisplayName;
    S := NameToSymbol(S);
    if S <> '' then
      Result := Format('%s[%s]', [Collection.GetNamePath, S])
    else
      Result := Format('%s[%d]', [Collection.GetNamePath, Index]);
  end else
    Result := ClassName;
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.GetHotKey
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    string
  Purpose:
-----------------------------------------------------------------------------}

function TShenHotKeyItem.GetHotKey: string;
begin
  Result := KeyLabels[FHotKey];
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.SetHotKey
  Author:    slq
  Date:      08-三月-2002
  Arguments: Key: string
  Result:    None
  Purpose:
-----------------------------------------------------------------------------}

procedure TShenHotKeyItem.SetHotKey(Key: string);
var i: Integer;
begin
  i := 0;
  while i < High(KeyLabels) do
  begin
    Inc(i);
    if CompareText(Key, KeyLabels[i]) = 0 then
      Break;
  end;
  if i > High(KeyLabels) then
    i := 0;
  FHotKey := i;
  if not (csDesigning in Manager.ComponentState) then
    RegisterHotKey;
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.SetShiftState
  Author:    slq
  Date:      08-三月-2002
  Arguments: State: TShenShiftState
  Result:    None
  Purpose:
-----------------------------------------------------------------------------}

procedure TShenHotKeyItem.SetShiftState(State: TShenShiftState);
begin
  FShiftState := State;
  if not (csDesigning in Manager.ComponentState) then
    RegisterHotKey;
end;

{-----------------------------------------------------------------------------
  Procedure: TShenHotKeyItem.GetManager
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    TShenHotKeys
  Purpose:
-----------------------------------------------------------------------------}

function TShenHotKeyItem.GetManager: TShenHotKeys;
begin
  Result := THotKeyCollection(Collection).FOwner;
end;

{ PropEditors 属性编辑器 }

type
  //
  THotKeyProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

{-----------------------------------------------------------------------------
  Procedure: THotKeyProperty.GetAttributes
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    TPropertyAttributes
  Purpose:
-----------------------------------------------------------------------------}

function THotKeyProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paMultiSelect];
end;

{-----------------------------------------------------------------------------
  Procedure: THotKeyProperty.GetValues
  Author:    slq
  Date:      08-三月-2002
  Arguments: Proc: TGetStrProc
  Result:    None
  Purpose:
-----------------------------------------------------------------------------}

procedure THotKeyProperty.GetValues(Proc: TGetStrProc);
var i: Integer;
begin
  for i := 1 to High(KeyLabels) do
    Proc(KeyLabels[i]);
end;

type
  //
  THotKeyManagerEditor = class(TComponentEditor)
  protected
    procedure GetPropEdit(Editor: TPropertyEditor);
  public
  end;

{-----------------------------------------------------------------------------
  Procedure: THotKeyManagerEditor.GetPropEdit
  Author:    slq
  Date:      08-三月-2002
  Arguments: Editor: TPropertyEditor
  Result:    None
  Purpose:
-----------------------------------------------------------------------------}

procedure THotKeyManagerEditor.GetPropEdit(Editor: TPropertyEditor);
begin
  if Editor.GetName = 'HotKeys' then
    Editor.Edit;
end;

{$IFDEF VER100} { Delphi 3/4 }

procedure THotKeyManagerEditor.Edit;
var L: TComponentList;
begin
  L := TComponentList.Create;
  try
    L.Add(Component);
    GetComponentProperties(L, [tkClass], Designer, GetPropEdit);
  finally
    L.Free;
  end;
end;
{$ENDIF}

{$IFDEF VER130} { Delphi 5 }

procedure THotKeyManagerEditor.Edit;
var L: TDesignerSelectionList;
begin
  L := TDesignerSelectionList.Create;
  try
    L.Add(Component);
    GetComponentProperties(L, [tkClass], Designer, GetPropEdit);
  finally
    L.Free;
  end;
end;
{$ENDIF}

{-----------------------------------------------------------------------------
  Procedure: Register
  Author:    slq
  Date:      08-三月-2002
  Arguments: None
  Result:    None
  Purpose:   注册
-----------------------------------------------------------------------------}

procedure Register;
begin
  RegisterComponents('shen', [TShenHotKeys]);
  RegisterPropertyEditor(TypeInfo(string), TShenHotKeyItem, 'HotKey',
    THotKeyProperty);
  RegisterComponentEditor(TShenHotKeys, THotKeyManagerEditor);
end;

end.