******拖放编程的问题，请真正的高手进来看看******

Question

我想实现在拖动一个控件时，跟随鼠标的移动显示一个和被拖动的控件的一样的一个图形，不知道什么方法最好？  
 
下面是我自己写的一个类及使用的代码(拖动一个Lable到一个Panel上)，它继承了TDragControlObject类，但为什么总是不显示图形呢，不知道问题出在哪里!  
请指教!谢谢!  
 
unit  Unit1;  
 
interface  
 
uses  
Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,  
Dialogs,  ComCtrls,  StdCtrls,  ExtCtrls;  
type  
TForm1  =  class(TForm)  
Label1:  TLabel;  
Panel1:  TPanel;  
procedure  Label1MouseDown(Sender:  TObject;  Button:  TMouseButton;  
Shift:  TShiftState;  X,  Y:  Integer);  
procedure  Label1StartDrag(Sender:  TObject;  
var  DragObject:  TDragObject);  
procedure  Panel1DragOver(Sender,  Source:  TObject;  X,  Y:  Integer;  
State:  TDragState;  var  Accept:  Boolean);  
private  
{  Private  declarations  }  
list1item  :  string;  
public  
{  Public  declarations  }  
end;  
 
type  
TTextDragObject  =  class(TDragControlObject)  
private  
DragImgs  :  TDragImageList;  
FDragText  :  string;  
protected  
function  GetDragImages:  TDragImageList;  override;  
public  
constructor  createNew(AControl:  TControl;Text  :  string);  
constructor  create(AControl:  TControl);  override;  
destructor  Destroy;  override;  
end;  
 
var  
Form1:  TForm1;  
 
implementation  
 
{$R  *.dfm}  
 
procedure  TForm1.Label1MouseDown(Sender:  TObject;  Button:  TMouseButton;  
Shift:  TShiftState;  X,  Y:  Integer);  
begin  
if  Button  =  mbleft  then  
Label1.BeginDrag(True);  
end;  
 
constructor  TTextDragObject.createNew(AControl:  TControl;Text  :  string);  
begin  
inherited  create(AControl);  
FDragText  :=  Text;  
end;  
 
constructor  TTextDragObject.create(AControl:  TControl);  
begin  
inherited;  
 
end;  
 
destructor  TTextDragObject.Destroy;  
begin  
 
inherited;  
end;  
 
function  TTextDragObject.GetDragImages:  TDragImageList;  
var  
Bmp  :  TBitmap;  
Idx  :  Integer;  
bmp2  :  TBitmap;  
p  :  TPoint;  
begin  
if  DragImgs=nil  then  
DragImgs  :=  TDragImageList.create(nil);  
Bmp  :=  TBitmap.create;  
bmp2  :=  TBitmap.create;  
Bmp.Height  :=  Bmp.Canvas.TextHeight(FDragText);  
Bmp.Width  :=  Bmp.Canvas.TextWidth(FDragText);  
Bmp.Canvas.TextOut(0,0,FDragText);  
DragImgs.Width  :=  Bmp.Width;  
DragImgs.Height  :=  Bmp.Height;  
Idx  :=  DragImgs.AddMasked(Bmp,clWhite);  
DragImgs.SetDragImage(Idx,  0,  0);  
Result  :=  DragImgs;  
Bmp.Free;  
end;  
 
procedure  TForm1.Label1StartDrag(Sender:  TObject;  
var  DragObject:  TDragObject);  
var  
pt:  TPoint;  
begin  
DragObject  :=  TTextDragObject.createNew(Panel1,Label1.Caption);  
end;  
 
procedure  TForm1.Panel1DragOver(Sender,  Source:  TObject;  X,  Y:  Integer;  
State:  TDragState;  var  Accept:  Boolean);  
begin  
if  Source  is  TLabel  then  
if  (Source  as  TLabel).Name  =  'Label2'  then  
Accept  :=  True;  
end;  
 
end.  

Answer 1

有个控件，是 Resizer.pas, 找找，就是你要的

Answer 2

楼主可以看看cxGrid与dxGrid的源代码当你在拖动某一列的时候
鼠标变成列的标题形状,我看了它的源代码好像实现起来
比较复杂.

Answer 3

如果你想要一个可拖动的文件？Q
unit TextObjectU;interfaceuses   Windows, Messages, SysUtils, Classes,Controls,Graphics,StdCtrls,Forms;const
  BASE_FONT_SIZE = 12;
