{-----------------------------------------------------------------------------
 Unit Name: ZoomPicture
 Author:    vesal
 Purpose:   Picture that can be zoomed and centered
 History:

 Usage:

 Methods:
    procedure CenterCurrentPoint;
     - center last clicked point to center of component if possible
    procedure ReSizePicture;
     - resize picture to fit to component

 Properties:

    property FileName:string
     - filename of Current picture.  Setting it loads a new picture
    property ZoomFactor : double
     - ZoomFactor at the moment
    property CurrentPoint : TPoint
     - Last Clicked point on picture coordintes, so 0,0 is allways the
       left top corner and width-1,height-1 is allways the right,down corner
    property CenterOnDblClick : boolean
     - is Igame centered automatically on double click.  Then current point
       is changed to center of component if possible
    property AutoSizeOnLoad : boolean
     - is loaded image resized to fit to component.  If false, then
       last zoom-factor is used
    property AutoSizeOnResize : boolean
     - is image resized to fit to component when component size is changed
    property CenterOnZoom : boolean
     - is picture centered to last clicked point when zoomed.
    property ImageBorder : TBorderStyle
     - border style for image
    property Scale : TJPEGScale
     - jpeg picture can be loaded in scales :1/1, 1/2, 1/4 , 1/8.
       Smaller ratios are faster to load.
    property RealScale : TJPEGScale
     - scale currently used.  When zooming f.ex 1/2 picture, it is first
       jumped to 1/1 scale and the zoomed.
    property ScaleSt : string
     - scale needed as a string
    property RealScaleSt : string
     - currently used scale as a string
    property FasterLoad : boolean
     - jpeg image can be loaded a bit faster by sacrifying a bit from quality
    property ImageSize : TSize
     - size in pixels for currently loaded image
    property AutoScroll : boolean
     - is autoscroll on on image or not

  Events:
    property ZoomFactorChange : TNotifyEvent
     - occurs when zoomfactor is changed
    property ScaleChange : TNotifyEvent
     - occurs when currently used scale is changed

  procedures:
    procedure CenterCurrentPoint; virtual;
     - centers the picture around currently slected point
    procedure ReSizePicture; virtual;
     - resizes pictures so that it fills the component


-----------------------------------------------------------------------------}

unit ZoomPicture;

interface
uses Windows,Types,Graphics,Controls,Classes,ExtCtrls,Forms, JPeg, StdCtrls;

