Làm cách nào để vẽ đường viền tùy chỉnh bên trong vùng không phải của khách hàng bằng điều khiển bằng thanh cuộn?

Question

Tôi có một điều khiển tùy chỉnh với cả hai thanh cuộn được bật và tôi muốn vẽ một đường viền màu đỏ đơn giản xung quanh khu vực khách hàng và các thanh cuộn, như trong hình bên dưới. Làm thế nào tôi làm điều này?

Đây là mã kiểm soát:

unit SuperList; 

interface 

uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls; 

type 

    TSuperList = class(TCustomControl) 
    protected 
    procedure Paint; override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    end; 

implementation 

procedure TSuperList.CreateParams(var Params: TCreateParams); 
begin 
    inherited; 
    Params.Style:=Params.Style or WS_VSCROLL or WS_HSCROLL; 
end; 

constructor TSuperList.Create(AOwner: TComponent); 
begin 
inherited; 
Color:=clBlack; 
Width:=300; 
Height:=250; 
end; 

procedure TSuperList.Paint; 
begin 
Canvas.Pen.Color:=clNavy; 
Canvas.Brush.Color:=clWhite; 
Canvas.Rectangle(ClientRect); // a test rectangle te see the client area 
end; 

end. 

Answer 1

Xuất bản các BorderWidth bất động sản, và thực hiện một handler WM_NCPAINT tin nhắn, như thể hiện trong this answer, kết hợp với các mã trong this answer:

type 
    TSuperList = class(TCustomControl) 
    private 
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; 
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; 
    protected 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure Paint; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    published 
    property BorderWidth default 10; 
    end; 

implementation 

constructor TSuperList.Create(AOwner: TComponent); 
begin 
    inherited Create(Aowner); 
    ControlStyle := ControlStyle - [csOpaque]; 
    BorderWidth := 10; 
end; 

procedure TSuperList.CreateParams(var Params: TCreateParams); 
begin 
    inherited CreateParams(Params); 
    Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL; 
    Params.WindowClass.style := 
    Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); 
end; 

procedure TSuperList.Paint; 
begin 
    Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255)); 
    Canvas.FillRect(Canvas.ClipRect); 
end; 

procedure TSuperList.WMEraseBkgnd(var Message: TWMEraseBkgnd); 
begin 
    Message.Result := 1; 
end; 

procedure TSuperList.WMNCPaint(var Message: TWMNCPaint); 
var 
    DC: HDC; 
    R: TRect; 
    WindowStyle: Integer; 
begin 
    inherited; 
    if BorderWidth > 0 then 
    begin 
    DC := GetWindowDC(Handle); 
    try 
     R := ClientRect; 
     OffsetRect(R, BorderWidth, BorderWidth); 
     ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); 
     WindowStyle := GetWindowLong(Handle, GWL_STYLE); 
     if WindowStyle and WS_VSCROLL <> 0 then 
     ExcludeClipRect(DC, R.Right, R.Top, 
      R.Right + GetSystemMetrics(SM_CXVSCROLL), R.Bottom); 
     if WindowStyle and WS_HSCROLL <> 0 then 
     ExcludeClipRect(DC, R.Left, R.Bottom, R.Right, 
      R.Bottom + GetSystemMetrics(SM_CXHSCROLL)); 
     SetRect(R, 0, 0, Width + BorderWidth, Height + BorderWidth); 
     Brush.Color := clRed; 
     FillRect(DC, R, Brush.Handle); 
    finally 
     ReleaseDC(Handle, DC); 
    end; 
    end; 
    Message.Result := 0; 
end; 

Answer 2

Bạn đang cố gắng vẽ (một phần) trong Nonclient Area.
Bạn có thể thêm WS_DLGFRAME vào Params.Style và xử lý thông báo WM_NCPaint để sơn trên HDC của cửa sổ.

TSuperList = class(TCustomControl) 
    private 
    procedure PaintBorder; 
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate; 
    procedure WMNCPaint(var Msg: TWMNCPaint);message WM_NCPaint; 
    protected 
    procedure Paint; override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    end; 

procedure TSuperList.CreateParams(var Params: TCreateParams); 
begin 
    inherited; 
    Params.Style:=Params.Style or WS_VSCROLL or WS_HSCROLL or WS_DLGFRAME; 
end; 

procedure TSuperList.WMNCActivate(var Msg: TWMNCActivate); 
begin 
    inherited; 
    PaintBorder; 
end; 

procedure TSuperList.WMNCPaint(var Msg: TWMNCPaint); 
begin 
    inherited; 
    PaintBorder; 
end; 

procedure TSuperList.PaintBorder; 
begin 
    Canvas.Handle := GetWindowDC(Handle); 
    Canvas.Pen.Color := clNavy; 
    Canvas.Pen.Width := 2; 
    Canvas.Brush.Style := bsClear; 
    Canvas.Rectangle(Rect(1,1,Width,Height)); 
    ReleaseDC(Handle,Canvas.Handle); 
end;  

constructor TSuperList.Create(AOwner: TComponent); 
begin 
inherited; 
Color:=clBlack; 
Width:=300; 
Height:=250; 
end; 

procedure TSuperList.Paint; 
begin 
Canvas.Brush.Color:=clWhite; 
Canvas.Pen.Style := psClear; 
Canvas.Rectangle(ClientRect); 
Canvas.Pen.Style := psSolid; 
Canvas.Ellipse(0,0,20,20); 
end;