自己设计一个简单的报表编辑工具遇到的控件拖放问题

Question

问题:生成一条横线或者直线,如何通过鼠标拖动,改变位置,改变大小.我的方法是生成一张细长的图片,但是效果不好.
其他:
大家有文本拖放,图片拖放的代码都可以贴出来.zdcnow

Answer 1

写成类的形式。
然后在mouse事件中写代码实现拖放类的操作，网上有很多这方面的例子。

Answer 2

應該用 delphi 自帶,如TShape, 或者自己編寫的控件來實現, 感覺比較好!
然後用這個來控制拖拉:
unit Resizer;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;const
   GRIDDEFAULT = 4;type
   TResizer = class;
   TMover = class;   TMovingEvent = procedure(Sender: TResizer; var NewLeft, NewTop: integer) of object;
   TSizingEvent = procedure(Sender: TResizer; var NewLeft, NewTop, NewWidth, NewHeight: integer) of object;   TResizer = class(TComponent)
   protected
      FActive     : boolean;
      FControl    : TControl;
      Sizers      : TList;
      GroupMovers : TList;
      FGroup      : TWinControl;
      FGridX      : integer;
      FGridY      : integer;
      FOnSized    : TNotifyEvent;
      FOnSizing   : TSizingEvent;
      FOnMoved    : TNotifyEvent;
      FOnMoving   : TMovingEvent;
      Sizing      : boolean;
      Moving      : boolean;
      OrigSize    : TRect;
      NewSize     : TRect;
      DownX       : integer;
      DownY       : integer;
      FAllowSize  : boolean;
      FAllowMove  : boolean;
      FKeepIn     : boolean;
      FHotTrack   : boolean;
      OneMover    : TMover;
      CurMover    : TMover;
      procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
      procedure   SetActive(b: boolean);
      procedure   SetControl(c: TControl);
      procedure   SetGroup(p: TWinControl);
      procedure   CreateSizers;
      procedure   CheckSizers;
      procedure   ShowSizers;
      procedure   HideSizers;
      procedure   SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      procedure   SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      procedure   SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      procedure   MoverDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      procedure   MoverUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      procedure   MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      procedure   DrawSizeRect(Rect: TRect);
      procedure   Calc_Size_Rect(SizerNum, dx, dy: integer);
      procedure   DoSizingEvent;
      procedure   Calc_Move_Rect(dx, dy: integer);
      procedure   DoMovingEvent;
      procedure   Constrain_Size;
      procedure   Constrain_Move;
      procedure   MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
      procedure   DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);
      procedure   CreateGroupMovers;
      procedure   CreateOneMover(m: TMover; c: TControl);
      function    FindMoverByBuddy(c: TControl): TMover;
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
   published
      property    Active: boolean read FActive write SetActive default True;
      property    ResizeControl: TControl read FControl write SetControl;
      property    ResizeGroup: TWinControl read FGroup write SetGroup;
      property    GridX: integer read FGridX write FGridX default GRIDDEFAULT;
      property    GridY: integer read FGridY write FGridY default GRIDDEFAULT;
      property    OnSized: TNotifyEvent read FOnSized write FOnSized;
      property    OnSizing: TSizingEvent read FOnSizing write FOnSizing;
      property    OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
      property    OnMoving: TMovingEvent read FOnMoving write FOnMoving;
      property    AllowSize: boolean read FAllowSize write FAllowSize default True;
      property    AllowMove: boolean read FAllowMove write FAllowMove default True;
      property    KeepInParent: boolean read FKeepIn write FKeepIn default True;
      property    HotTrack: boolean read FHotTrack write FHotTrack;
   end;

Answer 3

TInvisWin = class(TPanel)     // This could also derive from TPanel
   protected
      procedure WndProc(var Message: TMessage); override;
      procedure CreateParams(var Params: TCreateParams); override;
      procedure WMDLGCode(var Message: TMessage); message WM_GETDLGCODE;
   public
      property  OnKeyDown;
   end;   TMover = class(TInvisWin)
   public
      Buddy     : TControl;
      procedure Show;
   end;
procedure Register;implementationconst
   SIZE     = 6;
   HALFSIZE = SIZE div 2;type
   TSizer = class(TPanel)
   end;procedure Register;
begin
  RegisterComponents('Samples', [TResizer]);
end;// *****************************************************************
// TInvisWinprocedure TInvisWin.WndProc(var Message: TMessage);
var
   ps : TPaintStruct;
