Question

我尝试在标准TMemo中实现自定义滚动条绘制。为此，我拦截了WM_NCXXX消息，现在我可以绘制滚动条的按钮和标尺（仅限垂直）。
但是前一天我遇到了两个问题： 1.我应该在哪里进行计算以准备拇指绘画的信息？在WM_NCCALCSIZE？
2.我不知道如何进行必要的计算以便像标准滚动条那样用鼠标移动鼠标？
拇指绘画的信息我将通过GetScrollInfo函数获得，这并不困难。

在下面的图片中，您可以看到我已经完成的工作。左滚动条是系统滚动条，右侧是 - 自定义滚动条。

有完整的代码来创建类似于图片的控件。

unit MemoEx;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  StdCtrls,
  ExtCtrls,
  StrUtils,
  Dialogs,
  ClipBrd;


type
  TMemoEx = class(TCustomMemo)
  private
    { Private declarations }
    FVertBar: Boolean;

    FPressedBtn1,
    FPressedBtn2,
    FSelectedBtn1,
    FSelectedBtn2: Boolean;

    FBarBmp,
    FBtn1Bmp,
    FBtn2Bmp: TBitmap;
    MainDC: hDC;

  protected
    { Protected declarations }
    procedure WMGETDLGCODE(var Message: TWMGETDLGCODE); message WM_GETDLGCODE;
    procedure WMNCCALCIZE(var Message: TWMNCCALCSIZE); message WM_NCCALCSIZE;
    procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
    procedure WMNCHITTEST(var Message: TMessage); message WM_NCHITTEST;
    procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;
    procedure WMNCLBUTTONDOWN(var Message: TMessage); message WM_NCLBUTTONDOWN;
    procedure WMNCLBUTTONUP(var Message: TMessage); message WM_NCLBUTTONUP;

    procedure Change; override;

    procedure PaintScrollBarVert(DC: hDC);
    procedure PaintButtonVert1(DC: hDC);
    procedure PaintButtonVert2(DC: hDC);
    function CursorPosition(AControl: TControl): TPoint;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { new properties }
    property WordWrap;
    property Lines;
    property ScrollBars;
  end;


implementation


constructor TMemoEx.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  Width := 100;
  Height := 80;
  Constraints.MinWidth := 0;
  Constraints.MinHeight := 0;
  AutoSize := false;
  DoubleBuffered := false;

  FSelectedBtn1 := false;
  FSelectedBtn2 := false;
  FPressedBtn1 := false;
  FPressedBtn2 := false;

  FBarBmp := TBitmap.Create;
  FBtn1Bmp := TBitmap.Create;
  FBtn2Bmp := TBitmap.Create;
end;

destructor TMemoEx.Destroy;
begin
  FBarBmp.Free;
  FBtn1Bmp.Free;
  FBtn2Bmp.Free;

  Inherited Destroy;
end;

procedure TMemoEx.WMGETDLGCODE(var Message: TWMGETDLGCODE);
begin
  Inherited;
  Message.Result := Message.Result or DLGC_WANTTAB or DLGC_WANTALLKEYS;
end;

procedure TMemoEx.WMNCCALCIZE(var Message: TWMNCCALCSIZE);
begin
  Inherited;

  // decrease width to create non-client area
  Dec(Message.CalcSize_Params.rgrc[0].Right, 17);
  FVertBar := true;
end;

procedure TMemoEx.WMNCPAINT(var Message: TMessage);
begin
  Inherited;
  MainDC := GetWindowDC(Handle);

  if FVertBar then
    PaintScrollBarVert(MainDC);

  if FVertBar then
  begin
    PaintButtonVert1(MainDC);
    PaintButtonVert2(MainDC);
  end;

  ReleaseDC(Handle, MainDC);
end;

procedure TMemoEx.WMNCHITTEST(var Message: TMessage);
begin
  Inherited;
end;

