如何在Delphi中实现在运行时动态用鼠标修改控件的大小，位置改变已经解决.高分！

[小星星]

如何在Delphi中实现在运行时动态用鼠标修改控件的大小和位置。
位置改变已经解决.
最好提供点源码，本人加分100！！！
多谢！！！

[小星星]

我直接办它拷贝了，放到程序中，不能运行，给我发源代码,[e-mail]
多谢，快下班了，祝你好运！！

[chechy]

一行代码都不用写的啊，放到Form上就可以了。
这个控件的注册代码我写在其他文件里了，你自己加一下吧。
procedure Register;
begin
RegisterComponents('chechy', [TCcDrag]);
end;
控件一定要注册到Delphi环境中去。

[小星星]

我新建Component，将你的代码拷贝。。，然后修改，看看吧？
运行以后什么都看不到!!!，控件栏上没有你的控件！下面是代码
unit CcDrag;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms;
type
TMousePosition = (mpNone, mpRightBottom, mpRight, mpBottom);
TCcDrag = class(TGraphicControl)
private
{ Private Declarations }
FMouseDown: Boolean;
FDownPt: TPoint;
FMousePos: TMousePosition;
FOldWidth: Integer;
FOldHeight: Integer;
FLtdControl: TControl;
FAssignControl: Boolean;
FBoundsRect: TRect;
FFixSize: Boolean;
FFixHeight: Integer;
FFixWidth: Integer;
procedure SetLtdControl(const Value: TControl);
procedure AdjustControlBounds(const ABoundsRec: TRect);
procedure SetControlBounds(const ABoundsRect: TRect);
procedure SetFixSize(const Value: Boolean);
protected
{ Protected Declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
// Big Z Add This Procedure
// 避免在限制边缘拖动时的闪烁，使其表现更好！
procedure AdjustPosition(const OffsetX, OffsetY: Integer); virtual;
public
{ Public Declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published Declarations }
property LtdControl: TControl read FLtdControl write SetLtdControl;
// Big Z Add This 2000.07.21 10:20
// 增加一个属性，是否可以改变大小
property FixSize: Boolean read FFixSize write SetFixSize;
property Width default 90;
property Height default 120;
property Align;
property Anchors;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
{$IFDEF VER130}
property OnContextPopup;
{$ENDIF}
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;
implementation

const
OFFSET = 5;
procedure Register;
begin
RegisterComponents('MySample', [CcDrag]);
end;

procedure TCcDrag.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
{Method implementation code}
inherited MouseDown(Button, Shift, X, Y);

if Button = mbLeft then
begin
FMouseDown := True;
FDownPt := Point(X, Y);
FOldWidth := Width;
FOldHeight := Height;
if Assigned(FLtdControl) then
FBoundsRect := FLtdControl.BoundsRect;
if FMousePos = mpNone then
Screen.Cursor := crDrag;
end
end; {MouseDown}

procedure TCcDrag.MouseMove(Shift: TShiftState; X, Y: Integer);
var
OffsetX, OffsetY: Integer;
begin
{Method implementation code}
inherited MouseMove(Shift, X, Y);

if FMouseDown then
begin
OffsetX := X - FDownPt.x;
OffsetY := Y - FDownPt.y;
case FMousePos of
mpNone:
begin
{Left := OffsetX + Left;
Top := OffsetY + Top;
if FAssignControl then
AdjustControlBounds(FBoundsRect)}
// Big Z Modify Here 2000.07.21 11:18
AdjustPosition(OffsetX, OffsetY);
end;
mpRight:
begin
if FOldWidth + OffsetX > 0 then
Width := FOldWidth + OffsetX;
if FAssignControl then
SetControlBounds(FBoundsRect)
end;
mpBottom:
begin
if FOldHeight + OffsetY > 0 then
Height := FOldHeight + OffsetY;
if FAssignControl then
SetControlBounds(FBoundsRect)
end;
mpRightBottom:
begin
if FOldWidth + OffsetX > 0 then
Width := FOldWidth + OffsetX;
if FOldHeight + OffsetY > 0 then
Height := FOldHeight + OffsetY;
if FAssignControl then
SetControlBounds(FBoundsRect)
end
end;
end
else
begin
if (X >= Width - OFFSET) and (Y >= Height - OFFSET) then
begin
Cursor := crSizeNWSE;
FMousePos := mpRightBottom;
end
else if X >= Width - OFFSET then
begin
Cursor := crSizeWE;
FMousePos := mpRight
end
else if Y >= Height - OFFSET then
begin
Cursor := crSizeNS;
FMousePos := mpBottom
end
else
begin
Cursor := crDefault;
FMousePos := mpNone
end;
// Big Z Add This 2000.07.21 10:26
// 如果设定了 FixSize 属性，则尺寸的固定的值
if FFixSize then
begin
Cursor := crDefault;
FMousePos := mpNone
end
end
end; {MouseMove}

procedure TCcDrag.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
{Method implementation code}
inherited MouseUp(Button, Shift, X, Y);

FMouseDown := False;
Screen.Cursor := crDefault
end; {MouseUp}

constructor TCcDrag.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{Add any other initialization code here}
Width := 90;
Height := 120;
end; {Create}

procedure TCcDrag.Paint;
procedure PaintDot(X, Y: Integer);
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBlack;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Mode := pmCopy;
Canvas.Rectangle(X - 2, Y - 2, X + 2, Y + 2);
end;
begin
inherited;

Canvas.Pen.Style := psDot;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clRed;
Canvas.Pen.Mode := pmNot;
Canvas.Rectangle(0, 0, Width, Height);
// Big Z Add This 2000.07.21 11:32
if not FFixSize then
begin
PaintDot(Width, Height shr 1);
PaintDot(Width shr 1, Height);
PaintDot(Width, Height)
end;
end;

procedure TCcDrag.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);