begin
   case Message.Msg of
      WM_ERASEBKGND: Message.Result := 1;
      WM_PAINT: begin
         BeginPaint(Handle, ps);
         EndPaint(Handle, ps);
         Message.Result := 1;
      end;
   else
      inherited WndProc(Message);
   end;
end;procedure TInvisWin.CreateParams(var Params: TCreateParams);
begin
   inherited;
   Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;procedure TInvisWin.WMDLGCode(var Message: TMessage);
begin
   Message.Result := DLGC_WANTARROWS or DLGC_WANTALLKEYS;
end;
// *****************************************************************
// TMoverprocedure TMover.Show;
begin
   Assert(Buddy <> nil);
   BoundsRect := Buddy.BoundsRect;
   Parent     := Buddy.Parent;
   Visible    := True;
   BringToFront;
end;
// *****************************************************************
// TResizerconstructor TResizer.Create(AOwner: TComponent);
begin
   inherited;
   FActive      := True;
   FKeepIn      := True;
   FGridX       := GRIDDEFAULT;
   FGridY       := GRIDDEFAULT;
   FAllowSize   := True;
   FAllowMove   := True;
   GroupMovers  := TList.Create;
   Sizers       := TList.Create;   OneMover := TMover.Create(Self);
   CreateOneMover(OneMover, nil);   CreateSizers;
end;destructor TResizer.Destroy;
begin
   GroupMovers.Free;
   Sizers.Free;
   Sizers := nil;
   inherited;
end;procedure TResizer.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited;
   if csDestroying in ComponentState then exit;
   if (AComponent = ResizeControl) and (Operation = opRemove) then
      ResizeControl := nil;
end;procedure TResizer.SetActive(b: boolean);
begin
   if b<>FActive then begin
      FActive := b;
      CheckSizers;
   end;
end;procedure TResizer.SetControl(c: TControl);
begin
   if c <> FControl then begin      if c<>nil then begin
         if ResizeGroup<>nil then begin
            Assert(c.Parent = ResizeGroup, 'ResizeControl is not in ResizeGroup!');
            CurMover := FindMoverByBuddy(c);
         end else begin
            CurMover := OneMover;
            CurMover.Buddy := c;
         end;
         CurMover.Show;
      end;      FControl := c;
      CheckSizers;
   end;
end;procedure TResizer.SetGroup(p: TWinControl);
begin
   if p <> FGroup then begin
      FGroup := p;
      CreateGroupMovers;
   end;
end;

Answer 4

procedure TResizer.CreateGroupMovers;
var
   i : integer;
   m : TMover;
   c : TControl;
begin
   if csDesigning in ComponentState then exit;   // Clear out the old Movers
   for i := 0 to GroupMovers.Count-1 do
      TObject(GroupMovers[i]).Free;
   GroupMovers.Clear;   if ResizeGroup <> nil then begin
      for i := 0 to ResizeGroup.ControlCount-1 do begin
         c := ResizeGroup.Controls[i];
         if (c is TMover) or (c is TSizer) then continue;         m := TMover.Create(Self);
         CreateOneMover(m, c);
         GroupMovers.Add(m);
         m.Show;
      end;
   end;
end;procedure TResizer.CreateSizers;
var
   i : integer;
   p : TSizer;
begin
   if csDesigning in ComponentState then exit;   for i := 0 to 7 do begin
      p := TSizer.Create(Self);
      Sizers.Add(p);      p.BevelOuter   := bvNone;
      p.Width        := SIZE;
      p.Height       := SIZE;
      p.Color        := clBlack;
      p.Caption      := '';
      p.Tag          := i;
      p.OnMouseDown  := SizerDown;
      p.OnMouseUp    := SizerUp;
      p.OnMouseMove  := SizerMove;
      p.TabStop      := False;      case i of
         0, 7  : p.Cursor := crSizeNWSE;
         2, 5  : p.Cursor := crSizeNESW;
         1, 6  : p.Cursor := crSizeNS;
         3, 4  : p.Cursor := crSizeWE;
      end;
   end;
end;procedure TResizer.CreateOneMover(m: TMover; c: TControl);
begin
   m.OnMouseDown := MoverDown;
   m.OnMouseUp   := MoverUp;
   m.OnMouseMove := MoverMove;
   m.TabStop     := True;
   m.OnKeyDown   := MoverKeyDown;
   m.Buddy       := c;
end;procedure TResizer.CheckSizers;
begin
   if (ResizeControl<>nil) and Active and (not (csDesigning in ComponentState)) then
      ShowSizers
   else
      HideSizers;
