使用Delphi XE6，我正在创建一个类似TdateTimePicker的控件，但由于几个原因，我使用的是TButtonedEdit，其中嵌入了TMonthCalendar。一个完整的简单演示是：
当按下单击右键（使用Style = WS_POPUP ）时，我按照需要将月份日历显示为SHOWn，并在进行选择时隐藏它，用户导航， ESCapes等。
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 ：更新：我现在就展示了它。最初我已经将提示的文本设置为包含Pipe字符，因此我可以使用TCustomHint。删除管道符，导致提示显示。 但是这个提示不会隐藏自己，它会在TmonthCalendar显示时停留在屏幕上。我怎样才能让它“自我隐藏”？
问题2 ：如果我使用TCustomHint进行任一控制，那么CMHintShow过程永远不会触发。所以，如果我确实想要使用TCustomHint进行额外控制，那么它如何改变定位策略呢？ （我不希望在“应用程序”级别进行任何操作，例如通过OnShowHint - 它必须特定于这些控件）
答案 0 :(得分：2)
正如在问题的评论中已经确定的那样，提示不会无限期地保留在屏幕上，但实际上它一旦被隐藏就会不断重新显示。
原因是，VCL假设提示控件是子窗口，因为它的Parent属性不是nil。对于问题中的代码，虽然月份日历浮动通过将其变为弹出窗口，但就VCL知道它而言，其父级仍然是表单。这会导致应用程序的ActivateHint过程中的提示矩形的计算出错。另一方面，应用程序的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.