在程序运行时如何实现拖动、调整控件的大小,
有控件吗?
[email protected]
[email protected]
(如果解决连同以前的200分一起送上)

解决方案 »

  1.   

    一段程序:
    unit SizerControl;
    interface
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
    type
      TSizerControl = class(TCustomControl)
      private
        FControl: TControl;
        FRectList: Array [1..8] of TRect;
        FPosList: Array [1..8] of Integer;
        { Private declarations }
      protected
        { Protected declarations }
      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 SizeControlExit(Sender: TObject);
        { Public declarations }
      published
        { Published declarations }
      end;
    const
      sc_DragMove: Longint = $F012;
    procedure Register;
    implementation
    constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
    var
      R: TRect;
    begin
      inherited Create(AOwner);
      FControl := AControl;
      OnExit := SizeControlExit;
      R := FControl.BoundsRect;
      InflateRect(R, 2, 2);
      BoundsRect := R;
      Parent := FControl.Parent;
      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 TSizerControl.CreateParams(var Params: TCreateParams);
    begin
      inherited CreateParams(Params);
      //增加透明特性
      Params.ExStyle := Params.ExStyle
      + WS_EX_TRANSPARENT;
    end;
    procedure TSizerControl.Createhandle;
    begin
      inherited Createhandle;
      SetFocus;
    end;procedure TSizerControl.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[I], Pt) then
          Msg.Result := FPosList[I];
      if Msg.Result = 0 then
        inherited;
    end;procedure TSizerControl.WmSize(var Msg:TWmSize);
    var
      R: TRect;
    begin
      R := BoundsRect;
      InflateRect( R, -2, -2);
      FControl.BoundsRect := R;
      //计算8个黑方框
      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 TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
    begin
      //执行拖动命令
      Perform(Wm_SysCommand, sc_DragMove, 0);
    end;procedure TSizerControl.WmMove(var Msg: TWmMove);
    var
      R: TRect;
    begin
      R := BoundsRect;
      InflateRect( R, -2, -2);
      FControl.Invalidate;
      FControl.BoundsRect := R;
    end;
    procedure TSizerControl.Paint;
    var
      I: Integer;
    begin
      Canvas.Brush.Color := clBlack;
      for I := 1 to 8 do
        with FRectList[I] do
          Canvas.Rectangle (Left, Top, Right, Bottom);
    end;procedure TSizerControl.SizeControlExit(Sender: TObject);
    begin
      Free;
    end;
    procedure Register;
    begin
      RegisterNoicon([TSizerControl]);
    end;end
    主窗口程序:
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, ExtCtrls;type
      TForm1 = class(TForm)
        btn: TButton;
        GroupBox1: TGroupBox;
        procedure btnMouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
      private    { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation
    uses SizerControl;{$R *.DFM}procedure TForm1.btnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    var
      SizeControl: TSizerControl;
    begin
       SizeControl := TSizerControl.Create(self, btn);
    end;procedure TForm1.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    var
      SizeControl: TSizerControl;
    begin
      SizeControl := TSizerControl.Create(self, GroupBox1);
    end;
    end.
      

  2.   

    to: cg1120(代码最优化-§雪是冷的,人是暖的§) 有第三方组件吗?
    我的Email:  [email protected]
                [email protected]