使用Delphi XE6,我正在创建一个类似于TdateTimePicker的控件,但由于一些原因,我使用了一个TButtonedEdit控件,其中包含一个嵌入式的TMonthCalendar。一个完整的演示代码如下:
我已经通过在右侧按钮点击时显示月历(样式为WS_POPUP)来实现它的预期效果,并在做出选择、用户导航离开、按下ESC键等情况时隐藏它。
现在,我想为编辑框和TMonthCalendar分别添加提示,但我希望确保显示的提示不会遮挡相关控件。 对于编辑框,我已成功拦截了CM_HINTSHOW消息,并设置了HintInfo.HintPos来实现它。到目前为止,一切都很好。 问题1:更新:我现在已经显示出来了。最初,我将提示文本设置为包含管道字符,以便可以使用TCustomHint。去掉管道字符后,提示就会显示出来。但是,这个提示不会自动隐藏,只要TmonthCalendar显示,它就会一直停留在屏幕上。如何使其“自动隐藏”? 问题2:如果我为任一控件使用TCustomHint,则CMHintShow过程永远不会触发。因此,如果我确实想为额外的控件使用TCustomHint,那么它如何改变定位策略?(我不希望在“应用程序”级别上执行任何操作,例如通过OnShowHint - 它必须针对这些控件进行特定设置)
我已经通过在右侧按钮点击时显示月历(样式为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 - 它必须针对这些控件进行特定设置)