Delphi XE6을 사용하여 TdateTimePicker와 유사한 컨트롤을 만들었지 만 몇 가지 이유로 인해 TMonthCalendar가 "임베디드"된 TButtonedEdit을 사용하고 있습니다. 전체 베어 본 데모는 : 나는 오른쪽 버튼 (스타일 = WS_POPUP와 )를 클릭하면 월 달력이 표시되는으로 원하는대로가는 선택이는 만들어 질 때 나는 그것을 숨기기 가지고Delphi의 구성 요소에 대한 위치 힌트
사용자는
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를 사용할 수 있도록 파이프 문자를 포함하는 힌트 텍스트를 설정했습니다. 파이프 문자를 제거하면 힌트가 표시됩니다. BUT이 힌트는 숨기지 않고 TmonthCalendar가 표시되는 동안 화면에 그대로 있습니다. 어떻게하면 "자기 숨김"으로 만들 수 있습니까?
질문 2 : 어느 컨트롤에 대해서도 TCustomHint를 사용하면 CMHintShow 프로 시저가 실행되지 않습니다. 따라서 TCustomHint를 사용하여 추가 컨트롤을 제공하려는 경우 어떻게 배치 전략을 변경합니까? (예 : OnShowHint를 통해 "응용 프로그램"레벨 (예 : OnShowHint를 통해)을 원하지 않습니다.이 컨트롤과 관련이 있어야합니다.)
... –
: 여기
는 (일반에 대한 (비 부동) 제어) 작업 예입니다 이것을 데모해라. 그러나 포함되지 않은 리소스 파일에서 imagelist (편집 단추 이미지 용)의 이미지를로드합니다. – TomB걱정하지 않아도 "LoadFromResourceName"을 "ResBmp.SetSize (24, 24);"로 대체하여 리소스 로딩을 무시할 수 있습니다. 물론 당신은 비트 맵을 유출하고 있지만 어떤 경우에도 멋진 재생산을하고 있습니다. –