if (Operation = opReMove) and (AComponent = FLtdControl) then
FLtdControl := nil
end;

procedure TCcDrag.SetLtdControl(const Value: TControl);
begin
if FLtdControl <> Value then
begin
FLtdControl := Value;
FAssignControl := Assigned(Value);
if FAssignControl then
begin
FBoundsRect := Value.BoundsRect;
SetControlBounds(FBoundsRect);
end
end
end;

procedure TCcDrag.SetControlBounds(const ABoundsRect: TRect);
begin
if ABoundsRect.Left > Left then
Left := ABoundsRect.Left;
if ABoundsRect.Top > Top then
Top := ABoundsRect.Top;
if ABoundsRect.Right < (Left + Width) then
Width := ABoundsRect.Right - Left;
if ABoundsRect.Bottom < (Top + Height) then
Height := ABoundsRect.Bottom - Top
end;

procedure TCcDrag.AdjustControlBounds(const ABoundsRec: TRect);
begin
if ABoundsRec.Left > BoundsRect.Left then
Left := ABoundsRec.Left;
if ABoundsRec.Top > BoundsRect.Top then
Top := ABoundsRec.Top;
if ABoundsRec.Right < BoundsRect.Right then
Left := ABoundsRec.Right - Width;
if ABoundsRec.Bottom < BoundsRect.Bottom then
Top := ABoundsRec.Bottom - Height
end;

// Big Z Add This 2000.07.21 10:26
// 如果设定了 FixSize 属性，则尺寸的固定的值
// ----------------------------------------------------------------------------

procedure TCcDrag.SetFixSize(const Value: Boolean);
begin
if FFixSize <> Value then
begin
FFixSize := Value;
end;
end;

// Big Z Add This Procedure
// 避免在限制边缘拖动时的闪烁，使其表现更好！

procedure TCcDrag.AdjustPosition(const OffsetX, OffsetY: Integer);
begin
if not FAssignControl then
begin
Left := Left + OffsetX;
Top := Top + OffsetY;
Exit;
end;
if Left + OffsetX < FBoundsRect.Left then
Left := FBoundsRect.Left
else if Left + OffsetX + Width > FBoundsRect.Right then
Left := FBoundsRect.Right - Width
else
Left := Left + OffsetX;
if Top + OffsetY < FBoundsRect.Top then
Top := FBoundsRect.Top
else if Top + OffsetY + Height > FBoundsRect.Bottom then
Top := FBoundsRect.Bottom - Height
else
Top := Top + OffsetY;
end;

end.

[chechy]

注册代码是正确的。
有没有将这个控件Install到某个Package中？

[trainbox]

up

[小星星]

正在修改，好像代码有点问题，可能是拷贝时，有很多隐藏的字符。。

[小星星]

该好了，不过好像只能弄小，不能弄大呀，

[chechy]

不会吧，我可没加限制。

[小星星]

多谢，我现在开始加分！！！
chechy(chechy) 100
其它的每个人1分，表示参与，表示感谢！！

[小星星]

随便问一下chechy(chechy)，能不能改成Tlabel,Tedit???

[chechy]

这个，一种是在相应的OnMouseMove，Down，Up里面写代码，另外就是象我这样写控件。
暂时我只能想到这些。

[小星星]

好的，多谢，给你加了102，多谢，有机会向你请教，我下班了，多谢！！！

[小星星]

有Email吗？我以后好请教你呀？

[chechy]

我发到你的邮箱里面，可以吗？

[winsomewang]

我正在做一个控件,将其设置为其他控件控件的父窗体,就可以实现以上的功能了.不过可能还需要几天才能出来

[小星星]

好的,发到[e-mail]里吧
多谢各位了
!!

[dypher]

还需要用ini文件或数据库保存控件位置和大小

[小星星]

这个好办，存入数据库好说
有没有人有可以合并和打印StringGrid的代码？给我发,我家分，并且提供源代码

[hety]

去找一个叫做XLSheet的控件可以实现!!(还要写程序哦)

[小星星]

为了好维护,最好有源代码.