控件大小自由拖放,这样的功能如何实现?(20分)

  • 主题发起人 主题发起人 baifeng
  • 开始时间 开始时间
B

baifeng

Unregistered / Unconfirmed
GUEST, unregistred user!
就像是在设计期时,在FORM上放上一个MEMO控件,
可以用MOUSE自由拖放MEMO大小及其位置???
 
可以实现,但不知道你用来做什么???
 
to wlmmlw:
在做一个麻烦的报表,,能否指教。谢谢!
 
移动位置:当鼠标在控件上面移动&&点击时,鼠标移动,控件也随之移动就好,
改变大小也很容易:就是不知道你希望写什么样风格的,参考以下word上面画流程图的感觉,
就应该能够知道怎样实现了.
一种比较简单的方法是:鼠标在控件上面移动的时候,判断鼠标是否移动到了控件的边缘
,如果鼠标移动到了控件的边缘,那么判断鼠标所在的是控件的哪一边,同时改变鼠标光标形状,
,如果是在又边缘,就让鼠标边成左右箭头的形状,其它类似了.这是鼠标点击+移动就执行你写
的改变控件大小的程序了.不难,你可以试验一下.
 
DDHSIZER.PAS
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 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;

// components registration

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

end.

--------------------------------------------------------------------------------
Generated by PasToWeb, a tool by Marco Cantù.



SIZEFORM.PAS
unit SizeForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, DdhSizer;

type
TForm1 = class(TForm)
Button2: TButton;
CheckBox1: TCheckBox;
Edit1: TEdit;
Bevel1: TBevel;
Bevel2: TBevel;
DdhSizeButton1: TDdhSizeButton;
DdhSizeButton2: TDdhSizeButton;
procedure AttachSizer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.AttachSizer(Sender: TObject);
begin
TDdhSizerControl.Create (self, Sender as TControl);
end;

end.

--------------------------------------------------------------------------------
Generated by PasToWeb, a tool by Marco Cantù.


SIZEFORM.DFM
object Form1: TForm1
Left = 196
Top = 117
Width = 460
Height = 183
Caption = 'SizeDemo'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 8
Top = 8
Width = 441
Height = 65
end
object Bevel2: TBevel
Left = 8
Top = 80
Width = 441
Height = 65
end
object Button2: TButton
Left = 56
Top = 96
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 0
OnClick = AttachSizer
end
object CheckBox1: TCheckBox
Left = 175
Top = 102
Width = 85
Height = 17
Caption = 'CheckBox1'
TabOrder = 1
OnClick = AttachSizer
end
object Edit1: TEdit
Left = 293
Top = 99
Width = 105
Height = 21
TabOrder = 2
Text = 'Edit1'
OnClick = AttachSizer
end
object DdhSizeButton1: TDdhSizeButton
Left = 72
Top = 24
Width = 137
Height = 25
Caption = 'DdhSizeButton1'
TabOrder = 3
end
object DdhSizeButton2: TDdhSizeButton
Left = 248
Top = 24
Width = 137
Height = 25
Caption = 'DdhSizeButton2'
TabOrder = 4
end
end

--------------------------------------------------------------------------------
Generated by PasToWeb, a tool by Marco Cantù.


SIZEDEMO.DPR
program SizeDemo;

uses
Forms,
SizeForm in 'SizeForm.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

一个完整的例子——《Delphi 高级开发指南》
 

Similar threads

D
回复
0
查看
802
DelphiTeacher的专栏
D
D
回复
0
查看
747
DelphiTeacher的专栏
D
D
回复
0
查看
696
DelphiTeacher的专栏
D
后退
顶部