实现运行时对控件的Sizing和Dragging ( 积分: 50 )

  • 主题发起人 主题发起人 web_lance
  • 开始时间 开始时间
W

web_lance

Unregistered / Unconfirmed
GUEST, unregistred user!
主要的功能是要实现运行时对控件的Sizing和dragging。
调用方法：在OnMouseDown中加入代码ControlSizer.Attach(TControl(Sender));

　将下面源码中的注释符去掉，编译出错，其中一条错误提示是
Cannot focus a disabled or invisible window.
另外，有些地方应该还需要改进一下，麻烦各位指点一二。

unit ControlSizer;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
TControlSizer = class(TCustomControl)
private
{ Private declarations }
FPosList: array [1..8] of Integer;
FRectList: array [1..8] of TRect;
FControl: TControl;
FPatternColor: TColor;
procedure SetPatternColor(const Value: TColor);
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;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle; override;
procedure Paint; override;
procedure SizerControlExit(Sender: TObject);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(AControl: TControl);
published
{ Published declarations }
property Control: TControl read FControl;
property PatternColor: TColor read FPatternColor write SetPatternColor default clBlack;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TControlSizer]);
end;

{ TControlSizer }

procedure TControlSizer.Attach(AControl: TControl);
var
R: TRect;
begin
if AControl <> nil then
begin
FControl := AControl;
R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
end;
end;

constructor TControlSizer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 28;
Width := 28;
FPatternColor := clBlack;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;
OnExit := SizerControlExit;
end;

procedure TControlSizer.CreateHandle;
begin
inherited Createhandle;
end;

procedure TControlSizer.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_Ex_Transparent;
end;

destructor TControlSizer.Destroy;
begin

inherited Destroy;
end;

procedure TControlSizer.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := FPatternColor;
for I := 1 to 8 do
begin
with FRectList do
begin
Canvas.Rectangle(Left, Top, Right, Bottom);
end;
end;
end;

procedure TControlSizer.SetPatternColor(const Value: TColor);
begin
if FPatternColor <> Value then
begin
FPatternColor := Value;
Repaint;
end;
end;

procedure TControlSizer.SizerControlExit(Sender: TObject);
begin
Free;
end;

procedure TControlSizer.WMLButtonDown(var Msg: TWMLButtonDown);
const
SC_DragMove: Longint = $F012;
begin
Perform(WM_SYSCOMMAND, SC_DragMove, 0);
end;

procedure TControlSizer.WMMove(var Msg: TWMMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
end;

procedure TControlSizer.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
begin
if PtInRect(FRectList, Pt) then Msg.Result := FPosList;
end;
if Msg.Result = 0 then inherited;
end;

procedure TControlSizer.WMSize(var Msg: TWMSize);
var
R: TRect;
X, Y: Integer;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
if Odd(Width) then X := 2 else X := 3;
if Odd(Height) then Y := 2 else Y := 3;
FRectList[1] := Rect(0, 0, 5, 5);
FRectList[2] := Rect(Width div 2 - X, 0, Width div 2 + 5 - X, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, Height div 2 - Y, Width, Height div 2 + 5 - Y);
FRectList[5] := Rect(Width - 5, Height - 5, Width, Height);
FRectList[6] := Rect(Width div 2 - X, Height - 5, Width div 2 + 5 - X, Height);
FRectList[7] := Rect(0, Height - 5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - Y, 5, Height div 2 + 5 - Y);
end;

end.
 
主要的功能是要实现运行时对控件的Sizing和dragging。
调用方法：在OnMouseDown中加入代码ControlSizer.Attach(TControl(Sender));

　将下面源码中的注释符去掉，编译出错，其中一条错误提示是
Cannot focus a disabled or invisible window.
另外，有些地方应该还需要改进一下，麻烦各位指点一二。

unit ControlSizer;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
TControlSizer = class(TCustomControl)
private
{ Private declarations }
FPosList: array [1..8] of Integer;
FRectList: array [1..8] of TRect;
FControl: TControl;
FPatternColor: TColor;
procedure SetPatternColor(const Value: TColor);
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;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle; override;
procedure Paint; override;
procedure SizerControlExit(Sender: TObject);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(AControl: TControl);
published
{ Published declarations }
property Control: TControl read FControl;
property PatternColor: TColor read FPatternColor write SetPatternColor default clBlack;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TControlSizer]);
end;

{ TControlSizer }

procedure TControlSizer.Attach(AControl: TControl);
var
R: TRect;
begin
if AControl <> nil then
begin
FControl := AControl;
R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
end;
end;

constructor TControlSizer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 28;
Width := 28;
FPatternColor := clBlack;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;
OnExit := SizerControlExit;
end;

procedure TControlSizer.CreateHandle;
begin
inherited Createhandle;
end;

procedure TControlSizer.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_Ex_Transparent;
end;

destructor TControlSizer.Destroy;
begin

inherited Destroy;
end;

procedure TControlSizer.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := FPatternColor;
for I := 1 to 8 do
begin
with FRectList do
begin
Canvas.Rectangle(Left, Top, Right, Bottom);
end;
end;
end;

procedure TControlSizer.SetPatternColor(const Value: TColor);
begin
if FPatternColor <> Value then
begin
FPatternColor := Value;
Repaint;
end;
end;

procedure TControlSizer.SizerControlExit(Sender: TObject);
begin
Free;
end;

procedure TControlSizer.WMLButtonDown(var Msg: TWMLButtonDown);
const
SC_DragMove: Longint = $F012;
begin
Perform(WM_SYSCOMMAND, SC_DragMove, 0);
end;

procedure TControlSizer.WMMove(var Msg: TWMMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
end;

procedure TControlSizer.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
begin
if PtInRect(FRectList, Pt) then Msg.Result := FPosList;
end;
if Msg.Result = 0 then inherited;
end;

procedure TControlSizer.WMSize(var Msg: TWMSize);
var
R: TRect;
X, Y: Integer;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
if Odd(Width) then X := 2 else X := 3;
if Odd(Height) then Y := 2 else Y := 3;
FRectList[1] := Rect(0, 0, 5, 5);
FRectList[2] := Rect(Width div 2 - X, 0, Width div 2 + 5 - X, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, Height div 2 - Y, Width, Height div 2 + 5 - Y);
FRectList[5] := Rect(Width - 5, Height - 5, Width, Height);
FRectList[6] := Rect(Width div 2 - X, Height - 5, Width div 2 + 5 - X, Height);
FRectList[7] := Rect(0, Height - 5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - Y, 5, Height div 2 + 5 - Y);
end;

end.
 
没空看哟
 
还是自己动手，丰衣足食。
问题已解决，虽然不是很完善，但总算可行。
 
您必须登录或注册才可回复。

Similar threads

陈
给shape控件加上运行时改变大小的特性（帮忙找找错误谢谢）。(100分)
回复
13
查看
241
Another_eYes
A
S
思考半年都未解决的问题(奉献全部积分)(200分)
2
回复
30
查看
440
scLizongliang
S
G
一个简单控件的源程序，有谁可以添加点注释！(300分)
回复
10
查看
2K
gravel
G
J
怎么将几个从TGraphicControl继承来的控件合并为一个控件？(50分)
回复
2
查看
197
mayong
M
D
如何設置TBitBtn控件的背景顏色?急!急!!! (100分)
回复
8
查看
864
aizb
A
后退
顶部