那些遇到过的问题

捕获关键笔划以在自定义控件内手动绘制项目？

Jer*_*dge 3 delphi focus custom-controls delphi-7 keyboard-events

这个问题与我最近在这里提出的另一个问题有关,但更具体地说明我需要什么,而不是我的上一个问题,因为前一个问题我不确定如何解释甚至我想做什么.

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

说实话,我面临的问题有三个(如下所示),而这些问题都是因为我从来没有写过这个先进的控件.

  1. 引入击键(捕捉键盘消息)让用户浏览此控件中的项目 - 按键消息处理程序永远不会触发.
  2. 由于我将捕获Tab键并使用它来导航我的控件中的项目,如何在用户到达结束时将焦点传递给我的控件的父级的下一个/最后一个控件(按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.
Run Code Online (Sandbox Code Playgroud)

样品

以下是使用此任务栏的示例.在我的测试项目中,我暂时动态创建它,而不是发布到我的托盘上.虽然注册程序在那里.

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.
Run Code Online (Sandbox Code Playgroud)

Ser*_*yuz 5

VCL框架有自己的密钥处理方式,应用程序的消息循环使用CN_..常量转发关键消息.所以,例如,而不是:

procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
Run Code Online (Sandbox Code Playgroud)

你会拦截一个CN_KEYDOWN:

procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
Run Code Online (Sandbox Code Playgroud)


对于第(2)点,您可以使用FindNextControl(或甚至更好SelectNext:))表单.

此外,您可能想要调用inherited消息处理程序.

归档时间：

查看次数：

802 次

最近记录：

13 年，11 月 前
相关归档
我何时以及为什么要使用TStringBuilder？ 15
VCL样式随机打破 9
如何在编辑框中检测Enter键？ 8
聚焦任何类型元素的最佳方式 6
具有不同签名的功能指针(示例:带有默认值的可选参数) 5
GitHub API单一提交不获取所有文件 5
Delphi:RTTI和TObjectList <TObject> 4
Delphi编译器错误E2064左侧无法分配 4
生成FASTMM报告而不关闭对话框 4
Delphi - 需要Delphi7的XE2代码.使用wininet下载文件 1
难疑归档
为什么处理排序数组比处理未排序数组更快？ 23665
在JavaScript中创建GUID/UUID？ 3915
是否可以将CSS应用于角色的一半？ 2717
O(log n)究竟意味着什么？ 2021
如何在Git中完全替换另一个分支中的master分支？ 1549
如何递归计算目录中的所有代码行？ 1536
Node.js module.exports的目的是什么,你如何使用它？ 1397
如何在Linux shell脚本中提示是/否/取消输入？ 1352
为什么使用'=='或'is'比较字符串有时会产生不同的结果？ 1076
如何在psql中切换数据库？ 1029