在IMAGE中想用鼠标实现图像移动.(200分)

  • 主题发起人 主题发起人 dadabox
  • 开始时间 开始时间
D

dadabox

Unregistered / Unconfirmed
GUEST, unregistred user!
我看了前面的贴子,实现了移动,但图像闪动很厉害,
1.在TIMAGE中我找不到类似FORM中的POINT事件,不知该怎么处理.
2.,我想知道这幅图有多大,我想实现等图片拉到尽头就不允许拉动,不然会拉出一片空白
出来.
3.想放大后也可以拉动,缩小后也可以拉动.
最好用TIMAGE实现,若实在不行,或有困难,也可用其他控件,但请告诉控件位址.若最后回答
中有用TIMAGE就能实现的,以TIMAGE实现的为准,分要多些.谢谢!很急,不知明天能不能看到
结果?
 
[red]类似于ACDSEE里"手"的拖动,绝对合格,^_^,记得先加载一幅图片,Image.AutoSize:=True[/red]
var
MouseDownPoint,MouseMovePoint :TPoint;
IsMouseDown :Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
IsMouseDown :=False;
end;

procedure TForm1.MainImageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
IsMouseDown :=True;
MouseDownPoint :=Point(x,y);
end;
end;

procedure TForm1.MainImageMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if IsMouseDown then
begin
MouseMovePoint :=Point(x,y);
Form1.HorzScrollBar.Position :=Form1.HorzScrollBar.Position+MouseDownPoint.x-MouseMovePoint.x;
Form1.VertScrollBar.Position :=Form1.VertScrollBar.Position+MouseDownPoint.y-MouseMovePoint.y;
end;
end;

procedure TForm1.MainImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown :=False;
end;
 
卷起千堆雪tyn,你的方法不可行.我不要看到卷轴.我的表单中也不可能就放一幅图.我的
TIMAGE是放在TPANEL上的.也必须放到这上面,请问你还有什么其他的办法吗?
 
随手写的一些代码,希望对你有帮助

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
BP := Point(X, Y);
Screen.Cursor := crHandPoint;
BMPDrag := True;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Screen.Cursor := crDefault;
BMPDrag := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MemBMP := TBitmap.Create;
MemBMP.Assign(Image1.Picture.Bitmap);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNIL(MemBMP);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if BMPDrag then
with Image1.Picture do
begin
Bitmap.Canvas.Pen.Style := psClear;
Bitmap.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);
BitBlt(Bitmap.Canvas.Handle, X-BP.X, Y-BP.Y, MemBMP.Width, MemBMP.Height,
MemBMP.Canvas.Handle, 0, 0, SRCCOPY);
Image1.Refresh;
end;
end;
 
只有一个PANEL,里面有一个IMAGE。
可以实现你的第二个要求。但闪烁得你自己想办法了。
放大缩小没有关系,把IMAGE的AUTOSIZE设为TRUE;


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Image1: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MouseDownPoint :TPoint;
IsMouseDown :Boolean=False;


implementation

{$R *.dfm}

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

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if IsMouseDown then
begin
caption:=format('[%d,%d]',[image1.top,image1.left]);
if (Image1.Left<=0)and(Image1.Width+Image1.Left>=Panel1.Width) then begin
image1.Left:=Image1.Left+x-MouseDownPoint.x;
if Image1.Left>0 then
Image1.Left:=0;
if Image1.Width+Image1.Left<Panel1.Width then
Image1.Left:=Panel1.Width-Image1.Width;
end;
if (Image1.top<=0)and(Image1.Height+Image1.top>=Panel1.Height) then begin
image1.Top:=Image1.Top+y-MouseDownPoint.y;
if Image1.top>0 then
Image1.Top:=0;
if Image1.Height+Image1.top<Panel1.Height then
Image1.Top:=Panel1.Height-Image1.Height;
end;
end;

end;

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

end.
 
menxin,我的IMAGE的寬度和長度是定長的﹐但IMAGE中的圖片卻有的大﹐有的小﹐所以我要
改的是IMAGE里面的圖片﹐卻不是IMAGE。而且﹐我的IMAGE是包含在PANEL中的﹐不能隨便
移動﹐只能用Canvas.Draw的方式來動態畫移動的圖像。所以﹐你的也不太可行﹐謝謝你的
回答﹐能再給我其他的答案嗎﹖
 
autosize就是解决大小问题的呀,你的IMAGE,SIZE一定要固定吗?
 
