TDateTimePicker 的样式属性

【问题标题】：Style properties for TDateTimePickerTDateTimePicker 的样式属性
【发布时间】：2012-04-26 14:16:09
【问题描述】：

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

【问题讨论】：

  • “组件的解决方案不合适”是什么意思？
  • @TOndrej 在 TDateTimePicker 中，您有一个 ComboBox，当您单击它时，会显示日历。我更改了日历样式，但没有更改组合样式。我的问题不清楚：我会编辑它！
  • while not Assigned(RRUZ) do Refresh :-)
  • @TLama - 是的，我以为他会知道答案 :-)

标签： delphi delphi-xe2 vcl-styles


【解决方案1】：

为了使用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本身限制的任务，因为在其他因素之间

  1. 此控件没有所有者绘制的容量，
  2. 如果你尝试使用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 样式的钩子 here（作为 vcl styles utils 项目的一部分）

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

  TStyleManager.Engine.RegisterStyleHook(TDateTimePicker, TDateTimePickerStyleHookFix);

【讨论】：

  • 不，日历尚未设置样式（感谢您之前的回答），我需要设置 Combo 样式！
  • Gracias @LeonardoHerrera, es grato ver a otro desarrollador chileno por aca.
  • Si pues - vamos que se puede！
  • @RRUZ 你永远是 VCL 风格大师！我今天就试试！
  • @RRUZ 它不会像 TComboBox 那样在禁用控件时调整字体颜色（查看它使用 TComboBox 中的样式元素的代码）。
【解决方案2】：

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

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;

【讨论】：

  • 我需要为组合设置样式，而不是日历！
  • 所以，我认为你需要继承组件并重写 OnPaint 方法来做到这一点......让我们看看其他未来的 cmets......
  • 是的，我考虑继承一个带有日历的 TCustomComboBox，但我认为有人有更好的解决方案。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2013-10-21
  • 2019-09-10
  • 2017-08-13
  • 2014-08-10
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode