2017-01-04 10 views
4

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를 통해)을 원하지 않습니다.이 컨트롤과 관련이 있어야합니다.)

+1

... –

+0

: 여기

는 (일반에 대한 (비 부동) 제어) 작업 예입니다 이것을 데모해라. 그러나 포함되지 않은 리소스 파일에서 imagelist (편집 단추 이미지 용)의 이미지를로드합니다. – TomB

+0

걱정하지 않아도 "LoadFromResourceName"을 "ResBmp.SetSize (24, 24);"로 대체하여 리소스 로딩을 무시할 수 있습니다. 물론 당신은 비트 맵을 유출하고 있지만 어떤 경우에도 멋진 재생산을하고 있습니다. –

답변

2

질문에 대한 설명에 설정되어 있으므로 힌트가 유지되지 않습니다. 화면은 무기한으로 표시되지만 실제로 숨겨진 즉시 실제로 다시 표시됩니다.

그 이유는 VCL이 힌트 컨트롤을 자식 창으로 가정하기 때문입니다. 그 이유는 Parent 속성이 nil이 아니기 때문입니다. 문제의 코드의 경우 월 달력 이 팝업 창으로 변경되어으로 변했지만 부동 문자는 VCL이 알고있는 한 여전히 형식입니다. 이로 인해 응용 프로그램의 ActivateHint 절차의 힌트 사각형에 대한 계산이 잘못됩니다. 반면에, 응용 프로그램의 HintMouseMessage 절차는 제어가 parented인지 아닌지 상관하지 않습니다. 그런 다음 마우스 포인터를 컨트롤 위로 이동시키지 않아도 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로


, 사용자 정의 힌트 창 불행하게도위치 할 수 설계되지 않은 것 같습니다. 힌트 윈도우는 로컬에서 생성되며 다른 방법으로 위치를 지정할 수있는 깔끔한 방법은 없습니다. 내가 생각할 수있는 유일한 방법은 힌트 창을 매개 변수로 표시하는 사용자 지정 힌트의 페인트 메서드 중 하나를 재정의하는 것입니다. 따라서 페인트 메시지를 받자 마자 힌트 창을 재배치 할 수 있습니다. 나는 완전한 기능 단위를 추가 한 - @Sertac가

작동하는 경우없이 추측 하드
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. 
+1

고맙습니다. 이것은 정말로 도움이됩니다. – TomB