当LineTo成功时,为什么FillRect不会绘制?

时间:2015-04-08 15:45:49

标签: delphi winapi gdi delphi-xe6 common-controls

我正在尝试change the background color of a 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;

我什么都不做,控件正常涂漆:

enter image description here

现在开始有趣了

现在我将进行一些实际绘图。它不是我想要的图纸,但它表明它有效。我将在控件的矩形上绘制一个纵横交错的

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
  • 获取控件的客户端矩形
  • 创建一个坚实的红笔
  • 将笔选入 DC
  • 画出纵横交错的
  • 恢复旧笔
  • 删除我们的笔

它有效!

enter image description here

当然有效。

现在填写整个矩形

我不想画纵横交错,我想填补背景。首先,我将展示一种使用可怕的,可怕的方法实现目标的方法:

  

我将使用非常粗的笔来控制控件的宽度

这是一件可怕的事情,但它具有实际工作的优点:

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像素高的笔
  • 从左到右划动拣货员的整个宽度

它有效:

enter image description here

当然有效!

但我不想消灭一切

我不想删除datetimepicker中的所有内容,只是"客户端"区域。所以我调整了矩形:

  • 从顶部,左侧和底部减去2个像素
  • 从datetimepicker下拉按钮的右边缘减去34像素

使用代码段:

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;

它有效:

enter image description here

当然有效!

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;

并且它不起作用:

enter image description here

当然它不起作用。它试图让我的生活变得困难。如果它有效,那么我就不会花费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

并且它不起作用:

enter image description here

当然它不起作用。

为什么它不起作用?

为什么它不起作用?

Bonus Chatter

您无法使用Delphi样式引擎because the Styles Engine is not enabled when using Windows themes(仅在使用自定义主题时)。

1 个答案:

答案 0 :(得分:7)

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

您不需要将画笔选择到设备上下文中,因为您将其作为参数传递。然后选择它,将返回的值分配回刷子变量,然后使用坏刷子参数执行FillRect(这就是为什么它应该不起作用)。