TDateTimePickerのスタイルプロパティ

Question

TDateTimeピッカーは、ドロップダウンリストがカレンダーに置き換えられたComboBoxです。 XE2 VCLスタイルを使用し、スタイルを変更するとTDateTimePickerの色に影響しません&フォントの色。 私はこのquestionでカレンダースタイルを変更しましたが、解決策はOKではありませんComboBox、何か考えていますか？ TMonthCalendarで使用するTComboBoxを継承する予定ですが、誰かがより良いソリューションを持っているかどうかはわかります。あなたの他の質問に基づいてカレンダー自体については

Answer 1

、あなたはのドロップダウンウィンドウで、Windowsのテーマを無効にする必要がありますTDateTimePickerコンポーネントの場合は、 DTM_GETMONTHCALメッセージを使用してウィンドウハンドルを取得する必要があります。

チェックこのサンプルアプリケーション

unit Unit15; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.StdCtrls, Vcl.ComCtrls; 

type 
    TForm15 = class(TForm) 
    DateTimePicker1: TDateTimePicker; 
    procedure DateTimePicker1DropDown(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form15: TForm15; 

implementation 


{$R *.dfm} 

uses 
    Winapi.CommCtrl, 
    Vcl.Styles, 
    Vcl.Themes, 
    uxTheme; 

Procedure SetVclStylesColorsCalendar(DateTimePicker: TDateTimePicker); 
Var 
    LTextColor, LBackColor : TColor; 
begin 
    uxTheme.SetWindowTheme(DateTimePicker.Handle, '', '');//disable themes in the calendar 
    //get the vcl styles colors 
    LTextColor:=StyleServices.GetSystemColor(clWindowText); 
    LBackColor:=StyleServices.GetSystemColor(clWindow); 

    DateTimePicker.Color:=LBackColor; 
    //set the colors of the calendar 
    DateTimePicker.CalColors.BackColor:=LBackColor; 
    DateTimePicker.CalColors.MonthBackColor:=LBackColor; 
    DateTimePicker.CalColors.TextColor:=LTextColor; 
    DateTimePicker.CalColors.TitleBackColor:=LBackColor; 
    DateTimePicker.CalColors.TitleTextColor:=LTextColor; 
    DateTimePicker.CalColors.TrailingTextColor:=LTextColor; 
end; 


procedure TForm15.DateTimePicker1DropDown(Sender: TObject); 
var 
    hwnd: WinAPi.Windows.HWND; 
begin 
    hwnd := SendMessage(TDateTimePicker(Sender).Handle, DTM_GETMONTHCAL, 0,0); 
    uxTheme.SetWindowTheme(hwnd, '', '');//disable themes in the drop down window 
end; 

procedure TForm15.FormCreate(Sender: TObject); 
begin 
    SetVclStylesColorsCalendar(DateTimePicker1); 
end; 

end. 

UPDATE 1

変更TDateTimePickerの "コンボボックス" の背景色があるため、他の要因の間、Windows自体によって制限されたタスクであります

1. このコントロールには、
2. メッセージがこのコントロールで処理されないため、SetBkColor関数を使用しようとするとこのコントロールには効果がありません。

だから、可能な解決策は、WM_PAINTとWM_ERASEBKGNDメッセージを傍受し、コントロールを描画するために独自のコードを書きました。 Vclスタイルを使用するときは、スタイルフックを使用してこれらのメッセージを処理できます。

チェック（のみコンセプトの証明として）このコード

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.StdCtrls, Vcl.ComCtrls; 

type 
    TForm15 = class(TForm) 
    DateTimePicker1: TDateTimePicker; 
    DateTimePicker2: TDateTimePicker; 
    procedure DateTimePicker1DropDown(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    end; 


var 
    Form15: TForm15; 

implementation 


{$R *.dfm} 

uses 
    Winapi.CommCtrl, 
    Vcl.Styles, 
    Vcl.Themes, 
    Winapi.uxTheme; 

type 
TDateTimePickerStyleHookFix= class(TDateTimePickerStyleHook) 
private 
    procedure WMPaint(var Message: TMessage); message WM_PAINT; 
    procedure PaintBackground(Canvas: TCanvas); override; 
public 
    constructor Create(AControl: TWinControl); override; 
end; 

TDateTimePickerStyleHookHelper = class helper for TDateTimePickerStyleHook 
public 
    function GetButtonRect_: TRect; 
end; 


Procedure SetVclStylesColorsCalendar(DateTimePicker: TDateTimePicker); 
Var 
    LTextColor, LBackColor : TColor; 
begin 
    Winapi.uxTheme.SetWindowTheme(DateTimePicker.Handle, '', '');//disable themes in the calendar 
    //get the vcl styles colors 
    LTextColor:=StyleServices.GetSystemColor(clWindowText); 
    LBackColor:=StyleServices.GetSystemColor(clWindow); 

    DateTimePicker.Color:=LBackColor; 
    //set the colors of the calendar 
    DateTimePicker.CalColors.BackColor:=LBackColor; 
    DateTimePicker.CalColors.MonthBackColor:=LBackColor; 
    DateTimePicker.CalColors.TextColor:=LTextColor; 
    DateTimePicker.CalColors.TitleBackColor:=LBackColor; 
    DateTimePicker.CalColors.TitleTextColor:=LTextColor; 
    DateTimePicker.CalColors.TrailingTextColor:=LTextColor; 
end; 


procedure TForm15.DateTimePicker1DropDown(Sender: TObject); 
var 
    hwnd: WinAPi.Windows.HWND; 
begin 
    hwnd := SendMessage(TDateTimePicker(Sender).Handle, DTM_GETMONTHCAL, 0,0); 
    Winapi.uxTheme.SetWindowTheme(hwnd, '', '');//disable themes in the drop down window 
end; 

procedure TForm15.FormCreate(Sender: TObject); 
begin 
    //set the colors for the TDateTimePicker 
    SetVclStylesColorsCalendar(DateTimePicker1); 
    SetVclStylesColorsCalendar(DateTimePicker2); 
end; 


{ TDateTimePickerStyleHookHelper } 
function TDateTimePickerStyleHookHelper.GetButtonRect_: TRect; 
begin 
Result:=Self.GetButtonRect; 
end; 

{ TDateTimePickerStyleHookFix } 
constructor TDateTimePickerStyleHookFix.Create(AControl: TWinControl); 
begin 
    inherited; 
    OverrideEraseBkgnd:=True;//this indicates which this style hook will call the PaintBackground method when the WM_ERASEBKGND message is sent. 
end; 

procedure TDateTimePickerStyleHookFix.PaintBackground(Canvas: TCanvas); 
begin 
    //use the proper style color to paint the background 
    Canvas.Brush.Color := StyleServices.GetStyleColor(scEdit); 
    Canvas.FillRect(Control.ClientRect); 
end; 

procedure TDateTimePickerStyleHookFix.WMPaint(var Message: TMessage); 
var 
    DC: HDC; 
    LCanvas: TCanvas; 
    LPaintStruct: TPaintStruct; 
    LRect: TRect; 
    LDetails: TThemedElementDetails; 
    sDateTime : string; 
begin 
    DC := Message.WParam; 
    LCanvas := TCanvas.Create; 
    try 
    if DC <> 0 then 
     LCanvas.Handle := DC 
    else 
     LCanvas.Handle := BeginPaint(Control.Handle, LPaintStruct); 
    if TStyleManager.SystemStyle.Enabled then 
    begin 
     PaintNC(LCanvas); 
     Paint(LCanvas); 
    end; 
    if DateMode = dmUpDown then 
     LRect := Rect(2, 2, Control.Width - 2, Control.Height - 2) 
    else 
     LRect := Rect(2, 2, GetButtonRect_.Left, Control.Height - 2); 
    if ShowCheckBox then LRect.Left := LRect.Height + 2; 
    IntersectClipRect(LCanvas.Handle, LRect.Left, LRect.Top, LRect.Right, LRect.Bottom); 
    Message.wParam := WPARAM(LCanvas.Handle); 

    //only works for DateFormat = dfShort 
    case TDateTimePicker(Control).Kind of 
    dtkDate : sDateTime:=DateToStr(TDateTimePicker(Control).DateTime); 
    dtkTime : sDateTime:=TimeToStr(TDateTimePicker(Control).DateTime); 
    end; 

    //draw the current date/time value 
    LDetails := StyleServices.GetElementDetails(teEditTextNormal); 
    DrawControlText(LCanvas, LDetails, sDateTime, LRect, DT_VCENTER or DT_LEFT); 

    if not TStyleManager.SystemStyle.Enabled then 
     Paint(LCanvas); 
    Message.WParam := DC; 
    if DC = 0 then 
     EndPaint(Control.Handle, LPaintStruct); 
    finally 
    LCanvas.Handle := 0; 
    LCanvas.Free; 
    end; 
    Handled := True; 
end; 


initialization 
    TStyleManager.Engine.RegisterStyleHook(TDateTimePicker, TDateTimePickerStyleHookFix); 

end. 

注：TDateTimePickerのインナーテキストコントロール（コンボボックス）での集中（選択）の要素を描画していないこのスタイルフック、Iあなたのためにこの仕事をさせてください。

UPDATE私はちょうどOnDropDownイベントまたはフォームのOnCreateのイベントを使用せずに、TDateTimePickerコンポーネントに適切にVCLスタイルを適用するために、すべての論理を含むVCLスタイルのフックを書いた2

。 vclスタイルのフックhere（vcl styles utilsプロジェクトの一部として）

これを使用するには、Vcl.Styles.DateTimePickersユニットをプロジェクトに追加し、この方法でフックを登録する必要があります。

TStyleManager.Engine.RegisterStyleHook(TDateTimePicker, TDateTimePickerStyleHookFix); 

Answer 2

... ... CalColors財産の回避策を使用するためには

procedure SetVclStylesMonthCalColors(calColors: TMonthCalColors); 
var 
    LTextColor, LBackColor : TColor; 
begin 
    //get the vcl styles colors 
    LTextColor:=StyleServices.GetSystemColor(clWindowText); 
    LBackColor:=StyleServices.GetSystemColor(clWindow); 

    //set the colors of the calendar 
    calColors.BackColor:=LBackColor; 
    calColors.MonthBackColor:=LBackColor; 
    calColors.TextColor:=LTextColor; 
    calColors.TitleBackColor:=LBackColor; 
    calColors.TitleTextColor:=LTextColor; 
    calColors.TrailingTextColor:=LTextColor; 
end; 

Procedure SetVclStylesColorsCalendar(MonthCalendar: TMonthCalendar); 
Var 
    LTextColor, LBackColor : TColor; 
begin 
    uxTheme.SetWindowTheme(MonthCalendar.Handle, '', '');//disable themes in the calendar 
    MonthCalendar.AutoSize:=True;//remove border 

    SetVclStylesMonthCalColors(MonthCalendar.CalColors); 
end; 


procedure TForm1.dtp1DropDown(Sender: TObject); 
var 
    rec: TRect; 
begin 
    uxTheme.SetWindowTheme(DateTime_GetMonthCal(dtp1.Handle), '', ''); 
    MonthCal_GetMinReqRect(DateTime_GetMonthCal(dtp1.Handle), rec); 
    SetWindowPos(GetParent(DateTime_GetMonthCal(dtp1.Handle)), 0, rec.Left, rec.Top, rec.Width, rec.Height,0); 
    SetWindowPos(DateTime_GetMonthCal(dtp1.Handle), 0, rec.Left, rec.Top, rec.Width, rec.Height,0); 
    SetVclStylesMonthCalColors(dtp1.CalColors); 
end;