圖像漫游

[wingerX]

想實現類似ACDSEE看圖軟件放大，縮小，圖像漫游功能，以下是小弟的寫的代碼，
移動時出現問題(不能移動或者向相反方向移動),請各位大大指點指點.

Pb1: 為PaintBox控件 放在ScrollBox控件中
img1: 為Image控件 PP： 為放大倍數

procedure TForm1.pb1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft 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;
MoveX,MoveY: Integer;
setX,setY: Integer;
begin
if Canmove then
begin
setX := X - MouseOrg.X;
setY := Y - MouseOrg.Y;

if setX > 0 then //圖像左移顯示右邊看不到的部分
begin
if MouseOrg.X + setX + pb1.Width > (img1.Width * PP) then
MoveX := (img1.Width * PP) - pb1.Width ;
end
else
MoveX := MouseOrg.X + setX;

if setX < 0 then //圖像右移顯示左邊看不到的部分
begin
if MouseOrg.X + setX < 0 then
MoveX := 0
else
MoveX := MouseOrg.X + setX;
end;

if setY > 0 then //圖像上移顯示下邊看不到的部分
begin
if MouseOrg.Y + setY + pb1.Height > (img1.Height * PP) then
MoveY := img1.Height * PP - pb1.Height
else
MoveY := MouseOrg.Y + setY;
end;


if setY < 0 then //圖像下移顯示上邊看不到的部分
begin
if MouseOrg.Y + setY < 0 then
MoveY := 0
else
MoveY := MouseOrg.Y + setY;
end;

SrcRect := Rect(MoveX div PP, MoveY div PP, (MoveX + pb1.Width) div PP,(MoveY + pb1.Height) div PP); //在原始圖片上截取的大小
destRect := Rect(0,0,pb1.Width,pb1.Height);
pb1.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
end;
end;

procedure TForm1.pb1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Canmove then Canmove := False;
end;

[etomahawk]

OnMouseMove中，最后面绘图完成后添加下面两句：

MouseOrg.X := X;
MouseOrg.Y := Y;

[wingerX]

想不到回帖的人這麼少,還好我自己把他解決。樓上的朋友接分，全都給你啦。