一种独辟蹊径的滚动条自绘方法

最新推荐文章于 2021-02-27 17:14:45 发布

weixin_30781107

最新推荐文章于 2021-02-27 17:14:45 发布

阅读量169

点赞数

原文链接：http://www.cnblogs.com/coderush/p/3616125.html

版权

Windows界面控件的内置滚动条处于非客户区，要对其进行自绘非常麻烦。仅仅处理WM_NCPAINT消息是不够的，系统有很多情况下并不经由WM_NCPAINT绘制滚动条，比如鼠标在滚动条区域点击、滚轮滚动时。如果自行处理这些消息，复杂度大大增加，还可能有未知的漏网之鱼。处理滑块拖动，必须调用SetCapture，但是SetCapture后窗口收到的鼠标消息将是WM_MOUSEMOVE、WM_MOUSEUP而非WM_NCMOUSEMOVE、WM_NCMOUSEUP，因此还要增加对WM_MOUSEMOVE和WM_MOUSEUP的处理。总之，要做好滚动条的自绘，涉及到很多窗口消息，而且不少消息不能调用DefWindowProc让系统参与。设计一个基类封装这些处理逻辑，ListView、ListBox、TreeView从这个基类继承，可以把复杂度降到最低。在Delphi的VCL类库中，最适合作为这个基类的是TWinControl。很不幸，TWinControl并没有考虑到开发者的这个需求，没有封装并提供相应接口。如果继承TListView、TListBox、TTreeView等所有你需要自绘滚动条的控件，就需要编写很多重复的代码，既丑陋，又不好维护。本文将提供一种优雅便捷的滚动条自绘方法，无需替换窗口消息处理例程，也无需钩子。

先描述一下我的方法。创建一个容器控件，作为实际控件的父控件，容器和子控件都除去边框，子控件的滚动条就被隐藏了，而我们在容器的客户区绘制滚动条。容器控件的尺寸变化时，自动调整子控件尺寸以填满容器除滚动条以外的空间。由于将滚动条绘制在容器的客户区，消息处理非常便利。子控件的滚动条变化时，通知容器重绘。容器上滑块滚动时，给子控件发送WM_VSCROLL、WM_HSCROLL等相应的消息。以下是实际代码：

unit FSScrollControls;

interface

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

