hotkeyedit.pas

热键设置输入框

unit HotKeyEdit;

interface

uses
  Windows, Messages, SysUtils, Graphics, Classes, StdCtrls, Controls, Forms;

type
  THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
  THKModifiers = set of THKModifier;
  THKInvalidKey = (hcNone, hcShift, hcCtrl, hcAlt, hcShiftCtrl,
    hcShiftAlt, hcCtrlAlt, hcShiftCtrlAlt);
  THKInvalidKeys = set of THKInvalidKey;
  
  TCustomHotKeyEdit = class(TCustomEdit)
  private
    //当前控件接收到的热键组合是否合法
    FKeySetValid: Boolean;
    //组合键
    FModValue: Integer;
    //虚拟键码
    FVirtualKeyValue: Integer;
    //修改合法后显示的颜色
    FValidateColor: TColor;
    //修改非法后显示的颜色
    FInvalidColor: TColor;
    //用来覆盖OnKeyDown事件的函数
    procedure GetHotKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
    //用来覆盖OnKeyUp事件的函数
    procedure GetHotKeyUpEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
    //将热键数据转换为直观文字
    function GetDisplayText: string;
    //热键组合合法执行的代码
    procedure ActionOnHotKeyValid;
    //热键组合非法执行的代码
    procedure ActionOnHotKeyInvalid;
  protected
    property HasValidKeySet: Boolean read FKeySetValid;
    property VirtualKeyValue: Integer read FVirtualKeyValue write FVirtualKeyValue;
    property KeyModValue: Integer read FModValue write FModValue;
    property ValidateColor: TColor read FValidateColor write FValidateColor;
    property InvalidColor: TColor read FInvalidColor write FInvalidColor;
    procedure WmSetText(var Message: TMessage); message WM_SETTEXT;
  public
    //覆盖构造函数
    constructor Create(AOwner: TComponent); override;
    procedure SetDisplayText(Value: string);
  end;

  THotKeyEdit = class(TCustomHotKeyEdit)
  published
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnContextPopup;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property HasValidKeySet;
    property VirtualKeyValue;
    property KeyModValue;
    property ValidateColor;
    property InvalidColor;
  end;

const
  STR_INVALID = '无';

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('lqpComponent', [THotKeyEdit]);
end;

{ TCustomHotKeyEdit }

procedure TCustomHotKeyEdit.ActionOnHotKeyInvalid;
begin
  Color := FInvalidColor;
end;

procedure TCustomHotKeyEdit.ActionOnHotKeyValid;
begin
  Color := FValidateColor;
end;

constructor TCustomHotKeyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ReadOnly := True;
  OnKeyDown := GetHotKeyDownEvent;
  OnKeyUp := GetHotKeyUpEvent;
  FInvalidColor := clRed;
  FValidateColor := clBlue;
  Text := 'Alt + A';
  FModValue := 1;
  FVirtualKeyValue := Ord('A');
end;

function TCustomHotKeyEdit.GetDisplayText:string;
var
  M_strDisplay:String;
const
  SPLUS = ' + ';
begin
  FKeySetValid := True;
  //处理按键组合
  case FModValue of
    1: M_strDisplay := 'Alt + ';
    2: M_strDisplay := 'Ctrl + ';
    3: M_strDisplay := 'Ctrl + Alt + ';
    4: M_strDisplay := 'Shift + ';
    5: M_strDisplay := 'Shift + Alt + ';
    6: M_strDisplay := 'Ctrl + Shift + ';
    7: M_strDisplay := 'Ctrl + Shift + Alt + ';
  else
    begin
      M_strDisplay := '';
      FKeySetValid := False;
    end;
  end;
  //处理键码
 case FVirtualKeyValue of
    VK_F1..VK_F12:
    begin
      M_strDisplay := M_strDisplay + 'F' + IntToStr(FVirtualKeyValue - VK_F1 + 1);
      FKeySetValid := True;
    end;
    Ord('A')..Ord('Z'), Ord('0')..Ord('9'):
    begin
      M_strDisplay := M_strDisplay + Chr(FVirtualKeyValue);
      FKeySetValid := True;
    end else
    begin
      M_strDisplay := M_strDisplay ;
      FKeySetValid := False;
    end;
  end;
  Result := M_strDisplay
end;

procedure TCustomHotKeyEdit.GetHotKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  M_StrDisplay:String;
begin
  FModValue := 0;
  if (ssCtrl in Shift) then FModValue := FModValue + 2;
  if (ssAlt in Shift) then FModValue := FModValue + 1;
  if (ssShift in Shift) then FModValue := FModValue + 4;
  FVirtualKeyValue := Key;
  M_StrDisplay := GetDisplayText;
  if FKeySetValid then
    ActionOnHotKeyValid
  else
    ActionOnHotKeyInvalid ;
  Text := M_StrDisplay;
end;

procedure TCustomHotKeyEdit.GetHotKeyUpEvent(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  M_StrDisplay:String;
begin
  M_StrDisplay := GetDisplayText;
  if FKeySetValid then
  begin
    ActionOnHotKeyValid;
    Text := M_StrDisplay;
  end else
  begin
    ActionOnHotKeyInvalid;
    Text := STR_INVALID;
    FModValue := 0;
    FVirtualKeyValue := 0;
  end;
end;

procedure TCustomHotKeyEdit.SetDisplayText(Value: string);
var
  ArrGet: TStringList;
  i, j: Integer;
  StrOnePart: string;
  IsOK: Boolean;
  chrOne: Char;
begin
  FModValue := 0;
  FVirtualKeyValue := 0;
  if (Trim(Value) = '') or (Value = STR_INVALID) then Exit;
  ArrGet := TStringList.Create;
  IsOK := True;
  try
    ArrGet.Delimiter := '+';
    ArrGet.DelimitedText := Value;  
    for i := 0 to ArrGet.Count-1 do
    begin
      StrOnePart := UpperCase(Trim(ArrGet[i]));
      if StrOnePart = 'ALT' then
        FModValue := FModValue + 1
      else if StrOnePart = 'CTRL' then
        FModValue := FModValue + 2
      else if StrOnePart = 'SHIFT' then
        FModValue := FModValue + 4
      else if i = (ArrGet.Count-1) then
      begin
        IsOK := False;
        if Length(ArrGet[i]) = 1 then
        begin
          chrOne := ArrGet[i][1];
          if chrOne in ['A'..'Z', '0'..'9'] then
          begin
            FVirtualKeyValue := Ord(chrOne);
            IsOK := True;
          end;
        end else
        begin
          for j := VK_F1 to VK_F12 do
            if ArrGet[i] = ('F' + IntToStr(j-VK_F1+1)) then
            begin
              FVirtualKeyValue := j;
              IsOK := True;
              Break;
            end;
        end;
      end
      else
        IsOK := False;
    end;
  finally
    ArrGet.Free;
    if not IsOK then Text := STR_INVALID;
  end;
end;

procedure TCustomHotKeyEdit.WmSetText(var Message: TMessage);
begin
  inherited;
  SetDisplayText(Text);
end;

end.