type
  TZoomPicture = class(TPanel)
  private
    ScrollBoxImage: TScrollBox;
    dummyctrl : TMemo;
    ImagePicture: TImage;
    FFileName: string;
    FZoomFactor: double;
    FCurrentPoint: TPoint;
    FCenterOnDblClick: boolean;
    FAutoSizeOnLoad: boolean;
    FCenterOnZoom: boolean;
    FAutoSizeOnResize: boolean;
    FScale: TJPEGScale;
    FFasterLoad: boolean;
    FZoomFactorChange: TNotifyEvent;
    FScaleChange: TNotifyEvent;
    procedure SetFileName(const Value: string);
    procedure SetZoomFactor(const Value: double);
    procedure SetCenterOnDblClick(const Value: boolean);
    procedure SetAutoSizeOnLoad(const Value: boolean);
    procedure SetCenterOnZoom(const Value: boolean);
    procedure SetAutoSizeOnResize(const Value: boolean);
    function GetImageBorderStyle: TBorderStyle;
    procedure SetImageBorderStyle(const Value: TBorderStyle);
    procedure SetScale(const Value: TJPEGScale);
    procedure SetFasterLoad(const Value: boolean);
    procedure SetZoomFactorChange(const Value: TNotifyEvent);
    function GetScaleSt: string;
    procedure SetScaleChange(const Value: TNotifyEvent);
    function GetRealScaleSt: string;
    function GetRealScale: TJPEGScale;
    procedure SetRealScale(const Value: TJPEGScale);
    function GetRealZoomFactor: double;
    procedure SetRealZoomFactor(const Value: double);
    function GetImageSize: TSize;
    function GetAutoScroll: boolean;
    procedure SetAutoScroll(const Value: boolean);
    function GetGanGetFocus: boolean;
    procedure SetCanGetFocus(const Value: boolean);
  protected
    procedure OnImageMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure OnCtrlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ImagePictureMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImagePictureDblClick(Sender: TObject);
    procedure ImagePictureClick(Sender: TObject);
  public
    constructor Create(AOwner:TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure CenterCurrentPoint; virtual;
    procedure ReSizePicture; virtual;
  published
    property FileName:string read FFileName write SetFileName;
    property ZoomFactor : double read FZoomFactor write SetZoomFactor;
    property RealZoomFactor : double read GetRealZoomFactor write SetRealZoomFactor;
    property CurrentPoint : TPoint read FCurrentPoint write FCurrentPoint;
    property CenterOnDblClick : boolean read FCenterOnDblClick write SetCenterOnDblClick default true;
    property AutoSizeOnLoad : boolean read FAutoSizeOnLoad write SetAutoSizeOnLoad default true;
    property AutoSizeOnResize : boolean read FAutoSizeOnResize write SetAutoSizeOnResize default true;
    property CenterOnZoom : boolean read FCenterOnZoom write SetCenterOnZoom default true;
    property ImageBorder : TBorderStyle read GetImageBorderStyle write SetImageBorderStyle;
    property Scale : TJPEGScale read FScale write SetScale;
    property RealScale : TJPEGScale read GetRealScale  write SetRealScale;
    property ScaleSt : string read GetScaleSt;
    property RealScaleSt : string read GetRealScaleSt;
    property FasterLoad : boolean read FFasterLoad write SetFasterLoad default true;
    property ZoomFactorChange : TNotifyEvent read FZoomFactorChange write SetZoomFactorChange;
    property ScaleChange : TNotifyEvent read FScaleChange write SetScaleChange;
    property ImageSize : TSize read GetImageSize;
    property AutoScroll : boolean read GetAutoScroll write SetAutoScroll;
    property CanGetFocus : boolean read GetGanGetFocus write SetCanGetFocus;
  end;

  procedure Center(sb:TScrollBox;p:TPoint); overload;
  procedure Center(sb:TScrollBox;x,y:integer); overload;
  procedure Center(comp:TWinControl;var x,y,w,h:integer); overload;

implementation
uses IdGlobal;

procedure Center(sb:TScrollBox;p:TPoint); overload;
var dp : TPoint;
begin
  dp.y := p.Y - sb.VertScrollBar.Position;
  sb.VertScrollBar.Position := sb.VertScrollBar.Position - ( (sb.ClientHeight div 2) - dp.Y );
  dp.x := p.X - sb.HorzScrollBar.Position;
  sb.HorzScrollBar.Position := sb.HorzScrollBar.Position - ( (sb.ClientWidth div 2) - dp.X );
end;

procedure Center(sb:TScrollBox;x,y:integer); overload;
var dp : TPoint;
begin
  dp.y := Y - sb.VertScrollBar.Position;
  sb.VertScrollBar.Position := sb.VertScrollBar.Position - ( (sb.ClientHeight div 2) - dp.Y );
  dp.x := X - sb.HorzScrollBar.Position;
  sb.HorzScrollBar.Position := sb.HorzScrollBar.Position - ( (sb.ClientWidth div 2) - dp.X );
end;

procedure Center(comp:TWinControl;var x,y,w,h:integer); overload;
var sb : TScrollBox;
begin
  x := (comp.ClientWidth -w) div 2;
  y := (comp.ClientHeight -h) div 2;
  if ( x < 0 ) then x := 0;
  if ( y < 0 ) then y := 0;
  if not ( comp is TScrollBox ) then exit;
  sb := TScrollBox(comp);
  sb.HorzScrollBar.Position := 0;
  sb.VertScrollBar.Position := 0;
end;


{ TZoomPicture }

constructor TZoomPicture.Create(AOwner: TComponent);
begin
  inherited;
  OnMouseWheel := OnImageMouseWheel;
  ScrollBoxImage := TScrollBox.Create(self);
  ScrollBoxImage.Parent := self;
  ScrollBoxImage.Align := alClient;
  ScrollBoxImage.BorderStyle := bsNone;
  ImagePicture := TImage.Create(ScrollBoxImage);
  ImagePicture.Parent := ScrollBoxImage;
  ImagePicture.OnDblClick := ImagePictureDblClick;
  ImagePicture.OnClick := ImagePictureClick;
  ImagePicture.OnMouseDown := ImagePictureMouseDown;
  ImagePicture.Stretch := true;
  FZoomFactor := 1;
  FScale := jsFullSize;
  FFasterLoad := true;
  CenterOnDblClick := true;
  CenterOnZoom := true;
  AutoSizeOnLoad := true;
  AutoSizeOnResize := true;
end;

procedure TZoomPicture.ImagePictureDblClick(Sender: TObject);
begin
  CenterCurrentPoint;
end;

procedure TZoomPicture.ImagePictureMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FCurrentPoint.x := Round(X / ZoomFactor);
  FCurrentPoint.y := Round(Y / ZoomFactor);
  if ( CanGetFocus) then dummyctrl.SetFocus;
end;

procedure TZoomPicture.ReSizePicture;
var w,h:integer; r,rc: double; nx,ny,nw,nh : integer; comp : TWinControl;
begin
  comp := ScrollBoxImage;
  w := ImagePicture.Picture.Width;
  h := ImagePicture.Picture.Height;
  if ( w <= 0 ) or ( comp.ClientWidth <= 0 ) then exit;
  r := h/w;
  rc := comp.ClientHeight/comp.ClientWidth;
  if ( r < rc ) then begin
    nw := comp.ClientWidth;
    nh := Trunc(comp.ClientWidth * r);
  end
  else begin
    nh := comp.ClientHeight;
    nw := Trunc(comp.ClientHeight / r);
  end;
  if ( nh > h ) or ( nw > w ) then begin nh := h; nw := w; end;
  Center(comp,nx,ny,nw,nh);
  ImagePicture.SetBounds(nx,ny,nw,nh);
  ZoomFactor := nw/ImagePicture.Picture.Width;
end;


procedure TZoomPicture.SetFileName(const Value: string);
var pic : TPicture;
begin
  FFileName := Value;
  pic := ImagePicture.Picture;
  pic.LoadFromFile(FFileName);
  if ( pic.Graphic is TJpegImage ) then begin // To make calculations before
//    TJpegImage(pic.Graphic).ProgressiveDisplay := true;
    if ( FasterLoad ) then
      TJpegImage(pic.Graphic).Performance := jpBestSpeed
    else
      TJpegImage(pic.Graphic).Performance := jpBestQuality;
    TJpegImage(pic.Graphic).Scale := Scale;
    if ( Assigned(ScaleChange) ) then ScaleChange(self);
    TJpegImage(pic.Graphic).DIBNeeded;        // clearing the screen
  end;
  if ( AutoSizeOnLoad ) then ReSizePicture else ZoomFactor := ZoomFactor;
end;

const ScaleNames : array[TJPEGScale] of string = ('/1','/2','/4','/8');
const ScaleFactors : array[TJPEGScale] of integer = (1,2,4,8);

function TZoomPicture.GetScaleSt: string;
begin
  Result := ScaleNames[Scale];
end;

function TZoomPicture.GetRealScale: TJPEGScale;
var pic : TPicture;
begin
  Result := jsFullSize;
  pic := ImagePicture.Picture;
  if not ( pic.Graphic is TJpegImage ) then exit;
  Result := TJpegImage(pic.Graphic).Scale;
end;

procedure TZoomPicture.SetRealScale(const Value: TJPEGScale);
var pic : TPicture;
begin
  pic := ImagePicture.Picture;
  if not ( pic.Graphic is TJpegImage ) then exit;
  TJpegImage(pic.Graphic).Scale := Value;
  TJpegImage(pic.Graphic).DIBNeeded;        // clearing the screen
  if ( Assigned(ScaleChange) ) then ScaleChange(self);
end;

function TZoomPicture.GetRealScaleSt: string;
begin
  Result := ScaleNames[RealScale];
end;


procedure TZoomPicture.SetZoomFactor(const Value: double);
var nx,ny,nw,nh : integer;  sc : TJPEGScale;
begin
  FZoomFactor := Value;
  sc := RealScale;
  if ( Value > 1 ) and ( sc <> jsFullSize ) then begin
    FZoomFactor := FZoomFactor/ScaleFactors[sc];
    RealScale := jsFullSize;
  end;
  if ( Assigned(ZoomFactorChange) ) then ZoomFactorChange(self);
  nw := Round(ImagePicture.Picture.Width * FZoomFactor);
  nh := Round(ImagePicture.Picture.Height * FZoomFactor);
  Center(ScrollBoxImage,nx,ny,nw,nh);
  ImagePicture.SetBounds(nx,ny,nw,nh);
  if ( CenterOnZoom ) then CenterCurrentPoint;
end;

function TZoomPicture.GetRealZoomFactor: double;
begin
  Result := FZoomFactor/ScaleFactors[RealScale];
end;

procedure TZoomPicture.SetRealZoomFactor(const Value: double);
begin
  ZoomFactor := Value * ScaleFactors[RealScale];
end;


procedure TZoomPicture.CenterCurrentPoint;
var ZoomPoint : TPoint;
begin
  ZoomPoint.X := Round(CurrentPoint.X * ZoomFactor);
  ZoomPoint.Y := Round(CurrentPoint.Y * ZoomFactor);
  Center(ScrollBoxImage, ZoomPoint);
end;


procedure TZoomPicture.SetCenterOnDblClick(const Value: boolean);
begin
  FCenterOnDblClick := Value;
end;

procedure TZoomPicture.SetAutoSizeOnLoad(const Value: boolean);
begin
  FAutoSizeOnLoad := Value;
end;

procedure TZoomPicture.SetCenterOnZoom(const Value: boolean);
begin
  FCenterOnZoom := Value;
end;

procedure TZoomPicture.SetAutoSizeOnResize(const Value: boolean);
begin
  FAutoSizeOnResize := Value;
end;

procedure TZoomPicture.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var change : boolean;
begin
  change := ( AWidth <> Width ) or ( AHeight <> Height );
  inherited;
  if ( change and AutoSizeOnResize ) then ReSizePicture;
end;


function TZoomPicture.GetImageBorderStyle: TBorderStyle;
begin
  Result := ScrollBoxImage.BorderStyle;
end;

procedure TZoomPicture.SetImageBorderStyle(const Value: TBorderStyle);
begin
  ScrollBoxImage.BorderStyle := Value;
end;

procedure TZoomPicture.SetScale(const Value: TJPEGScale);
begin
  FScale := Value;
  if ( Assigned(ScaleChange) ) then ScaleChange(self);
end;

procedure TZoomPicture.SetFasterLoad(const Value: boolean);
begin
  FFasterLoad := Value;
end;

procedure TZoomPicture.SetZoomFactorChange(const Value: TNotifyEvent);
begin
  FZoomFactorChange := Value;
end;

procedure TZoomPicture.SetScaleChange(const Value: TNotifyEvent);
begin
  FScaleChange := Value;
end;


function TZoomPicture.GetImageSize: TSize;
begin
  Result.cx := ImagePicture.Picture.Width;
  Result.cy := ImagePicture.Picture.Height;
end;

procedure TZoomPicture.ImagePictureClick(Sender: TObject);
begin
  if Assigned(OnClick) then OnClick(self);
end;

function TZoomPicture.GetAutoScroll: boolean;
begin
  Result := ScrollBoxImage.AutoScroll
end;

procedure TZoomPicture.SetAutoScroll(const Value: boolean);
begin
  ScrollBoxImage.AutoScroll := Value;
end;

procedure TZoomPicture.OnCtrlKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var n : integer;
begin
  n := 20;
  if ( ssCtrl in Shift ) then n := 200;
  case ( Key ) of
    VK_NUMPAD2, VK_DOWN:  ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position + n;
    VK_NUMPAD8, VK_UP:    ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position - n;
    VK_NUMPAD6, VK_RIGHT: ScrollBoxImage.HorzScrollBar.Position := ScrollBoxImage.HorzScrollBar.Position + n;
    VK_NUMPAD4, VK_LEFT:  ScrollBoxImage.HorzScrollBar.Position := ScrollBoxImage.HorzScrollBar.Position - n;
    VK_NUMPAD7, VK_HOME:  ScrollBoxImage.HorzScrollBar.Position := 0;
    VK_NUMPAD1, VK_END:   ScrollBoxImage.HorzScrollBar.Position := 10000;
    VK_NUMPAD9, VK_PRIOR: ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position - 15*n;
    VK_NUMPAD3, VK_NEXT:  ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position + 15*n;
    VK_NUMPAD5, VK_CLEAR: Center(ScrollBoxImage,ImagePicture.Width div 2,ImagePicture.Height div 2);
//    VK_SPACE:  if Assigned(OnClick) then OnClick(Picture[ItemIndex]);
//    VK_RETURN: if Assigned(OnClick) then OnClick(Picture[ItemIndex]);
  end;
end;

function TZoomPicture.GetGanGetFocus: boolean;
begin
  Result := Assigned(dummyctrl);
end;

procedure TZoomPicture.SetCanGetFocus(const Value: boolean);
begin
  if ( Value ) then begin
    if ( CanGetFocus ) then exit;
    dummyctrl := TMemo.Create(self);
    dummyctrl.Parent := self;
    dummyctrl.OnKeyDown := OnCtrlKeyDown;
    dummyctrl.Top := -100;
    dummyctrl.Height := 10;
    dummyctrl.SendToBack;
    exit;
  end;

  FreeAndNil(dummyctrl);

end;

procedure TZoomPicture.OnImageMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
var n:integer;
begin
  Handled := true;
  if ( ssShift in Shift ) or ( ssMiddle in Shift ) then begin
    if ( WheelDelta > 0 )  then ZoomFactor := ZoomFactor * 1.2
                           else ZoomFactor := ZoomFactor / 1.2;
    exit;
  end;
  n := 40;
  if ( ssCtrl in Shift ) then n := 100;
  if ( WheelDelta < 0 )  then
    ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position + n
  else
    ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position - n;

end;

end.