type
  TFsCustomScrollBar = class(TComponent)
  private
    FVScrollWidth: Integer;
    FHScrollHeight: Integer;
    FVArrowHeight: Integer;
    FHArrowWidth: Integer;
    FMinThumbLength: Integer;
    procedure SetHScrollHeight(const Value: Integer);
    procedure SetVScrollWidth(const Value: Integer);
    procedure SetHArrowWidth(const Value: Integer);
    procedure SetVArrowHeight(const Value: Integer);
    procedure SetMinThumbLength(const Value: Integer);
  protected
    procedure Changed;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CalcVScroll(const rc: TRect; const si: TScrollInfo; var rcTopArrow, rcBottomArrow, rcThumb: TRect);
    procedure CalcHScroll(const rc: TRect; const si: TScrollInfo; var rcLeftArrow, rcRightArrow, rcThumb: TRect);
    function CalcVPos(const rc: TRect; const si: TScrollInfo; Y: Integer): Integer;
    function CalcHPos(const rc: TRect; const si: TScrollInfo; Y: Integer): Integer;
    procedure DrawVScroll(dc: HDC; const rc, rcTopArrow, rcBottomArrow, rcThumb: TRect); virtual; abstract;
    procedure DrawHScroll(dc: HDC; const rc, rcLeftArrow, rcRightArrow, rcThumb: TRect); virtual; abstract;
    procedure DrawIntersect(dc: HDC; const rc: TRect); virtual; abstract;
    property HScrollHeight: Integer read FHScrollHeight write SetHScrollHeight;
    property VScrollWidth: Integer read FVScrollWidth write SetVScrollWidth;
    property VArrowHeight: Integer read FVArrowHeight write SetVArrowHeight;
    property HHArrowWidth: Integer read FHArrowWidth write SetHArrowWidth;
    property MinThumbLength: Integer read FMinThumbLength write SetMinThumbLength;
  end;

  TFsFlatScrollBar = class(TFsCustomScrollBar)
  private
    procedure DrawUpArrow(dc: HDC; const rc: TRect; h, bw: Integer);
    procedure DrawDownArrow(dc: HDC; const rc: TRect; h, bw: Integer);
    procedure DrawLeftArrow(dc: HDC; const rc: TRect; h, bw: Integer);
    procedure DrawRightArrow(dc: HDC; const rc: TRect; h, bw: Integer);
  public
    procedure DrawVScroll(dc: HDC; const rc, rcTopArrow, rcBottomArrow, rcThumb: TRect); override;
    procedure DrawHScroll(dc: HDC; const rc, rcLeftArrow, rcRightArrow, rcThumb: TRect); override;
    procedure DrawIntersect(dc: HDC; const rc: TRect); override;
  end;

  TFsScrollInfo = record
    ShowVScroll: Boolean;
    ShowHScroll: Boolean;
    VScroll: TRect;
    TopArrow: TRect;
    BottomArrow: TRect;
    VThumb: TRect;
    HScroll: TRect;
    LeftArrow: TRect;
    RightArrow: TRect;
    HThumb: TRect;
    Intersect: TRect;
  end;

  TScrollHitTest = (shtNoWhere, shtBorder, shtLeftArrow, shtRightArrow, shtHorzThumb, shtPageLeft, shtPageRight,
    shtTopArrow, shtBottomArrow, shtVertThumb, shtPageUp, shtPageDown);

  TFsScrollContainer = class(TCustomControl)
  private
    FTimer: TTimer;
    FCaptureRegion: TScrollHitTest;
    FCapturePoint: TPoint;
    FScrollBarDrawer: TFsCustomScrollBar;
    FRealControl: TControl;
    procedure SetScrollBarDrawer(const Value: TFsCustomScrollBar);
    function GetRealScrollBar: TFsCustomScrollBar;
    function NeedScrollBar(out HScroll: Boolean): Boolean;
    procedure GetScrollInfo(var fsi: TFsScrollInfo; var vsi, hsi: TScrollInfo);
    procedure OnTimer(Sender: TObject);
    function ControlMessage(msg: DWORD; wparam, lparam: Integer): Integer;
  protected
    FMouseInControl: Boolean;
    procedure WMSize(var msgr: TWMSize); message WM_SIZE;
    procedure CMMouseEnter(var msgr: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var msgr: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;

    function GetControlScrollInfo(var si: TScrollInfo; isVert: Boolean): Boolean; virtual;
    function CreateRealControl: TControl; virtual; abstract;
    procedure DragThumb(BarFlag, ScrollCode, nTrackPos: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AdjustInnerControlBounds;
    function HitTest(X, Y: Integer): TScrollHitTest; 
    property Canvas;
    property RealControl: TControl read FRealControl;
  published
    property Align;
    property Anchors;
    property ScrollBarDrawer: TFsCustomScrollBar read FScrollBarDrawer write SetScrollBarDrawer;
  end;

function GetDefaultScrollBar: TFsCustomScrollBar;

implementation


type
  TControlHack = class(TControl)

  end;

var
  DefaultScrollBar: TFsCustomScrollBar;

function GetDefaultScrollBar: TFsCustomScrollBar;
begin
  if not Assigned(DefaultScrollBar) then
    DefaultScrollBar := TFsFlatScrollBar.Create(nil);

  Result := DefaultScrollBar;
end;

procedure GradientFillRect(dc: THandle; const rect: TRect; TopLeftColor, BottomRightColor: TColor; IsVertical: Boolean);
var
  vertexs: array [0..1] of TRIVERTEX;
  color1, color2, mode: DWORD;
  gr: TGradientRect;
begin
  color1 := ColorToRGB(TopLeftColor);
  vertexs[0].x := rect.Left;
  vertexs[0].y := rect.Top;
  vertexs[0].Red := GetRValue(color1) * $ff00 div 255;
  vertexs[0].Green := GetGValue(color1) * $ff00 div 255;
  vertexs[0].Blue := GetBValue(color1) * $ff00 div 255;
  vertexs[0].Alpha := 0;

  color2 := ColorToRGB(BottomRightColor);
  vertexs[1].x := rect.Right;
  vertexs[1].y := rect.Bottom;
  vertexs[1].Red := GetRValue(color2) * $ff00 div 255;
  vertexs[1].Green := GetGValue(color2) * $ff00 div 255;
  vertexs[1].Blue := GetBValue(color2)* $ff00 div 255;
  vertexs[1].Alpha := 0;

  gr.UpperLeft := 0;
  gr.LowerRight := 1;

  if IsVertical then mode := GRADIENT_FILL_RECT_V
  else mode := GRADIENT_FILL_RECT_H;
  
  Windows.GradientFill(dc, @vertexs, 2, @gr, 1, mode);
end;

procedure GradientFillTriangle(dc: THandle; x1, y1, x2, y2, x3, y3: Integer; color1, color2, color3: TColor);
var
  vertexs: array [0..2] of TRIVERTEX;
  _color1, _color2, _color3: DWORD;
  gt: TGradientTriangle;
begin
  _color1 := ColorToRGB(color1);
  vertexs[0].x := x1;
  vertexs[0].y := y1;
  vertexs[0].Red := GetRValue(_color1) * $ff00 div 255;
  vertexs[0].Green := GetGValue(_color1) * $ff00 div 255;
  vertexs[0].Blue := GetBValue(_color1) * $ff00 div 255;
  vertexs[0].Alpha := 0;

  _color2 := ColorToRGB(color2);
  vertexs[1].x := x2;
  vertexs[1].y := y2;
  vertexs[1].Red := GetRValue(_color2) * $ff00 div 255;
  vertexs[1].Green := GetGValue(_color2) * $ff00 div 255;
  vertexs[1].Blue := GetBValue(_color2) * $ff00 div 255;
  vertexs[1].Alpha := 0;

  _color3 := ColorToRGB(color3);
  vertexs[2].x := x3;
  vertexs[2].y := y3;
  vertexs[2].Red := GetRValue(_color3) * $ff00 div 255;
  vertexs[2].Green := GetGValue(_color3) * $ff00 div 255;
  vertexs[2].Blue := GetBValue(_color3) * $ff00 div 255;
  vertexs[2].Alpha := 0;

  gt.Vertex1 := 0;
  gt.Vertex2 := 1;
  gt.Vertex3 := 2;

  Windows.GradientFill(dc, @vertexs, 3, @gt, 1, GRADIENT_FILL_TRIANGLE);
end;

{ TFsCustomScrollBar }

const
  SCROLL_MIN_THUMB_LENGTH = 20;

function TFsCustomScrollBar.CalcHPos(const rc: TRect; const si: TScrollInfo; Y: Integer): Integer;
var
  ThumbWidth, ScrollWidth: Integer;
begin
  if (si.nMax >= si.nMin) and (si.nPage <= si.nMax - si.nMin) then
  begin
    ScrollWidth := rc.Right - rc.Left - FHArrowWidth shl 1;

    ThumbWidth := si.nPage * ScrollWidth div (si.nMax - si.nMin + 1);

    if ThumbWidth < Self.MinThumbLength then ThumbWidth := Self.MinThumbLength;

    if Y <= rc.Left + FHArrowWidth then Result := si.nMin
    else if Y > rc.Right - FHArrowWidth - ThumbWidth then Result := si.nMax - si.nPage
    else begin
      Y := Y - rc.Left - FHArrowWidth;
      Result := (si.nMax - si.nMin + 1 - si.nPage) * Y div (ScrollWidth - ThumbWidth) + si.nMin - 1;
    end;
  end
  else Result := si.nMin - 1;
end;

procedure TFsCustomScrollBar.CalcHScroll(const rc: TRect; const si: TScrollInfo; var rcLeftArrow, rcRightArrow,
  rcThumb: TRect);
var
  ThumbWidth, ThumbPos, ScrollWidth: Integer;
begin
  rcLeftArrow.Left := rc.Left;
  rcLeftArrow.Right := rc.Left + FHArrowWidth;
  rcLeftArrow.Top := rc.Top;
  rcLeftArrow.Bottom := rc.Bottom;

  rcRightArrow.Left := rc.Right - FHArrowWidth;
  rcRightArrow.Right := rc.Right;
  rcRightArrow.Top := rc.Top;
  rcRightArrow.Bottom := rc.Bottom;

  if (si.nMax >= si.nMin) and (si.nPage <= si.nMax - si.nMin) then
  begin
    ScrollWidth := rc.Right - rc.Left - FHArrowWidth shl 1;

    rcThumb.Top := rc.Top;
    rcThumb.Bottom := rc.Bottom;

    ThumbWidth := si.nPage * ScrollWidth div (si.nMax - si.nMin + 1);

    if ThumbWidth < Self.MinThumbLength then ThumbWidth := Self.MinThumbLength;

    ThumbPos := (si.nPos - si.nMin + 1) * (ScrollWidth - ThumbWidth) div (si.nMax - si.nMin + 1 - si.nPage);

    rcThumb.Left := rc.Left + FHArrowWidth + ThumbPos;
    rcThumb.Right := rcThumb.Left + ThumbWidth;
  end
  else begin
    rcThumb.Left := 0;
    rcThumb.Right := -1;
    rcThumb.Top := 0;
    rcThumb.Bottom := -1;
  end;
end;

function TFsCustomScrollBar.CalcVPos(const rc: TRect; const si: TScrollInfo; Y: Integer): Integer;
var
  ThumbHeight, ScrollHeight: Integer;
begin
  if (si.nMax >= si.nMin) and (si.nPage <= si.nMax - si.nMin) then
  begin
    ScrollHeight := rc.Bottom - rc.Top - FVArrowHeight shl 1;

    ThumbHeight := si.nPage * ScrollHeight div (si.nMax - si.nMin + 1);

    if ThumbHeight < Self.MinThumbLength then ThumbHeight := Self.MinThumbLength;

    if Y <= rc.Top + FVArrowHeight then Result := si.nMin
    else if Y > rc.Bottom - FVArrowHeight - ThumbHeight then Result := si.nMax - si.nPage
    else begin
      Y := Y - rc.Top - FVArrowHeight;
      Result := (si.nMax - si.nMin + 1 - si.nPage) * Y div (ScrollHeight - ThumbHeight) + si.nMin - 1;
    end;
  end
  else Result := si.nMin - 1;
end;

procedure TFsCustomScrollBar.CalcVScroll(const rc: TRect; const si: TScrollInfo;
  var rcTopArrow, rcBottomArrow, rcThumb: TRect);
var
  ThumbHeight, ThumbPos, ScrollHeight: Integer;
begin
  rcTopArrow.Left := rc.Left;
  rcTopArrow.Right := rc.Right;
  rcTopArrow.Top := rc.Top;
  rcTopArrow.Bottom := rcTopArrow.Top + FVArrowHeight;

  rcBottomArrow.Left := rc.Left;
  rcBottomArrow.Right := rc.Right;
  rcBottomArrow.Top := rc.Bottom - FVArrowHeight;
  rcBottomArrow.Bottom := rc.Bottom;

  if (si.nMax >= si.nMin) and (si.nPage <= si.nMax - si.nMin) then
  begin
    ScrollHeight := rc.Bottom - rc.Top - FVArrowHeight shl 1;
    
    rcThumb.Left := rc.Left;
    rcThumb.Right := rc.Right;

    ThumbHeight := si.nPage * ScrollHeight div (si.nMax - si.nMin + 1);

    if ThumbHeight < Self.MinThumbLength then ThumbHeight := Self.MinThumbLength;
    
    ThumbPos := (si.nPos - si.nMin + 1) * (ScrollHeight - ThumbHeight) div (si.nMax - si.nMin + 1 - si.nPage);

    rcThumb.Top := rc.Top + FVArrowHeight + ThumbPos;
    rcThumb.Bottom := rcThumb.Top + ThumbHeight;
  end
  else begin
    rcThumb.Left := 0;
    rcThumb.Right := -1;
    rcThumb.Top := 0;
    rcThumb.Bottom := -1;
  end;
end;

procedure TFsCustomScrollBar.Changed;
begin
  
end;

constructor TFsCustomScrollBar.Create(AOwner: TComponent);
begin
  inherited;
  FVScrollWidth := GetSystemMetrics(SM_CXVSCROLL);
  FHScrollHeight := GetSystemMetrics(SM_CYHSCROLL);
  FVArrowHeight := GetSystemMetrics(SM_CYVSCROLL);
  FHArrowWidth := GetSystemMetrics(SM_CXHSCROLL);
  FMinThumbLength := SCROLL_MIN_THUMB_LENGTH;
end;

procedure TFsCustomScrollBar.SetHArrowWidth(const Value: Integer);
begin
  if (FHArrowWidth <> Value) and (Value > 0) then
  begin
    FHArrowWidth := Value;
    Changed;
  end;
end;

procedure TFsCustomScrollBar.SetHScrollHeight(const Value: Integer);
begin
  if (FHScrollHeight <> Value) and (Value > 0) then
  begin
    FHScrollHeight := Value;
    Changed;
  end;
end;

procedure TFsCustomScrollBar.SetMinThumbLength(const Value: Integer);
begin
  if (FMinThumbLength <> Value) and (Value >= SCROLL_MIN_THUMB_LENGTH) then
  begin
    FMinThumbLength := Value;
    Changed;
  end;
end;

procedure TFsCustomScrollBar.SetVArrowHeight(const Value: Integer);
begin
  if (FVArrowHeight <> Value) and (Value > 0) then
  begin
    FVArrowHeight := Value;
    Changed;
  end;
end;

procedure TFsCustomScrollBar.SetVScrollWidth(const Value: Integer);
begin
  if (FVScrollWidth <> Value) and (Value > 0) then
  begin
    FVScrollWidth := Value;
    Changed;
  end;
end;

{ TFsFlatScrollBar }

procedure TFsFlatScrollBar.DrawHScroll(dc: HDC; const rc, rcLeftArrow, rcRightArrow, rcThumb: TRect);
var
  brush: HBRUSH;
begin
  Windows.FillRect(dc, rc, GetStockObject(LTGRAY_BRUSH));

  GradientFillRect(dc, Rect(rcLeftArrow.Left + 1, rcLeftArrow.Top + 1,
    rcLeftArrow.Right - 1, rcLeftArrow.Bottom - 1),
    RGB(255, 255, 255), RGB(229, 229, 229), False);

  Self.DrawLeftArrow(dc, rcLeftArrow,
    (rcLeftArrow.Right - rcLeftArrow.Left) div 2,
    (rcLeftArrow.Bottom - rcLeftArrow.Top) div 2);

  GradientFillRect(dc, Rect(rcRightArrow.Left + 1, rcRightArrow.Top + 1,
    rcRightArrow.Right - 1, rcRightArrow.Bottom - 1),
    RGB(255, 255, 255), RGB(229, 229, 229), False);

  Self.DrawRightArrow(dc, rcRightArrow,
    (rcRightArrow.Right - rcRightArrow.Left) div 2,
    (rcRightArrow.Bottom - rcRightArrow.Top) div 2);

  if rcThumb.Left < rcThumb.Right then
  begin
    brush := CreateSolidBrush(RGB(136, 136, 136));

    FillRect(dc, Rect(rcThumb.Left, rcThumb.Top + 1, rcThumb.Right - 1, rcThumb.Top + 2), GetStockObject(WHITE_BRUSH));
    FillRect(dc, Rect(rcThumb.Left, rcThumb.Top + 2, rcThumb.Left + 1, rcThumb.Bottom - 1), GetStockObject(WHITE_BRUSH));
    FillRect(dc, Rect(rcThumb.Right - 1, rcThumb.Top + 1, rcThumb.Right, rcThumb.Bottom - 1), brush);
    FillRect(dc, Rect(rcThumb.Left + 1, rcThumb.Bottom - 2, rcThumb.Right - 1, rcThumb.Bottom - 1), brush);

    DeleteObject(brush);

    GradientFillRect(dc, Rect(rcThumb.Left + 1, rcThumb.Top + 2, rcThumb.Right - 1, rcThumb.Bottom - 2),
      RGB(254, 254, 254), RGB(229, 229, 229), True);
  end;
end;

procedure TFsFlatScrollBar.DrawVScroll(dc: HDC; const rc, rcTopArrow, rcBottomArrow, rcThumb: TRect);
var
  brush: HBRUSH;
begin
  Windows.FillRect(dc, rc, GetStockObject(LTGRAY_BRUSH));

  GradientFillRect(dc, Rect(rcTopArrow.Left + 1, rcTopArrow.Top + 1,
    rcTopArrow.Right - 1, rcTopArrow.Bottom - 1),
    RGB(255, 255, 255), RGB(229, 229, 229), False);

  Self.DrawUpArrow(dc, rcTopArrow, (rcTopArrow.Bottom - rcTopArrow.Top) div 2, (rcTopArrow.Right - rcTopArrow.Left) div 2);

  GradientFillRect(dc, Rect(rcBottomArrow.Left + 1, rcBottomArrow.Top + 1,
    rcBottomArrow.Right - 1, rcBottomArrow.Bottom - 1),
    RGB(255, 255, 255), RGB(229, 229, 229), False);

  Self.DrawDownArrow(dc, rcBottomArrow, (rcBottomArrow.Bottom - rcBottomArrow.Top) div 2, (rcBottomArrow.Right - rcBottomArrow.Left) div 2);

  if rcThumb.Left < rcThumb.Right then
  begin
    brush := CreateSolidBrush(RGB(136, 136, 136));

    FillRect(dc, Rect(rcThumb.Left + 1, rcThumb.Top, rcThumb.Right - 2, rcThumb.Top + 1), GetStockObject(WHITE_BRUSH));
    FillRect(dc, Rect(rcThumb.Left + 1, rcThumb.Top + 1, rcThumb.Left + 2, rcThumb.Bottom), GetStockObject(WHITE_BRUSH));
    FillRect(dc, Rect(rcThumb.Right - 2, rcThumb.Top, rcThumb.Right - 1, rcThumb.Bottom), brush);
    FillRect(dc, Rect(rcThumb.Left + 2, rcThumb.Bottom - 1, rcThumb.Right - 1, rcThumb.Bottom), brush);

    DeleteObject(brush);

    GradientFillRect(dc, Rect(rcThumb.Left + 2, rcThumb.Top + 1, rcThumb.Right - 2, rcThumb.Bottom - 1),
      RGB(254, 254, 254), RGB(229, 229, 229), False);
  end;
end;

procedure TFsFlatScrollBar.DrawDownArrow(dc: HDC; const rc: TRect; h, bw: Integer);
var
  pts: array [0..2] of TPoint;
begin
  pts[0].X := rc.Left + (rc.Right - rc.Left - bw) div 2 ;
  pts[0].Y := rc.Top + (rc.Bottom - rc.Top - h) div 2;

  pts[1].X := pts[0].X + bw;
  pts[1].Y := pts[0].Y;

  pts[2].X := rc.Left + (rc.Right - rc.Left) div 2;
  pts[2].Y := pts[0].Y + h;

  GradientFillTriangle(dc, pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y,
    RGB(180, 180, 180), RGB(180, 180, 180), RGB(192, 192, 192));
end;

procedure TFsFlatScrollBar.DrawIntersect(dc: HDC; const rc: TRect);
begin
  FillRect(dc, rc, GetStockObject(LTGRAY_BRUSH));
end;

procedure TFsFlatScrollBar.DrawLeftArrow(dc: HDC; const rc: TRect; h, bw: Integer);
var
  pts: array [0..2] of TPoint;
begin
  pts[0].X := rc.Left + (rc.Right - rc.Left - h) div 2;
  pts[0].Y := rc.Top + (rc.Bottom - rc.Top) div 2;

  pts[1].X := pts[0].X + h;
  pts[1].Y := rc.Top + (rc.Bottom - rc.Top - bw) div 2;

  pts[2].X := pts[1].X;
  pts[2].Y := pts[1].Y + bw;

  GradientFillTriangle(dc, pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y,
    RGB(192, 192, 192), RGB(180, 180, 180), RGB(180, 180, 180));
end;

procedure TFsFlatScrollBar.DrawRightArrow(dc: HDC; const rc: TRect; h, bw: Integer);
var
  pts: array [0..2] of TPoint;
begin
  pts[1].X := rc.Left + (rc.Right - rc.Left - h) div 2;
  pts[1].Y := rc.Top + (rc.Bottom - rc.Top - bw) div 2;

  pts[2].X := pts[1].X;
  pts[2].Y := pts[1].Y + bw;

  pts[0].X := pts[1].X + h;
  pts[0].Y := rc.Top + (rc.Bottom - rc.Top) div 2;

  GradientFillTriangle(dc, pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y,
    RGB(192, 192, 192), RGB(180, 180, 180), RGB(180, 180, 180));
end;

procedure TFsFlatScrollBar.DrawUpArrow(dc: HDC; const rc: TRect; h, bw: Integer);
var
  pts: array [0..2] of TPoint;
begin
  pts[0].X := rc.Left + (rc.Right - rc.Left) div 2;
  pts[0].Y := rc.Top + (rc.Bottom - rc.Top - h) div 2;

  pts[1].X := rc.Left + (rc.Right - rc.Left - bw) div 2;
  pts[1].Y := pts[0].Y + h;

  pts[2].X := pts[1].X + bw;
  pts[2].Y := pts[1].Y;

  GradientFillTriangle(dc, pts[0].X, pts[0].Y, pts[1].X, pts[1].Y, pts[2].X, pts[2].Y,
    RGB(192, 192, 192), RGB(180, 180, 180), RGB(180, 180, 180));
end;

{ TFsScrollContainer }

procedure TFsScrollContainer.AdjustInnerControlBounds;
var
  L, R, T, B: Integer;
  sb: TFsCustomScrollBar;
  VScroll, HScroll: Boolean;
begin
  if Assigned(FRealControl) then
  begin
  L := 2;
    R := Self.ClientWidth - 2;
    T := 2;
    B := Self.ClientHeight - 2;

    VScroll := Self.NeedScrollBar(HScroll);

    sb := Self.GetRealScrollBar;

    if VScroll then Dec(R, sb.VScrollWidth);

    if HScroll then Dec(B, sb.HScrollHeight);

    FRealControl.SetBounds(L, T, R - L, B - T);
  end;
end;

procedure TFsScrollContainer.CMMouseEnter(var msgr: TMessage);
begin
  inherited;
  FMouseInControl := True;
  Self.Invalidate;
end;

procedure TFsScrollContainer.CMMouseLeave(var msgr: TMessage);
begin
  inherited;
  FMouseInControl := False;
  Self.Invalidate;
end;

function TFsScrollContainer.ControlMessage(msg: DWORD; wparam, lparam: Integer): Integer;
begin
  if Assigned(FRealControl) then
    Result := FRealControl.Perform(msg, wparam, lparam)
  else Result := -1;
end;

constructor TFsScrollContainer.Create(AOwner: TComponent);
begin
  inherited;

  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csPannable];

  Width := 185;
  Height := 41;

  FRealControl := Self.CreateRealControl;
  FRealControl.Parent := Self;

  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 200;
  FTimer.OnTimer := Self.OnTimer;
end;

procedure TFsScrollContainer.CreateParams(var Params: TCreateParams);
begin
  inherited;

  Params.Style := Params.Style and not WS_BORDER;
  Params.WindowClass.style := Params.WindowClass.style or CS_HREDRAW or CS_VREDRAW;
end;

destructor TFsScrollContainer.Destroy;
begin

  inherited;
end;

procedure TFsScrollContainer.DragThumb(BarFlag, ScrollCode, nTrackPos: Integer);
begin
  if BarFlag = SB_VERT then
    Self.ControlMessage(WM_VSCROLL, MakeLong(ScrollCode, nTrackPos), 0)
  else
    Self.ControlMessage(WM_HSCROLL, MakeLong(ScrollCode, nTrackPos), 0);
end;

function TFsScrollContainer.GetControlScrollInfo(var si: TScrollInfo; isVert: Boolean): Boolean;
const
  BARS: array [Boolean] of DWORD = (SB_HORZ, SB_VERT);
begin
  if Assigned(FRealControl) and (FRealControl is TWinControl) and (TWinControl(FRealControl).HandleAllocated) then
    Result := Windows.GetScrollInfo(TWinControl(FRealControl).Handle, BARS[isVert], si) and (si.nPage <> 0)
  else Result := False;
end;

function TFsScrollContainer.GetRealScrollBar: TFsCustomScrollBar;
begin
  if Assigned(FScrollBarDrawer) then Result := FScrollBarDrawer
  else Result := GetDefaultScrollBar;
end;

procedure TFsScrollContainer.GetScrollInfo(var fsi: TFsScrollInfo; var vsi, hsi: TScrollInfo);
var
  sb: TFsCustomScrollBar;
begin
  sb := GetRealScrollBar;

  fsi.ShowVScroll := False;
  fsi.ShowHScroll := False;

  vsi.cbSize := SizeOf(vsi);
  vsi.fMask := SIF_RANGE or SIF_POS or SIF_PAGE;

  if GetControlScrollInfo(vsi, True) and (vsi.nMax - vsi.nMin + 1 > vsi.nPage) then
    fsi.ShowVScroll := True;

  hsi.cbSize := SizeOf(hsi);
  hsi.fMask := SIF_RANGE or SIF_POS or SIF_PAGE;

  if GetControlScrollInfo(hsi, False) and (hsi.nMax - hsi.nMin + 1 > hsi.nPage) then
    fsi.ShowHScroll := True;

  if fsi.ShowVScroll then
  begin
    fsi.VScroll.Right := Self.Width - 2;
    fsi.VScroll.Left := fsi.VScroll.Right - sb.VScrollWidth;
    fsi.VScroll.Top := 2;

    if fsi.ShowHScroll then fsi.VScroll.Bottom := Self.Height - 2 - sb.HScrollHeight
    else fsi.VScroll.Bottom := Self.Height - 2;

    sb.CalcVScroll(fsi.VScroll, vsi, fsi.TopArrow, fsi.BottomArrow, fsi.VThumb);
  end;

  if fsi.ShowHScroll then
  begin
    fsi.HScroll.Bottom := Self.Height - 2;
    fsi.HScroll.Top := fsi.HScroll.Bottom - sb.HScrollHeight;
    fsi.HScroll.Left := 2;

    if fsi.ShowHScroll then fsi.HScroll.Right := Self.Width - 2 - sb.VScrollWidth
    else fsi.HScroll.Right := Self.Width - 2;

    sb.CalcHScroll(fsi.HScroll, hsi, fsi.LeftArrow, fsi.RightArrow, fsi.HThumb);
  end;

  if fsi.ShowVScroll and fsi.ShowHScroll then
  begin
    fsi.Intersect.Left := Self.Width - 2 - sb.VScrollWidth;
    fsi.Intersect.Right := Self.Width - 2;
    fsi.Intersect.Top := Self.Height - 2 - sb.HScrollHeight;
    fsi.Intersect.Bottom := Self.Height - 2;
  end;
end;

function TFsScrollContainer.HitTest(X, Y: Integer): TScrollHitTest;
var
  fsi: TFsScrollInfo;
  vsi, hsi: TScrollInfo;
  pt: TPoint;
begin
  pt.X := X;
  pt.Y := Y;

  Self.GetScrollInfo(fsi, vsi, hsi);

  Result := shtNoWhere;

  if fsi.ShowVScroll then
  begin
    if PtInRect(fsi.TopArrow, pt) then Result := shtTopArrow
    else if PtInRect(fsi.BottomArrow, pt) then Result := shtBottomArrow
    else if PtInRect(fsi.VThumb, pt) then Result := shtVertThumb
    else if PtInRect(fsi.VScroll, pt) then
    begin
      if pt.Y < fsi.VThumb.Top then Result := shtPageUp
      else Result := shtPageDown;
    end;
  end;

  if fsi.ShowHScroll and (Result = shtNoWhere) then
  begin
    if PtInRect(fsi.LeftArrow, pt) then Result := shtLeftArrow
    else if PtInRect(fsi.RightArrow, pt) then Result := shtRightArrow
    else if PtInRect(fsi.HThumb, pt) then Result := shtHorzThumb
    else if PtInRect(fsi.HScroll, pt) then
    begin
      if pt.X < fsi.HThumb.Left then Result := shtPageLeft
      else Result := shtPageRight;
    end;
  end;
end;

procedure TFsScrollContainer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  sht: TScrollHitTest;
  DoCapture: Boolean;
  fsi: TFsScrollInfo;
  vsi, hsi: TScrollInfo;
begin
  DoCapture := True;
  sht := Self.HitTest(X, Y);

  case sht of
    shtNoWhere, shtBorder: DoCapture := False;
    shtLeftArrow: Self.ControlMessage(WM_HSCROLL, SB_LINELEFT, 0);
    shtRightArrow: Self.ControlMessage(WM_HSCROLL, SB_LINERIGHT, 0);
    shtHorzThumb: ;
    shtPageLeft: Self.ControlMessage(WM_HSCROLL, SB_PAGELEFT, 0);
    shtPageRight: Self.ControlMessage(WM_HSCROLL, SB_PAGERIGHT, 0);
    shtTopArrow: Self.ControlMessage(WM_VSCROLL, SB_LINEUP, 0);
    shtBottomArrow: Self.ControlMessage(WM_VSCROLL, SB_LINEDOWN, 0);
    shtVertThumb: ;
    shtPageUp: Self.ControlMessage(WM_VSCROLL, SB_PAGEUP, 0);
    shtPageDown: Self.ControlMessage(WM_VSCROLL, SB_PAGEDOWN, 0);
  end;

  if DoCapture then
  begin
    FCaptureRegion := sht;
    SetCapture(Self.Handle);

    if FCaptureRegion in [shtVertThumb, shtHorzThumb] then
    begin
      Self.GetScrollInfo(fsi, vsi, hsi);
      FCapturePoint.X := X - fsi.HThumb.Left;
      FCapturePoint.Y := Y - fsi.VThumb.Top;
    end
    else FTimer.Enabled := True;
  end;

  inherited;
end;

procedure TFsScrollContainer.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
  fsi: TFsScrollInfo;
  vsi, hsi: TScrollInfo;
  nPos: Integer;
begin
  case FCaptureRegion of
    shtLeftArrow, shtRightArrow, shtPageLeft, shtPageRight,
    shtTopArrow, shtBottomArrow, shtPageUp, shtPageDown:
      begin
        GetCursorPos(pt);
        Windows.ScreenToClient(Handle, pt);
        FTimer.Enabled := HitTest(pt.X, pt.Y) = FCaptureRegion;
      end;

    shtVertThumb:
      begin
        Self.GetScrollInfo(fsi, vsi, hsi);

        if fsi.ShowVScroll then
        begin
          nPos := GetRealScrollBar.CalcVPos(fsi.VScroll, vsi, Y - FCapturePoint.Y);

          if nPos >= hsi.nMin then
            Self.DragThumb(SB_VERT, SB_THUMBTRACK, nPos);
        end;
      end;

    shtHorzThumb:
      begin
        Self.GetScrollInfo(fsi, vsi, hsi);

        if fsi.ShowHScroll then
        begin
          nPos := GetRealScrollBar.CalcHPos(fsi.HScroll, hsi, X - FCapturePoint.X);

          if nPos >= hsi.nMin then
            Self.DragThumb(SB_HORZ, SB_THUMBTRACK, nPos);
        end;
      end;
  end;

  inherited;
end;

procedure TFsScrollContainer.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  fsi: TFsScrollInfo;
  vsi, hsi: TScrollInfo;
  nPos: Integer;
begin
  case FCaptureRegion of
    shtVertThumb:
      begin
        Self.GetScrollInfo(fsi, vsi, hsi);

        if fsi.ShowVScroll then
        begin
          nPos := GetRealScrollBar.CalcVPos(fsi.VScroll, vsi, Y - FCapturePoint.Y);

          if nPos >= hsi.nMin then
            Self.DragThumb(SB_VERT, SB_THUMBPOSITION, nPos);
        end;
      end;

    shtHorzThumb:
      begin
        Self.GetScrollInfo(fsi, vsi, hsi);

        if fsi.ShowHScroll then
        begin
          nPos := GetRealScrollBar.CalcHPos(fsi.HScroll, hsi, X - FCapturePoint.X);

          if nPos >= hsi.nMin then
            Self.DragThumb(SB_HORZ, SB_THUMBPOSITION, nPos);
        end;
      end;
  end;

  ReleaseCapture;
  FCaptureRegion := shtNoWhere;
  FTimer.Enabled := False;
  
  inherited;
end;

function TFsScrollContainer.NeedScrollBar(out HScroll: Boolean): Boolean;
var
  si: TScrollInfo;
begin
  si.cbSize := SizeOf(si);
  si.fMask := SIF_RANGE or SIF_PAGE;

  HScroll := GetControlScrollInfo(si, False) and (si.nMax - si.nMin + 1 > si.nPage);

  si.cbSize := SizeOf(si);
  si.fMask := SIF_RANGE or SIF_PAGE;

  Result := GetControlScrollInfo(si, True) and (si.nMax - si.nMin + 1 > si.nPage);
end;

procedure TFsScrollContainer.OnTimer(Sender: TObject);
var
  pt: TPoint;
begin
  case FCaptureRegion of
    shtLeftArrow: Self.ControlMessage(WM_HSCROLL, SB_LINELEFT, 0);
    shtRightArrow: Self.ControlMessage(WM_HSCROLL, SB_LINERIGHT, 0);
    shtPageLeft:
      begin
        Self.ControlMessage(WM_HSCROLL, SB_PAGELEFT, 0);
        GetCursorPos(pt);
        Windows.ScreenToClient(Handle, pt);
        if HitTest(pt.X, pt.Y) <> shtPageLeft then FTimer.Enabled := False;
      end;
    shtPageRight:
      begin
        Self.ControlMessage(WM_HSCROLL, SB_PAGERIGHT, 0);
        GetCursorPos(pt);
        Windows.ScreenToClient(Handle, pt);
        if HitTest(pt.X, pt.Y) <> shtPageLeft then FTimer.Enabled := False;
      end;
    shtTopArrow: Self.ControlMessage(WM_VSCROLL, SB_LINEUP, 0);
    shtBottomArrow: Self.ControlMessage(WM_VSCROLL, SB_LINEDOWN, 0);
    shtPageUp:
      begin
        Self.ControlMessage(WM_VSCROLL, SB_PAGEUP, 0);
        GetCursorPos(pt);
        Windows.ScreenToClient(Handle, pt);
        if HitTest(pt.X, pt.Y) <> shtPageUp then FTimer.Enabled := False;
      end;
    shtPageDown:
      begin
        Self.ControlMessage(WM_VSCROLL, SB_PAGEDOWN, 0);
        GetCursorPos(pt);
        Windows.ScreenToClient(Handle, pt);
        if HitTest(pt.X, pt.Y) <> shtPageDown then FTimer.Enabled := False;
      end;
  end;
end;

procedure TFsScrollContainer.Paint;
var
  sb: TFsCustomScrollBar;
  r: TRect;
  fsi: TFsScrollInfo;
  vsi, hsi: TScrollInfo;
begin
  inherited;

  if FMouseInControl then Canvas.Brush.Color := RGB(123, 228, 255)
  else Canvas.Brush.Color := RGB(78, 160, 209);

  r.Left := 0;
  r.Top := 0;
  r.Right := Self.Width;
  r.Bottom := Self.Height;

  Canvas.FrameRect(r);

  if FMouseInControl then Canvas.Brush.Color := RGB(78, 160, 209)
  else Canvas.Brush.Color := TControlHack(FRealControl).Color;

  r.Left := 1;
  r.Top := 1;
  r.Right := Self.Width - 1;
  r.Bottom := Self.Height - 1;

  Canvas.FrameRect(r);

  sb := GetRealScrollBar;

  Self.GetScrollInfo(fsi, vsi, hsi);

  if fsi.ShowVScroll then
    sb.DrawVScroll(Canvas.Handle, fsi.VScroll, fsi.TopArrow, fsi.BottomArrow, fsi.VThumb);

  if fsi.ShowHScroll then
    sb.DrawHScroll(Canvas.Handle, fsi.HScroll, fsi.LeftArrow, fsi.RightArrow, fsi.HThumb);

  if fsi.ShowVScroll and fsi.ShowHScroll then
    sb.DrawIntersect(Canvas.Handle, fsi.Intersect);
end;

procedure TFsScrollContainer.SetScrollBarDrawer(const Value: TFsCustomScrollBar);
begin
  if Value <> FScrollBarDrawer then
  begin
    if Assigned(FScrollBarDrawer) then
      FScrollBarDrawer.RemoveFreeNotification(Self);

    FScrollBarDrawer := Value;

    if Assigned(FScrollBarDrawer) then
      FScrollBarDrawer.FreeNotification(Self);

    Self.AdjustInnerControlBounds;

    //Self.Invalidate;
  end;
end;

procedure TFsScrollContainer.WMSize(var msgr: TWMSize);
begin
  inherited;
  AdjustInnerControlBounds;
end;

initialization

finalization
  DefaultScrollBar.Free;

end.

继承TFsScrollContainer并重写（overide）CreateRealControl方法，就写好了相应的自绘滚动条控件了。以Memo为例：

  TFsMemo = class(TFsScrollContainer)
  private
    function GetScrollBars: TScrollStyle;
    procedure SetScrollBars(const Value: TScrollStyle);
    function GetLines: TStrings;
    procedure SetLines(const Value: TStrings);
    function GetMemo: TCustomMemo;
  protected
    function CreateRealControl: TControl; override;
  public
    property Memo: TCustomMemo read GetMemo;
  published
    property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars;
    property Lines: TStrings read GetLines write SetLines;
  end;

  TFsBorderlessMemo = class(TCustomMemo)
  protected
    procedure WndProc(var msgr: TMessage); override;
    procedure WMNCCalcSize(var msgr: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var msgr: TWMNCPaint); message WM_NCPAINT;
  end;

{ TFsBorderlessMemo }

procedure TFsBorderlessMemo.WMNCCalcSize(var msgr: TWMNCCalcSize);
begin
  msgr.Result := 0;
end;

procedure TFsBorderlessMemo.WMNCPaint(var msgr: TWMNCPaint);
begin
  msgr.Result := 0;
end;

procedure TFsBorderlessMemo.WndProc(var msgr: TMessage);
var
  vsi1, hsi1, vsi2, hsi2: TScrollInfo;
  style: Integer;
  changed: Boolean;
begin
  if not HandleAllocated or (msgr.Msg = WM_CREATE) or (msgr.Msg = WM_NCCREATE)
    or (msgr.Msg = WM_DESTROY) or (msgr.Msg = WM_NCDESTROY) then
  begin
    inherited;
    Exit;
  end;

  changed := False;

  style := GetWindowLong(Self.Handle, GWL_STYLE);

  if style and WS_VSCROLL <> 0 then
  begin
    vsi1.cbSize := SizeOf(vsi1);
    vsi1.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_VERT, vsi1);
  end;

  if style and WS_HSCROLL <> 0 then
  begin
    hsi1.cbSize := SizeOf(hsi1);
    hsi1.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_HORZ, hsi1);
  end;

  inherited;

  if style and WS_VSCROLL <> 0 then
  begin
    vsi2.cbSize := SizeOf(vsi2);
    vsi2.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_VERT, vsi2);

    if (vsi1.nMin <> vsi2.nMin) or (vsi1.nMax <> vsi2.nMax)
      or (vsi1.nPage <> vsi2.nPage) or (vsi1.nPos <> vsi2.nPos) then
      changed := True;
  end;

  if style and WS_HSCROLL <> 0 then
  begin
    hsi2.cbSize := SizeOf(hsi2);
    hsi2.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_HORZ, hsi2);

    if (hsi1.nMin <> hsi2.nMin) or (hsi1.nMax <> hsi2.nMax)
      or (hsi1.nPage <> hsi2.nPage) or (hsi1.nPos <> hsi2.nPos) then
      changed := True;
  end;

  if changed and (Self.Parent is TFsScrollContainer) then
  begin
    TFsScrollContainer(Self.Parent).AdjustInnerControlBounds;
    Self.Parent.Invalidate;
  end;
