Delphi中组件的定位提示

Question

使用Delphi XE6，我正在创建一个类似于TdateTimePicker的控件，但由于一些原因，我使用了一个TButtonedEdit控件，其中包含一个嵌入式的TMonthCalendar。一个完整的演示代码如下：

我已经通过在右侧按钮点击时显示月历（样式为WS_POPUP）来实现它的预期效果，并在做出选择、用户导航离开、按下ESC键等情况时隐藏它。

unit DateEditBare1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ImgList,  Vcl.ComCtrls, Vcl.StdCtrls,
  CommCtrl;

type

  TespMonthCalendar = class(TMonthCalendar)
    procedure DoCloseUp(Sender: TObject);
  private
    FDroppedDown: boolean;
    FManagerHandle: HWND;   // just a convenience to avoid having to assume its in the owner

    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure SetWindowDIMs;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
 end;

  TespDateEdit = class(TButtonedEdit)
  private
    FMonthCalendar: TespMonthCalendar;

    procedure DoRightButtonClick(Sender: TObject);
  protected
    procedure CreateWnd; override;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  public
    constructor Create(AOwner:TComponent); override;
    property MonthCalendar: TespMonthCalendar read FMonthCalendar write FMonthCalendar;
  end;

  TfrmDateEditBare1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    espDateEdit1: TespDateEdit;
  public
  end;

var
  frmDateEditBare1: TfrmDateEditBare1;

implementation

{$R *.dfm}

var
  _espdateEdit_ImageList: TImageList=nil;

//------------------------------------------------------------------------------


function MakeImageList(const ResNames: array of String): TImageList;
var
  ResBmp: TBitmap;
  I: Integer;
begin
  { Create an image list. }
  _espdateEdit_ImageList := TImageList.Create(nil);
  _espdateEdit_ImageList.Width  := 24;
  _espdateEdit_ImageList.Height := 16;
  Result := _espdateEdit_ImageList;

  for I := 0 to Length(ResNames) - 1 do
  begin
    ResBmp := TBitmap.Create();
    try
      { Try to load the bitmap from the resource. }
      try
        //ResBmp.LoadFromResourceName(HInstance, ResNames[I]);
        ResBmp.SetSize(24,16);

        ResBmp.Transparent := true;
      except
        ResBmp.Free();
        Result.Free();
        Exit;
      end;
      Result.Add(ResBmp, nil);
    finally
      ResBmp.Free;
    end;
  end;
end;



// Aowner is ignored for now
function GetImageList: TImageList;
begin
  if _espdateEdit_ImageList = nil then
    result  := MakeImageList(['CalendarDrop', 'CalendarDropShifted'])
  else
    result := _espdateEdit_ImageList;
end;

//------------------------------------------------------------------------------



procedure TfrmDateEditBare1.FormCreate(Sender: TObject);
begin
  espDateEdit1:= TespDateEdit.Create(self);
  espDateEdit1.Parent := self;
  espDateEdit1.left := 100;
  espDateEdit1.top  := 100;
  espDateEdit1.Visible := true;

end;

//------------------------------------------------------------------------------


{ TespMonthCalendar }

procedure TespMonthCalendar.CMHintShow(var Message: TCMHintShow);
begin
  inherited;
  if Message.HintInfo.HintControl=Self then
  begin
    Message.HintInfo.HintPos := self.ClientToScreen(Point(0, self.Height + 1));
    Message.HintInfo.HideTimeout := 1000;
//    Message.HintInfo.ReshowTimeout := 1500; // setting this does not help
  end;
end;


procedure TespMonthCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  with Params do
  begin
    Style := WS_POPUP;
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS ;
    if CheckWin32Version(5, 1) then
      WindowClass.Style := WindowClass.style or CS_DROPSHADOW;
  end;
end;


procedure TespMonthCalendar.CreateWnd;
begin
  inherited;
  // Get/set the dimensions of the calendar
  SetWindowDIMs;
end;


procedure TespMonthCalendar.SetWindowDIMs;
var
  ReqRect: TRect;
  MaxTodayWidth: Integer;
begin
  FillChar(ReqRect, SizeOf(TRect), 0);
  // get required rect
  Win32Check(MonthCal_GetMinReqRect(Handle, ReqRect));
  // get max today string width
  MaxTodayWidth := MonthCal_GetMaxTodayWidth(Handle);
  // adjust rect width to fit today string
  if MaxTodayWidth > ReqRect.Right then
    ReqRect.Right := MaxTodayWidth;
  // set new height & width
  Width := ReqRect.Right ;
  Height:= ReqRect.Bottom ;
end;  (* SetWindowDIMs *)




procedure TespMonthCalendar.CNNotify(var Message: TWMNotify);
begin
  // hand off control of the selection to the boss i.e. the espDateEdit that I belong to
  // skip for demo ... just closeup
  if ( Message.NMHdr^.code = MCN_SELECT) then
    DoCloseUp(self);
  inherited;
