delphi - 捕获击键以导航自定义控件内手动绘制的项目？

Question

此问题与 another question I asked here recently 相关，但比上一个问题更具体地说明我需要什么，因为上一个问题我不确定如何解释，甚至不确定我想做什么。

我正在构建一个自定义控件，它看起来(并且最终会工作)类似于 Windows 任务栏的工作方式。它的最左侧有一个主菜单按钮，控件内排列着动态数量的其他按钮。它可以被认为是某种列表控件，只是带有 1 个额外的按钮(菜单)。菜单按钮我认为索引为-1，第一个动态按钮的索引为0。

说实话，我面临 3 个问题(如下所列)，它们都是由于我从未编写过如此高级的控件而导致的。

1. 引入击键(捕获键盘消息)以让用户浏览此控件中的项目 - 按键消息处理程序永远不会触发。
2. 由于我将捕获 Tab 键并使用它来导航控件内的项目，因此当用户到达末尾(或如果使用 Shift+Tab 则开始)？
3. 就像我说的，我以前从未使用过如此先进的控件，我想确保我有一个良好的开端。您是否发现我的代码中还需要进行其他修复？以防万一您碰巧在我的代码中看到一些奇怪的东西。

我想我应该同时提出所有 3 个问题，因为它们都与我在下面发布的同一单元相关......

组件TJDTaskbar

unit JDTaskbar;

interface

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

type
  TJDTaskbar = class;
  TJDTaskbarItem = class;
  TJDTaskbarItems = class;

  TJDTaskHandle = Integer;  //Future use
  TFocusIndex = -1..MaxInt; //Range of possible indexes in list

  //Mimics the Windows taskbar for managing forms in an application
  //Main component
  TJDTaskbar = class(TCustomControl)
  private
    FButtonColor: TColor;
    FItems: TJDTaskbarItems;
    FButtonHover: TColor;
    FButtonWidth: Integer;
    FButtonText: TCaption;
    FButtonCaption: TCaption;
    FButtonFont: TFont;
    FFocusIndex: TFocusIndex;
    function GetColor: TColor;
    procedure SetButtonColor(const Value: TColor);
    procedure SetColor(const Value: TColor);
    procedure SetButtonHover(const Value: TColor);
    procedure ItemEvent(Sender: TObject);
    procedure SetButtonWidth(const Value: Integer);
    procedure SetButtonText(const Value: TCaption);
    procedure SetButtonCaption(const Value: TCaption);
    procedure SetButtonFont(const Value: TFont);
    procedure ButtonFontEvent(Sender: TObject);   
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS; 
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
  protected
    procedure Paint; override;
    procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetItemSize: Integer;
    function NewTask(AForm: TForm): TJDTaskbarItem;
    function ButtonRect: TRect;
    function ItemRect(const Index: Integer): TRect;
    procedure MoveFocus(const StepBy: Integer);
    property Items: TJDTaskbarItems read FItems;
  published
    property Align;
    property Anchors;
    property ButtonCaption: TCaption read FButtonCaption write SetButtonCaption;
    property ButtonFont: TFont read FButtonFont write SetButtonFont;
    property Color: TColor read GetColor write SetColor;
    property ButtonColor: TColor read FButtonColor write SetButtonColor;
    property ButtonHover: TColor read FButtonHover write SetButtonHover;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
    property ButtonText: TCaption read FButtonText write SetButtonText;
    property Visible;
  end;

  TJDTaskbarItems = class(TObject)
  private
    FLastHandle: TJDTaskHandle;
    FItems: TStringList;
    FOwner: TJDTaskbar;
    FOnEvent: TNotifyEvent;
    procedure Event;
    function GetItem(Index: Integer): TJDTaskbarItem;
    function NewHandle: TJDTaskHandle;
    procedure SetItem(Index: Integer; const Value: TJDTaskbarItem);
  public
    constructor Create(AOwner: TJDTaskbar);
    destructor Destroy; override;
    function Count: Integer;
    function Add(AForm: TForm): TJDTaskbarItem;
    procedure Delete(const Index: Integer);
    procedure Clear;
    property Items[Index: Integer]: TJDTaskbarItem read GetItem write SetItem; default;
  published
    property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
  end;

  TJDTaskbarItem = class(TObject)
  private
    FForm: TForm;
    FOwner: TJDTaskbarItems;
    FPinned: Bool;
    FCaption: TCaption;
    FOnEvent: TNotifyEvent;
    FHandle: TJDTaskHandle;
    procedure SetCaption(const Value: TCaption);
    procedure SetPinned(const Value: Bool);
    procedure Event;
  public
    constructor Create(AOwner: TJDTaskbarItems; AForm: TForm; AHandle: TJDTaskHandle);
    destructor Destroy; override;
    property Form: TForm read FForm;
    property Handle: TJDTaskHandle read FHandle;
  published
    property Pinned: Bool read FPinned write SetPinned;
    property Caption: TCaption read FCaption write SetCaption;
    property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('JD Custom', [TJDTaskbar]);
