怎么像acdsee的手一样移动图片??(100分)

  • 主题发起人 主题发起人 felong11
  • 开始时间 开始时间
F

felong11

Unregistered / Unconfirmed
GUEST, unregistred user!
如题。
当image的大小不够显示图片时,怎么移动图片。
同时怎么放大和缩小图片??
请高手指教!!
 
试试看,带双缓冲的。放大和缩小就用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.
 
滚屏 :
var
Draw : Boolean;
StartPt,MovePt : TPoint;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
Draw :=True;
StartPt :=Point(x,y);
end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Draw then
begin
MovePt :=Point(x,y);
Form2.VertScrollBar.Position :=Form2.VertScrollBar.Position+StartPt.y-MovePt.y;
Form2.HorzScrollBar.Position :=Form2.HorzScrollBar.Position+StartPt.x-MovePt.x;
end;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Draw := False;
end;

缩放 :
用BitBlt,每次改变IMAGE的大小即可.
 
我是要能够放大固定倍数的,而且放大后还可以移动的,请各位大虾指教。
 
你可以用内存设备描述表和scrollDC函数试试
 
放一个panel,加上imager,
当mouse down-->getcursor(p1),
mouse up-->getcursor(p2),
x:=p1.x-p2.x, y:=p1.y-p2.y,
imager.height:=imager.height-y,
imager.weight:=imager.weight-x;
 
定一个放大倍数BIGK
在PAINT中说明:height:=height*bigk,weight:=weight*bigk.
其它的和以上几位说得一样即可。
 
接受答案了.
 
后退
顶部