请问如何在运行时,使控件周边也有6各黑点,鼠标可以任意调整其大小和位置!
解决方案 »
- 如何判断从数据库里取出的字符,是否存在于ListView项目名称中
- delphi6.0 运行提示:Acess violation at address 0730267B in module 'BORdbbk61.dll'.write of address 5C60204.
- >在QQ网络硬盘中将ACCESS数据库和EXE程序放入,增加一条数据后将软件关闭重新打开数据确没有,这是为何??
- 关于QRREPORT的预览问题
- inttohex()后面的那个参数到底有啥用?显示位数?我用什么值代入都是一样结果,怎么回事
- 丢失更新问题 (sql server 2000)
- 这句SQL该怎么写?
- 哪里有串口通讯的程序
- 怎么在api form中使用vcl组件?
- 刚安装完WINDOWS XP PRO,很爽:),不过要激活么?
- DELPHI对EMAIL的操作,急
- ★★如何更改InputBox的字体及将其中的英文改为中文?
Windows, Messages, SysUtils, Classes, Controls, Graphics, Menus;const
SC_DRAGMOVE = $F012;type
TdcbsSizeControlTemplate = class(TCustomControl)
private
FControl: TControl;
FRectList: array [1..8] of TRect;
FResizePosList: array [ 1..8] of DWORD; procedure PopupMenuItemFreeClick(Sender: TObject); procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMMove(var Msg: TWMMove); message WM_MOVE;
procedure WMNcHitTest(var Msg: TWMNcHitTest); message WM_NCHITTEST;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMRButtonUp(var Msg: TWMRButtonUp); message WM_RBUTTONUP;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl); procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle; override; procedure SizeControlTemplateExit(Sender: TObject);
published
{ Published declarations }
end;
TSizeControlTemplate = TdcbsSizeControlTemplate; procedure CreateSizeControl(AOwner: TComponent; AControl: TControl); stdcall;implementation//***************************************************************************
{ TdcbsSizeControlTemplate }constructor TdcbsSizeControlTemplate.Create(AOwner: TComponent;
AControl: TControl);
var
R: TRect;
MenuItem: TMenuItem;
FPopupMenu: TPopupMenu;
begin
inherited Create(AOwner); FControl := AControl;
OnExit := SizeControlTemplateExit;
R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent; FPopupMenu := TPopupMenu.Create(Self);
with FPopupMenu do
begin
MenuItem := TMenuItem.Create(FPopupMenu);
MenuItem.Caption := 'Free(&F)';
MenuItem.Name := 'FreeControlMenuItem';
MenuItem.OnClick := PopupMenuItemFreeClick;
Items.Add(MenuItem);
end;
PopupMenu := FPopupMenu; FResizePosList[1] := htTopLeft;
FResizePosList[2] := htTop;
FResizePosList[3] := htTopRight;
FResizePosList[4] := htRight;
FResizePosList[5] := htBottomRight;
FResizePosList[6] := htBottom;
FResizePosList[7] := htBottomLeft;
FResizePosList[8] := htLeft;
end;procedure TdcbsSizeControlTemplate.CreateHandle;
begin
inherited; SetFocus;
end;procedure TdcbsSizeControlTemplate.CreateParams(var Params: TCreateParams);
begin
inherited; Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;procedure TdcbsSizeControlTemplate.PopupMenuItemFreeClick(Sender: TObject);
begin
SizeControlTemplateExit(Self);
end;procedure TdcbsSizeControlTemplate.SizeControlTemplateExit(
Sender: TObject);
begin
Free;
end;procedure TdcbsSizeControlTemplate.WMLButtonDown(var Msg: TWMLButtonDown);
begin
Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;procedure TdcbsSizeControlTemplate.WMMove(var Msg: TWMMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;procedure TdcbsSizeControlTemplate.WMNcHitTest(var Msg: TWMNcHitTest);
var
Pt: TPoint;
I: Byte;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
for I := 1 to 8 do
if PtInRect(FRectList[I], Pt) then
Msg.Result := FResizePosList[I];
if Msg.Result = 0 then
inherited;
end;procedure TdcbsSizeControlTemplate.WMPaint(var Msg: TWMPaint);
var
I: Byte;
begin
with Canvas do
begin
Brush.Color := clBlue;
for I := 1 to 8 do
Rectangle(FRectList[I]);
end;
end;procedure TdcbsSizeControlTemplate.WMRButtonUp(var Msg: TWMRButtonUp);
begin
inherited; FControl.Invalidate;
end;procedure TdcbsSizeControlTemplate.WMSize(var Msg: TWMSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.BoundsRect := R; FRectList[1] := Rect(0, 0, 5, 5);
FRectList[2] := Rect(Width div 2 - 3, 0, Width div 2 + 2, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, Height div 2 - 3, Width, Height div 2 + 2);
FRectList[5] := Rect(Width - 5, Height - 5, Width , Height);
FRectList[6] := Rect(Width div 2 - 3, Height - 5, Width div 2 + 2, Height);
FRectList[7] := Rect(0, Height - 5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - 3, 5, Height div 2 + 2);
end;procedure CreateSizeControl(AOwner: TComponent; AControl: TControl);
begin
if not Assigned(AOwner) then
raise Exception.Create('Invalid parameter "AOwner"!');
if not Assigned(AControl) then
raise Exception.Create('Invalid parameter "AControl"');
TdcbsSizeControlTemplate.Create(AOwner, AControl);
end;end.
建立一个新的unit,把上面的代码都贴进去。在需要使用时只要调用CreateSizeControl()函数就可以了:
// Example:
begin
CreateSizeControl(Form1, Button1);
end;// 注意这个东西还不完善,如果不乱用是不会用问题的。
(1)当Button1失去焦点时,控件会自动释放;
(2)使用鼠标右键可以手工释放。
{ }
{ DCB Studio Library }
{ }
{ Copyright(C) 2002-2003 DCB Studio }
{ }
{*************************************************}希望你在新的单元的顶部加上这个!谢谢!
覆盖在原控件上的透明控件?呵呵,我原先作的一个界面设计器也是这样的思路,不过覆盖的范围很大,Form或者Panel等,可以调整多个控件.hryyx ,
深入的话,需要看看RTTI方面的资料(TypInfo单元)