procedure TMemoEx.WMNCMOUSEMOVE(var Message: TMessage);
begin
  Inherited;

  // top vert button
  if PtInRect(Rect(Width - 17 - 2, ClientRect.Top, Width - 2, 17), CursorPosition(Self)) then
    FSelectedBtn1 := true
  else
    FSelectedBtn1 := false;

  // bottom vert button
  if PtInRect(Rect(Width - 17 - 2, ClientRect.Bottom - 17, Width - 2, ClientRect.Bottom + 17), CursorPosition(Self)) then
    FSelectedBtn2 := true
  else
    FSelectedBtn2 := false;

  Perform(WM_NCPAINT, 1, 0);
end;

procedure TMemoEx.WMNCLBUTTONDOWN(var Message: TMessage);
begin
  Inherited;

  // top vert button
  if PtInRect(Rect(Width - 17 - 2, ClientRect.Top, Width, 17), CursorPosition(Self)) then
    FPressedBtn1 := true;

  // top vert button
  if PtInRect(Rect(Width - 17 - 2, ClientRect.Bottom - 17, Width, ClientRect.Bottom + 17), CursorPosition(Self)) then
    FPressedBtn2 := true;

  Perform(WM_NCPAINT, 1, 0);
end;

procedure TMemoEx.WMNCLBUTTONUP(var Message: TMessage);
begin
  Inherited;

  FPressedBtn1 := false;
  FPressedBtn2 := false;
  Perform(WM_NCPAINT, 1, 0);
end;

procedure TMemoEx.Change;
begin
  Inherited Changed;
  Perform(WM_NCPAINT, 1, 0);
end;

procedure TMemoEx.PaintScrollBarVert(DC: hDC);
begin
  FBarBmp.Width := 17;
  FBarBmp.Height := ClientRect.Bottom;

  FBarBmp.Canvas.Brush.Color := clLime;
  FBarBmp.Canvas.FillRect(FBarBmp.Canvas.ClipRect);
  BitBlt(MainDC, Width - 17 - 2, ClientRect.Top + 2, FBarBmp.Width, FBarBmp.Height, FBarBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TMemoEx.PaintButtonVert1(DC: hDC);
begin
  FBtn1Bmp.Width := 17;
  FBtn1Bmp.Height := 17;

  if not FSelectedBtn1 then
    FBtn1Bmp.Canvas.Brush.Color := clRed;
  if FSelectedBtn1 then
    FBtn1Bmp.Canvas.Brush.Color := clBlue;
  if FSelectedBtn1 and FPressedBtn1 then
    FBtn1Bmp.Canvas.Brush.Color := clPurple;

  FBtn1Bmp.Canvas.FillRect(FBtn1Bmp.Canvas.ClipRect);
  BitBlt(DC, Width - 17 - 2, ClientRect.Top + 2, FBtn1Bmp.Width, FBtn1Bmp.Height, FBtn1Bmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TMemoEx.PaintButtonVert2(DC: hDC);
begin
  FBtn2Bmp.Width := 17;
  FBtn2Bmp.Height := 17;

  if not FSelectedBtn2 then
    FBtn1Bmp.Canvas.Brush.Color := clRed;
  if FSelectedBtn2 then
    FBtn1Bmp.Canvas.Brush.Color := clBlue;
  if FSelectedBtn2 and FPressedBtn2 then
    FBtn1Bmp.Canvas.Brush.Color := clPurple;

  FBtn1Bmp.Canvas.FillRect(FBtn1Bmp.Canvas.ClipRect);
  BitBlt(DC, Width - 17 - 2, ClientRect.Bottom - 17 + 2, FBtn1Bmp.Width, FBtn1Bmp.Height, FBtn1Bmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

function TMemoEx.CursorPosition(AControl: TControl): TPoint;
begin
  GetCursorPos(Result);
  Result := AControl.ScreenToClient(Result);
end;


end.

P.S。顶部和底部按钮是交互式的）

感谢任何人的建议！

自定义ScrollBar Delphi的问题

0 个答案: