How to get a zoomed preview of a full-size TScrollBox

Problem/Question/Abstract:

I have a TScrollBox. In it are between 10 to 300 other components (TCustomControls and TGraphic descendants) which are moveable and resizeable. For a better overview of the large scrollbox workspace I would like to write a small zoombox component showing an overview of the whole workspace in a small 50x50 pixel (or whatever size) area. Is there any easy Windows function for doing this fast? Or do I have to write an own routine?

Answer:

You have to write your own. Following is a little example that shows a 50% reduced preview of the full scrollbox. The controls edit1, edit2, shape1, shape2, image1, memo1 are all on the scrollbox, image2 is used for the preview, button1 triggers the painting of the preview. The main problem here is the way I use to paint a TWinControl owned by the scrollbox. The WM_PRINT message used is supported by all standard and common Windows controls, but not by pure VCL controls like TPanel or the grid classes. For those you may have to use WM_PAINT instead, or the PaintTo method.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Image1: TImage;
    Shape1: TShape;
    Shape2: TShape;
    Memo1: TMemo;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure PaintControl(aControl: TWinControl; aCanvas: TCanvas; offsetx, offsety: Integer);
begin
  SaveDC(aCanvas.handle);
  try
    SetWindowOrgEx(aCanvas.handle, -(acontrol.left + offsetx), -(acontrol.top + offsety), nil);
    acontrol.perform(WM_PRINT, acanvas.handle, PRF_CHILDREN or PRF_CLIENT or
      PRF_NONCLIENT or PRF_ERASEBKGND);
  finally
    RestoreDC(aCanvas.handle, -1);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitmap;
  i: integer;
begin
  bmp := TBitmap.Create;
  try
    bmp.width := scrollbox1.HorzScrollBar.Range div 2;
    bmp.height := scrollbox1.VertScrollBar.Range div 2;
    bmp.canvas.lock;
    SetMapMode(bmp.canvas.handle, MM_ISOTROPIC);
    SetWindowExtEx(bmp.canvas.handle, 200, 200, nil);
    SetViewportExtEx(bmp.canvas.handle, 100, 100, nil);
    try
      SetWindowOrgEx(bmp.canvas.handle, -scrollbox1.HorzScrollBar.Position,
        -scrollbox1.VertScrollBar.POsition, nil);
      scrollbox1.perform(WM_PAINT, bmp.canvas.handle, 1);
      SetWindowOrgEx(bmp.canvas.handle, 0, 0, nil);
      for i := 0 to scrollbox1.controlcount - 1 do
        if scrollbox1.controls[i] is TWincontrol then
          Paintcontrol(TWincontrol(scrollbox1.Controls[i]), bmp.canvas,
            scrollbox1.horzscrollBar.Position, scrollbox1.vertScrollBar.Position);
    finally
      bmp.canvas.unlock;
    end;
    image2.picture.bitmap := bmp;
  finally
    bmp.free;
  end;
end;

end.