end; (*CNNotify*)




procedure TespMonthCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
  begin
    Key  := 0;
    DoCloseUp(self);
  end
  else
    inherited KeyDown(Key, Shift);
end;


procedure TespMonthCalendar.WMActivate(var Msg: TWMActivate);
begin
  if (Msg.Active <> WA_INACTIVE) then
    // tell form to paint itself as though it still has focus (as we are no outside the form with POPUP)
    SendMessage(screen.ActiveForm.Handle, WM_NCACTIVATE, WPARAM(True), -1)
  else
    DoCloseUp(self);
  inherited;
end;




procedure TespMonthCalendar.DoCloseUp(Sender: TObject);
begin
  if FDroppedDown then
  begin
    FDroppedDown := false;
    Hide;
    // put focus back on dateedit so that checking is done if we leave here to go on to another control
    SendMessage(FManagerHandle, WM_ACTIVATE, WPARAM(True), -1);  // less assumptions this way
  end;
end;


//------------------------------------------------------------------------------

{ TespDateEdit }

procedure TespDateEdit.CMHintShow(var Message: TCMHintShow);
begin
  inherited;
  if Message.HintInfo.HintControl=Self then
    Message.HintInfo.HintPos := self.ClientToScreen(Point(0, 21));
end;


constructor TespDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not(csDesigning in ComponentState) then
  begin
    FmonthCalendar := TespMonthCalendar.Create(self);

    self.hint      := 'DUMMY HINT for Edit Box';
    FMonthCalendar.Hint := 'Select required Date,' + ^M^J +  'or ESCape to close the calendar.';
    FMonthCalendar.ShowHint := true;
  end;

  Width        := 100;
  Height       := 21;
  Images       := GetImageList;
  Text         := ''; // FormatdateTime('dd/mm/yy', Date);  // not for demo
  ShowHint     := True;

  DoubleBuffered := true;  // reduces flicker when passing thru and within control
  RightButton.ImageIndex        := 0;
  RightButton.PressedImageIndex := 1;
  RightButton.Visible           := True;

  OnRightButtonClick := DoRightButtonClick;
end;



procedure TespDateEdit.CreateWnd;
var
  P: TWinControl;
begin
  inherited CreateWnd;
  if not(csDesigning in ComponentState) then
  begin
    FMonthCalendar.left := -900;
    P := self.Parent;
    while (P <> nil ) and not ( P is TCustomForm ) do
      P := P.parent;
    FmonthCalendar.Parent       := P;  // ie form (or the topmost non nil entry in the tree)

    FmonthCalendar.FManagerHandle := self.Handle;
    FMonthCalendar.Hide;
    FmonthCalendar.OnExit    := FmonthCalendar.DoCloseUp;
  end;
end;




procedure TespDateEdit.DoRightButtonClick(Sender: TObject);
var
  dt: Tdate;
  TopLeft: TPoint;
  Rect: TRect;
begin
  if FmonthCalendar.FdroppedDown then
  begin
    FMonthCalendar.DoCloseUp(nil);
    exit;
  end;

  // load non-zero date into calendar as the selected date ... skip for demo

  TopLeft               := self.ClientToScreen(Point(0, 0));    // i.e. screen co-ords of top left of edit box
  monthCalendar.left   := TopLeft.X - 3 ;                // shift a poopsie to line up visually
  monthCalendar.Top    := TopLeft.Y  + self.Height - 2;

  // only move it if it exceeds screen bounds ... skip this for demo

  FmonthCalendar.FDroppedDown := true;
  MonthCal_SetCurrentView(FmonthCalendar.handle, MCMV_MONTH);
  FmonthCalendar.Show;

  // showing is not enough - need to grab focus to get kbd events happening on the calendar
  FmonthCalendar.SetFocus;

  inherited OnRightButtonClick;
end;

//------------------------------------------------------------------------------

initialization
finalization
  FreeAndNil(_espdateEdit_ImageList);


end.

现在，我想为编辑框和TMonthCalendar分别添加提示，但我希望确保显示的提示不会遮挡相关控件。 对于编辑框，我已成功拦截了CM_HINTSHOW消息，并设置了HintInfo.HintPos来实现它。到目前为止，一切都很好。 问题1：更新：我现在已经显示出来了。最初，我将提示文本设置为包含管道字符，以便可以使用TCustomHint。去掉管道字符后，提示就会显示出来。但是，这个提示不会自动隐藏，只要TmonthCalendar显示，它就会一直停留在屏幕上。如何使其“自动隐藏”？ 问题2：如果我为任一控件使用TCustomHint，则CMHintShow过程永远不会触发。因此，如果我确实想为额外的控件使用TCustomHint，那么它如何改变定位策略？（我不希望在“应用程序”级别上执行任何操作，例如通过OnShowHint - 它必须针对这些控件进行特定设置）

- TomB

---

没有一个可行的案例很难进行推测... - Sertac Akyuz