end;procedure TResizer.ShowSizers;
var
   i : integer;
   p : TPanel;
   c : TControl;
begin
   c := ResizeControl;
   Assert(c <> nil);   for i := 0 to 7 do begin
      p := TPanel(Sizers[i]);
      case i of
         0, 1, 2 : p.Top := c.Top - HALFSIZE;
         3,    4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;
         5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;
      end;      case i of
         0, 3, 5 : p.Left := c.Left - HALFSIZE;
         1,    6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;
         2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;
      end;
   end;   Assert(CurMover<>nil);
   CurMover.Show;   for i := 0 to Sizers.Count-1 do begin
      p := TPanel(Sizers[i]);
      p.Parent  := c.Parent;
      p.Visible := True;
      p.BringToFront;
   end;   if CurMover.HandleAllocated and CurMover.CanFocus then
      CurMover.SetFocus;
end;procedure TResizer.HideSizers;
var
   i : integer;
   p : TPanel;
begin
   for i := 0 to Sizers.Count-1 do begin
      p := TPanel(Sizers[i]);
      p.Visible := False;
      p.Update;
   end;
   OneMover.Visible := False;
end;procedure TResizer.SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   Sizing  := True;
   DownX   := X;
   DownY   := Y;
   HideSizers;
   ResizeControl.Parent.Update;
   ResizeControl.Update;
   OrigSize := ResizeControl.BoundsRect;
   NewSize  := OrigSize;
   DrawSizeRect(NewSize);
end;procedure DoSwap(DoSwap: boolean; var a, b: integer);
var
   t : integer;
begin
   if DoSwap then begin
      t := a;
      a := b;
      b := t;
   end;
end;procedure TResizer.SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if NewSize.Right < NewSize.Left then
      DoSwap(True, NewSize.Right, NewSize.Left);
   if NewSize.Bottom < NewSize.Top then
      DoSwap(True, NewSize.Bottom, NewSize.Top);   Sizing := False;
   DrawSizeRect(NewSize);
   ResizeControl.Invalidate;
   ResizeControl.BoundsRect := NewSize;
   ShowSizers;
   if Assigned(OnSized) then OnSized(Self);
end;procedure TResizer.SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
   if Sizing then begin
      DrawSizeRect(NewSize);      if AllowSize then begin
         Calc_Size_Rect((Sender as TSizer).Tag, X - DownX, Y - DownY);
         DoSizingEvent;
      end;      DrawSizeRect(NewSize);
      if HotTrack then ResizeControl.BoundsRect := NewSize;
   end;
end;

Answer 5

个人感觉最好还是不要用自带的控件，自带的控件有一个问题，当一个选中的图元某一部分在另一个图元下方时，选中的图元被遮挡的部分将无法捕获鼠标事件，这比较讨厌。
最好还是自己写一个类。
比如：
  TMyGraphic = class
  ...
  public
    //开始拖动时间
    procedure StartDrag(const Shift: TShiftState; AHitTest:
      TSSQGraphicHitTest; var ADragData: TSSQDragData);virtual;
   //拖动中
    procedure DragMove(AHitTest: TSSQGraphicHitTest;
      var ADragData: TSSQDragData);virtual;
   //拖动图元上选择标记框
    procedure DragPointMove(AHitTest: TSSQGraphicHitTest;
      var ADragData: TSSQDragData);virtual;
   //拖动结束
    procedure DragEnd(AHitTest: TSSQGraphicHitTest;
      var ADragData: TSSQDragData);virtual;
   //拖动选择标记结束 
    procedure DragPointEnd(AHitTest: TSSQGraphicHitTest;
      var ADragData: TSSQDragData);virtual;
  end;
  
在绘制的Canvas拥有者Mouse事件中处理调用以上方法。这种方式做可以避免上述问题，个人感觉扩展性等也要好一些

Answer 6

aiirii(ari-爱的眼睛) :
你的代友码还没帖完啊！

Answer 7

