一句话为当前窗口客户区捉图: GetFormImage 来自万一的博客

一句话为当前窗口客户区捉图: 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:\temp\Form1.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 = WinControl.Width - Precision) and (Y > Precision) and (Y Precision) and (X Precision) and (X = WinControl.Height - Precision) then
begin
SC_MANIPULATE := $F006;
WinControl.Cursor := crSizeNS;
end
else
//光标在控件的左上角
if (X = WinControl.Width - 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 (Shape2.Height - 5)) then Shape2.Cursor := crSizeNESW
else
Shape2.Cursor := crSizeWE;
end else
if (x > (Shape2.Width - 5)) then
begin
if y (Shape2.Height - 5)) then Shape2.Cursor := crSizeNWSE
else
Shape2.Cursor := crSizeWE;

end else
if ((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 + 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截图