Почему FillRect не рисует, когда LineTo преуспевает?

Я пытаюсь изменить цвет фона DateTimePicker, но мой вопрос не связан с тем, что я пытаюсь сделать.

Я ловлю окно WM_PAINT сообщение, позволяя реализации чертежа по умолчанию (т. е. внутри ComCtrl.dll), а затем приходит после этого и строчит поверх него.

изначально мой код очень простой:

TDateTimePicker = class(Vcl.ComCtrls.TDateTimePicker)
protected
   procedure WMPaint(var Message: TMessage); message WM_PAINT;
end;

procedure TDateTimePicker.WMPaint(var Message: TMessage);
begin
   inherited;
end;

Я ничего не делаю и контроля краски обычно:

теперь начинается самое интересное

теперь я выполню некоторый фактический рисунок. Это не рисунок!--27-->хочу, но это демонстрирует, что он работает. Я нарисую крест на прямой кишке управления:

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;

это довольно простой материал:

• скачать HDC что мы будем рисовать на
• получить клиент rect управления
• создать сплошной красный Пен!--36-->
• выберите перо в DC
• нарисуйте крест-накрест
• восстановить старое перо
• удалить наши ручки

и это работает!

конечно работает.

теперь, чтобы заполнить всю прямую кишку

Я не хочу рисовать крест-накрест, я хочу, чтобы заполнить фон. Сначала я продемонстрирую способ достижения моей цели, используя ужасный, ужасно способ:

Я буду гладить ширину элемента управления с очень толстой ручкой

это ужасная вещь, но она имеет то достоинство, что действительно работает:

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;

это довольно простой материал:

• создать перо высотой 23 пикселя
• удар слева направо по всей ширине подборщика

и это работает:

Of конечно, работает!

но я не хочу стереть все

Я не хочу стирать все в datetimepicker, только область "клиент". Поэтому я настраиваю прямую кишку:

• вычесть 2 пикселя сверху, слева, снизу
• вычесть 34 пикселя с правого края для раскрывающегося списка datetimepicker

фрагмент кода:

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(CCCCFF);
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;

и это работает:

конечно, это работает!

что случилось с FillRect?

Первоначально я просто использовал FillRect, за исключением того, что он настаивает только на рисовании белым цветом; а не любым цветом:

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;

и это не работает:

конечно, это не сработает. Он пытается усложнить мне жизнь. Если бы это сработало, я бы не потратил на это 9 часов.

Я пробовал только заполнение верхняя-половина прямоугольника; чтобы убедиться, что мое происхождение было правильным:

        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

и это не работает:

конечно, это не сработает.

почему это не работает?

почему это не работает?

Бонус Треп

вы не можете использовать движок стилей Delphi,потому что механизм стилей не включен при использовании тем Windows (только при использовании custom тема.)