<< 搂主
俺最近也弄了一个，比较简单（水平不够，想此之策，别见笑），大概就是，简单省事，从qrshape继承下来一个，
  TNQRShape = class(TQRShape)
  private
    { Private declarations }
    FOnMouseDown : TMouseEvent;
    FOnMouseUp : TMouseEvent;
    procedure WMLButtonDown(var message : TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMRButtonDown(var message : TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMLButtonUp(var message : TWMLButtonUp);message WM_LBUTTONUP;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property OnMouseMove;
    property OnMouseDown:TMouseEvent Read FOnMouseDown Write FOnMouseDown;
    property OnMouseUp:TMouseEvent Read FOnMouseUp Write FOnMouseUp;
    property OnDblClick；
  end;

Answer 8

然后，我在 OnMouseDown 中进行处理

Answer 9

<<aiirii,看了看代码，爽~~~~~顶着````````````````

Answer 10

<<< ssq237712(流亡帅哥) 您好，刚才您说的那种方法，能不能给我个例子，，不胜感激~

Answer 11

给你看一下我的部分代码吧：  
类型定义
//鼠标移动时检测的类型：无、对象上、选择标记框
  TSSQHitKind = (shtNoWhere, shtObject, shtPoint);
  //鼠标移动时检测内容
  TSSQGraphicHitTest = record
    GraphicIndex: SmallInt;
    HitKind: TSSQHitKind;
    HitIndex: Byte;
    HitPoint: TPoint;
  end;
  //拖动类型：无、区域选择，创建元素，拖动对象，拖动点， 窗口缩放，实时缩放
  TSSQDragKind = (sdkNone, sdkSelect, sdkCreate, sdkObject, sdkDragPoint,
    sdkZoomWin, sdkZoomRealTime);  //拖动数据
  TSSQDragData = record
    OrgPoint: TPoint; //原点 MouseDown
    LastPoint: TPoint;//上次鼠标位置
    CurPoint: TPoint; //目前点
    DragKind: TSSQDragKind;//拖动类型
    tag: smallInt; //自由使用
    GraphicIndex: SmallInt; //拖动对象
    DragIndex: Smallint; //拖动的点的索引
  end;

Answer 12

//页面类，将在这个类上面绘制
TSSQDesignPanel = class(TPaperPreview)
...
procedure TSSQDesignPanel.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: integer;
begin
  //需要对齐网格
  if FDrawGrid then
  begin
    X := Round(X / FGridWidth) * FGridWidth;
    Y := Round(Y / FGridWidth) * FGridWidth;
  end;
  inherited MouseDown(Button, Shift, X, Y);
  //外部程序控制作其他事情
  if (Button <> mbLeft) or (FUserMouse) then
    Exit;  FDragData.GraphicIndex := FHitTest.GraphicIndex;
  if FHitTest.HitKind = shtNoWhere then//空白区域, 选择模式
  begin
    FDragData.DragKind := sdkSelect;
    FDragData.OrgPoint := Point(X, Y);
    FDragData.CurPoint := Point(X, Y);
    DrawFocusRect(FDragData.OrgPoint, FDragData.CurPoint);
  end
  //下移给元素自行处理
  else if not Graphics[FHitTest.GraphicIndex].Selected or (FHitTest.HitIndex > 0) or (Shift <> []) then
  begin
    Graphics[FHitTest.GraphicIndex].SetDragData(Shift, FHitTest, FDragData);
  end
  else for i := 0 to GetSelectedCount - 1 do
    Selecteds[i].SetDragData(Shift, FHitTest, FDragData);
end;procedure TSSQDesignPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  OldX, OldY, i: integer;
begin
  Cursor := crDefault;
  OldX := X;
  OldY := Y;
  if FDrawGrid then
  begin
    X := Round(X / FGridWidth) * FGridWidth;
    Y := Round(Y / FGridWidth) * FGridWidth;
  end;
  inherited MouseMove(Shift, X, Y);  if FDragData.DragKind = sdkNone then//非拖动
  begin
    FHitTest := GetHitTest(Point(OldX, OldY));
    Exit;
  end;
  if FUserMouse then Exit;
  FDragData.LastPoint := FDragData.CurPoint;
  if FDragData.DragKind = sdkSelect then
  begin//创建新元素或选择模式，绘制选择
    DrawFocusRect(FDragData.OrgPoint, FDragData.CurPoint);
    FDragData.CurPoint := Point(X, Y);
    DrawFocusRect(FDragData.OrgPoint, FDragData.CurPoint);
  end
  else//下移给对象自行处理
  begin
    FDragData.CurPoint := Point(X, Y);
    if not Graphics[FHitTest.GraphicIndex].Selected or (FHitTest.HitIndex > 0) or (Shift <> [ssLeft]) then //下移给元素自行处理
      Graphics[FHitTest.GraphicIndex].DragMove(FHitTest, FDragData)
    else
      for i := 0 to GetSelectedCount - 1 do
        Selecteds[i].DragMove(FHitTest, FDragData);
  end;
end;procedure TSSQDesignPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i: integer;
  r: TRect;
begin
  if FUserMouse then//用户在该事件中可能更改了UserMouse属性，所以，必须在前面判断一下
  begin
    inherited;
    Exit;
  end;
  inherited;
  if FDragData.DragKind = sdkSelect then
  begin//创建新元素或选择模式，绘制选择
    DrawFocusRect(FDragData.OrgPoint, FDragData.CurPoint);
    r := SSQRect(FDragData.OrgPoint, FDragData.CurPoint);
    if ssShift in Shift then
    begin
      for i := GraphicCount - 1 downto 0 do
      begin
        if Graphics[i].IsIntersect(r) then
        begin
          if Graphics[i].Selected then
            RemoveSelected(Graphics[i])
          else
            AddSelected(Graphics[i]);
        end;
      end;
    end
    else
    begin
      ClearSelected;
      for i := GraphicCount - 1 downto 0 do
      begin
        if Graphics[i].IsIntersect(r) then
          AddSelected(Graphics[i]);
      end;
    end;
  end
  else if not Graphics[FHitTest.GraphicIndex].Selected or (FHitTest.HitIndex > 0) or (Shift <> []) then //下移给元素自行处理
    Graphics[FHitTest.GraphicIndex].DragEnd(FHitTest, FDragData)
  else
    for i := 0 to GetSelectedCount - 1 do
      Selecteds[i].DragEnd(FHitTest, FDragData);
  ClearDragData;//清空拖动数据
end;

Answer 13

//图元类
TSSQGraphic = class(TSSQPropertyObject)procedure TSSQGraphic.SetDragData(const Shift: TShiftState; AHitTest:
  TSSQGraphicHitTest; var ADragData: TSSQDragData);
  procedure _SetDragObject(const OnlyDrag: Boolean);
  begin
    ADragData.DragIndex := AHitTest.HitIndex;
    ADragData.OrgPoint := AHitTest.HitPoint;
    ADragData.CurPoint := AHitTest.HitPoint;
    if (AHitTest.HitIndex < 1) or OnlyDrag then//拖动
    begin
      ADragData.DragKind := sdkObject;
    end
    else
    begin
      ADragData.DragKind := sdkDragPoint;
    end;
    FPaper.DrawFocusRect(Bounds);
  end;
begin
  if FSelected then//已选择
  begin
    if ssShift in Shift then//删除选择
      FPaper.RemoveSelected(Self)
    else
    begin//拖动模式
      _SetDragObject(False);
    end;
  end
  else
  begin
    if ssShift in Shift then//添加到选择，并置拖动模式
    begin
      FPaper.AddSelected(Self);
    end
    else
    begin//选择当前元素，并置拖动模式
      //Paper.SetSelected(Self);
      FPaper.ClearSelected;
      _SetDragObject(True);
    end;
  end;
end;procedure TSSQGraphic.DragMove(AHitTest: TSSQGraphicHitTest;
  var ADragData: TSSQDragData);
var
  r: TRect;
begin
  case ADragData.DragKind of
    sdkObject:
    begin
      r := Bounds;
      OffsetRect(r, ADragData.LastPoint.X - ADragData.OrgPoint.X, ADragData.LastPoint.Y - ADragData.OrgPoint.Y);
      FPaper.DrawFocusRect(r);
      r := Bounds;
      OffsetRect(r, ADragData.CurPoint.X - ADragData.OrgPoint.X, ADragData.CurPoint.Y - ADragData.OrgPoint.Y);
      FPaper.DrawFocusRect(r);
    end;
    sdkDragPoint:
    begin
      DragPointMove(AHitTest, ADragData);
    end;
  end;
end;procedure TSSQGraphic.DragEnd(AHitTest: TSSQGraphicHitTest;
  var ADragData: TSSQDragData);
var
  r: TRect;
begin
  case ADragData.DragKind of
    sdkObject:
    begin
      r := Bounds;
      OffsetRect(r, ADragData.CurPoint.X - ADragData.OrgPoint.X, ADragData.CurPoint.Y - ADragData.OrgPoint.Y);
      FPaper.DrawFocusRect(r);
      Offset(Point(ADragData.CurPoint.X - ADragData.OrgPoint.X, ADragData.CurPoint.Y - ADragData.OrgPoint.Y));
      if not FSelected then
        FPaper.SetSelected(Self);
    end;
    sdkDragPoint:
    begin
      DragPointEnd(AHitTest, ADragData);
    end;
  end;
end;