{************************************************}
{                                                }
{  ATImageBox component                          }
{  Copyright (C) 2006-2007 Alexey Torgashin      }
{  http://atorg.net.ru                           }
{  atorg@yandex.ru                               }
{                                                }
{************************************************}

{
------------------------------------------------------------------------------
ATImageBox is a Delphi/C++Builder control which displays an image in the
scrollbox. It is a TScrollBox descendant which has a TImage object as a child.
It has such properties as ImageFitToWindow, ImageCenter, ImageScale etc,
so it's easy for you to control the placement of an image.

Image can be dragged by mouse and scrolled by keys and mouse wheel.
An informational label can be displayed over the left-top control corner.
------------------------------------------------------------------------------
}

{$I ATImageBoxDef.inc}

unit ATImageBox;

interface

uses
  Windows, Messages, Classes, Controls, Graphics,
  StdCtrls, ExtCtrls,
  {$ifdef TNT} TntExtCtrls, {$endif}
  Forms;

type
  TATImageBox = class(TScrollBox)
  private
    {$ifdef TNT}
    FImage: TTntImage;
    {$else}
    FImage: TImage;
    {$endif}
    FImageLabel: TLabel;
    FImageWidth: Integer;
    FImageHeight: Integer;
    FIsIcon: Boolean;
    FIsMetafile: Boolean;
    FImageFit: Boolean;
    FImageFitOnlyBig: Boolean;
    FImageCenter: Boolean;
    FImageScale: Integer;
    FImageKeepPosition: Boolean;
    FImageDrag: Boolean;
    FImageDragCursor: TCursor;
    FImageMoving: Boolean;
    FImageMousePnt: TPoint;
    FOnHScroll: TNotifyEvent;
    FOnVScroll: TNotifyEvent;
    procedure DoHScroll;
    procedure DoVScroll;
    procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure UpdateImagePosition(AResetPosition: Boolean = False);
    procedure UpdateImageLabelPosition;
    procedure SetImageFit(AValue: Boolean);
    procedure SetImageFitOnlyBig(AValue: Boolean);
    procedure SetImageCenter(AValue: Boolean);
    procedure SetImageScale(AValue: Integer);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ImageClick(Sender: TObject);

  public
    constructor Create(AOwner: TComponent); override;
    procedure UpdateImageInfo;
    property Image: {$ifdef TNT}TTntImage{$else}TImage{$endif} read FImage;
    property ImageWidth: Integer read FImageWidth;
    property ImageHeight: Integer read FImageHeight;
    property ImageScale: Integer read FImageScale write SetImageScale;
    property ImageLabel: TLabel read FImageLabel;

  protected
    procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Resize; override;
    procedure Click; override;

  published
    property ImageFitToWindow: Boolean read FImageFit write SetImageFit;
    property ImageFitOnlyBig: Boolean read FImageFitOnlyBig write SetImageFitOnlyBig;
    property ImageCenter: Boolean read FImageCenter write SetImageCenter;
    property ImageKeepPosition: Boolean read FImageKeepPosition write FImageKeepPosition;
    property ImageDrag: Boolean read FImageDrag write FImageDrag default True;
    property ImageDragCursor: TCursor read FImageDragCursor write FImageDragCursor default crSizeAll;
    property OnHScroll: TNotifyEvent read FOnHScroll write FOnHScroll;
    property OnVScroll: TNotifyEvent read FOnVScroll write FOnVScroll;
  end;

procedure Register;


implementation

uses
  ATxImageProc;


{ Constants }

const
  cImageLineSize = 50; //Line size: pixels to scroll by arrows and mouse sheel
  cImageGapSize = 20; //Gap size: PgUp/PgDn/Home/End scroll by control size minus gap size

{ Helper functions }

function IMax(N1, N2: Integer): Integer;
begin
  if N1 >= N2 then
    Result := N1
  else
    Result := N2;
end;

function IMin(N1, N2: Integer): Integer;
begin
  if N1 <= N2 then
    Result := N1
  else
    Result := N2;
end;


{ TATImageBox }

constructor TATImageBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  //Init inherited properties
  AutoScroll := False;
  DoubleBuffered := True; //To remove flicker when new image is loaded
  HorzScrollBar.Tracking := True;
  VertScrollBar.Tracking := True;

  //Init fields
  FImageFit := False;
  FImageFitOnlyBig := True;
  FImageCenter := True;

  FIsIcon := False;
  FIsMetafile := False;

  FImageWidth := 0;
  FImageHeight := 0;
  FImageScale := 100;
  FImageKeepPosition := True;
  FImageDrag := True;
  FImageDragCursor := crSizeAll;
  FImageMoving := False;
  FImageMousePnt := Point(0, 0);

  //Init objects
  FImage := {$ifdef TNT}TTntImage{$else}TImage{$endif}.Create(Self);
  with FImage do
  begin
    Parent := Self;
    Align := alNone;
    AutoSize := False;
    OnMouseDown := ImageMouseDown;
    OnMouseUp := ImageMouseUp;
    OnMouseMove := ImageMouseMove;
    OnClick := ImageClick;
  end;

  FImageLabel := TLabel.Create(Self);
  with FImageLabel do
  begin
    Parent := Self;
    Visible := False;
    Brush.Style := bsClear;
    Font.Style := [fsBold];
    Font.Color := clWhite;
    Caption := '';
  end;

  //Init events
  OnMouseWheelUp := MouseWheelUp;
  OnMouseWheelDown := MouseWheelDown;
end;

procedure TATImageBox.DoHScroll;
begin
  UpdateImageLabelPosition;

  if Assigned(FOnHScroll) then
    FOnHScroll(Self);
end;

procedure TATImageBox.DoVScroll;
begin
  UpdateImageLabelPosition;

  if Assigned(FOnVScroll) then
    FOnVScroll(Self);
end;

procedure TATImageBox.WMHScroll(var Msg: TMessage);
begin
  inherited;
  DoHScroll;
end;

procedure TATImageBox.WMVScroll(var Msg: TMessage);
begin
  inherited;
  DoVScroll;
end;

procedure TATImageBox.MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if Shift = [] then
  begin
    with VertScrollBar do
      Position := Position - cImageLineSize;
    DoVScroll;
  end
  else
  if Shift = [ssShift] then
  begin
    with HorzScrollBar do
      Position := Position - cImageLineSize;
    DoHScroll;
  end;

  Handled := True;
end;

procedure TATImageBox.MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if Shift = [] then
  begin
    with VertScrollBar do
      Position := Position + cImageLineSize;
    DoVScroll;
  end
  else
  if Shift = [ssShift] then
  begin
    with HorzScrollBar do
      Position := Position + cImageLineSize;
    DoHScroll;
  end;

  Handled := True;
end;

procedure TATImageBox.WMGetDlgCode(var Message: TMessage);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TATImageBox.KeyDown(var Key: Word; Shift: TShiftState);

  function PageSize(AClientSize: Integer): Integer;
  begin
    Result := IMax(AClientSize - cImageGapSize, AClientSize div 3 * 2);
  end;

begin
  case Key of
    VK_LEFT:
    begin
      if Shift = [] then
      begin
        with HorzScrollBar do
          Position := Position - cImageLineSize;
        DoHScroll;
        Key := 0;
      end
      else
      if Shift = [ssCtrl] then
      begin
        with HorzScrollBar do
          Position := 0;
        DoHScroll;
        Key := 0;
      end;
    end;

    VK_RIGHT:
    begin
      if Shift = [] then
      begin
        with HorzScrollBar do
          Position := Position + cImageLineSize;
        DoHScroll;
        Key := 0;
      end
      else
      if Shift = [ssCtrl] then
      begin
        with HorzScrollBar do
          Position := Range;
        DoHScroll;
        Key := 0;
      end;
    end;

    VK_HOME:
      if Shift = [] then
      begin
        with HorzScrollBar do
          Position := Position - PageSize(ClientWidth);
        DoHScroll;
        Key := 0;
      end;

    VK_END:
      if Shift = [] then
      begin
        with HorzScrollBar do
          Position := Position + PageSize(ClientWidth);
        DoHScroll;
        Key := 0;
      end;

    VK_UP:
    begin
      if Shift = [] then
      begin
        with VertScrollBar do
          Position := Position - cImageLineSize;
        DoVScroll;
        Key := 0;
      end
      else
      if Shift = [ssCtrl] then
      begin
        with VertScrollBar do
          Position := 0;
        DoVScroll;
        Key := 0;
      end;
    end;

    VK_DOWN:
    begin
      if Shift = [] then
      begin
        with VertScrollBar do
          Position := Position + cImageLineSize;
        DoVScroll;
        Key := 0;
      end
      else
      if Shift = [ssCtrl] then
      begin
        with VertScrollBar do
          Position := Range;
        DoVScroll;
        Key := 0;
      end;
    end;

    VK_PRIOR:
      if Shift = [] then
      begin
        with VertScrollBar do
          Position := Position - PageSize(ClientHeight);
        DoVScroll;
        Key := 0;
      end;

    VK_NEXT:
      if Shift = [] then
      begin
        with VertScrollBar do
          Position := Position + PageSize(ClientHeight);
        DoVScroll;
        Key := 0;
      end;
  end;
end;


procedure TATImageBox.UpdateImagePosition(AResetPosition: Boolean = False);
var
  AWidth, AHeight,
  ANewWidth, ANewHeight,
  ANewLeft, ANewTop,
  AScrollMaxX, AScrollMaxY: Integer;
  ARatio, AImageRatio,
  ACenterRatioX, ACenterRatioY: Double;
begin
  AWidth := ClientWidth;
  AHeight := ClientHeight;

  //Save center position, need to restore it later
  ACenterRatioX := 0;
  ACenterRatioY := 0;

  if FImage.Width>0 then
    begin
    if FImage.Left>=0 then
      ACenterRatioX := (AWidth div 2 - FImage.Left) / FImage.Width
    else
      ACenterRatioX := (AWidth div 2 + HorzScrollBar.Position) / FImage.Width;
    end;

  if FImage.Height>0 then
    begin
    if FImage.Top>=0 then
      ACenterRatioY := (AHeight div 2 - FImage.Top) / FImage.Height
    else
      ACenterRatioY := (AHeight div 2 + VertScrollBar.Position) / FImage.Height;
    end;

  //Set controls params
  HorzScrollBar.Position := 0;
  VertScrollBar.Position := 0;

  AutoScroll := not FImageFit;

  FImage.AutoSize := (not FImageFit) and (FImageScale=100);
  FImage.Stretch := not FImage.AutoSize;

  //Work around VCL draw bug for icons
  if FIsIcon then
    begin
    FImage.AutoSize := False;
    FImage.Stretch := True;
    FImage.Width := FImageWidth;
    FImage.Height := FImageHeight;
    end;

  //Fit and recalculate ImageScale
  FImage.Left := 0;
  FImage.Top := 0;

  AWidth := ClientWidth;
  AHeight := ClientHeight;

  if FImageFit then
    begin
    ANewWidth := FImageWidth;
    ANewHeight := FImageHeight;

    if FImageFitOnlyBig and
      (FImageWidth<=AWidth) and (FImageHeight<=AHeight) then
      FImageScale := 100
    else
      begin
      if (AWidth>0) and (AHeight>0) and
        (FImageWidth>0) and (FImageHeight>0) then
        begin
        ARatio := AWidth/AHeight;
        AImageRatio := FImageWidth/FImageHeight;
        if ARatio>AImageRatio then
          begin
          ANewHeight := AHeight;
          ANewWidth := Trunc(ANewHeight*AImageRatio);
          FImageScale := AHeight * 100 div FImageHeight;
          end
        else
          begin
          ANewWidth := AWidth;
          ANewHeight := Trunc(ANewWidth/AImageRatio);
          FImageScale := AWidth * 100 div FImageWidth;
          end;
        end;
      end
    end
  else
    begin
    ANewWidth := Round(FImageWidth * FImageScale / 100);
    ANewHeight := Round(FImageHeight * FImageScale / 100);
    end;

  //Update image position
  ANewLeft := 0;
  ANewTop := 0;

  if FImageCenter then
    begin
    if AWidth>ANewWidth then
      ANewLeft := (AWidth-ANewWidth) div 2;
    if AHeight>ANewHeight then
      ANewTop := (AHeight-ANewHeight) div 2;
    end;

  if FImage.Visible then
    FImage.SetBounds(ANewLeft, ANewTop, ANewWidth, ANewHeight);

  //Restore saved center position
  if FImageKeepPosition and (not AResetPosition) then
    begin
    if ANewLeft=0 then
      begin
      AScrollMaxX := IMax(ANewWidth - AWidth, 0);
      HorzScrollBar.Position :=
        IMin(AScrollMaxX, Trunc(ACenterRatioX * ANewWidth) - AWidth div 2);
      end
    else
      HorzScrollBar.Position := 0;

    if ANewTop=0 then
      begin
      AScrollMaxY := IMax(ANewHeight - AHeight, 0);
      VertScrollBar.Position :=
        IMin(AScrollMaxY, Trunc(ACenterRatioY * ANewHeight) - AHeight div 2);
      end
    else
      VertScrollBar.Position := 0;
    end;

  UpdateImageLabelPosition;
end;

procedure TATImageBox.UpdateImageLabelPosition;
begin
  FImageLabel.Left := 0;
  FImageLabel.Top := 0;
end;

procedure TATImageBox.SetImageFit(AValue: Boolean);
begin
  if AValue <> FImageFit then
  begin
    FImageFit := AValue;
    if not FImageFit then
      FImageScale := 100;
    UpdateImagePosition(True);
  end;
end;

procedure TATImageBox.SetImageFitOnlyBig(AValue: Boolean);
begin
  if AValue <> FImageFitOnlyBig then
  begin
    FImageFitOnlyBig := AValue;
    UpdateImagePosition(True);
  end;
end;

procedure TATImageBox.SetImageCenter(AValue: Boolean);
begin
  if AValue <> FImageCenter then
  begin
    FImageCenter := AValue;
    UpdateImagePosition(True);
  end;
end;

procedure TATImageBox.UpdateImageInfo;
begin
  FIsIcon := False;
  FIsMetafile := False;

  FImageWidth := 0;
  FImageHeight := 0;

  if Assigned(FImage.Picture) and Assigned(FImage.Picture.Graphic) then
  begin
    FIsIcon := FImage.Picture.Graphic is TIcon;
    if FIsIcon then
    begin
      FixIcon(FImage.Picture.Graphic as TIcon);
      CorrectImage(FImage, Color);
    end;

    FIsMetafile := FImage.Picture.Graphic is TMetafile;

    FImageWidth := FImage.Picture.Width;
    FImageHeight := FImage.Picture.Height;

    UpdateImagePosition(True);
  end;
end;

procedure TATImageBox.Resize;
begin
  inherited;
  UpdateImagePosition;
end;

procedure TATImageBox.SetImageScale(AValue: Integer);
begin
  FImageScale := AValue;
  FImageFit := False;
  UpdateImagePosition;
end;

procedure TATImageBox.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FImageDrag then
    if Button = mbLeft then
    begin
      FImageMoving := True;
      FImageMousePnt := Point(X, Y);
      Screen.Cursor := FImageDragCursor;
    end;
end;

procedure TATImageBox.ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and FImageMoving then
  begin
    FImageMoving := False;
    Screen.Cursor := crDefault;
  end;
end;

procedure TATImageBox.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if FImageDrag then
    if FImageMoving then
    begin
      HorzScrollBar.Position := HorzScrollBar.Position + (FImageMousePnt.X - X);
      VertScrollBar.Position := VertScrollBar.Position + (FImageMousePnt.Y - Y);
      UpdateImageLabelPosition;
    end;
end;

procedure TATImageBox.Click;
begin
  SetFocus;
end;

procedure TATImageBox.ImageClick(Sender: TObject);
begin
  SetFocus;
end;



{ Registration }

procedure Register;
begin
  RegisterComponents('Samples', [TATImageBox]);
end;

end.
