一句话为当前窗口客户区捉图: GetFormImage
http://www.cnblogs.com/del/archive/2008/10/24/1318738.html
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Self.GetFormImage.SaveToFile('c: empForm1.bmp');
end;
end.
分类: 其他常用控件
好文要顶 关注我 收藏该文
万一
关注 - 34
粉丝 - 844
荣誉：推荐博客
+加关注
0 0
« 上一篇：建立快捷方式的函数: CreateShortcut - 非常实用、特别方便
» 下一篇：学习 Message(1): 消息发送
posted on 2008-10-24 14:42 万一 阅读(1990) 评论(4) 编辑 收藏
FeedBack:
#1楼 2010-05-27 11:52 仰望天
万老师 请教您一个问题 我想做一个截取头像的控件。功能：显示一个本地图片，在图片上有一个选择区域（tshape）。可以拖动改变shape的大小和位置。最后完成对选择区域的截图。现在的难题是怎么让鼠标可以拖动改变shape的大小和位置？或者有别的控件来替代实现类似的效果呢？希望您能指点一下。
支持(0)反对(0)
回复引用
#2楼 2010-05-27 11:59 仰望天
功能类似QQ的头像上传之前的截图功能。我在网上找到这样一个函数
procedure ManipulateControl(WinControl: TControl; Shift: TShiftState; X,
Y, Precision: integer);
var SC_MANIPULATE: Word;
begin
//光标在控件的最左侧
if (X <= Precision) and (Y > Precision) and (Y < WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F001;
WinControl.Cursor := crSizeWE;
end
else
//光标在控件的最右侧
if (X >= WinControl.Width - Precision) and (Y > Precision) and (Y < WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F002;
WinControl.Cursor := crSizeWE;
end
else
//光标在控件的最上侧
if (X > Precision) and (X < WinControl.Width - Precision) and (Y <= Precision) then
begin
SC_MANIPULATE := $F003;
WinControl.Cursor := crSizeNS;
end
else
//光标在控件的最下侧
if (X > Precision) and (X < WinControl.Width - Precision) and (Y >= WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F006;
WinControl.Cursor := crSizeNS;
end
else
//光标在控件的左上角
if (X <= Precision) and (Y <= Precision) then
begin
SC_MANIPULATE := $F004;
WinControl.Cursor := crSizeNWSE;
end
else
//光标在控件的右上角
if (X >= WinControl.Width - Precision) and (Y <= Precision) then
begin
SC_MANIPULATE := $F005;
WinControl.Cursor := crSizeNESW;
end
else
//光标在控件的左下角
if (X <= Precision) and (Y >= WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F007;
WinControl.Cursor := crSizeNESW;
end
else
//光标在控件的右下角
if (X >= WinControl.Width - Precision) and (Y >= WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F008;
WinControl.Cursor := crSizeNWSE;
end
else
//光标在控件的客户区（移动整个控件）
if (X > 5) and (Y > 5) and (X < WinControl.Width - 5) and
(Y < WinControl.Height - 5) then
begin
SC_MANIPULATE := $F009;
WinControl.Cursor := crSizeAll;
end
else
begin
SC_MANIPULATE := $F000;
WinControl.Cursor := crDefault;
end;
if Shift = [ssLeft] then
begin
ReleaseCapture;
WinControl.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
end;
可以实现动态改变控件的大小 但是只能对继承自TWINCONTROL的控件有效 Tshape无效。
支持(0)反对(0)
回复引用
#3楼 2010-05-27 14:55 仰望天
问题还是自己解决了 借万老师的宝地把结果贴出来 希望可以帮到其他人 我的QQ 1478706 希望可以认识一些朋友 共同探讨学习。
const
smNone = 0;
smMove = 1;
smLeft = 2;
smRight = 4;
smUp = 8;
smDown = 16;
implementation
var
ClickX,
ClickY,
ClickLeft,
ClickTop,
ClickWidth,
ClickHeight,
SizeMode: Integer;
procedure TForm3.Shape2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Shift = [ssLeft] then
begin
Clickx := x;
ClickY := y;
ClickLeft := Shape2.Left;
ClickTop := Shape2.Top;
ClickWidth := Shape2.Width;
ClickHeight := Shape2.Height;
case Shape2.Cursor of
crSizeNS:
begin
if y < 5 then
SizeMode := smUp else
SizeMode := smDown;
end;
crSizeWE:
begin
if (X < 5) then SizeMode := smLeft
else SizeMode := smRight;
end;
crSizeNWSE:
begin
if (X < 5) then SizeMode := smLeft or smUp
else SizeMode := smRight or smDown;
end;
crSizeNESW:
begin
if (X < 5) then SizeMode := smLeft or smDown
else SizeMode := smRight or smUp;
end;
crSizeAll:
begin
SizeMode := smMove;
end;
end;
end;
end;
procedure TForm3.Shape2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if x < 5 then
begin
if y < 5 then Shape2.Cursor := crSizeNWSE
else
if (y > (Shape2.Height - 5)) then Shape2.Cursor := crSizeNESW
else
Shape2.Cursor := crSizeWE;
end else
if (x > (Shape2.Width - 5)) then
begin
if y < 5 then Shape2.Cursor := crSizeNESW
else
if (y > (Shape2.Height - 5)) then Shape2.Cursor := crSizeNWSE
else
Shape2.Cursor := crSizeWE;
end else
if ((y < 5) or (y > Shape2.Height - 5)) then Shape2.Cursor := crSizeNS
else Shape2.Cursor := crSizeAll;
if SizeMode = smNone then Exit;
//限制shape的移动范围在image1内部
if (Shape2.Left + (X - clickx) < Image1.Left)
or (Shape2.Top + (Y - clicky) < Image1.Top)
or (Shape2.Left + (X - clickx) > Image1.Left + Image1.Width - Shape2.Width)
or (Shape2.Top + (Y - clicky) > Image1.Top + Image1.Height - Shape2.Height)
then Exit;
if SizeMode = smMove then
begin
Shape2.Left := Shape2.Left + (x - clickx);
Shape2.Top := Shape2.Top + (y - clicky);
Exit;
end;
if (SizeMode and smLeft) <> 0 then
begin
shape2.left := Shape2.left + (x - clickx);
Shape2.Width := ClickWidth - (shape2.Left - clickleft);
Shape2.Height:=Shape2.Width;
end;
if (SizeMode and smRight) <> 0 then
begin
Shape2.Width := ClickWidth + (x - clickx);
Shape2.Height:=Shape2.Width;
end;
if (SizeMode and smUp) <> 0 then
begin
shape2.top := Shape2.top + (y - clicky);
Shape2.Height := ClickHeight - (shape2.Top - clicktop);
Shape2.Width:=Shape2.Height;
end;
if (SizeMode and smDown) <> 0 then
begin
Shape2.Height := ClickHeight + (y - clicky);
Shape2.Width:=Shape2.Height;
end;
end;
procedure TForm3.Shape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
SizeMode := smNone;
end;
支持(0)反对(0)
回复引用
#4楼 2013-07-23 18:48 Doctorate
我实现的效果 ..仿QQ截图