如何让滚动条在自定义控件中很好地播放？

Question

我的问题是我正在尝试开发的自定义控件，我似乎无法弄清楚如何正确实现滚动条。我将在关键点上突出显示我正在努力使问题更容易理解。

该控件将是一个简单的图像查看器，图像将绘制在控件的中央。
控件来自 TScrollingWinControl。
我有一个名为 FImage 的已发布属性，它是一个 TPicture class，这允许将图像加载到控件中。
不会添加子控件，因为我会将 FImage 绘制到控件上。
在我写的构造函数中AutoScroll := False;
我截获了 WM_SIZE 消息，在这里我确定了将 FImage 居中到控件中间的偏移量，并尝试重新计算滚动范围。
最后，我覆盖了 Paint 方法以将居中的 FImage 绘制到控件上。

到目前为止一切顺利，图像可以在设计时或运行时加载并显示在控件的中央。现在我不明白如何正确设置滚动。

目前相关代码如下：

unit uImageViewer;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Graphics;

type
  TMyImageViewer = class(TScrollingWinControl)
  private
    FCanvas: TCanvas;
    FImage: TPicture;
    FOffsetX: Integer; // center position in control for FImage
    FOffsetY: Integer; // center position in control for FImage
    procedure SetImage(const Value: TPicture);
  private
    procedure CalculateOffsets; //recalculates the center for FImage
    procedure CalculateScrollRanges;
  protected
    procedure Loaded; override;
    procedure PaintControl;
    procedure PaintWindow(DC: HDC); override;
    procedure WMEraseBkGnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Canvas: TCanvas read FCanvas;
  published
    property Align;

    property Color;
    property Image: TPicture read FImage write SetImage;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TMyImageViewer]);
end;

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

  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control:=Self;

  FImage := TPicture.Create;
  Self.AutoSize := False; //?
  AutoScroll := False;

  ControlStyle := ControlStyle + [csOpaque];
end;

destructor TMyImageViewer.Destroy;
begin
  FCanvas.Free;
  FImage.Free;
  inherited Destroy;
end;

procedure TMyImageViewer.Loaded;
begin
  inherited Loaded;
  CalculateOffsets;
  CalculateScrollRanges;
end;

procedure TMyImageViewer.PaintControl;

  procedure DrawClientBackground; // paints the control color
  begin
    Canvas.Brush.Color  := Color;
    Canvas.Brush.Style  := bsSolid;
    Canvas.FillRect(ClientRect);
  end;

begin
 // if not (csDesigning in ComponentState) then
 // begin
  DrawClientBackground;

  // draw the FImage
  if (FImage <> nil) and (FImage.Graphic <> nil) then
  begin
    Canvas.Draw(FOffsetX, FOffsetY, FImage.Graphic);
  end;
//  end;

end;

procedure TMyImageViewer.PaintWindow(DC: HDC);
begin
  FCanvas.Handle := DC;
  try
    PaintControl;
  finally
    FCanvas.Handle := 0;
  end;
end;

procedure TMyImageViewer.SetImage(const Value: TPicture);
begin
  if Value <> FImage then
  begin
    FImage.Assign(Value);
    CalculateOffsets;
    CalculateScrollRanges;
    Invalidate;
  end;
end;

procedure TMyImageViewer.CalculateOffsets;
begin
  // for centering FImage in the middle of the control
  if FImage.Graphic <> nil then
  begin
    FOffsetX := (Width - FImage.Width) div 2;
    FOffsetY := (Height - FImage.Height) div 2;
  end;
end;

procedure TMyImageViewer.CalculateScrollRanges;
begin
  HorzScrollBar.Range:= FOffsetX + FImage.Width + FOffsetX;
  VertScrollBar.Range:=  FOffsetY + FImage.Height + FOffsetY;
end;

procedure TMyImageViewer.WMEraseBkGnd(var Message: TMessage);
begin
  Message.Result := 1;
end;

procedure TMyImageViewer.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TMyImageViewer.WMSize(var Message: TMessage);
begin
  inherited;

  CalculateOffsets;
  CalculateScrollRanges;
  Invalidate;
end;

end.

我最初是在 Lazarus 中开始写的，但也想在 Delphi 中使用它，因此两个标签都已添加。

应该如何精确计算滚动条？请记住，没有子项或启用自动滚动，因此必须手动计算，我只是在控件的中心绘制图像，需要知道如何计算滚动条范围等。

我已经尝试了一些不同的事情但没有成功，看起来我现在正在投入任何东西并希望得到最好的结果，所以我真的可以在这里得到一些指导。

编辑

所以在运行中尝试 Delphi 中的原始代码现在让我意识到 Lazarus 有多么不同，很多东西必须更改为运行 Delphi 甚至现在滚动条都在消失。

Answer 1

只需将滚动条范围设置为图像的宽度和高度，并将偏移量设置为滚动条位置。根据您的位图格式，您可能需要使用 height-Foffsety 代替绘图。

Answer 2

如一样，您应该将滚动条的范围设置为图片的大小。但这还不够。您必须意识到您需要两种截然不同的图像放置行为：当滚动条可见时 (1)，您可以将图像平移到非居中位置，但当滚动条不可见时 (2)，图像应自动居中。这需要在您的代码中进行类似的区分。

