试试看，带双缓冲的。放大和缩小就用StretchDraw就可以了。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
BufBMP,FormBuf : TBitmap;
Position,FirstPt : TPoint;
Down : Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
BufBMP := TBitmap.Create;
FormBuf := TBitmap.Create;
FormBuf.Width := Width;
FormBuf.Height := Height;
BufBMP.LoadFromFile('c:\1.bmp');
Position := Point(0,0);
Down := FALSE;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BufBMP.Free;
FormBuf.Free;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(Position.X,Position.Y,BufBMP);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := TRUE;
FirstPt := Point(X,Y);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Position := Point(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y);
Down := FALSE;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Down then begin
FormBuf.Canvas.Pen.color := clBtnFace;
FormBuf.Canvas.Brush.color := clBtnFace;
FormBuf.Canvas.Rectangle(0,0,Width,Height);
FormBuf.Canvas.Draw(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y,BufBMP);
Canvas.Draw(0,0,FormBuf);
end;
end;
end.
***********
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;