Очень нужна помощь с масштабированием изображений в Delphi XE2
Ребята, помогите кто может. Есть картинка разрешением 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.
|