如何在运行状态花控件,并能够移动(200分)

  • 主题发起人 主题发起人 kingjet
  • 开始时间 开始时间
K

kingjet

Unregistered / Unconfirmed
GUEST, unregistred user!
我是初学者
现在有一个问题思考了好长一段时间没有结果,希望能够有人帮助解答,一定给高分。
需求描述:
我希望在运行时能够划出一个按钮,用鼠标点击后,在按钮周遍有小黑方块提示,移动鼠标按钮能够被移动(就象DELPHI设计环境中一样)
给出原理或代码都有分,我有4000分,不怕人多,只要有帮助都有分
 
在onkeydown及onmousemove等事件中写代码实现
 
只是针对一个按钮吗?
 
我都是这样实现的:
1、创建:运用Popup菜单来列出可创建的控件(可以是输入框等),在Popup的Click创建控件,按照Popup.PopupComponent找到Parent。
2、移动控件,是在创建控件的时候指定MouseDown事件,MouseDown;( ReleaseCapture; (Sender as TWinControl).Perform(WM_SysCommand,$F012,0);)只要是从TWinControl下继承的都可以用这种来移动。
3、控件的大小:我是利用一个TActionList来的,建几个Action定义快捷键,Actoin事件写( case (Sender as TAction).Tag of
1: ActiveControl.Width := ActiveControl.Width - 4 ;
2: ActiveControl.Width := ActiveControl.Width + 4 ;
3: ActiveControl.Height := ActiveControl.Height - 4 ;
4: ActiveControl.Height := ActiveControl.Height + 4 ;
5: ActiveControl.Left := ActiveControl.Left - 1 ;
6: ActiveControl.Left := ActiveControl.Left + 1 ;
7: ActiveControl.Top := ActiveControl.Top - 1 ;
8: ActiveControl.Top := ActiveControl.Top + 1 ;
end ;
),
4、至于控件的执行事件,当然也是事先写好,在控件的创建时指定的。
虽然这样还是没法做到象delphi设计时的那样,但还是能应急用的,希望楼下的能提出
建设性的办法,向楼下的前辈学习。
 
to:zfsfj能够给出你实现的思路;
to:foxyxyan非常谢谢你,提出的想法,但是好象这并不是我想要的,希望大家继续,问题解决了我一定会给分的。
 
下列方法可以的已经在用了!
procedure TMainForm.fcImageBtn1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012;
begin
If LockBoxFlag Then
Begin
ReleaseCapture;
(Sender as TfcImageBtn).perform(WM_SysCommand, SC_DragMove, 0);
End;
end;
 
我试了一下pizilai的方法是对的,把分给他吧,随便给我一点!
 
to kingjet :
我提供的办法所欠缺的就是在控件上直接的显示出八个小黑块,提供鼠标来拖动,这个
Delphi是怎么实现,我也想学习。
 
是呀,就是哪个小点很讨厌,我也不知道怎么处理,
to:pizilai 非常感谢你关心这个话题,但是你的程序没有注释,我看不懂,我是菜鸟呀,希望你能注释清楚一些好吗。
 
先告訴你一點東西。

使用8個點的方框框住控件,然後托動或改變控件大小。

8個點的透明方框原碼如下:
unit DdhSizer;

interface

uses
Classes, Windows, Messages, Controls, StdCtrls;

const
sc_DragMove: Longint = $F012;

type
TDdhSizeButton = class (TButton)
public
procedure WmNcHitTest (var Msg: TWmNcHitTest);
message wm_NcHitTest;
end;

TDdhSizerControl = class (TCustomControl)
private
FControl: TControl;
FRectList: array [1..8] of TRect;
FPosList: array [1..8] of Integer;
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 WmKeyDown(var Msg: TWMKEY); message WM_KEYDOWN;
procedure Paint; override;
procedure SizerControlExit (Sender: TObject);
end;

procedure Register;

implementation

uses
Graphics;

// TDdhSizeButton methods

procedure TDdhSizeButton.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
begin
Pt := Point (Msg.XPos, Msg.YPos);
Pt := ScreenToClient (Pt);
if (Pt.x < 5) and (pt.y < 5) then
Msg.Result := htTopLeft
else if (Pt.x > Width - 5) and (pt.y < 5) then
Msg.Result := htTopRight
else if (Pt.x > Width - 5) and (pt.y > Height - 5) then
Msg.Result := htBottomRight
else if (Pt.x < 5) and (pt.y > Height - 5) then
Msg.Result := htBottomLeft
else if (Pt.x < 5) then
Msg.Result := htLeft
else if (pt.y < 5) then
Msg.Result := htTop
else if (Pt.x > Width - 5) then
Msg.Result := htRight
else if (pt.y > Height - 5) then
Msg.Result := htBottom
else
inherited;
end;

// TDdhSizerControl methods

constructor TDdhSizerControl.Create (
AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create (AOwner);
FControl := AControl;
// install the new handler
OnExit := SizerControlExit;
// set the size and position
R := FControl.BoundsRect;
InflateRect (R, 2, 2);
BoundsRect := R;
// set the parent
Parent := FControl.Parent;
// create the list of positions
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 TDdhSizerControl.CreateHandle;
begin
inherited CreateHandle;
SetFocus;
end;

procedure TDdhSizerControl.CreateParams (var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle +
ws_ex_Transparent;
end;

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

procedure TDdhSizerControl.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 , Pt) then
Msg.Result := FPosList ;
// if the return value was not set
if Msg.Result = 0 then
inherited;
end;

procedure TDdhSizerControl.WmSize (var Msg: TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect (R, -2, -2);
FControl.BoundsRect := R;
// setup data structures
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 TDdhSizerControl.SizerControlExit (Sender: TObject);
begin
Free;
end;

procedure TDdhSizerControl.WmLButtonDown (var Msg: TWmLButtonDown);
begin
Perform (wm_SysCommand, sc_DragMove, 0);
end;

procedure TDdhSizerControl.WmMove (var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect (R, -2, -2);
FControl.Invalidate; // repaint entire surface
FControl.BoundsRect := R;
end;

procedure TDdhSizerControl.WmKeyDown(var Msg: TWMKEY);
begin
if (Msg.CharCode = VK_DELETE) then
begin
FControl.Free;
Free;
end;
end;

// components registration

procedure Register;
begin
RegisterComponents ('DDHB', [TDdhSizeButton]);
RegisterNoIcon ([TDdhSizerControl]);
end;

end.



在被托動控件的OnClick事件中寫:
TDdhSizerControl.Create(self, Sender as TControl);
 
非常谢谢楼上的兄弟,我接受答案了
 
多人接受答案了。
 
后退
顶部