zoomimagemainu.pas

Zooming an image in a tpaintbox on a tscrollbox like magnifier in delphi , source code sample.

unit ZoomImageMainU;

interface

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

type
  TZoomImageMainform = class(TForm)
    StatusBar: TStatusBar;
    Messagetimer: TTimer;
    Panel2: TPanel;
    ButtonPanel: TPanel;
    LoadImageButton: TButton;
    CloseButton: TButton;
    ScrollBox: TScrollBox;
    PaintBox: TPaintBox;
    Label1: TLabel;
    ResetButton: TButton;
    ZoomInfoPanel: TPanel;
    Label2: TLabel;
    ZoomFactorLabel: TLabel;
    OpenPictureDialog: TOpenPictureDialog;
    procedure FormDestroy(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure LoadImageButtonClick(Sender: TObject);
    procedure MessagetimerTimer(Sender: TObject);
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift:
        TShiftState; X, Y: Integer);
    procedure PaintBoxPaint(Sender: TObject);
    procedure ResetButtonClick(Sender: TObject);
  private
    FImage: TJpegImage;
    FZoomFactor: Double;
    procedure LoadImage;
    procedure ResetImage;
    procedure SetZoomFactor(const Value: Double);
    procedure ZoomBy(X, Y: Integer; Increment: Double);
    procedure ZoomIn(X, Y: Integer);
    function ZoomIncrement: Double;
    procedure ZoomOut(X, Y: Integer);
  public
    procedure Display(const S: string; Timed: Boolean = false); overload;
    procedure Display(const Fmt: string; const A: array of const; Timed:
      Boolean = false); overload;
    property ZoomFactor: Double read FZoomFactor write SetZoomFactor;
  end;

var
  ZoomImageMainform: TZoomImageMainform;

implementation

uses Math;

{$R *.dfm}

const
  MessageTimeout = 30000;  // 30 seconds

procedure TZoomImageMainform.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FImage);
end;

procedure TZoomImageMainform.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TZoomImageMainform.MessagetimerTimer(Sender: TObject);
begin
  Messagetimer.Enabled := false;
  Display('');
end;

procedure TZoomImageMainform.Display(const S: string; Timed:
  Boolean = false);
begin
  if Statusbar.SimplePanel then
    Statusbar.SimpleText := S
  else if Statusbar.Panels.Count > 0 then
    Statusbar.Panels[0].Text := S;
  if Timed then begin
    MessageTimer.Interval := MessageTimeout;
    MessageTimer.Enabled := true
  end; {if}
end;

procedure TZoomImageMainform.Display(const Fmt: string; const A: array of const; Timed:
  Boolean = false);
begin
  Display(Format(Fmt, A), Timed);
end;

procedure TZoomImageMainform.LoadImage;
begin
  if OpenPictureDialog.Execute(Handle) then begin
    if not Assigned(FImage) then
      FImage := TJPEGImage.Create;
    FImage.LoadFromFile(OpenPictureDialog.FileName);
    ResetImage;
  end; {if};
end;

procedure TZoomImageMainform.LoadImageButtonClick(Sender: TObject);
begin
  LoadImage;
end;

procedure TZoomImageMainform.PaintBoxMouseUp(Sender: TObject; Button:
    TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Assigned(FImage) then
    Exit;
  case Button of
    mbLeft  : ZoomIn(X,Y);
    mbRight : ZoomOut(X,Y);
    mbMiddle: ResetImage;
  end; {case }
  Display('Mouse at (%d, %d)',[X,Y]);
end;

procedure TZoomImageMainform.PaintBoxPaint(Sender: TObject);
begin
  if Assigned(FImage) then
    Paintbox.Canvas.StretchDraw(Paintbox.ClientRect, FImage)
  else begin
    Paintbox.Canvas.Brush.Color := Scrollbox.Color;
    Paintbox.Canvas.FillRect(Paintbox.ClientRect);
  end; {else}
end;

procedure TZoomImageMainform.ResetButtonClick(Sender: TObject);
begin
  ResetImage;
end;

procedure TZoomImageMainform.ResetImage;
begin
  Scrollbox.VertScrollBar.Position := 0;
  Scrollbox.HorzScrollBar.Position := 0;
  if Assigned(FImage) then
    Paintbox.SetBounds(0, 0, FImage.Width, FImage.Height);
  ZoomFactor := 100;
end;

procedure TZoomImageMainform.SetZoomFactor(const Value: Double);
begin
  if FZoomFactor <> Value then begin
    FZoomFactor := Value;
    Paintbox.Invalidate;
    ZoomFactorLabel.Caption := FormatFloat('0.0', ZoomFactor);
  end; {if}
end;


function CenterVertical(const rect: TRect; h: Integer): Integer;
begin
  Result := (rect.bottom + rect.top - h) div 2;
end;

function CenterHorizontal(const rect: TRect; w: Integer): Integer;
begin
  Result := (rect.right + rect.left - w) div 2;
end;

procedure TZoomImageMainform.ZoomBy(X, Y: Integer; Increment: Double);
var
  UnzoomedPos, NewZoomedPos, Offset: TPoint;
  NewImageRect: TRect;
  NewZoom: Double;
begin
  UnzoomedPos := Point(Round(X*100/ZoomFactor), Round(Y*100/ZoomFactor));
  NewZoom := Math.Max(5, ZoomFactor + Increment);
  NewZoomedPos := Point(Round(UnzoomedPos.X * NewZoom / 100),
    Round(UnzoomedPos.Y * NewZoom / 100 ));
  NewImageRect := Rect(0, 0, Round(FImage.Width * NewZoom / 100),
    Round(FImage.Height * NewZoom/ 100));
  Scrollbox.VertScrollBar.Position := 0;
  Scrollbox.HorzScrollBar.Position := 0;
  Offset := NewImagerect.TopLeft;
  OffsetRect(NewImageRect, -Offset.X, -Offset.Y);
  Paintbox.BoundsRect := NewImageRect;

  Scrollbox.VertScrollBar.Position := Math.Max(0,
    (NewZoomedPos.Y - Offset.Y) - Scrollbox.ClientHeight div 2);
  Scrollbox.HorzScrollBar.Position := Math.Max(0,
    (NewZoomedPos.X - Offset.X)- Scrollbox.ClientWidth div 2);

  if Scrollbox.VertScrollBar.Position = 0 then
    Paintbox.Top := CenterVertical(Scrollbox.ClientRect, Paintbox.Height);
  if Scrollbox.HorzScrollBar.Position = 0 then
    Paintbox.Left := CenterHorizontal(Scrollbox.ClientRect, Paintbox.Width);
  ZoomFactor := NewZoom;
end;

procedure TZoomImageMainform.ZoomIn(X, Y: Integer);
begin
  ZoomBy(X, Y, ZoomIncrement);
end;

function TZoomImageMainform.ZoomIncrement: Double;
begin
  case Round(ZoomFactor) of
    0..9    : Result := 1;
    10..24  : Result := 5;
    25..150 : Result := 10;
    151..250: Result := 50;
    251..500: Result := 100;
  else
    Result := ZoomFactor;
  end;
end;

procedure TZoomImageMainform.ZoomOut(X, Y: Integer);
begin
  ZoomBy(X, Y, -ZoomIncrement);
end;

end.