end;


{ TFsMemo }

function TFsMemo.CreateRealControl: TControl;
begin
  Result := TFsBorderlessMemo.Create(Self);
  TFsBorderlessMemo(Result).ScrollBars := ssVertical;
end;

function TFsMemo.GetLines: TStrings;
begin
  Result := TFsBorderlessMemo(RealControl).Lines;
end;

function TFsMemo.GetMemo: TCustomMemo;
begin
  Result := TCustomMemo(RealControl);
end;

function TFsMemo.GetScrollBars: TScrollStyle;
begin
  Result := TFsBorderlessMemo(RealControl).ScrollBars;
end;

procedure TFsMemo.SetLines(const Value: TStrings);
begin
  TFsBorderlessMemo(RealControl).Lines := Value;
end;

procedure TFsMemo.SetScrollBars(const Value: TScrollStyle);
begin
  TFsBorderlessMemo(RealControl).ScrollBars := Value;
end;

如果读者依照TFsMemo写TFsListView，TFsTreeView，将会发现拖动滑块时没有任何反应，控件的内容并不滚动。这是因为这ListView和TreeView在处理SB_THUMBTRACK和SB_THUMBPOITION操作时，并没有提取里面的nTrackPos参数，而是调用GetScrollInfo获取，但是Windows没有提供任何API来设置nTrackPos。而且用SetScrollInfo、SetScrollPos也无法设置它们的滚动条滑块位置。因此我们必须想另外的方式来实现ListView和TreeView的滑块拖动。我的方案是用循环的SB_PAGEDOWN、SB_LINEDOWN、SB_PAGEUP、SB_LINEUP来达到一样的目的。为了避免循环次数太多导致界面一直慢慢滚动很久，我用LockWindowUpdate来禁止控件的界面重绘，等循环结束再解除。从TFsHackThumbDragScrollContainer派生出的TFsListView和TFsTreeView就不会有拖动滑块异常了：

  TFsHackThumbDragScrollContainer = class(TFsScrollContainer)
  protected
    procedure DragThumb(BarFlag, ScrollCode, nTrackPos: Integer); override;
  end;

