I am trying to change the background color of a DateTimePicker, but my question is unrelated to what i'm trying to do.
I am catching a window's WM_PAINT
message, letting the default drawing implementation happen (i.e. the one inside ComCtrl.dll), and then coming along after that and scribbling over top of it.
Initially my code is simple:
TDateTimePicker = class(Vcl.ComCtrls.TDateTimePicker)
protected
procedure WMPaint(var Message: TMessage); message WM_PAINT;
end;
procedure TDateTimePicker.WMPaint(var Message: TMessage);
begin
inherited;
end;
I do nothing, and the control paints normally:
Now i will perform some actual drawing. It's not the drawing i want, but it demonstrates that it works. I will draw a criss-cross on the control's rect:
procedure TDateTimePicker.WMPaint(var Message: TMessage);
var
dc: HDC;
rc: TRect;
p: HPEN;
begin
inherited;
//Get the device context to scribble on
dc := GetDC(Self.Handle);
if dc = 0 then
Exit;
try
rc := Self.GetClientRect;
//Create a pen to draw a criss-cross
p := CreatePen(PS_SOLID, 0, ColorToRGB(clLime));
p := SelectObject(dc, p); //select the pen into the dc
Winapi.Windows.MoveToEx(dc, rc.Left, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Right, rc.Bottom);
Winapi.Windows.MoveToEx(dc, rc.Right, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Left, rc.Bottom);
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
finally
ReleaseDC(Self.Handle, dc);
end;
end;
It's pretty simple stuff:
HDC
that we will draw onAnd it works!
Of course it works.
I don't want to draw a criss-cross, i want to fill the background. First i will demonstrate a way to accomplish my goal using a horrible, horrible method:
I will stroke the width of the control with a very thick pen
It is a horrible thing to do, but it has the virtue of actually working:
procedure TDateTimePicker.WMPaint(var Message: TMessage);
var
dc: HDC;
rc: TRect;
p: HPEN;
begin
inherited;
dc := GetDC(Self.Handle);
if dc = 0 then
Exit;
try
rc := Self.GetClientRect;
//Fill a rectangle using a pen (cause FillRect doesn't work)
p := CreatePen(PS_SOLID, rc.Height, ColorToRGB(clRed));
p := SelectObject(dc, p);
Winapi.Windows.MoveToEx(dc, rc.Left, (rc.Bottom+rc.Top) div 2, nil); //middle of left edge
Winapi.Windows.LineTo(dc, rc.Right, (rc.Bottom+rc.Top) div 2); //middle of right edge
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
//Create a pen to draw a criss-cross
p := CreatePen(PS_SOLID, 0, ColorToRGB(clLime));
p := SelectObject(dc, p); //select the pen into the dc
Winapi.Windows.MoveToEx(dc, rc.Left, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Right, rc.Bottom);
Winapi.Windows.MoveToEx(dc, rc.Right, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Left, rc.Bottom);
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
finally
ReleaseDC(Self.Handle, dc);
end;
end;
It's pretty simple stuff:
And it works:
Of course it works!
I don't want to erase everything in the datetimepicker, just the "client" area. So i adjust the rect:
with code snippet:
rc := Self.GetClientRect;
//rc := GetRectOfThePartIWant;
rc.Left := 2;
rc.Top := 2;
rc.Bottom := rc.Bottom-2;
rc.Right := rc.Right-34; //button width is 34 (use DateTime_GetDateTimePickerInfo.rcButton)
//Fill a rectangle using a pen (cause FillRect doesn't work)
//p := CreatePen(PS_SOLID, rc.Height, ColorToRGB(clRed));
br := Default(TLogBrush);
br.lbStyle := BS_SOLID;
br.lbColor := ColorToRGB($00CCCCFF);
br.lbHatch := 0; //ignored for a BS_SOLID brush
p := ExtCreatePen(PS_SOLID or PS_GEOMETRIC or PS_ENDCAP_FLAT, rc.Height, br, 0, nil);
if p <> 0 then
begin
p := SelectObject(dc, p);
Winapi.Windows.MoveToEx(dc, rc.Left, (rc.Bottom+rc.Top) div 2, nil); //middle of left edge
Winapi.Windows.LineTo(dc, rc.Right, (rc.Bottom+rc.Top) div 2); //middle of right edge
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
end;
And it works:
Of course it works!
Originally i simply used FillRect
, except it insists only on drawing in white; rather than any color:
procedure TDateTimePicker.WMPaint(var Message: TMessage);
var
dc: HDC;
rc: TRect;
br: TLogBrush;
b: HBRUSH;
le: Integer;
p: HPEN;
begin
inherited;
dc := GetDC(Self.Handle);
if dc = 0 then
Exit;
try
rc := Self.GetClientRect;
b := CreateSolidBrush(ColorToRGB(clRed));
if b <> 0 then
begin
b := SelectObject(dc, b); //select the brush into the DC
if b <> 0 then
begin
le := FillRect(dc, rc, b);
if le = 0 then
begin
//Draw failed
if IsDebuggerPresent then
DebugBreak;
end;
SelectObject(dc, b); //restore the old brush
end;
DeleteObject(b);
end;
//Create a pen to draw a criss-cross
p := CreatePen(PS_SOLID, 0, ColorToRGB(clLime));
p := SelectObject(dc, p); //select the pen into the dc
Winapi.Windows.MoveToEx(dc, rc.Left, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Right, rc.Bottom);
Winapi.Windows.MoveToEx(dc, rc.Right, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Left, rc.Bottom);
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
finally
ReleaseDC(Self.Handle, dc);
end;
end;
and it doesn't work:
of course it doesn't work. It's trying to make my life difficult. If it worked then i wouldn't have gotten to spend 9 hours on it.
I tried only filling the top-half of the rectangle; to make sure my origin was correct:
rc := Self.GetClientRect;
rc2 := rc;
rc2.Bottom := (rc2.Top + rc2.Bottom) div 2;
b := CreateSolidBrush(ColorToRGB(clRed));
if b <> 0 then
begin
b := SelectObject(dc, b); //select the brush into the DC
if b <> 0 then
begin
le := FillRect(dc, rc2, b);
if le = 0 then
begin
//Draw failed
if IsDebuggerPresent then
DebugBreak;
end;
SelectObject(dc, b); //restore the old brush
end;
DeleteObject(b);
end;
//Create a pen to draw a criss-cross
p := CreatePen(PS_SOLID, 0, ColorToRGB(clLime));
p := SelectObject(dc, p); //select the pen into the dc
Winapi.Windows.MoveToEx(dc, rc.Left, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Right, rc.Bottom);
Winapi.Windows.MoveToEx(dc, rc.Right, rc.Top, nil);
Winapi.Windows.LineTo(dc, rc.Left, rc.Bottom);
P := SelectObject(dc, p); //restore old pen
DeleteObject(p); //delete our pen
and it doesn't work:
Of course it doesn't work.
Why doesn't it work?
You cannot use the Delphi Styles Engine, because the Styles Engine is not enabled when using Windows themes (only when using custom theme).
b := CreateSolidBrush(ColorToRGB(clRed));
if b <> 0 then
begin
b := // *** original brush gets overwritten here ***
SelectObject(dc, b); //select the brush into the DC
if b <> 0 then
begin
le := FillRect(dc, rc, b);
You don't need to select the brush into device context because you pass it as parameter. Then selecting it, you assign the returned value back to the brush variable and then you do FillRect
with bad brush argument (which is why it supposedly does not work).
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With