delphi - TDateTimePicker 的样式属性

Question

TDateTime 选择器是一个下拉列表替换为日历的组合框。我使用 XE2 VCL 样式并且更改样式不会影响 TDateTimePicker 颜色和字体颜色。我已经用这个问题更改了日历样式，但ComboBox的解决方案不合适，知道吗？现在我计划继承一个 TComboBox 用于 TMonthCalendar 但我会知道是否有人有更好的解决方案。

score 16 · Accepted Answer

为了使用该CalColors属性的解决方法，您必须在 TDateTimePicker 组件的下拉窗口中禁用 Windows 主题，因为您必须使用 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.

在此处输入图像描述

更新 1

更改 TDateTimePicker 的“组合框”的背景颜色是一个受 windows 本身限制的任务，因为在其他因素之间

此控件没有所有者绘制的容量，
如果您尝试使用该 SetBkColor功能在此控件中没有效果，因为该WM_CTLCOLOREDIT消息未由该控件处理。

所以一个可能的解决方案是拦截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 的内部文本控件（组合框）中绘制焦点（选定）元素，我让这个任务为您完成。

在此处输入图像描述

更新 2

我刚刚编写了一个 vcl 样式挂钩，其中包含将 vcl 样式正确应用于TDateTimePicker组件的所有逻辑，而不使用表单的 OnDropDown 事件或 OnCreate 事件。您可以在此处找到 vcl 样式挂钩（作为vcl 样式实用程序项目的一部分）

要使用它，您必须将Vcl.Styles.DateTimePickers单元添加到您的项目中并以这种方式注册钩子。

  TStyleManager.Engine.RegisterStyleHook(TDateTimePicker, TDateTimePickerStyleHookFix);

score 2 · Accepted Answer

对于日历本身...基于您的其他问题...

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;

delphi - TDateTimePicker 的样式属性

2 回答 2

更新 1

更新 2

Related

Reference