[vigard373]

Доброго дня.

Есть jpg-файл с картой местности (2866х1672) пикселей.
Изображение выводиться на Image1 (390х228), Proportional := True, т.е. вся картинка умещается в этот маленький прямоугольник.
Есть две кнопки button1 и button2, с помощью которых я меняю масштаб изображения относительно центра Image1.
Также использую процедуры image_mouse_move для перемещения изображения внутри видимой области с проверкой на границы.
Но никак не могу подобрать формулу для корректного масштабирования, ведь при перемещении увеличенной карты центр изображения почти всегда не совпадает с центром видимой области (Image1).

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  old_Height, old_Width : Word;
  begin
    old_Height := Image1.Height;
    old_Width :=  Image1.Width;
    Image1.Height := round(Image1.Height / 1.05);
    Image1.Width := round(Image1.Width / 1.05);
    Image1.Top := Image1.Top - Round((Image1.Height - old_Height) / 2); 
    Image1.Left := Image1.Left - Round((Image1.Width - old_Width) / 2); 
  end;

procedure TForm1.Button2Click(Sender: TObject);
var
  old_Height, old_Width : Word;
begin
    old_Height := Image1.Height;
    old_Width :=  Image1.Width;
    Image1.Height := round(Image1.Height * 1.05);
    Image1.Width := round(Image1.Width * 1.05);
    Image1.Top := Image1.Top - Round((Image1.Height - old_Height) / 2); 
    Image1.Left := Image1.Left - Round((Image1.Width - old_Width) / 2); 
end;

Если все двойки (выделены жирным) заменить на 1, то масштабирование будет выполняться корректно, только в том случае если границы изображения достигли нижнего правого угла.

Прошу помочь разобраться в формуле, по которой можно было бы корректно масштабировать изображение в любой части видимой области.

Код файла unit1.pas:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Button1: TButton;
    Button2: TButton;
    Panel2: TPanel;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  x0,y0:integer;
  move:boolean;
  old_Height, old_Width : Word;

{$R *.dfm}

Procedure info_2;
begin
  Form1.Label1.Caption :=  'Top: ' + InttoStr(Form1.Image1.Top)      ;
  Form1.Label2.Caption :=  'Left: ' + InttoStr(Form1.Image1.Left)    ;
  Form1.Label3.Caption :=  'Width: ' + InttoStr(Form1.Image1.Width)  ;
  Form1.Label4.Caption :=  'Height: ' + InttoStr(Form1.Image1.Height);
  Form1.Label5.Caption :=  InttoStr(Round(Form1.Image1.Height + Form1.Image1.Top));
  Form1.Label6.Caption :=  InttoStr(Round(Form1.Image1.Width + Form1.Image1.Left));

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if button<>mbLeft then move:=false
   else begin
      move:=true;
      x0:=x;
      y0:=y;
   end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if move then
 begin
 image1.SetBounds(image1.Left+x-x0,image1.Top+y-y0,image1.width,image1.height);
 if (Image1.Top > 0) Then begin
      Image1.Top := 0;
      end;
 if (Image1.Left > 0) Then Begin
      Image1.Left := 0;
      end;
 if (Image1.Height + Image1.Top) < 228 then Begin
      Image1.Top := (228 - Image1.Height);
      end;
      if (Image1.Width + Image1.Left) < 390 then Begin
      Image1.Left := (390 - Image1.Width);
      end;
  info_2;
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbMiddle then begin
   Image1.Width:=390;
   Image1.Height:=228;
   end;
   move:=false;
   info_2;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  JpegIm: TJpegImage;
  bm: TBitMap;
begin
  Image1.Parent.DoubleBuffered := True;
  bm := TBitMap.Create;
  JpegIm := TJpegImage.Create;
  JpegIm.LoadFromFile('World_Map.jpg');
  bm.Assign(JpegIm);
  Form1.Image1.Picture.Assign(JpegIm);
  bm.Destroy;
  JpegIm.Destroy;
  if Image1.Picture.Graphic is TJPEGImage then
  TJPEGImage(Image1.Picture.Graphic).DIBNeeded;
end;

procedure TForm1.Button1Click(Sender: TObject);
  begin
    old_Height := Image1.Height;
    old_Width :=  Image1.Width;
    Image1.Height := round(Image1.Height / 1.05);
    Image1.Width := round(Image1.Width / 1.05);
    Image1.Top := Image1.Top - Round((Image1.Height - old_Height) / 2);
    Image1.Left := Image1.Left - Round((Image1.Width - old_Width) / 2);
    info_2;
  end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    old_Height := Image1.Height;
    old_Width :=  Image1.Width;
    Image1.Height := round(Image1.Height * 1.05);
    Image1.Width := round(Image1.Width * 1.05);
    Image1.Top := Image1.Top - Round((Image1.Height - old_Height) / 2);
    Image1.Left := Image1.Left - Round((Image1.Width - old_Width) / 2);
    info_2;
end;

end.

Код файла: Unit1.dfm

Код:

object Form1: TForm1
  Left = 395
  Top = 684
  Width = 405
  Height = 312
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 9
    Top = 250
    Width = 3
    Height = 13
  end
  object Label2: TLabel
    Left = 79
    Top = 250
    Width = 3
    Height = 13
  end
  object Label3: TLabel
    Left = 153
    Top = 250
    Width = 3
    Height = 13
  end
  object Label4: TLabel
    Left = 219
    Top = 250
    Width = 3
    Height = 13
  end
  object Label5: TLabel
    Left = 297
    Top = 250
    Width = 3
    Height = 13
  end
  object Label6: TLabel
    Left = 353
    Top = 250
    Width = 3
    Height = 13
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 390
    Height = 228
    BevelOuter = bvNone
    Caption = 'Panel1'
    Ctl3D = False
    ParentCtl3D = False
    TabOrder = 0
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 390
      Height = 228
      Proportional = True
      OnMouseDown = Image1MouseDown
      OnMouseMove = Image1MouseMove
      OnMouseUp = Image1MouseUp
    end
  end
  object Button1: TButton
    Left = 136
    Top = 275
    Width = 25
    Height = 9
    Caption = #160
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 233
    Top = 274
    Width = 25
    Height = 9
    Caption = #160
    TabOrder = 2
    OnClick = Button2Click
  end
  object Panel2: TPanel
    Left = 0
    Top = 228
    Width = 390
    Height = 3
    Caption = #160
    Color = clRed
    TabOrder = 3
  end
end

В прикреплённом файле изображение World-Map.jpg (2866х1672)

Спасибо за внимание!

[angvelem]

Я вообще бы не стал для этого использовать TImage, вывел бы в TPaintBox.

[vigard373]

В данном случае TPaintBox мне использовать неудобно, т.к. изображение с него пропадает, стоит свернуть/развернуть окно и т.п.
Дополнительно писать код, который следил бы за перерисовкой. Не вижу смысла.

[dr. F.I.N.]

Я бы действительно юзал PaintBox, кода там на 3 копейки:

Код:

procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, BmpBuffer);
end;

где BmpBuffer - битмап размером с рабочую область PaintBox1, на котором бы производил все операции по отрисовке.