type
  TPrintFont = set of (pfCustom,pfNormal,pfDbWidth,pfDbHeight,pfBold,pfStrikeOut,pfSmooth,pfItalic,pfUnderline);
  TTextObject = class(TCustomControl)
  private
    FLock: Boolean;
    FActive: Boolean;
    FAutoSize: Boolean;
    FSelected: Boolean;
    FCanReSize: Boolean;
    FEditing: Boolean;
    FEdit: TEdit;
    FOldPos: TPoint;                            //记录鼠标屏幕位置
    FMouseDownArea: Word;                       //记录鼠标按下时区域
    FCharSpacing: SmallInt;
    FPrintFont: TPrintFont;                     //模拟显示字体
    FPFWTimes: Integer;                    //自定义字体宽
    FPFHTimes: Integer;                   //自定义字体高
    FLogFont: TLogFont;
    FSmallRect: array[1..8] of TRect;
    FClientRect: TRect;                         //文本 显示&编辑 区
    FOnSelected: TNotifyEvent;
    procedure DrawCtHandle;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    function GetCharSpacing: Byte;
    procedure SetCharSpacing(const Value: Byte);
    function InchToPoint(Value: Byte): SmallInt;
    function PointToInch(Value: SmallInt): Byte;
    procedure MouseDragMoveResize(CtrHandle: Integer);
    procedure SetPrintFont(const Value: TPrintFont);
    procedure MessageFocusEnter(var Msg: TMessage); message CM_Enter;
    procedure MessageFocusExit(var Msg: TMessage); message CM_Exit;
    procedure SetSelected(const Value: Boolean);  protected
    procedure Paint; override;
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure MouseDoubleClick(Sender: TObject);
    procedure Resize(Sender: TObject);
    procedure EditExit(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    function MakeLogFont(PFType: TPrintFont): HFont;
    function CheckEdge(P: TPoint): Integer;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Lock;
    procedure UnLock;
    procedure EditText;
    property Active: Boolean read GetActive write SetActive Default True;
    property Caption;
    property Font;
    property CharSpacing: Byte read GetCharSpacing write SetCharSpacing Default 0;
    property PrintFont: TPrintFont read FPrintFont Write SetPrintFont;
    property CustomPFWidth: Integer read FPFWTimes write FPFWTimes;
    property CustomPFHeight: Integer read FPFHTimes write FPFHTimes;
    property Selected: Boolean read FSelected write SetSelected;
    property OnSelected: TNotifyEvent read FOnSelected write FOnSelected;
  end;implementation
const
  CTH_SIZE: Byte = 3;
  Cursor_Type: array[0..8] of TCursor = (crDefault,crSizeNWSE,crSizeNS,crSizeNESW,crSizeWE,
                                         crSizeNWSE,crSizeNS,crSizeNESW,crSizeWE);{ TTextObject }function TTextObject.CheckEdge(P: TPoint): Integer;
var
  ii: Integer;
begin
  Result := 0;
  for ii := Low(FSmallRect) to High(FSmallRect) do
  if (P.x >= FSmallRect[ii].Left) AND (P.x <= FSmallRect[ii].Right)  AND (P.y >= FSmallRect[ii].Top ) AND (P.y <= FSmallRect[ii].Bottom) then
  begin
    Result := ii;
    Break;
  end;
end;constructor TTextObject.Create(AOwner: TComponent);
begin
  inherited;
  Parent := TWinControl(AOwner);
  AutoSize := True;
  FPrintFont := [pfNormal];
  FillChar(FLogFont,SizeOf(TLogFont),0);
  Font.Handle := MakeLogFont(FPrintFont);
  AutoSize := False;
  Caption := '广州中鸣显示';
  Canvas.Font := Font;
  FCanReSize := False;  OnMouseDown := MouseDown;
  OnMouseMove := MouseMove;
  OnMouseUp := MouseUp;
  OnDblClick := MouseDoubleClick;
  OnResize := Resize;  Height := Canvas.TextHeight(Caption) + 2 * CTH_SIZE;
  Width := Canvas.TextWidth(Caption) + 2 * CTH_SIZE;
  SetFocus;
end;procedure TTextObject.DrawCtHandle;  //画出八个小方块
var
  ii: Integer;
begin
  //编辑状态只画虚线框
  if FEditing then
  with Canvas do
  begin
    Pen.Color := clLime;
    Brush.Style := bsClear;
    Pen.Style := psDashDot;
    Rectangle(ClientRect);
  end
  else
  with Canvas do
  begin
    Pen.Color := clLime;
    Brush.Style := bsClear;
    Pen.Style := psDot;
    Rectangle(CTH_SIZE,CTH_SIZE,Width - CTH_SIZE,Height - CTH_SIZE);
    Brush.Style := bsSolid;
    Brush.Color := clLime;
    Pen.Style := psSolid;
    Pen.Color := clBlack;
    for ii := Low(FSmallRect) to High(FSmallRect) do
    Rectangle(FSmallRect[ii]);
  end;
end;procedure TTextObject.EditExit(Sender: TObject);
begin
  Caption := (Sender as TEdit).Text;
  (Sender as TEdit).Visible := False;
  FEditing := False;
  Invalidate;
end;procedure TTextObject.EditKeyPress(Sender: TObject; var Key: Char);
begin
  //Enter键完成编辑退出 ESC 取消编辑退出
  if Key in [#13,#27] then
  begin
    if Key = #27 then
    FEdit.Text := Caption;
    Key := #0;
    SetFocus;
  end;
end;procedure TTextObject.EditText;
begin
  FEditing := True;
  if not Assigned(FEdit) then
  begin
    FEdit := TEdit.Create(Self);
    with FEdit do
    begin
      Parent := Self;
      ParentFont := True;
      BorderStyle := bsNone;
      AutoSelect := True;
      Left := FClientRect.Left;
      Top := FClientRect.Top;
      Width := FClientRect.Right - Left;
      Height := FClientRect.Bottom - Top;      OnExit := EditExit;
      OnKeyPress := EditKeyPress;
    end;
  end;  with FEdit do
  begin
     Text := Self.Caption;
     Visible := True;
     BringToFront;
     SetFocus;
  end;
  Invalidate;   //重画
end;function TTextObject.GetActive: Boolean;
begin
  Result := FActive;
end;function TTextObject.GetCharSpacing: Byte;
begin
  Result := FCharSpacing div 70 * 180
end;function TTextObject.InchToPoint(Value: Byte): SmallInt;
begin
  Result := Value * 70;
end;procedure TTextObject.Lock;
begin
  DragMode := dmManual;
end;

Answer 4

function TTextObject.MakeLogFont(PFType: TPrintFont): HFont;  //生成特殊的模拟显示字体
const
  BoolToInt: array[False..True] of Byte = (0,1);
var
  iW,iH: Integer;
  iWeight: Integer;
begin
//pfDbWidth,pfDbHeight,pfStrong,pfSmooth
  iW := BASE_FONT_SIZE div 2;
  iH := BASE_FONT_SIZE;
  if PFType = [] then
  PFType := [pfNormal];
  if Not (pfNormal in PFType) then
  begin
    if pfDbWidth in PFType then
    iW := BASE_FONT_SIZE;
    if pfDbHeight in PFType then
    iH := BASE_FONT_SIZE * 2;    if pfCustom in PFType then
    begin
      iW := BASE_FONT_SIZE * FPFWTimes div 2;
      iH := BASE_FONT_SIZE * FPFHTimes;
    end;
  end;
  if pfBold in PFType then
  iWeight := 700
  else
  iWeight := 400;  with FLogFont do
  begin
    lfHeight := iH;
    lfWidth := iW;
    lfEscapement := GM_COMPATIBLE;
    lfOrientation := GM_COMPATIBLE;
    lfWeight := iWeight;
    lfCharSet := GB2312_CHARSET;
    lfQuality := 2;//ANTIALIASED_QUALITY;
    lfPitchAndFamily := FF_ROMAN OR DEFAULT_PITCH;
    lfUnderline := BoolToInt[pfUnderline in PFType];
    lfItalic := BoolToInt[pfItalic in PFType];
    lfStrikeOut := BoolToInt[pfStrikeOut in PFType];
    StrPCopy(lfFaceName,'宋体');
  end;
  Result := CreateFontIndirect(fLogFont);
end;procedure TTextObject.MessageFocusEnter(var Msg: TMessage);
begin
  if FEditing then Exit;
  Selected := True;
end;procedure TTextObject.MessageFocusExit(var Msg: TMessage);
begin
  if FEditing then Exit;
  Selected := False;
end;procedure TTextObject.MouseDoubleClick(Sender: TObject);
begin
  EditText;
end;procedure TTextObject.MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  GetCursorPos(FOldPos);                    //保存开始移动时鼠标全局坐标
  FMouseDownArea := CheckEdge(Point(X,Y));  //计算区域
  Selected := True;
end;procedure TTextObject.MouseDragMoveResize(CtrHandle: Integer);   //通过鼠标拖啦移动或改变对象大小
var
  NewPos: TPoint;
begin
    if Cursor <> Cursor_Type[CtrHandle] then
    Cursor := Cursor_Type[CtrHandle];   //换鼠标形状
    GetCursorPos(NewPos);               //取鼠标全局位置
    try
      if NewPos.x <> FOldPos.x then
      begin
        case CtrHandle of
          0,1,8:     SetBounds(Left + NewPos.x - FOldPos.x,Top,Width,Height);
          7:         SetBounds(Left + (NewPos.x - FOldPos.x),Top,Width,Height);                
        end;
        case CtrHandle of
          1,7,8:   Width := Width - (NewPos.x - FOldPos.x);
          3,4,5:   Width := Width + (NewPos.x - FOldPos.x);
        end;
      end;
      if NewPos.y <> FOldPos.y then
      begin
        case CtrHandle of
          0,1,2,3:  Top := Top + NewPos.y - FOldPos.y;
        end;
        case CtrHandle of
          1,2,3:    Height := Height - (NewPos.y - FOldPos.y);
          5,6,7:    Height := Height + (NewPos.y - FOldPos.y);
        end;
      end;
    finally
      FOldPos := NewPos;
    end;
end;procedure TTextObject.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  if ssLeft in Shift then
  begin
    //左键按下进行拖拉移动操作
    MouseDragMoveResize(FMouseDownArea);
  end
  else
  begin
    //检查位置更换鼠标形状
    if Cursor <> Cursor_Type[CheckEdge(Point(X,Y))] then
    Cursor := Cursor_Type[CheckEdge(Point(X,Y))];
  end;
end;procedure TTextObject.MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  if Cursor <> crDefault then
  Cursor := crDefault;
end;procedure TTextObject.Paint;
var
  Rect: TRect;
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    FillRect(ClientRect);
    Rect := FClientRect;
    Font := Self.Font;
    DrawText(Handle,PChar(Caption),Length(Caption),Rect, DT_LEFT);
  end;  if FSelected then
  DrawCtHandle;
end;
function TTextObject.PointToInch(Value: SmallInt): Byte;
begin
  Result := (Value div 70) AND $FF;
end;procedure TTextObject.Resize(Sender: TObject);  //计算八个操控句柄位置
var
  ii: Integer;
  function GetDrawRect(X,Y: Integer): TRect;
  begin
    Result := Rect(X - CTH_SIZE,Y - CTH_SIZE,X + CTH_SIZE,Y + CTH_SIZE);
  end;
begin
  if Width < (3 * CTH_SIZE + 20) then
  Width := CTH_SIZE * 3 + 20;
  if Height < (3 * CTH_SIZE + 10) then
  Height := CTH_SIZE * 3 + 10;  FClientRect := Rect(ClientRect.Left + CTH_SIZE,
                      ClientRect.Top + CTH_SIZE,
                      ClientRect.Right - CTH_SIZE,
                      ClientRect.Bottom - CTH_SIZE);
  if Assigned(FEdit) then
  with FEdit do
  begin
    Left := FClientRect.Left;
    Top := FClientRect.Top;
    Width := FClientRect.Right - Left;
    Height := FClientRect.Bottom - Top;
  end;  FSmallRect[1] := GetDrawRect(CTH_SIZE,CTH_SIZE);
  FSmallRect[2] := GetDrawRect((Width - 1) div 2,CTH_SIZE);
  FSmallRect[3] := GetDrawRect(Width - CTH_SIZE - 1,CTH_SIZE);
  FSmallRect[4] := GetDrawRect(Width - CTH_SIZE - 1 ,(Height - 1) div 2);
  FSmallRect[5] := GetDrawRect(Width - CTH_SIZE - 1,Height - CTH_SIZE - 1);
  FSmallRect[6] := GetDrawRect((Width - 1) div 2,Height - CTH_SIZE - 1);
  FSmallRect[7] := GetDrawRect(CTH_SIZE,Height - CTH_SIZE - 1);
  FSmallRect[8] := GetDrawRect(CTH_SIZE,(Height - 1) div 2);
end;procedure TTextObject.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    Invalidate;
  end;
end;procedure TTextObject.SetCharSpacing(const Value: Byte);
begin
  FCharSpacing := InchToPoint(Value);
  Invalidate;
end;procedure TTextObject.SetPrintFont(const Value: TPrintFont);
var
 iW,iH: Integer;
begin
  //if FPrintFont <> Value then
  begin
    FPrintFont := Value;
    Font.Handle := MakeLogFont(FPrintFont);
    Canvas.Font := Font;
     //重新计算大小    begin
      iH := Canvas.TextHeight(Caption) + 2 * CTH_SIZE;
      iW := Canvas.TextWidth(Caption) + 2 * CTH_SIZE;
      if iW > Width then
      Width := iW;
      if iH > Height then
      Height := iH;
    end;
  end;
end;procedure TTextObject.SetSelected(const Value: Boolean);
begin
  if FSelected <> Value then
  begin
    FSelected := Value;
    Invalidate;
    if Selected AND Assigned(FOnSelected) then
    FOnSelected(Self);
  end;
end;procedure TTextObject.UnLock;
begin
  DragMode := dmAutomatic;
end;end.

Answer 5

你是不是要做象visio那样的软件哦？如果是的话用矢量图

Answer 6

我倒是想做类于viso某些功能软件，但不知矢量图怎么玩啊，楼上的大哥有没什么资料可以参考下？