如何将控件的运行时状态设计成跟设计时一样,能完成拖过,多选控件,并且在选中控件的周围显示六个小点。
解决方案 »
- Delphi中如何在两个窗体中访问同一个assess数据库?
- [急] 在delphi里怎么打开 .mdi图片文件,有没有什么控件啊?
- [考题]如何用过程(procedure)具有函数的返回值功能
- 帮帮忙,关于三层问题
- ExpressQuantumGrid多选的时候,如何得到多选的这些数据的ID,急!谢谢
- Ado保存blob大字段问题!!?急!!!
- 我现在是用ASP语言的中级程序员,我现在想学编软件,请问..
- 查询结果在另一窗口的应用
- TTreeview里如何转换打开文件和关闭文件图标?
- 请教DLL有没有办法里面加上事件?
- 请问如何得到窗体内的当前焦点在哪个控件上?谢谢
- 100分!Oracle开发方面的诸多问题(连接、安装等)!希望不吝赐教!
----
unit Unit2;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs;type
TSizerControl = class(TCustomControl)
private
FControl: TControl;
FRectList: array [1..8] of TRect;
FPosList: array [1..8] of integer;
{ Private declarations }
procedure Drawreg;
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle; override;
procedure WmNcHitTest(var Msg: TWmNcHitTest); message wm_NcHitTest;
procedure WmSize(var Msg: TWmSize); message wm_Size;
procedure WmLButtonDown(var Msg: TWmLButtonDown); message wm_LButtonDown;
procedure WmMove(var Msg: TWmMove); message Wm_Move;
procedure Paint; override;
procedure SizeControlExit(Sender: TObject);
{ Public declarations }
published
{ Published declarations }
end;const
sc_DragMove: longint = $F012;
implementationconstructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit; R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;
end;procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;procedure TSizerControl.Drawreg;
var
I: integer;
begin
Canvas.Brush.Color := $0024FF24;
for I := 1 to 8 do
with FRectList[I] do
Canvas.Rectangle(Left, Top, Right, Bottom);end;procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;procedure TSizerControl.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: integer;
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 := FPosList[I];
if Msg.Result = 0 then
inherited;
end;procedure TSizerControl.WmSize(var Msg: TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.BoundsRect := R;
//计算8个黑方框
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 TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(Wm_SysCommand, sc_DragMove, 0);
Self.Drawreg;
end;procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
Drawreg;
end;procedure TSizerControl.Paint;
begin
Drawreg;
end;procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;end.
用法如下:
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, Image1); //这里将要移动的是Image1
end;
六个小点点有点麻烦~~可以考虑用LABEL代替!拖动的时候要写代码改变控件的大小~
http://www.codechina.net/resource/html/2006-02/23/141782.html
里面有判断是不是设计期的语句
所以了 其实它已经给你写好代码了
你只需要改写一下就可以用到你的程序里了
//
哈哈。。这段代码好熟啊。。跟我上次回的一模一样啊呵呵~`~
1.插入一个TWebBrowser控件;
2.Navigate('about:blank')后设置Document.DesignMode:='on';
3.可以在TWebBrowser控件里放置控件,以及按你的要求编辑控件了。
(如果要获得设计的控件的信息可以使用MSHTML单元的各种接口)