1,183
社区成员
发帖
与我相关
我的任务
分享怎样在TImage中加入鼠标点击坐标?及对图像做裁剪?
要能将图像中的一个矩形区域裁剪出来成为另一个TIamge,点击鼠标时能读取在图像中的坐标位置.
...全文
请发表友善的回复…
发表回复
clion 2003-02-07
- 打赏
- 举报
多谢诸位
grail_ 2003-02-07
- 打赏
- 举报
都说的很明白了
Billy_Chen28 2003-02-07
- 打赏
- 举报
转贴一篇：
基于Delphi的图像漫游
向晖
在开发多媒体应用中,经常会遇到需要在有限区域内显示大图像的情况,有不少文章
对此提出过解决方法,如通过调用Windows的API函数,直接读写内存等。这些方法有某些
优点,但实现起来较为复杂,且易出错。笔者在实践中通过仔细摸索,利用Delphi的强大的
面向对象可视化开发环境开发了一种交互式图像漫游方法。
Delphi中,鼠标的消息响应是通过元件的OnMouseDown、OnMouseUp和OnMouseMove事
件实现的,通过对此三个事件编程,可控制图像在有限区域内移动。考虑到所移动的图像
的边界应总在该区域外,因此图像的左上角坐标应小于该区域对应坐标,图像右下角坐标
应大于该区域对应坐标(除非图像大小比该区域小)。
具体方法是:
1、新建一工程Project1,在Form1中依次放入Panel1、Panel2和Image1元件,注意Pa
nel2和Image1分别在Panel1和Panel2上,再将一Label1元件加入Panel2中,调整Panel1尺
寸为适当大小,并修改各元件属性为:
元件
属性名
属性值
Panel1
BevelInner:
bvRaised
BevelOuter: bvNone
BorderStyle: bsSingle
Panel2
Align:
alClient
Image1
AutoSize:
True
Picture:
"Apple.bmp"
Label1
Align:
alClient
Transparent : True
注意:此处Label1的作用不是显示字符,而是利用它响应鼠标消息,如果不用Label1而
直接利用Image1的鼠标事件响应,则会由于其OnMouseDown事件的激活与Image1的自身坐
标移动事件冲突而使图像发生闪烁甚至不能移动。
2、在implementation后加入变量声明:
origin:Tpoint;
image_left:integer;
image_top:integer;
visa1:Tpoint; (鼠标当前位置相对图像右下角的坐标)
visa2:Tpoint; (鼠标当前位置相对图像左上角的坐标)
canmove:boolean;
编写Label1鼠标响应事件:
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;S
hift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
origin.x:=X;
origin.y:=Y;
image_left:=image1.left;
image_top:=image1.top;
visa1.x:=X-(image1.width-panel2.width+image1.left);
visa1.y:=Y-(image1.height-panel2.height+image1.top);
visa2.x:=X-image1.left;
visa2.y:=Y-image1.top;
canmove:=true;
end;
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if canmove then
begin
if X< visa1.x then X:=visa1.x;
if X>visa2.x then X:=visa2.x;
if Y< visa1.y then Y:=visa1.y;
if Y>visa2.y then Y:=visa2.y;
image1.left:=image_left+(X-origin.x);
image1.top:=image_top+(Y-origin.y);
end;
end;
procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;Shi
ft: TShiftState; X, Y: Integer);
begin
canmove:=false;
end;
基于Delphi的图像漫游
向晖
在开发多媒体应用中,经常会遇到需要在有限区域内显示大图像的情况,有不少文章
对此提出过解决方法,如通过调用Windows的API函数,直接读写内存等。这些方法有某些
优点,但实现起来较为复杂,且易出错。笔者在实践中通过仔细摸索,利用Delphi的强大的
面向对象可视化开发环境开发了一种交互式图像漫游方法。
Delphi中,鼠标的消息响应是通过元件的OnMouseDown、OnMouseUp和OnMouseMove事
件实现的,通过对此三个事件编程,可控制图像在有限区域内移动。考虑到所移动的图像
的边界应总在该区域外,因此图像的左上角坐标应小于该区域对应坐标,图像右下角坐标
应大于该区域对应坐标(除非图像大小比该区域小)。
具体方法是:
1、新建一工程Project1,在Form1中依次放入Panel1、Panel2和Image1元件,注意Pa
nel2和Image1分别在Panel1和Panel2上,再将一Label1元件加入Panel2中,调整Panel1尺
寸为适当大小,并修改各元件属性为:
元件
属性名
属性值
Panel1
BevelInner:
bvRaised
BevelOuter: bvNone
BorderStyle: bsSingle
Panel2
Align:
alClient
Image1
AutoSize:
True
Picture:
"Apple.bmp"
Label1
Align:
alClient
Transparent : True
注意:此处Label1的作用不是显示字符,而是利用它响应鼠标消息,如果不用Label1而
直接利用Image1的鼠标事件响应,则会由于其OnMouseDown事件的激活与Image1的自身坐
标移动事件冲突而使图像发生闪烁甚至不能移动。
2、在implementation后加入变量声明:
origin:Tpoint;
image_left:integer;
image_top:integer;
visa1:Tpoint; (鼠标当前位置相对图像右下角的坐标)
visa2:Tpoint; (鼠标当前位置相对图像左上角的坐标)
canmove:boolean;
编写Label1鼠标响应事件:
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;S
hift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
origin.x:=X;
origin.y:=Y;
image_left:=image1.left;
image_top:=image1.top;
visa1.x:=X-(image1.width-panel2.width+image1.left);
visa1.y:=Y-(image1.height-panel2.height+image1.top);
visa2.x:=X-image1.left;
visa2.y:=Y-image1.top;
canmove:=true;
end;
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if canmove then
begin
if X< visa1.x then X:=visa1.x;
if X>visa2.x then X:=visa2.x;
if Y< visa1.y then Y:=visa1.y;
if Y>visa2.y then Y:=visa2.y;
image1.left:=image_left+(X-origin.x);
image1.top:=image_top+(Y-origin.y);
end;
end;
procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;Shi
ft: TShiftState; X, Y: Integer);
begin
canmove:=false;
end;
Billy_Chen28 2003-02-07
- 打赏
- 举报
var
p:TPoint;
p:=Image1.ScreenToClient(Mouse.CursorPos);
p就是在image1的位置了,p.x;p.y;
p:TPoint;
p:=Image1.ScreenToClient(Mouse.CursorPos);
p就是在image1的位置了,p.x;p.y;
Billy_Chen28 2003-02-07
- 打赏
- 举报
//剪切区域
var
rgn :HRgn;
bmp :TBitmap;
begin
bmp :=TBitmap.Create;
bmp.Assign(Image1.Picture.Bitmap);
rgn :=CreateRectRgn(40,40,250,150);
SelectClipRgn(Image1.Canvas.Handle,rgn);
Image1.Picture :=nil;
BitBlt(Image1.Canvas.Handle,40,40,250,150,bmp.Canvas.Handle,0,0,SRCCOPY);
bmp.Free;
end;
var
rgn :HRgn;
bmp :TBitmap;
begin
bmp :=TBitmap.Create;
bmp.Assign(Image1.Picture.Bitmap);
rgn :=CreateRectRgn(40,40,250,150);
SelectClipRgn(Image1.Canvas.Handle,rgn);
Image1.Picture :=nil;
BitBlt(Image1.Canvas.Handle,40,40,250,150,bmp.Canvas.Handle,0,0,SRCCOPY);
bmp.Free;
end;
idilent 2003-02-07
- 打赏
- 举报
关注这个问题。不过觉得应该可以实现。