此外，您想要在 TScrollingWinControl 上作画，这让您自己变得有点困难。要获得 canvas，最简单的方法是模仿 TCustomControl 的实现，我在下面显示的示例中就是这样做的，然后您的代码可能如下所示：

unit AwImageViewer;

interface

uses
  Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms,
  Vcl.Graphics;

type
  TAwImageViewer = class(TScrollingWinControl)
  private
    FPicture: TPicture;
    procedure PictureChanged(Sender: TObject);
    procedure SetPicture(Value: TPicture);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure PaintWindow(DC: HDC); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Color;
    property Picture: TPicture read FPicture write SetPicture;
  end;

implementation

{ TAwImageViewer }

constructor TAwImageViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
end;

destructor TAwImageViewer.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TAwImageViewer.PaintWindow(DC: HDC);
var
  Canvas: TCanvas;
  R: TRect;
begin
  if FPicture.Graphic = nil then
    inherited PaintWindow(DC)
  else
  begin
    Canvas := TCanvas.Create;
    try
      Canvas.Lock;
      try
        Canvas.Handle := DC;
        try
          if ClientWidth > FPicture.Width then
            R.Left := (ClientWidth - FPicture.Width) div 2
          else
            R.Left := -HorzScrollBar.Position;
          if ClientHeight > FPicture.Height then
            R.Top := (ClientHeight - FPicture.Height) div 2
          else
            R.Top := -VertScrollBar.Position;
          R.Width := FPicture.Width;
          R.Height := FPicture.Height;
          Canvas.Draw(R.Left, R.Top, FPicture.Graphic);
          ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
          FillRect(DC, ClientRect, Brush.Handle);
        finally
          Canvas.Handle := 0;
        end;
      finally
        Canvas.Unlock;
      end;
    finally
      Canvas.Free;
    end;
  end;
end;

procedure TAwImageViewer.PictureChanged(Sender: TObject);
begin
  HorzScrollBar.Range := FPicture.Width;
  VertScrollBar.Range := FPicture.Height;
  Invalidate;
end;

procedure TAwImageViewer.Resize;
begin
  HorzScrollBar.Position := (FPicture.Width - ClientWidth) div 2;
  VertScrollBar.Position := (FPicture.Height - ClientHeight) div 2;
  if HorzScrollBar.Position * VertScrollBar.Position = 0 then
    Invalidate;
  inherited Resize;
end;

procedure TAwImageViewer.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TAwImageViewer.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

end.

如果您在临时位图上准备绘画，则不需要 canvas:

procedure TAwImageViewer.PaintWindow(DC: HDC);
var
  Bmp: TBitmap;
  R: TRect;
begin
  if FPicture.Graphic = nil then
    inherited PaintWindow(DC)
  else
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.Canvas.Brush.Assign(Brush);
      Bmp.SetSize(ClientWidth, ClientHeight);
      if ClientRect.Width > FPicture.Width then
        R.Left := (ClientWidth - FPicture.Width) div 2
      else
        R.Left := -HorzScrollBar.Position;
      if ClientHeight > FPicture.Height then
        R.Top := (ClientHeight - FPicture.Height) div 2
      else
        R.Top := -VertScrollBar.Position;
      R.Width := FPicture.Width;
      R.Height := FPicture.Height;
      Bmp.Canvas.Draw(R.Left, R.Top, FPicture.Graphic);
      BitBlt(DC, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas.Handle, 0, 0,
        SRCCOPY);
    finally
      Bmp.Free;
    end;
  end;
end;

但是如果您在控件上放置一个 TImage 组件，那么这一切都会变得简单得多：

unit AwImageViewer2;

interface

uses
  System.Classes, Vcl.Forms, Vcl.Graphics, Vcl.ExtCtrls;

type
  TAwImageViewer = class(TScrollingWinControl)
  private
    FImage: TImage;
    function GetPicture: TPicture;
    procedure SetPicture(Value: TPicture);
  protected
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color;
    property Picture: TPicture read GetPicture write SetPicture;
  end;

implementation

{ TAwImageViewer }

constructor TAwImageViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoScroll := True;
  FImage := TImage.Create(Self);
  FImage.AutoSize := True;
  FImage.Parent := Self;
end;

function TAwImageViewer.GetPicture: TPicture;
begin
  Result := FImage.Picture;
end;

procedure TAwImageViewer.Resize;
begin
  if ClientWidth > FImage.Width then
    FImage.Left := (ClientWidth - FImage.Width) div 2
  else
    HorzScrollBar.Position := (FImage.Width - ClientWidth) div 2;
  if ClientHeight > FImage.Height then
    FImage.Top := (ClientHeight - FImage.Height) div 2
  else
    VertScrollBar.Position := (FImage.Height - ClientHeight) div 2;
  inherited Resize;
end;

procedure TAwImageViewer.SetPicture(Value: TPicture);
begin
  FImage.Picture := Value;
end;

end.

如何让滚动条在自定义控件中很好地播放？

How to get scrollbars to play nicely in a custom control?

delphi

lazarus