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

Question

My problem is with a custom control I am trying to develop and I cannot seem to figure out how to implement the scroll bars correctly. I will highlight in key points what I am trying to do to make the question easier to understand.

• The control will be a simple image viewer, the image will be drawn in the center of the control.
• The control derives from TScrollingWinControl.
• I have a published property called FImage which is a TPicture class, this allows loading a image into the control.
• There will be no child controls added as I will be painting the FImage onto the control.
• In the constructor I have written AutoScroll := False;
• I have intercepted the WM_SIZE message and here I determine offsets for centering FImage to the middle of the control and also try to recalculate the scroll ranges.
• Finally I override the Paint method to draw the centered FImage onto the control.

So far so good, an image can be loaded at design or runtime and is displayed in the center of the control. Now I cannot understand how to get the scrolling set up properly.

Here is the relevant code so far:

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.

I originally started writing this in Lazarus but would also like to use it in Delphi hence both tags have been added.

How exactly should the scrollbars be calculated? Bearing in mind there is no children or auto scrolling enabled so it must be manual calculations, I am simply drawing a image in the center of the control and need to know how to calculate the scrollbar ranges etc.

I have tried a few different things with no success and it just seems like I am now putting anything in and hoping for the best, so I really could do with some guidance here please.

EDIT

So having tried running the original code in Delphi has now made me realise how much more different Lazarus is, lots of things had to be changed to run under Delphi and even right now the scrollbars are disappearing.

Answer 1

As Garth already answered, you should set the scroll bar's range to the size of the picture. But that is not enough. You must realize that you need two distinct kinds of placement behaviour of your image: When the scroll bar is visible (1), you are able to pan the image to an uncentered position, but when the scroll bar is not visible (2), the image should automatically center. This requires a similar distinction in your code.

Also, you are making it yourself a little hard by wanting to paint on a TScrollingWinControl. To acquire a canvas, the most easy way is by mimicking the implementation of TCustomControl, which I kind of did in the example shown below, and then your code could look like:

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.

And if you prepare your painting on a temporary bitmap, then you do not need a 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;

But if you place a TImage component on your control, then this all becomes much more simple:

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.