加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 （https://www.lidatong.com.cn/）- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置： 首页 > 大数据 > 正文

在Delphi中定位组件的提示

发布时间：2020-12-15 09:47:46 所属栏目：大数据 来源：网络整理
导读：使用Delphi XE6,我正在创建一个类似TdateTimePicker的控件,但由于几个原因,我使用的是TButtonedEdit,其中嵌入了TMonthCalendar“嵌入”.一个完整的简单演示是： 当点击右键(使用Style = WS_POPUP)时,我按照需要将月份日历显示为SHOWn,并在进行选择时隐藏它,
使用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.

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
    相关内容
      推荐文章
        站长推荐
        热点阅读

          【免责声明】本站内容转载自互联网，其发布内容言论不代表本站观点，如果其链接、内容的侵犯您的权益，烦请提交相关链接至邮箱bqsm@foxmail.com我们将及时予以处理。

          建议您使用1920×1080分辨率、谷歌浏览器Google Chrome、Microsoft Edge以获得本站的最佳浏览效果

          Copygight © 2008-2022 https://www.lidatong.com.cn/ All Rights Reserved. 李大同