第2个问题:拉动不出界限例子,但还是有闪动,我再想想有没有其他法子.实在没法子,先将就
var
SecondPic:TPicture;
Position,FirstPt : TPoint;
Down : Boolean;
cx,cy:Integer;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var now:TPoint;
begin
if Down then
with Image1 do
begin
Now.X:=Position.X + X - FirstPt.X;
Now.Y:=Position.Y + Y - FirstPt.Y;
if Now.X>0 then Now.X:=0;
if Now.Y>0 then Now.Y:=0;
if Now.X<-Cx then Now.X:=-Cx;
if Now.Y<-Cy then Now.Y:=-Cy;
Canvas.Pen.color := clBtnFace;
Canvas.Brush.color := clBtnFace;
Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
Canvas.Draw(Now.X,Now.Y,SecondPic.Graphic);
Canvas.Draw(0,0,Picture.Graphic);
refresh;
end;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := TRUE;
FirstPt := Point(X,Y);
Screen.Cursor:=crHandPoint;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Position := Point(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y);
Down:=False;
Screen.Cursor:=crArrow;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
SecondPic:=TPicture.Create;
SecondPic.Assign(Image1.Picture);//若你是动态改图片,要改在动态变图片的地方
Position := Point(0,0);
Down := FALSE;
Cx:=Picture.Width-Image1.Width;
Cy:=Picture.Height-Image1.Height;
end;
 
呵呵,闪烁问题可以这样解决
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.DoubleBuffered:=true
end;
 
你是不是在一个大PANEL里有几个IMAGE,里面各有一个图,如果这样可以用panel套panel。
 
厲害﹐厲害﹐前兩個問題解決﹗謝謝各位﹐現在還有最后一個問題。如何放大和縮小圖片﹐
并且縮小放大后也可移動。
to menxin, 你說的是什么意思﹖怎樣panel套panel﹐能不能說詳細一點﹖謝謝﹗
 
+--------------------------------------------+ 最外面是PANEL
| +----------+ |
| | | 里面也是PANEL |
| | | 小PANEL里再放IMAGE |
| +----------| |
| |
| +----------+ |
| | | |
| | | |
| +----------| |
| |
| |
| |
| |
+--------------------------------------------+
 
to menxin,谢谢你的热情,你的意思是小Panel里放图片?那么移动怎么做呢?图像有可能大于
Panel哟.你有没有例子?我会多给你一些分的,谢谢!
 
第三个问题:放大,缩小,及其倍数.呵呵,参考了别人的东东.
procedure TForm2.Zoom_In(Img: TImage;const Times:Integer);
var
Bmp :TBitmap;
begin
Bmp :=TBitmap.Create;
Bmp.Width :=Img.Picture.Bitmap.Width*Times;
Bmp.Height :=Img.Picture.Bitmap.Height*Times;
StretchBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,
Img.Picture.Bitmap.Canvas.Handle,0,0,Img.Picture.Bitmap.Width,Img.Picture.Bitmap.Height,SRCCOPY);
Img.AutoSize :=True;
Img.Picture.Bitmap.Assign(Bmp);
SecondPic.Assign(Img.Picture);
Bmp.Free;
end;

procedure TForm2.Zoom_Out(Img: TImage;const Times:Integer);
var
Bmp :TBitmap;
begin
Bmp :=TBitmap.Create;
Bmp.Width :=Img.Picture.Bitmap.Width div Times;
Bmp.Height :=Img.Picture.Bitmap.Height div Times;
StretchBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,
Img.Picture.Bitmap.Canvas.Handle,0,0,Img.Picture.Bitmap.Width,Img.Picture.Bitmap.Height,SRCCOPY);
Img.AutoSize :=True;
Img.Picture.Bitmap.Assign(Bmp);
SecondPic.Assign(Img.Picture);
Bmp.Free;
end;
 
to dadabox:你所说的图象移动是不是就是Pan操作。想发给你一个DEMO,我自己做的。请
留下email。
 
好了﹐都行了。
to deadcandance,請问是Pan还是Pen?我的dadabox_sz@21cn.com,你的要有源代碼喲。
to menxin,能否再詳細說說你的那種方法﹖能實現什么什么﹐怎么做﹖也可以給我發mail。
我准備在今天結束問題﹐謝謝各位捧場﹗若收到信﹐我會根據內容放分。
 
謝謝各位朋友捧場﹐這個問題解決了。
 
兄弟,你是搞定了,还可以给我一个例子吗,谢谢,我的是zsgkw@126.com

非常感谢
 
呵呵,搞好了,,,
 
scan888兄弟,给我一个制作桌面移动图标的dome好吗,谢谢了
 
后退
顶部