{ TFsHackThumbDragScrollContainer }

procedure TFsHackThumbDragScrollContainer.DragThumb(BarFlag, ScrollCode, nTrackPos: Integer);
var
  si: TScrollInfo;
  offset: Integer;
  msg: DWORD;
begin
  if BarFlag = SB_VERT then msg := WM_VSCROLL
  else msg := WM_HSCROLL;

  si.cbSize := SizeOf(si);
  si.fMask := SIF_PAGE or SIF_POS;

  if not Windows.GetScrollInfo(TWinControl(RealControl).Handle, BarFlag, si) then
  begin
    inherited;
    Exit;
  end;

  if si.nPos <> nTrackPos then
  begin
    //OutputDebugString(PChar('before scroll: ' + IntToStr(si.nPos) + ', ' + IntToStr(nTrackPos)));

    Windows.LockWindowUpdate(Handle);

    try
      if si.nPos < nTrackPos then
      begin
        offset := nTrackPos - si.nPos;

        while offset > 0 do
        begin
          if offset >= si.nPage then
          begin
            RealControl.Perform(msg, SB_PAGEDOWN, 0);
            Dec(offset, si.nPage);
          end
          else begin
            RealControl.Perform(msg, SB_LINEDOWN, 0);
            Dec(offset);
          end;
        end;
      end
      else begin
        offset := si.nPos - nTrackPos;

        while offset > 0 do
        begin
          if offset >= si.nPage then
          begin
            RealControl.Perform(msg, SB_PAGEUP, 0);
            Dec(offset, si.nPage);
          end
          else begin
            RealControl.Perform(msg, SB_LINEUP, 0);
            Dec(offset);
          end;
        end;
      end;
    finally
      Windows.LockWindowUpdate(0);
      Self.Invalidate;
    end;

    //OutputDebugString(PChar('after scroll: ' + IntToStr(GetScrollPos(TWinControl(RealControl).Handle, BarFlag))));
  end;
