使用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,-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 – 它必须特定于这些控件)

正如在问题的评论中已经确定的那样,提示不会无限期地保留在屏幕上,但实际上它一旦被隐藏就会不断重新显示.

原因是,VCL假定提示控件是子窗口,这是因为它的Parent属性不是nil.在问题中的代码的情况下,尽管月历通过将其变为弹出窗口而浮动,但是其父级仍然是VCL知道它的形式.这会导致Application的ActivateHint过程中的提示矩形的计算出错.另一方面,Application的HintMouseMessage过程并不关心控件是否是父级.然后会发生什么,虽然你没有在控件上移动鼠标指针,但是VCL推断鼠标指针连续离开提示边界然后重新进入.

以下是该问题的简化复制：

unit Unit1;

interface

uses
  Winapi.Windows,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,Width,Height);
end;

至于问题2,遗憾的是,自定义提示窗口似乎没有设计位置.提示窗口是在本地创建的,没有任何简洁的方法来获取它或以任何其他方式指定其位置.我能想到的唯一方法是覆盖一个自定义提示的绘制方法,它将提示窗口公开为参数.因此,我们可以在收到绘制消息后立即重新定位提示窗口.

这是一个工作示例(对于普通(非浮动)控件)：

unit Unit1;

interface

uses
  Winapi.Windows,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,Pt.X,Pt.Y + FControl.Height,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.

我有一个复选框,将在运行时启用/禁用.我只想显示启用/禁用的不同工具提示.我正在考虑重写OnMouseEnter事件并在那里处理它,但只有在启用控件时才会调用OnMouseEnter.我怎么可能实现这种行为？任何帮助,将不胜感激.

我试图处理表单的OnMouseMove并执行类似的操作

procedure Tdlg.pnlTopMouseMove(Sender: TObject;Shift: TShiftState; X,Y: Integer);
var
  point: TPoint;
  checkBoxCursorPos: TPoint;
begin
  inherited;
  point.X := X;
  point.Y := Y;
  checkBoxCursorPos := chkBx.ScreenToClient(point);
  if (PtInRect(chkBx.ClientRect,checkBoxCursorPos)) then
  begin
    if(chkBx.Enabled) then
      chkBx.Hint := 'Enabled'
    else
      chkBx.Hint := 'disabled' ;

    Application.ShowHint := True;
  end;

end;

但条件PtinRect不满意.我做错了什么？

有一个简单的解决方案：在复选框上放置一个空TLabel,并将其提示设置为禁用复选框状态的值.标签必须关闭AutoSize,您可以通过将BoundsRect属性设置为CheckBox的属性来强制执行位置和大小.

启用CheckBox时,将使用复选框的提示,而禁用CheckBox时将使用标签的提示.

更新：刚看到Bummi在评论中提到了类似的想法.

我如何获得appdata文件夹路径？这个id我的代码：

begin
Winexec(PAnsichar('%appdata%\TEST.exe'),sw_show);
end;
end.

但没有工作.

您无法将环境变量传递给WinExec().你必须先解决它们：

uses
  ...,SysUtils;

function GetPathToTestExe: string;
begin
  Result := SysUtils.GetEnvironmentvariable('APPDATA');
  if Result <> '' then
    Result := IncludeTrailingPathDelimiter(Result) + 'TEST.exe';
end;

uses
  ...,Windows;

var
  Path: string;
begin
  Path = GetPathToTestExe;
  if Path <> '' then
    WinExec(PAnsiChar(Path),SW_SHOW);
end;

或者：

uses
  ...,SysUtils,Windows;

function GetPathToTestExe: string;
var
  Path: array[0..MAX_PATH+1] of Char;
begin
  if ExpandEnvironmentStrings('%APPDATA%',Path,Length(Path)) > 1 then
    Result := IncludeTrailingPathDelimiter(Path) + 'TEST.exe'
  else
    Result := '';
end;

获取APPDATA文件夹路径的更可靠(和官方)方式是使用SHGetFolderPath()(或Vista上的SHGetKNownFolderPath())：

uses
  ...,Windows,SHFolder;

function GetPathToTestExe: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
  if SHGetFolderPath(0,CSIDL_APPDATA,SHGFP_TYPE_CURRENT,Path) = S_OK then
    Result := IncludeTrailingPathDelimiter(Path) + 'TEST.exe'
  else
    Result := '';
end;

但是,无论如何,自Windows 95以来,WinExec()已被弃用,你真的应该使用CreateProcess()代替：

uses
  ...,Windows;

var
  Path: String;
  si: TStartupInfo;
  pi: TProcessinformation;

Path := GetPathToTetExe;
if Path <> '' then
begin
  ZeroMemory(@si,SizeOf(si));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_SHOW;

  if CreateProcess(nil,PChar(Path),nil,FALSE,@si,pi)
  begin
    //...
    CloseHandle(pi.hThread);
    CloseHandle(pi.hProcess);
  end;
end;