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
SetBkColor
function has not effect in this control because theWM_CTLCOLOREDIT
message 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);
For the Calendar itself... based on your other question...
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;
© 2022 - 2024 — McMap. All rights reserved.
while not Assigned(RRUZ) do Refresh
:-) – Nephrolith