Форум: "Основная";
Текущий архив: 2003.04.07;
Скачать: [xml.tar.bz2];

Вниз

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

← →
Мыш   (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; сенк ю.

---

← →
vlad40   (2003-03-25 14:59) [4]

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


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;


---

← →
Мыш   (2003-03-25 20:05) [5]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.04.07;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.007 c