у меня есть подозрение, что для таких вещей нужно писать своего наследника от TDragObject (это если "по науке"). но я обычно делаю так:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ExtCtrls;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Panel1: TPanel;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1StartDrag(Sender: TObject;
var DragObject: TDragObject);
procedure StringGrid1EndDrag(Sender, Target: TObject; X, Y: Integer);
private
{ Private declarations }
StartCol,
StartRow: integer;
StartX,
StartY: integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
Image: TImage;
implementation
uses Types;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
ACol, ARow: integer;
begin
// Çàïîëíèì StringGrid1 âñÿêîé ìóðîé
Randomize;
with StringGrid1 do begin
for ARow := FixedRows to RowCount - 1 do
for ACol := FixedCols to ColCount - 1 do
Cells [ACol, ARow] := IntToStr (Random (High (integer)));
end;
end;
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Çàïîìèíàåì ÿ÷åéêó è íà÷èíàåì ïåðåòàñêèâàòü, åñëè þçåð äâèíóë ìûøà íà 10 ïèêñåëîâ
StartX := X;
StartY := Y;
StringGrid1.MouseToCell(X, Y, StartCol, StartRow);
StringGrid1.BeginDrag(False, 10);
end;
procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
// Ïîêà íàä StringGrid1 - âñåãäà ìîæíî ñáðîñèòü
Accept := (Sender = Source);
Panel1.Left := X + 20;
Panel1.Top := Y + 20;
end;
procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
EndCol,
EndRow: integer;
begin
// Âûÿñíÿåì êóäà, è êîïèðóåì ÿ÷åéêó, íàä êîòîðîé íà÷àëîñü ïåðåòàñêèâàíèå
with StringGrid1 do begin
MouseToCell (X, Y, EndCol, EndRow);
Cells [EndCol, EndRow] := Cells [StartCol, StartRow];
end;
end;
procedure TForm1.StringGrid1StartDrag(Sender: TObject;
var DragObject: TDragObject);
var
Rect: TRect;
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
Rect := StringGrid1.CellRect(StartCol, StartRow);
bmp.Width := Rect.Right - Rect.Left;
bmp.Height := Rect.Bottom - Rect.Top;
BitBlt (bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
StringGrid1.Canvas.Handle, Rect.Left, Rect.Top, SRCCOPY);
Image1.Picture.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
Panel1.Left := StartX + 20;
Panel1.Top := StartY + 20;
Panel1.Visible := TRUE;
end;
procedure TForm1.StringGrid1EndDrag(Sender, Target: TObject; X,
Y: Integer);
begin
Panel1.Visible := FALSE;
end;
end. |
здесь на форму кладётся TPanel (AutoSize := TRUE, Visible := FALSE) и TImage (AutoSize := TRUE). в момент начала перетаксивания в TImage копируется участок канвы грида, и в панельке таскается вслед за курсором (т.е. программного изменения курсора не происходит). когда перетаскивания окончено - панелька прячется. для пущей красоты имеет смысл выставить TStringGrid.DragCursor в crDefault. |