end;

  TFsBorderlessListView = class(TCustomListView)
  protected
    procedure WndProc(var msgr: TMessage); override;
    procedure WMNCCalcSize(var msgr: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var msgr: TWMNCPaint); message WM_NCPAINT;
  end;

{ TFsBorderlessListView }

procedure TFsBorderlessListView.WMNCCalcSize(var msgr: TWMNCCalcSize);
begin
  msgr.Result := 0;
end;

procedure TFsBorderlessListView.WMNCPaint(var msgr: TWMNCPaint);
begin
  msgr.Result := 0;
end;

procedure TFsBorderlessListView.WndProc(var msgr: TMessage);
var
  vsi1, hsi1, vsi2, hsi2: TScrollInfo;
  style: Integer;
  changed: Boolean;
begin
  if not HandleAllocated or (msgr.Msg = WM_CREATE) or (msgr.Msg = WM_NCCREATE)
    or (msgr.Msg = WM_DESTROY) or (msgr.Msg = WM_NCDESTROY) then
  begin
    inherited;
    Exit;
  end;

  changed := False;

  style := GetWindowLong(Self.Handle, GWL_STYLE);

  if style and WS_VSCROLL <> 0 then
  begin
    vsi1.cbSize := SizeOf(vsi1);
    vsi1.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_VERT, vsi1);
  end;

  if style and WS_HSCROLL <> 0 then
  begin
    hsi1.cbSize := SizeOf(hsi1);
    hsi1.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_HORZ, hsi1);
  end;

  inherited;

  if style and WS_VSCROLL <> 0 then
  begin
    vsi2.cbSize := SizeOf(vsi2);
    vsi2.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_VERT, vsi2);

    if (vsi1.nMin <> vsi2.nMin) or (vsi1.nMax <> vsi2.nMax)
      or (vsi1.nPage <> vsi2.nPage) or (vsi1.nPos <> vsi2.nPos) then
      changed := True;
  end;

  if style and WS_HSCROLL <> 0 then
  begin
    hsi2.cbSize := SizeOf(hsi2);
    hsi2.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
    GetScrollInfo(Self.Handle, SB_HORZ, hsi2);

    if (hsi1.nMin <> hsi2.nMin) or (hsi1.nMax <> hsi2.nMax)
      or (hsi1.nPage <> hsi2.nPage) or (hsi1.nPos <> hsi2.nPos) then
      changed := True;
  end;

  if changed and (Self.Parent is TFsScrollContainer) then
  begin
    TFsScrollContainer(Self.Parent).AdjustInnerControlBounds;
    Self.Parent.Invalidate;
  end;
