[Sv-academy]

Ребята, помогите кто может. Есть картинка разрешением 13177*7417. Так как разрешение достаточно высокое, то вывод картинки в Image1 осуществляю по частям из буфера. В свойствах Image1 в графе WrapMode стоит iwTile, то есть выводится только часть картинки, и перетаскивания картинки мышью происходит гладко без рывков, но стоит изменить масштаб как тут же начинает рубится, даже если вернул картинку в исходный масштаб все равно перетаскивания получаются рваными. Я не могу понять почему, помогите кто может!! Код программы представлен ниже.

Код:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Edit;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Edit1: TEdit;
    Button1: TButton;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; var Handled: Boolean);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Buff,Buff2,Buff3:TBitmap;
  i,j,G:integer;
  pos,delta:TPoint;
  Rt1:array[0..100,0..100] of TRectF;
  Rt2:array[0..100,0..100] of TRectF;

implementation

{$R *.fmx}



procedure TForm1.FormCreate(Sender: TObject);
begin
   Image1.Bitmap.LoadFromFile('c:\RRV\Temp\2\42.png');
   Buff2:=TBitmap.Create(Round(Image1.Width),Round(Image1.Height));
   Buff2.LoadFromFile('c:\RRV\Temp\2\42.png');
   G:=15;
//делим загруженную в буфер картинку на G частей
 for i := 0 to G do
    begin
      for j := 0 to G do
        begin
          Rt1[i,j].Right:=Buff2.Width/G+(Buff2.Width/G)*j;
          Rt1[i,j].Left:=(Buff2.Width/G)*j;
          Rt1[i,j].Bottom:=(Buff2.Height/G)*i+Buff2.Height/G;
          Rt1[i,j].Top:=(Buff2.Height/G)*i;
        end;
    end;
 for i := 0 to G do
   begin
     for j := 0 to G do
       begin
         Rt2[i,j].Right:=Buff2.Width/G+(Buff2.Width/G)*j;
         Rt2[i,j].Left:=(Buff2.Width/G)*j;
         Rt2[i,j].Bottom:=(Buff2.Height/G)*i+Buff2.Height/G;
         Rt2[i,j].Top:=(Buff2.Height/G)*i;
       end;
   end;
end;
 //получаем координаты курсора при нажатии
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  pos:=Point(Round(x),Round(y));
end;
//двигаем картинку
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  if SSLeft in Shift then
    begin
      delta:=point(Round(x)-pos.X,Round(y)-pos.Y);
      for i := 0 to G do
        for j := 0 to G do
          begin
            Rt2[i,j].Left:=Rt2[i,j].Left+Round(delta.X);
            Rt2[i,j].Right:=Rt2[i,j].Right+Round(delta.X);
            Rt2[i,j].Top:=Rt2[i,j].Top+Round(delta.Y);
            Rt2[i,j].Bottom:=Rt2[i,j].Bottom+Round(delta.Y);
          end;

      for i := 0 to G do
        for j := 0 to G do
          if ((Rt2[i,j].Left+Round(delta.X))<Image1.Width) and ((Rt2[i,j].Right+Round(delta.X))>0) and
             ((Rt2[i,j].Top+Round(delta.Y))<Image1.Height) and ((Rt2[i,j].Bottom+Round(delta.Y))>0) then
             begin
               with Image1.Bitmap do
                 begin
                   Canvas.BeginScene;
                   try
                   Canvas.DrawBitmap(Buff2,Rt1[i,j],Rt2[i,j],1,True);
                   Canvas.EndScene;
                   finally
                   BitmapChanged
                   end;
                 end;
             end;
    end;
   pos.X:=pos.X+delta.X;
   pos.Y:=pos.Y+delta.Y;
end;
//делаем масштаб
procedure TForm1.Image1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
  const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
begin
 for i := 0 to G do
   for j := 0 to G do
     begin
       Rt2[i,j].Left:=Rt2[i,j].Left*ZoomFactor[WheelDelta > 0];
       Rt2[i,j].Right:=Rt2[i,j].Right*ZoomFactor[WheelDelta > 0];
       Rt2[i,j].Top:=Rt2[i,j].Top*ZoomFactor[WheelDelta > 0];
       Rt2[i,j].Bottom:=Rt2[i,j].Bottom*ZoomFactor[WheelDelta > 0];
     end;
   for i := 0 to G do
     for j := 0 to G do
       if (Rt2[i,j].Left<Image1.Width) and (Rt2[i,j].Right>0) and
          (Rt2[i,j].Top<Image1.Height) and (Rt2[i,j].Bottom>0) then
           begin
             with Image1.Bitmap do
               begin
                 Canvas.BeginScene;
                 try
                 Canvas.DrawBitmap(Buff2,Rt1[i,j],Rt2[i,j],1,True);
                 Canvas.EndScene;
                 finally
                 BitmapChanged
                 end;
               end;
           end;
end;

end.  

[Klyaksa]

Тебе нужен общий буфер который не будет изменять свои размеры. А от этого буфера уже масштабируешь в image1.

[Sv-academy]

Так я ведь в своем буфере никакие размеры не меняю, я меняю размер или местоположение целевого прямоугольника Rt2 в который будет выводится участок картинки в Image1 из исходной области Rt1. Rt1 и Rt2 используются только при рисовании в Image1 и на буфер никак не влияют?

[Klyaksa]

Попробуй сделать так

Код:

Canvas.DrawBitmap(Buff2,Rt2[i,j],Rt1[i,j],1,True);

[icWasya]

Ну для начала - вынести Canvas.BeginScene и Canvas.EndScene за цикл отрисовки.
Во вторых, сделай DoubleBuffered:=True;
в третьих - у меня нет XE, но на шестёрке проявляется заметное торможение при уменьшении масштаба. Похоже, что при этом просто приходится обрабатывать больше кусков исходного изображения.
Как вариант - попробуй сделать несколько уменьшеных копий исходного изображения с разной степенью уменьшения, и при заметном изменении масштаба переключаться на них.