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

Вниз

Проблема с динамическим созданием набора Shape-ов.   Найти похожие ветки 

← →
Random bystander   (2003-03-11 12:41) [0]

Приветствую вас, господа.

Стоит следующая задача:
Имеется таблица, в которой хранится информация о компьютерах фирмы по этажам с привязкой к координатам на плане этажа.
Необходимо реализовать отображение позиций компьютеров на плане этажа с возможностью добавления/удаления компьютеров и перетаскивания их значков.

Идея такова:
Компьютеры отображаются динамически генерируемыми TShape.
При переключении этажа (они расположены на разных страницах PageControl) делается выборка необходимых строк из таблицы и на странице создается некоторое количество TShape, обозначающих все компьютеры.

Реализовано:
Добавление и удаление строк таблицы. Перетаскивание TShape. Запись данных в таблицу.

Симптомы:
Само по себе все работает.
При добавлении или удалении строки появляются странные симптомы - от выделения всех TShape до критической ошибки. Подозреваю, что проблема - в процедуре пересоздания набора TShape.


var Comps: array [1..20] of TShape;

procedure TCatalog.Freshen;
var i: integer;
var j: integer;
begin
for i := 1 to 20 do if Comps[i] <> nil then Comps[i].Free;
i := 1;
tbCompark.First;
//if not tbCompark.Eof then
repeat
Comps[i] := TShape.Create (Catalog);
Comps[i].Brush.Style := bsSolid;
Comps[i].Brush.Color := clSilver;
Comps[i].Pen.Style := psSolid;
Comps[i].Pen.Color := clBlack;
Comps[i].Shape := stCircle;
Comps[i].Width := 26;
Comps[i].Height := 26;
Comps[i].Left := tbComparkCoord_x.AsInteger;
Comps[i].Top := tbComparkCoord_y.AsInteger;
Comps[i].Tag := tbComparkID_Comp.AsInteger;
if SpeedButton1.Down then Comps[i].DragMode := dmManual else Comps[i].DragMode := dmAutomatic;
Comps[i].DragKind := dkDock;
Comps[i].OnEndDock := BaseShapeEndDock;
Comps[i].OnStartDock := BaseShapeStartDock;
Comps[i].OnContextPopup := BaseShapeContextPopup;
Comps[i].Parent := PageControl1.ActivePage;
Inc (i);
tbCompark.Next;
until tbCompark.Eof;
for j := i+1 to 20 do if Comps[j] <> nil then Comps[j].Free;
end;

procedure TCatalog.AddButtonClick(Sender: TObject);
var i: integer;
begin
for i := 1 to 32767 do
if not tbCompark.FindKey ([i]) then begin
tbCompark.Insert;
tbComparkID_Comp.AsInteger := i;
tbComparkCoord_X.AsInteger := 5;
tbComparkCoord_Y.AsInteger := 5;
tbComparkNetName.AsString := "User Anonymous #" + IntToStr (i);
tbComparkOfis.AsInteger := PageControl1.ActivePageIndex;
Freshen;
Exit;
end;
end;

procedure TCatalog.DeleteButtonClick(Sender: TObject);
var i:integer;
begin
tbCompark.Edit;
tbCompark.Delete;
Freshen;
end;


Хотелось сначала их все уничтожать, затем создавать заново, но не действует.

Помогите исправить положение.

---

← →
Random bystander   (2003-03-12 15:13) [1]

Не дайте прозябнуть в неведении - покажите, где глюк.

---

← →
Clickmaker   (2003-03-12 15:52) [2]

я бы сделал так
var Comps: TObjectList;


TCatalog.FormCreate
begin
Comps := TObjectList.Create(true);
end;

TCatalog.FormDestroy
begin
Comps.Free;
end;

procedure TCatalog.Freshen;
Comp: TShape;
begin
Comps.Clear;
tbCompark.First;
while not tbCompark.Eof do begin
Comp := TShape.Create(nil);
...
Comps.Add(Comp);
end;
end;

---

← →
Random bystander   (2003-03-12 17:28) [3]

О!
Спасибо, мне полегчало...

Обидно, конечно, что сам не догадался не усложнять себе жизнь :-)

---

← →
icWasya   (2003-03-12 17:32) [4]

а глюк в такой строке
написано
for i := 1 to 20 do if Comps[i] <> nil then Comps[i].Free;

надо
for i := 1 to 20 do FreeAndNil(Comps[i]);

---

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

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

Наверх

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