TDateTimePicker的样式属性 [英] Style properties for TDateTimePicker
问题描述
TDateTime选择器是一个ComboBox，其中下拉列表被日历替换。
我使用XE2 VCL样式和更改样式不影响TDateTimePicker颜色&字体颜色。
我已经使用此功能在此控件中没有影响，因为（作为 vcl styles utils 项目）
要使用它，您必须添加 Vcl.Styles.DateTimePickers 单元到您的项目，并以这种方式注册挂钩。
TStyleManager.Engine.RegisterStyleHook（TDateTimePicker，TDateTimePickerStyleHookFix）;
A TDateTime picker is a ComboBox where the drop-down list is replaced with a calendar. I use XE2 VCL Styles and changing style does'nt affect TDateTimePicker Color & Font Color. I have change the Calendar style with this question but the solution is not OK for the ComboBox, any idea ? Now I plan to inherit a TComboBox for use with a TMonthCalendar but I would know if anybody had a better solution.
In order to use the workaround of the CalColors property, you must disable the Windows Theme in the drop down window of the TDateTimePicker component, for that you must use the
DTM_GETMONTHCAL message to get the window handle.
Check this sample App
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
Change the background color of the "combobox" of the TDateTimePicker is a task limited by windows itself, because between others factors
- This control doesn't have the owner drawn capacity,
- And if you try using the
SetBkColorfunction has not effect in this control because theWM_CTLCOLOREDITmessage is not handled by this control.
So a possible solution is intercept the WM_PAINT and WM_ERASEBKGND messages and wrote your own code to paint the control. When you uses the Vcl Styles you can use a Style hook to handle these messages.
Check this code (only as a proof of concept)
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.
Note: This style hook doesn't draw the focused (selected) elements in the Inner text control (combobox) of the TDateTimePicker, i let this task for you.
UPDATE 2
I just wrote a vcl style hook which includes all the logic to apply the vcl style properly to the TDateTimePicker component, without use the OnDropDown event or the OnCreate event of the form. You can find the vcl style hook here (as part of the vcl styles utils project)
To use it you must add the Vcl.Styles.DateTimePickers unit to your project and register the hook in this way.
TStyleManager.Engine.RegisterStyleHook(TDateTimePicker, TDateTimePickerStyleHookFix);
这篇关于TDateTimePicker的样式属性的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
