我要作一个运行时可以拖动窗体中某个控件位置及大小的程序,怎样才能实现选中该控件后,该控件边缘出现几个控制点,并且怎样实现控件的动态拖动(现在拖动过程中,没有实时显示控件当前位置)????
有没有哪位大虾有相关的源码,学习学习!!!!
有没有哪位大虾有相关的源码,学习学习!!!!
解决方案 »
- 请帮我解决一下这个SQL问题?
- 请教数据插入相关问题。
- 懂条形码的高手请进!
- 关于dbrid的问题!!!
- 大家帮我看看,这样的编号怎么实现?
- 如何将MemoryStream内容的一部分赋给另一个MemoryStream对象
- 一个窗体form1,一个button1,一个query1, 一个datasource1。在button1按扭的代码中怎样来实现:
- 如何在控件中加入控件??例如在Dbgrid中的单元格中加入checkbox?
- 我用AdoQuery做的程序有问题,想用AdoTable,我想知道在AdoTable中怎么过滤条件,比如说年龄大于30的。
- 哪有DELPHI网络编程书籍?
- 请问如何向WINSOCKSTREAM中将动态数组字节流写入
- HOTKEY和发送消息问题
很灵活的,也可以自己写代码实现,
也可以让用户自己在预览时自己改变报表中文字或框的位置。
以下直接加入你的程序就可以啦,
调用方法
var
SizeControl: TSizerControl;SizeControl := TSizerControl.Create(self, sender as TLabel);
//改变控件位置及大小
unit SizerControl;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 }
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;
procedure Register;implementation
uses djtool;constructor 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.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);
//-------------------------added by guozhaofeng 以下部分用于变动时实时显示高度和宽度
// djtool.EdtWit.Text:=templen;
// Edtlen.Text:=inttostr(Width);
end;
procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(Wm_SysCommand, sc_DragMove, 0);
end;procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;procedure TSizerControl.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := clBlack;
for I := 1 to 8 do
with FRectList[I] do
Canvas.Rectangle (Left, Top, Right, Bottom);
end;procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;procedure Register;
begin
RegisterNoicon([TSizerControl]);
end;end.
[email protected]