@Sertac - 我已经添加了一个完整的功能单元来演示这个。然而，它从一个未包含的资源文件中加载图像列表（用于编辑按钮图像）的图像。 - TomB

没问题，我可以通过将“LoadFromResourceName”替换为“ResBmp.SetSize（24, 24）;”来绕过资源加载。当然你会泄漏你的位图，但无论如何都很好复制。 - Sertac Akyuz

@Sertac 感谢您抽出时间。关于位图泄漏：我确实在终止部分释放了imagelist（这只是演示）。不确定“heizenbug”是什么，但我想我明白了。我注意到当日历下拉时，即使鼠标静止不动，它也会连续接收CM_HINTSHOW消息，大约每半秒或一秒钟一次。我在Calendar对象上放置了一个简单的计数器，在鼠标进入时初始化它，在每个CM_HINTSHOW消息上递增，并且当它达到某个值时，我只需将消息中的提示字符串设置为空。粗糙但可能必须这样做。再次感谢。 - TomB

我已经向您解释过（在您现在已删除的回答中）这是一个“每个帖子一个问题”的网站，您提出一个问题并得到对该问题的回答。如果您有两个问题，您需要创建两个独立的帖子来提问；如果需要，您可以添加一个链接到第二个帖子以参考第一个帖子，以便更容易解释。如果您想为这个问题提供解决方案，请使用下面提供的空间发表一个包含该解决方案的回答。[帮助]页面提供了关于该网站如何运作的更多信息。我正在撤销您的编辑，因为它不正确。 - Ken White

Answer 1

如问题的评论中所述，提示信息并不会一直停留在屏幕上，而是在隐藏后立即持续重新显示。

这是因为VCL假定提示控件是一个子窗口，因为它的“Parent”属性不为空。在问题的代码中，虽然月历通过将其变异为弹出窗口而漂浮，但在VCL知道的范围内，它的父级仍然是表单。这导致应用程序中“ActivateHint”过程中的提示矩形计算出现错误。另一方面，“Application”的“HintMouseMessage”过程不关心控件是否有父级。然后发生的情况是，尽管您没有将鼠标指针移动到控件上，但VCL推断鼠标指针不断离开提示边界，然后重新进入。

以下是该问题的简化重现：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TPanel = class(vcl.extctrls.TPanel)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPanel }

procedure TPanel.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := WS_POPUPWINDOW or WS_THICKFRAME;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Hint := 'Button1';
  Panel1.Hint := 'Panel1';
  ShowHint := True;
  Application.HintHidePause := 1000;
  Left := 0;
  Top := 0;
  Panel1.ParentBackground := False;
  Panel1.Left := 0;
  Panel1.Height := 50;
  Panel1.Top := Top + Height;
end;

end.

在上面的代码中，按钮的提示将在超时后隐藏，而面板的提示在隐藏后会重新显示。我故意将窗口定位到它们的位置，以便您可以观察提示激活时指针位置的重要性。如果您从下方进入面板，则提示只会显示一次，然后隐藏。但是，如果您从上方进入面板，则会看到问题。

解决方法很简单，您可以在CM_HINTSHOW消息处理程序中修改提示矩形。由于控件是浮动的，因此不需要复杂的计算。相应地修改了重现案例，也修复了问题中的日历：

type
  TPanel = class(vcl.extctrls.TPanel)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  end;

  TForm1 = class(TForm)
    ...

{ TPanel }

procedure TPanel.CMHintShow(var Message: TCMHintShow);
begin
  inherited;
  if (GetAncestor(Handle, GA_ROOT) = Handle) and Assigned(Parent) then
    Message.HintInfo.CursorRect := Rect(0, 0, Width, Height);
end;

---

关于问题2，自定义提示窗口不幸地似乎没有被设计成可定位的。提示窗口是本地创建的，没有简便的方法来获取它或以其他方式指定其位置。我能想到的唯一方法是重写其中一个自定义提示的绘制方法，该方法将提示窗口作为参数公开。因此，我们可以在收到绘制消息时重新定位提示窗口。

这里是一个正常（非浮动）控件的工作示例：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyCustomHint = class(TCustomHint)
  private
    FControl: TControl;
  public
    procedure NCPaintHint(HintWindow: TCustomHintWindow; DC: HDC); override;
  end;

procedure TMyCustomHint.NCPaintHint(HintWindow: TCustomHintWindow; DC: HDC);
var
  Pt: TPoint;
begin
  Pt := FControl.ClientToScreen(Point(0, 0));
  SetWindowPos(HintWindow.Handle, 0, Pt.X, Pt.Y + FControl.Height, 0, 0,
      SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
  inherited;
end;

//--------

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShowHint := True;
  Button1.Hint := 'button1 hint';
  Button1.CustomHint := TMyCustomHint.Create(Self);
  TMyCustomHint(Button1.CustomHint).FControl := Button1;
end;

end.

- Sertac Akyuz

---

谢谢你。这真的很有帮助 - 非常感激。 - TomB