我正在捕捉一个窗口的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;

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

现在好玩的开始了

现在我将进行一些实际绘图.这不是我想要的图画,但它表明它有效.我将在控件的矩形上绘制一个十字交叉：

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,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.Bottom);
        P := SelectObject(dc,p); //restore old pen
        DeleteObject(p); //delete our pen
    finally
        ReleaseDC(Self.Handle,dc);
    end;
end;

这很简单：

>获取我们将使用的HDC
>获取控件的客户端rect
>创造一个坚实的红笔
>选择笔进入DC
>画十字交叉
>恢复旧笔
>删除我们的笔

它的工作原理！

当然有效.

现在填写整个矩形

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

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.Bottom+rc.Top) div 2,nil); //middle of left edge
        Winapi.Windows.LineTo(dc,(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,dc);
    end;
end;

这很简单：

>创建一个23像素高的笔
>从左到右划动拣货员的整个宽度

它有效：

当然有效！

但我不想消灭一切

我不想删除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,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,br,nil);
if p <> 0 then
begin
    p := SelectObject(dc,p);
    Winapi.Windows.MoveToEx(dc,nil); //middle of left edge
    Winapi.Windows.LineTo(dc,(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,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,rc2,p); //restore old pen
        DeleteObject(p); //delete our pen

它不起作用：

当然它不起作用.

为什么不起作用？

为什么不起作用？

奖金Chatter

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