рисование

← →
Мыш © (2003-03-25 10:44) [0]

Делаю перетаскивание строк в stringgrid-e с помощью dragndrop, сетка с двумя колонками, первая fixed. Отрисовывать место, куда после перетаскивания вставится строка приходиться вручную, делаю это с помощью динамически создаваемого битмапа, накладываемого на канву сетки инверсно. По-идее, битмап-чистый синий прямоугольник, но после нескольких перетаскиваний он превращается вдруг в кучу мусора - размеры те же, а заполнение - полный хаос из пикселов.
Вот код:
-----------------------------------------------------------------
var

FormPreview: TFormPreview;
CellRctLast:Trect;
startcell:tpoint;
CellDrawed:boolean;
bm:tbitmap;

procedure TFormPreview.SG1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
c,r:integer;
begin
bm.Width:=CellRctLast.Right-CellRctLast.Left;
bm.Height:=4;//CellRctLast.Bottom-CellRctLast.Top;
bm.Canvas.Brush.Color:=clblue;
bm.Canvas.Rectangle(0,0,bm.Width,bm.Height);
sg1.Canvas.CopyMode:=cmSrcInvert;
sg1.Canvas.Draw(CellRctLast.Left, CellRctLast.Top,bm);
end;

procedure TFormPreview.SG1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
c,r:integer;
begin
sg1.BeginDrag(false);
sg1.MouseToCell(x,y,c,r);
CellRctLast:=sg1.CellRect(c,r);
startcell:=point(c,r);
caption:=floatToStr(CellRctLast.Top);
CellDrawed:=true;

bm.Width:=CellRctLast.Right-CellRctLast.Left;
bm.Height:=4;//CellRctLast.Bottom-CellRctLast.Top;
bm.Canvas.Brush.Color:=clblue;
bm.Canvas.Rectangle(0,0,bm.Width,bm.Height);
sg1.Canvas.CopyMode:=cmSrcInvert;
sg1.Canvas.Draw(CellRctLast.Left, CellRctLast.Top,bm);
end;

procedure TFormPreview.SG1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
c,r:integer;
CellRct:Trect;
begin
sg1.MouseToCell(x,y,c,r);
CellRct:=sg1.CellRect(c,r);
if (CellRctLast.Top<>CellRct.Top) then
begin
sg1.Canvas.CopyMode:=cmSrcInvert ;
sg1.Canvas.Draw(cellrct.Left, cellrct.Top,bm);

sg1.Canvas.Draw(CellRctLast.Left, CellRctLast.Top,bm);
CellRctLast:=CellRct;
end;

if source=sg1 then accept:=true;
end;

← →
vlad40 © (2003-03-25 12:32) [1]

А зачем такие сложности с битмапами, если не секрет? Ведь можно при перетаскивании просто делать ячейку (строку) текущей и присваивать значения перетаскиваемой ячейки (строки).

← →
MBo © (2003-03-25 12:38) [2]

>Мыш
В статьи загляни

← →
Мыш © (2003-03-25 14:36) [3]

2vlad: Желательно конечно, помучиться (с) Сухов.

И красивше хоца.
2MBo; сенк ю.

Попробуй этот вариант, может понравится:

var Form1: TForm1; drRow, drCol: integer; procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var c,r: integer; tRow: tstringlist; begin StringGrid1.MouseToCell(x,y,c,r); if r>=0 then begin tRow:=tstringlist.Create; tRow.Assign(StringGrid1.Rows[r]); StringGrid1.row:=r; StringGrid1.Rows[r]:=StringGrid1.Rows[drRow]; StringGrid1.Rows[drRow]:=tRow; drRow:=r; tRow.free; Accept:=true; end else Accept:=false; end; procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer); var c,r: integer; begin StringGrid1.MouseToCell(x,y,c,r); StringGrid1.row:=r; StringGrid1.Rows[r]:=StringGrid1.Rows[drRow]; StringGrid1.DragMode:=dmManual; end; procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if ssLeft in Shift then StringGrid1.BeginDrag(true); end; procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin StringGrid1.MouseToCell(x,y,drCol,drRow); if drRow<0 then exit; StringGrid1.col:=drCol; StringGrid1.row:=drRow; end; procedure TForm1.FormCreate(Sender: TObject); var i,j: integer; begin for i:=0 to StringGrid1.RowCount-1 do for j:=0 to StringGrid1.ColCount-1 do StringGrid1.cells[j,i]:=IntToStr(i); StringGrid1.Options:=StringGrid1.Options+[goRowSelect]; end;

Да, все замечательно, только хочется еще и линеечку отрисовывать, которая показывает, между какими строчками вставится перетаскиваемая

рисование Найти похожие ветки