急！怎么实现放大缩小！
现在有个paintbox，一个控制放大倍数的控件，调节放大倍数，可以实现paintbox上图形整体放大，然后出现横拉条和纵拉条，类似word里显示比例的功能，求个位高手指点！！！
[解决办法]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Buttons, ExtDlgs, StdCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
btn_Enlarge: TSpeedButton;
btn_Narrow: TSpeedButton;
ScrollBox1: TScrollBox;
Img1: TImage;
PB1: TPaintBox;
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
procedure btn_EnlargeClick(Sender: TObject);
procedure btn_NarrowClick(Sender: TObject);
procedure pb1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pb1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pb1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Multiples: Integer;
pp: Integer; //放大倍數
Canmove: Boolean; //移動標志
BitmapTmp: TBitmap; //臨時變量
LeftTop: TPoint; //第一次移動時截取原始圖像的左上角坐標
SecondTop: TPoint; //記錄移動過程中要截取的原始圖像的左上角坐標
MouseOrg: TPoint; //記錄鼠標按下去的坐標
procedure drawline;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn_EnlargeClick(Sender: TObject);
var
SrcRect,DestRect: TRect;
W,H:Integer;
tempW,tempH: Integer;
begin
Inc(Multiples,2);
BitmapTmp.Free;
BitmapTmp := TBitmap.Create;
BitmapTmp.Width := pb1.Width;
BitmapTmp.Height := pb1.Height;
if Multiples >20 then
begin
pp := 20;
Multiples := 20;
end
else pp := Multiples;
img1.Visible := False;
tempW := Img1.Width; //imgRB.X - imgLT.X;
tempH := Img1.Height;// imgRB.Y - imgLT.Y;
if (tempW * PP) <= pb1.Width then
w := tempW
else
w := pb1.Width div PP;
if (tempH * PP) <= pb1.Height then
h := tempH
else
h := pb1.Height div PP;
pb1.Refresh;
SrcRect := Rect(0, 0, W, H);
destRect := Rect(0,0,W * pp,H *pp);
BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
if pp > 2 then
drawline
else
pb1.Canvas.CopyRect(Rect(0,0,pb1.Width div pp * pp,pb1.Height div pp * pp),
BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));
//SecondTop := imgLT;
end;
procedure TForm1.btn_NarrowClick(Sender: TObject);
var
SrcRect,DestRect: TRect;
W,H:Integer;
tempW,tempH: Integer;
begin
Dec(Multiples,2);
BitmapTmp.Free;
BitmapTmp := TBitmap.Create;
BitmapTmp.Width := pb1.Width;
BitmapTmp.Height := pb1.Height;
if Multiples >= 2 then
begin
pp := Multiples;
tempW := Img1.Width;
tempH := Img1.Height;
if (tempW * PP) <= pb1.Width then
w := tempW
else
w := pb1.Width div PP;
if (tempH * PP) <= pb1.Height then
h := tempH
else
h := pb1.Height div PP;
pb1.Refresh;
SrcRect := Rect(0, 0, W, H);
destRect := Rect(0,0,w *pp,h * pp);
BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
if pp > 2 then
drawline
else
pb1.Canvas.CopyRect(Rect(0,0,pb1.Width div pp * pp,pb1.Height div pp * pp),
BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));
end
else
begin
Multiples := 0;
pp := 1;
pb1.Canvas.CopyRect(Rect(0,0,pb1.Width,pb1.Height),img1.Canvas,Rect(0,0,img1.Width,img1.Height));
SecondTop.X := 0;
SecondTop.Y := 0;
end;
end;
procedure TForm1.pb1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbright then
begin
Canmove := True;
MouseOrg.X := X;
MouseOrg.Y := Y;
end;
end;
procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
SrcRect,destRect: TRect;
setX,setY: Integer;
begin
LeftTop.X := SecondTop.X;
LeftTop.Y := SecondTop.Y;
if Canmove and (ssright in Shift) then
begin
if pb1.Cursor <> crHandPoint then pb1.Cursor := crHandPoint;
if pp = 0 then pp := 1; //原始大小時
setX := (MouseOrg.X - X) div pp;
setY := (MouseOrg.Y - Y) div pp;
if Img1.Width * pp <= pb1.Width then setX := 0;
if Img1.Height * pp <= pb1.Height then setY := 0;
if setX > 0 then //圖像左移顯示右邊看不到的部分(移動過程中)
begin
if LeftTop.X + setX + BitmapTmp.Width div pp > Img1.Width then
LeftTop.X := Img1.Width - BitmapTmp.Width div pp
else
LeftTop.X := LeftTop.X + setX;
end;
if setX < 0 then //圖像右移顯示左邊看不到的部分(移動過程中)
begin
if (LeftTop.X + setX < 0)then
LeftTop.X := 0
else
LeftTop.X := LeftTop.X + setX;
end;
if setY > 0 then //圖像上移顯示下邊看不到的部分(移動過程中)
begin
if LeftTop.Y + setY + BitmapTmp.Height div pp > Img1.Height then
LeftTop.Y := Img1.Height - BitmapTmp.Height div pp
else
LeftTop.Y := LeftTop.Y + setY;
end;
if setY < 0 then //圖像下移顯示上邊看不到的部分(移動過程中)
begin
if (LeftTop.Y + setY < 0) then
LeftTop.Y := 0
else
LeftTop.Y := LeftTop.Y + setY;
end;
SrcRect := Rect(LeftTop.X , LeftTop.Y, LeftTop.X + BitmapTmp.Width div PP, LeftTop.Y + BitmapTmp.Height div PP); //在原始圖片上截取的大小
destRect := Rect(0,0,BitmapTmp.Width div pp * pp,BitmapTmp.Height div pp * PP); // div pp * PP 避免運算誤差
BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
drawline;
end
else
if pb1.Cursor <> crDefault then pb1.Cursor := crDefault;
end;
procedure TForm1.pb1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Canmove and (ssright in Shift) then
begin
Canmove := False;
end;
if pb1.Cursor <> crDefault then pb1.Cursor := crDefault;
SecondTop.X := LeftTop.X;
SecondTop.Y := LeftTop.Y;
end;
procedure TForm1.pb1Paint(Sender: TObject);
begin
if pp = 0 then Exit;
drawline;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Multiples := 0; //初始化倍數
pp := Multiples;
BitmapTmp := TBitmap.Create;
BitmapTmp.Width := pb1.Width;
BitmapTmp.Height := pb1.Height;
end;
procedure TForm1.drawline;
var
i,j: Integer;
begin
if PP >= 4 then
begin
i := 0;
while i <= BitmapTmp.Width div pp * pp do // (...div pp * PP) 避免運算誤差
begin
BitmapTmp.Canvas.MoveTo(i,0);
BitmapTmp.Canvas.LineTo(i,BitmapTmp.Height div pp * PP );
Inc(i,pp);
end;
j := 0;
while j <= BitmapTmp.Height div pp * PP do
begin
BitmapTmp.Canvas.MoveTo(0,j);
BitmapTmp.Canvas.LineTo(BitmapTmp.Width div pp * pp ,j);
Inc(j,pp);
end;
end;
if pp = 1 then
pb1.Canvas.CopyRect(Rect(0,0,pb1.Width,pb1.Height),img1.Canvas,Rect(0,0,img1.Width,img1.Height))
else
pb1.Canvas.CopyRect(Rect(0,0,BitmapTmp.Width div pp * pp,BitmapTmp.Height div pp *pp),BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Img1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
end.
