Свойства стиля для TDateTimePicker

выбор TDateTime-это поле со списком, в котором раскрывающийся список заменяется календарем. Я использую стили XE2 VCL, и изменение стиля не влияет на цвет TDateTimePicker и цвет шрифта. Я изменил стиль календаря с помощью этого вопрос но решение не в порядке для ComboBox есть идеи ? Теперь я планирую унаследовать TComboBox для использования с TMonthCalendar, но я бы знал, есть ли у кого-нибудь лучшее решение.

7
delphi delphi-xe2 vcl-styles

2 ответов

для того, чтобы использовать метод CalColors свойство, необходимо отключить тему 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.

enter image description here

обновление 1

изменить цвет фона "combobox" 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.

Примечание: этот крюк стиля не рисует сфокусированные (выбранные) элементы во внутреннем текстовом элементе управления (combobox) TDateTimePicker, я позволяю этой задаче для вас.

enter image description here

обновление 2

Я только что написал крюк стиля vcl, который включает в себя всю логику, чтобы правильно применить стиль vcl к TDateTimePicker компонент, без использования события OnDropDown или OnCreate событие формы. Вы можете найти крючок стиля vcl здесь (в составе vcl стили utils)

чтобы использовать его, вы должны добавить в VCL.Стили.DateTimePickers блок к вашему проекту и зарегистрируйте крюк таким образом.

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

для самого календаря... основываясь на вашем другом вопросе...

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;
2