绘制标题部分拖动图像

Question

即时通讯使用德尔福2006年。

我有一个自定义的头控件，我从头开始写。它几乎完成，除了我不知道如何绘制标题部分的半透明拖动图像，当用户拖动标题部分以改变其位置时。

Delphi中的THeaderControl做的很好，但它是windows头控件的子类，我的不是，它是从头开始编写的。所以我想知道是否有一个windows函数可以为你绘制，或者你必须自己绘制它。

谢谢

Answer 1

实施GetDragImages。例如。如下：

type 
    THeader = class(TCustomControl) 
    private 
    FColWidth: Integer; 
    FDragImages: TDragImageList; 
    FDragIndex: Integer; 
    FDragPos: TPoint; 
    protected 
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; 
     var Accept: Boolean); override; 
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override; 
    function GetDragImages: TDragImageList; override; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 
     X, Y: Integer); override; 
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 
    procedure Paint; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    end; 

{ THeader } 

constructor THeader.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    ControlStyle := ControlStyle + [csDisplayDragImage]; 
    DragCursor := crNone; 
    FColWidth := 100; 
end; 

procedure THeader.DoEndDrag(Target: TObject; X, Y: Integer); 
begin 
    FreeAndNil(FDragImages); 
    // Eat inherited if you do not publish the default drag events 
end; 

procedure THeader.DragOver(Source: TObject; X, Y: Integer; 
    State: TDragState; var Accept: Boolean); 
begin 
    // Eat inherited if you do not publish the default drag events 
    Accept := Source = Self; 
end; 

function THeader.GetDragImages: TDragImageList; 
var 
    Bmp: TBitmap; 
begin 
    if FDragImages = nil then 
    begin 
    FDragImages := TDragImageList.Create(nil); 
    Bmp := TBitmap.Create; 
    try 
     Bmp.Width := FColWidth; 
     Bmp.Height := Height; 
     BitBlt(Bmp.Canvas.Handle, 0, 0, FColWidth, Height, Canvas.Handle, 
     FDragIndex * FColWidth, 0, SRCCOPY); 
     FDragImages.Width := FColWidth; 
     FDragImages.Height := Height; 
     FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), FDragPos.X, 
     FDragPos.Y); 
    finally 
     Bmp.Free; 
    end; 
    end; 
    Result := FDragImages; 
end; 

procedure THeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X, 
    Y: Integer); 
begin 
    inherited MouseDown(Button, Shift, X, Y); 
    FDragIndex := X div FColWidth; 
    FDragPos.X := X mod FColWidth; 
    FDragPos.Y := Y; 
end; 

procedure THeader.MouseMove(Shift: TShiftState; X, Y: Integer); 
begin 
    inherited MouseMove(Shift, X, Y); 
    if ssLeft in Shift then 
    BeginDrag(False, Mouse.DragThreshold); 
end; 

procedure THeader.Paint; 
var 
    i: Integer; 
    R: TRect; 
begin 
    for i := 0 to 3 do 
    begin 
    SetRect(R, i * FColWidth, 0, (i + 1) * FColWidth, Height); 
    Canvas.Brush.Color := clSilver; 
    Canvas.Font.Color := clWhite; 
    DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONPUSH or 
     DFCS_PUSHED or DFCS_ADJUSTRECT); 
    Canvas.TextRect(R, R.Left + 2, R.Top + 2, 'Column ' + IntToStr(i + 1)); 
    end; 
end; 

{ TForm1 } 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    with THeader.Create(Self) do 
    begin 
    SetBounds(0, 100, 500, 30); 
    Parent := Self; 
    end; 
end; 

如果你不想（像默认THeaderControl）拖动图像的垂直运动，那么你每次都来重建图像拖动鼠标移动。见Drag image change while drag...。