求救!如何实现图片的拖动(类似ACDSee的拖动)。(100分)

  • 主题发起人 主题发起人 creep
  • 开始时间 开始时间
C

creep

Unregistered / Unconfirmed
GUEST, unregistred user!
有类似的源程序最好。我的邮箱是sthcg@263.net
 
说得再详细点好吗?
 
就是类似ACDSee的放大图片(超出图片框的显示范围)之后,
拖动图片在固定的窗口内移动和浏览。
~~~~
 
type
TForm1 = class(TForm)
...
private
Jpg: TJpegImage;
StartX, StartY, px, py, mx, my: Integer;
MouseDown: Boolean;
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
...
end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
Jpg := TJpegImage.Create;
Jpg.LoadFromFile(FileName);
px := 0;
py := 0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Jpg.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(px, py, Jpg);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
if Assigned(Jpg) then begin
mx := ClientWidth - Jpg.Width;
my := ClientHeight - Jpg.Height;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not MouseDown then begin
MouseDown := True;
StartX := X;
StartY := Y;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseDown then begin
Dec(px, StartX - X);
Dec(py, StartY - Y);
if px > 0 then px := 0;
if px < mx then px := mx;
if py > 0 then py := 0;
if py < my then py := my;
StartX := X;
StartY := Y;
Refresh;
end;
end;

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

procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
Msg.Result := -1;
end;

 
谢谢啦。
 

Similar threads

后退
顶部