Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why would FillRect not draw when LineTo succeeds?

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:

enter image description here

Now the fun begins

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:

  • get the HDC that we will draw on
  • get the client rect of the control
  • create a solid red pen
  • select the pen into the DC
  • draw the criss-cross
  • restore the old pen
  • delete our pen

And it works!

enter image description here

Of course it works.

Now to fill the entire rect

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:

  • create a pen 23 pixels high
  • stroke left-to-right the entire width of the picker

And it works:

enter image description here

Of course it works!

But i don't want to wipe out everything

I don't want to erase everything in the datetimepicker, just the "client" area. So i adjust the rect:

  • subtract 2 pixels off the top, left, and bottom
  • subtract 34 pixels off the right edge for the datetimepicker drop-down button

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:

enter image description here

Of course it works!

What's wrong with FillRect?

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:

enter image description here

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:

enter image description here

Of course it doesn't work.

Why doesn't it work?

Why doesn't it work?

Bonus Chatter

You cannot use the Delphi Styles Engine, because the Styles Engine is not enabled when using Windows themes (only when using custom theme).

like image 911
Ian Boyd Avatar asked Apr 08 '15 15:04

Ian Boyd


1 Answers

    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).

like image 167
Roman R. Avatar answered Sep 20 '22 11:09

Roman R.