end;

{ TJDTaskbar }

constructor TJDTaskbar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop:= True;
  ControlStyle:= ControlStyle + [csCaptureMouse,csClickEvents];
  FButtonFont:= TFont.Create;
  FButtonFont.OnChange:= ButtonFontEvent;
  FButtonCaption:= 'Menu';
  FButtonFont.Color:= clWhite;
  FButtonFont.Size:= 12;
  FButtonFont.Style:= [fsBold];
  Parent:= TWinControl(AOwner);
  FItems:= TJDTaskbarItems.Create(Self);
  FItems.OnEvent:= ItemEvent;
  inherited Color:= clNavy;
  FButtonColor:= clNavy;
  FButtonHover:= clBlue;
  FButtonWidth:= 80;
  FFocusIndex:= -1;
  Invalidate;
end;

destructor TJDTaskbar.Destroy;
begin
  FButtonFont.Free;
  FItems.Free;
  inherited;
end;

function TJDTaskbar.GetColor: TColor;
begin
  Result:= inherited Color;
end;

function TJDTaskbar.GetItemSize: Integer;
begin
  Result:= ClientHeight - 4;
end;

procedure TJDTaskbar.ItemEvent(Sender: TObject);
begin
  Invalidate;
end;

procedure TJDTaskbar.Paint;
var
  C: TCanvas;   //Canvas to work on
  Br: TBrush;   //Canvas brush
  Pn: TPen;     //Canvas pen
  R: TRect;     //Cliprect of taskbar
  X: Integer;   //Loop index
  L: Integer;   //Running left position
  BS: Integer;  //Item width/height
  MG: Integer;  //Margin between buttons
  BTR: TRect;   //Button rect
  I: TJDTaskbarItem;  //Temp item in loop
begin
  //Prepare Variables
  C:= Self.Canvas;
  R:= C.ClipRect;
  Br:= C.Brush;
  Pn:= C.Pen;
  BS:= GetItemSize;
  MG:= 3;
  L:= FButtonWidth + 2 + MG;

  //Draw taskbar background
  Br.Style:= bsSolid;
  Pn.Style:= psClear;
  Br.Color:= Color;
  C.FillRect(R);

  //Draw main menu button   
  Br.Style:= bsSolid;
  Pn.Style:= psSolid;
  if (Focused) and (FFocusIndex = -1) then begin
    Br.Color:= FButtonColor;
    Pn.Color:= clGray;
  end else begin
    Br.Color:= FButtonColor;
    Pn.Color:= clBlack;
  end;
  C.RoundRect(2, 2, FButtonWidth + 2, ClientHeight - 2, 4, 4);
  //Text
  BTR:= Rect(4, 4, FButtonWidth, ClientHeight - 4);
  C.Font.Assign(FButtonFont);
  DrawText(C.Handle, PChar(FButtonCaption), Length(FButtonCaption), BTR,
    DT_CENTER   or DT_VCENTER);


  //Draw taskbar icons  
  if (Focused) and (FFocusIndex >= 0) then begin
    Br.Color:= FButtonColor;
    Pn.Color:= clGray;
  end else begin
    Br.Color:= FButtonColor;
    Pn.Color:= clBlack;
  end;
  for X:= 0 to FItems.Count - 1 do begin
    I:= FItems[X];
    R:= ItemRect(X);
    C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 4, 4);
    L:= L + BS + MG;
  end;

end;

procedure TJDTaskbar.SetButtonColor(const Value: TColor);
begin
  if Value <> FButtonColor then begin
    FButtonColor := Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetButtonHover(const Value: TColor);
begin
  if Value <> FButtonHover then begin
    FButtonHover := Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetButtonText(const Value: TCaption);
begin
  if Value <> FButtonText then begin
    FButtonText := Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetButtonWidth(const Value: Integer);
begin
  if Value <> FButtonWidth then begin
    FButtonWidth := Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetButtonCaption(const Value: TCaption);
begin
  if Value <> FButtonCaption then begin
    FButtonCaption := Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetColor(const Value: TColor);
