如何将控件的运行时状态设计成跟设计时一样,能完成拖过,多选控件,并且在选中控件的周围显示六个小点。

解决方案 »

  1.   

    参考一下----
    ----
    unit Unit2;interfaceuses
      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   }
        procedure Drawreg;
      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;
    implementationconstructor 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.Drawreg;
    var
      I: integer;
    begin
      Canvas.Brush.Color := $0024FF24;
      for I := 1 to 8 do
        with FRectList[I] do
          Canvas.Rectangle(Left, Top, Right, Bottom);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);
      Self.Drawreg;
    end;procedure TSizerControl.WmMove(var Msg: TWmMove);
    var
      R: TRect;
    begin
      R := BoundsRect;
      InflateRect(R, -2, -2);
      FControl.Invalidate;
      FControl.BoundsRect := R;
      Drawreg;
    end;procedure TSizerControl.Paint;
    begin
      Drawreg;
    end;procedure TSizerControl.SizeControlExit(Sender: TObject);
    begin
      Free;
    end;end.
    用法如下:
    var
      SizeControl:   TSizerControl;
    begin
        SizeControl   :=   TSizerControl.Create(self, Image1); //这里将要移动的是Image1
    end;
      

  2.   

    鼠标拖动这个好说,写代码就可以了!
    六个小点点有点麻烦~~可以考虑用LABEL代替!拖动的时候要写代码改变控件的大小~
      

  3.   

    安装DevExpress中的ExpressForumLibrary,有个叫dxfDesigner的可以实现这个功能.参考一下,可以根据自己的需要重新写一个.我就是这样做的
      

  4.   

    参考
    http://www.codechina.net/resource/html/2006-02/23/141782.html
      

  5.   

    查看delphi带任意一个可视控件的源代码
    里面有判断是不是设计期的语句
    所以了 其实它已经给你写好代码了
    你只需要改写一下就可以用到你的程序里了
      

  6.   

    andyzhou1101(〆.赱 極端(http://lovelcy.blogcn.com)
    //
    哈哈。。这段代码好熟啊。。跟我上次回的一模一样啊呵呵~`~
      

  7.   

    最另类的方法:
    1.插入一个TWebBrowser控件;
    2.Navigate('about:blank')后设置Document.DesignMode:='on';
    3.可以在TWebBrowser控件里放置控件,以及按你的要求编辑控件了。
    (如果要获得设计的控件的信息可以使用MSHTML单元的各种接口)