delphi - 为什么当 LineTo 成功时 FillRect 不绘制？

标签 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

当然有效。

现在填充整个矩形

我不想画十字，我想填充背景。首先，我将演示一种使用可怕的、可怕方法来实现我的目标的方法:

I will stroke the width of the control with a very thick pen

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

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

当然有效!

但我不想消灭一切

我不想删除日期时间选择器中的所有内容，只想删除“客户端”区域。所以我调整了矩形:

  • 从顶部、左侧和底部减去 2 个像素
  • 从日期时间选择器下拉按钮的右边缘减去 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

当然不行。

为什么不起作用？

为什么不起作用？

奖金闲聊

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

最佳答案 

    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(这就是它不起作用的原因)。

关于delphi - 为什么当 LineTo 成功时 FillRect 不绘制？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/29519335/

上一篇：delphi - 创建对象实例触发 AV

下一篇：delphi - 在 pascal 中动态分配匿名函数

相关文章：

delphi - 阻止运行主窗体的OnActivate事件

c++ - 在 RichEdit winapi 中隐藏插入符号

Delphi 7，当在表单:)上移动光标时，句柄无效

c++ - 默认 Win32 项目具有恒定数量的内存泄漏

c - GDI 泄漏问题

delphi - 转换 TNTUnicode

Delphi - 将两个 exe 转换为一个服务？

delphi - 奇怪的 WM_CHAR 行为(错误的 chCharCode)

winapi - 通过发送消息点击鼠标

c - 在我的菜单栏下方划线!

©2024 IT工具网  联系我们