begin
  if Value <> inherited Color then begin
    inherited Color:= Value;
    Invalidate;
  end;
end;

procedure TJDTaskbar.SetButtonFont(const Value: TFont);
begin
  FButtonFont.Assign(Value);
end;

procedure TJDTaskbar.ButtonFontEvent(Sender: TObject);
begin
  Invalidate;
end;

function TJDTaskbar.NewTask(AForm: TForm): TJDTaskbarItem;
begin
  Result:= FItems.Add(AForm);
end;

function InRect(const Point: TPoint; const Rect: TRect): Bool;
begin
  Result:= (Point.X >= Rect.Left) and (Point.X <= Rect.Right)
    and (Point.Y >= Rect.Top) and (Point.Y <= Rect.Bottom);
end;

procedure TJDTaskbar.WMKillFocus(var Message: TWMSetFocus);
begin
  Invalidate;
end;

procedure TJDTaskbar.WMSetFocus(var Message: TWMSetFocus);
begin
  Invalidate;
end;

//I know this procedure is a weird mess, plan to clean it up
procedure TJDTaskbar.WMNCHitTest(var Message: TWMNCHitTest);
var
  P: TPoint;
  CR: TCursor;
  X: Integer;
  DI: Bool;
begin    
  DI:= True;
  CR:= crDefault;
  with Message do begin
    if (csDesigning in ComponentState) and (Parent <> nil) then begin
      Result := HTCLIENT;
    end else begin
      P:= Point(Message.XPos, Message.YPos);
      P:= Self.ScreenToClient(P);
      if InRect(P, ButtonRect) then begin    
        DI:= False;
        Result:= HTCLIENT;
        FFocusIndex:= -1;
        CR:= crHandPoint;
      end else begin
        for X:= 0 to FItems.Count - 1 do begin
          if InRect(P, ItemRect(X)) then begin
            DI:= False;
            Result:= HTCLIENT;
            FFocusIndex:= X;
            CR:= crHandPoint;
            Break;
          end;
        end;
      end;
    end;
  end;   
  if DI then begin
    inherited;
  end;
  if CR <> Cursor then begin
    Cursor:= CR;
  end;
end;

function TJDTaskbar.ButtonRect: TRect;
begin
  Result:= Rect(
    2,
    2,
    FButtonWidth + 2,
    GetItemSize + 2
  );
end;

function TJDTaskbar.ItemRect(const Index: Integer): TRect;
var
  Z: Integer;
begin
  Z:= GetItemSize;
  Result.Top:= 2;
  Result.Bottom:= Z + 2;
  Result.Left:= FButtonWidth + 4 + ((Z + 2) * Index);
  Result.Right:= Result.Left + Z;
end;

procedure TJDTaskbar.CMEnter(var Message: TCMEnter);
begin
  //Haven't tried yet
end;

procedure TJDTaskbar.CMExit(var Message: TCMExit);
begin
  //Haven't tried yet
end;

//Why doesn't this ever trigger?
procedure TJDTaskbar.WMKeyDown(var Message: TWMKeyDown);
begin
  //I tried handling it here but a few issues, including it never triggered
  //and how do I determine shift state?
end;

procedure TJDTaskbar.WMKeyUp(var Message: TWMKeyUp);
begin
  //Haven't tried yet
end;

procedure TJDTaskbar.WMGetDlgCode(var Msg: TMessage);
begin
  inherited;
  Msg.Result:= Msg.Result or DLGC_WANTTAB;
end;

//Why doesn't this ever trigger either?
procedure TJDTaskbar.KeyDown(var Key: Word; Shift: TShiftState);
begin   
  case Key of
    VK_TAB: begin
      if(ssShift in Shift)then begin
        if FFocusIndex = -1 then begin
          //Go to prior control?
        end else begin
          //Go back a space
          MoveFocus(-1);
        end;
      end else begin
        if FFocusIndex >= FItems.Count - 1 then begin
          //Go to next control?
        end else begin
          //Go forward a space
          MoveFocus(1);
        end;
      end;
    end;
    VK_LEFT: begin
      MoveFocus(-1);
    end;
    VK_RIGHT: begin
      MoveFocus(1);
    end;
    VK_UP: begin
      MoveFocus(-1);
    end;
    VK_DOWN: begin
      MoveFocus(1);
    end;
    VK_RETURN: begin
      //Future use
    end;
    else inherited;
  end;
  Invalidate;
end;

//Moves +/- in internal focus      //1 or -1
procedure TJDTaskbar.MoveFocus(const StepBy: Integer);
var
  R: Integer;
