How to draw a custom border inside the non client area of a control with scroll bars?

前端 未结 2 1344
遥遥无期
遥遥无期 2021-01-12 20:44

I have a custom control with both scroll bars enabled and I want to draw a simple red line border around the client area and the scroll bars, like in the image below. How I

相关标签:
2条回答
  • 2021-01-12 21:17

    You are trying to paint (partial) in the Nonclient Area.
    You could add WS_DLGFRAME to the Params.Style and handle the message WM_NCPaint to Paint on the HDC of the window.

      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;
    

    enter image description here

    0 讨论(0)
  • 2021-01-12 21:21

    Publish the BorderWidth property, and implement a WM_NCPAINT message handler, like shown in this answer, combined with the code in 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;
    
    0 讨论(0)
提交回复
热议问题