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

我以前写过的一个控件，你可以参考一下吧。unit CcDrag;interfaceuses
  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;implementationconst
  OFFSET = 5;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.

我的意思是说，在窗体上放几个text,button,label,用户可以随意改动他们的位置和大小的效果。还有一个我自己弄的Grid。组成了一个用户自定义报表的效果，然后我打印出来呀。就是这种效果。如果有人在明天之内给我好的答案或者源码，我加分，我还有2966分！！！！多谢各位大哥大姐。我是学生。在兼职呀。要求用Delphi5.X。

多谢chechy(chechy),不管是否可以，先给你20分！！如果可以，我再给你加！！
我先试试。多谢你。我给你加了20。如果好的话，我接着加。我有的是分！

别着急不难得
主要就是使用控件的 MouseDown();MouseUp();MouseMove();三个事件；同时用鼠标的各个形状作配合！
OnMouseDown();//用来置可拖动标志位
OnMouseMove();//拖动事改变控件尺寸程序
OnMouseUp();//由来取消可拖动标志位

位置改变我是利用窗体的ondragover事件写的。

你有没有发现利用Form的OnDragOver事件的时候如果窗体上有其他控件（如一个TRichEdit），
你的鼠标移过去就没有事件发生了，同样如果你鼠标起始位置在要移动的控件中间位置，为鼠标
移出控件之前也是没有事件的，如果你看一下Delphi IDE上移动控件就可以比较出不同了。
要解决这个问题，最要不要用OnDragOver事件，用SetCapture捕获鼠标，然后响应OnMouseMove
事件，这样就可以在任何时候得到鼠标事件了（当需要响应WM_LBUTTONDOWN记录初始位置）。
控件尺寸改变就是用 Width,Height两个属性啊，关键还是要在WM_LBUTTONDOWN地时候记录
操作的类型，是移动还是改变大小（也就是根据鼠标的位置点了），当然我建议不要实时地
移动或改变大小，用一个虚线框，等放开鼠标的时候再移动和改变大小。

源码不要意思了，我也很忙啊，还要忙着回答其他问题挣分啊，呵呵.... 不过
如果你要操作的不是自己的控件而是TEdit，TButton这样的标准控件，我建议你
重载一下变成自己的控件比较方便，这样可以在里面增加OnMouseMove响应来控制
不同位置的鼠标形状，并且在选中的时候出现一个带黑点的虚线框啊...

不好改，不好意思.....你的控件改变大小好像只是设计时的改动呀。别人拿去用，放在窗体里，必须用程序让你的控件的大小和位置改变，你的代码才有用呀。
帮帮忙嘛。我开发Delphi的时间不长，不过VB很熟。

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

一行代码都不用写的啊，放到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;
implementationconst
  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.

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

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

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

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

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

好的,发到[email protected]里吧
多谢各位了
!!

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

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

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

调试易

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

解决方案 »