begin
  if (FFocusIndex = -1) and (StepBy < 0) then
    FFocusIndex:= FItems.Count - 1
  else if (FFocusIndex >= FItems.Count - 1) then
    FFocusIndex:= -1
  else begin
    R:= FFocusIndex + StepBy;
    if R < -1 then R:= -1;
    if R > FItems.Count - 1 then R:= FItems.Count - 1;
    FFocusIndex:= R;
  end;
  Invalidate;
end;

{ TJDTaskbarItems }

constructor TJDTaskbarItems.Create(AOwner: TJDTaskbar);
begin
  FOwner:= AOwner;
  FItems:= TStringList.Create;
end;

destructor TJDTaskbarItems.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TJDTaskbarItems.Add(AForm: TForm): TJDTaskbarItem;
var
  S: String;
  H: TJDTaskHandle;
begin
  S:= 'New Taskbar Item';
  H:= Self.NewHandle;
  Result:= TJDTaskbarItem.Create(Self, AForm, H);
  FItems.AddObject(S, Result);
end;

function TJDTaskbarItems.Count: Integer;
begin
  Result:= FItems.Count;
end;

procedure TJDTaskbarItems.Event;
begin
  if assigned(FOnEvent) then FOnEvent(Self);
end;

procedure TJDTaskbarItems.Clear;
begin
  while FItems.Count > 0 do
    Delete(0);
end;

procedure TJDTaskbarItems.Delete(const Index: Integer);
begin
  if (Index >= 0) and (Index < FItems.Count) then begin
    TJDTaskbarItem(FItems.Objects[Index]).Free;
    FItems.Delete(Index);
  end else begin

  end;
end;

function TJDTaskbarItems.GetItem(Index: Integer): TJDTaskbarItem;
begin
  if (Index >= 0) and (Index < FItems.Count) then begin
    Result:= TJDTaskbarItem(FItems.Objects[Index]);
  end else begin

  end;
end;

procedure TJDTaskbarItems.SetItem(Index: Integer;
  const Value: TJDTaskbarItem);
begin
  if (Index >= 0) and (Index < FItems.Count) then begin
    FItems.Objects[Index]:= Value;
  end else begin

  end;
end;

function TJDTaskbarItems.NewHandle: TJDTaskHandle;
begin
  FLastHandle:= FLastHandle + 1;
  Result:= FLastHandle;
end;

{ TJDTaskbarItem }

constructor TJDTaskbarItem.Create(AOwner: TJDTaskbarItems; AForm: TForm; 
  AHandle: TJDTaskHandle);
begin
  FOwner:= AOwner;
  FForm:= AForm;
  FHandle:= AHandle;
end;

destructor TJDTaskbarItem.Destroy;
begin
  inherited;
end;

procedure TJDTaskbarItem.Event;
begin
  if assigned(FOnEvent) then FOnEvent(Self);
end;

procedure TJDTaskbarItem.SetCaption(const Value: TCaption);
begin
  if Value <> FCaption then begin
    FCaption := Value;
    Event;
  end;
end;

procedure TJDTaskbarItem.SetPinned(const Value: Bool);
begin
  if Value <> FPinned then begin
    FPinned := Value;
    Event;
  end;
end;

end.

示例

这是使用此任务栏的示例。在我的测试项目中，我暂时动态创建它，而不是发布到我的托盘中。虽然注册程序是有的。

unit uTaskMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JDTaskbar, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FTaskbar: TJDTaskbar;
  public
    property Taskbar: TJDTaskbar read FTaskbar;
  end;

var
  Form1: TForm1;

implementation

//Form2 is in Unit2
uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  T: TJDTaskbarItem;
begin
  FTaskbar:= TJDTaskbar.Create(nil);
  FTaskbar.Parent:= Self;
  FTaskbar.Align:= alBottom;
  FTaskbar.Color:= clBlue;
  FTaskbar.Height:= 26;
  //Mimic adding a few icons to taskbar using "Form2"
  T:= FTaskbar.NewTask(Form2);
  T:= FTaskbar.NewTask(Form2);
  T:= FTaskbar.NewTask(Form2);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin           
  FTaskbar.Free;
end;

end.

Answer 1

VCL框架有自己的按键处理方式，应用程序的消息循环使用CN_..常量转发按键消息。因此，例如，而不是:

procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;

您将拦截CN_KEYDOWN:

procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;

对于第(2)点，您可以使用表单的FindNextControl(或者更好的SelectNext:))。

此外，您可能希望在消息处理程序中调用inherited。