end;

  TFsListView = class(TFsHackThumbDragScrollContainer)
  private
    function GetItems: TListItems;
    procedure SetItems(const Value: TListItems);
    function GetColumns: TListColumns;
    procedure SetColumns(const Value: TListColumns);
    function GetViewStyle: TViewStyle;
    procedure SetViewStyle(const Value: TViewStyle);
    function GetListView: TCustomListView;
  protected
    function CreateRealControl: TControl; override;
  public
    property ListView: TCustomListView read GetListView;
  published
    property Columns: TListColumns read GetColumns write SetColumns;
    property Items: TListItems read GetItems write SetItems;
    property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsIcon;
  end;


{ TFsListView }

function TFsListView.CreateRealControl: TControl;
begin
  Result := TFsBorderlessListView.Create(Self);
end;

function TFsListView.GetColumns: TListColumns;
begin
  Result := TFsBorderlessListView(RealControl).Columns;
end;

function TFsListView.GetItems: TListItems;
begin
  Result := TFsBorderlessListView(RealControl).Items;
end;

function TFsListView.GetListView: TCustomListView;
begin
  Result := TCustomListView(RealControl);
end;

function TFsListView.GetViewStyle: TViewStyle;
begin
  Result := TFsBorderlessListView(RealControl).ViewStyle;
end;

procedure TFsListView.SetColumns(const Value: TListColumns);
begin
  TFsBorderlessListView(RealControl).Columns := Value;
end;

procedure TFsListView.SetItems(const Value: TListItems);
begin
  TFsBorderlessListView(RealControl).Items := Value;
end;

procedure TFsListView.SetViewStyle(const Value: TViewStyle);
begin
  TFsBorderlessListView(RealControl).ViewStyle := Value;
end;

转载于:https://www.cnblogs.com/coderush/p/3616125.html

weixin_30781107

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
一种独辟蹊径的滚动条自绘方法

Windows界面控件的内置滚动条处于非客户区，要对其进行自绘非常麻烦。仅仅处理WM_NCPAINT消息是不够的，系统有很多情况下并不经由WM_NCPAINT绘制滚动条，比如鼠标在滚动条区域点击、滚轮滚动时。如果自行处理这些消息，复杂度大大增加，还可能有未知的漏网之鱼。处理滑块拖动，必须调用SetCapture，但是SetCapture后窗口收到的鼠标消息将是WM_MOUSEMOVE...
复制链接

扫一扫