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

时间：2016-01-24 20:44:53

标签： delphi lazarus

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

  • 控件将是一个简单的图像查看器，图像将绘制在控件的中心。
  • 该控件来自TScrollingWinControl。
  • 我有一个名为FImage的已发布属性，它是一个TPicture类，可以将图像加载到控件中。
  • 我将不会添加子控件，因为我将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下运行很多东西甚至现在滚动条正在消失。

2 个答案:

答案 0 :(得分：1)

作为Garth already answered，您应该将滚动条的范围设置为图片的大小。但这还不够。您必须意识到您需要两种不同的图像放置行为：当滚动条可见（1）时，您可以将图像平移到未中心位置，但是当滚动条不可见时（2），图像应自动居中。这需要在代码中进行类似的区分。

另外，你想要在TScrollingWinControl上画画，你自己有点努力。要获取画布，最简单的方法是模仿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.

如果你在临时位图上准备你的绘画，那么你不需要画布：

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.

答案 1 :(得分：0)

只需将滚动条范围设置为图像的宽度和高度，并将偏移设置为滚动条位置。您可能需要使用height-Foffsety来绘制，具体取决于您的位图格式。

相关问题
最新问题