描画ヘッダーセクションのドラッグイメージ

Question

私はDelphi 2006を使用しています。

私は最初から書きましたカスタムヘッダーコントロールがあります。そのほとんどは、ユーザーがヘッダーセクションをドラッグしてその位置を変更するときに、ヘッダーセクションの半透明ドラッグイメージを描画する方法がわからないことを除いて、ほぼ完成しました。

DelphiのTHeaderControlはこれを非常にうまく行いますが、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...を参照してください。