PHP DM Gate v0.9 » Не соответствие индексов. <span class="vd">[Delphi, Windows]</span>

RusSun © (25.12.09 22:23) [0]

Добрый день, уважаемые мастера.

Что есть: QuestionList:pList; и QuestionTreeView:=NewTreeView.
Что пытаюсь сделать: Удалять элемент в QuestionTreeView и соответстующий ему в
QuestionList.
….
begin {DeleteQstn}//процедура удаления в общем виде

if QuestionTreeView.TVSelected=0 then exit;

if MessageBoxA(0,pchar('Вы действительно хотите удалить - '+QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]),'Внимание!!!',MB_OKCAN CEL+MB_ICONQUESTION)=IDCANCEL then exit;
ResultQ:=ResultQ-1;

QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
index:=QuestionTreeView.TVSelected;
QuestionList.Delete(index);// QuestionList.Delete(2); <= сдесь ошибка

ResultView.Clear;
if QuestionTreeView.TVRoot=0 then exit;
QuestionTreeViewSelChange(Sender);
End;
….

В итоге индексы не соответствуют:
в QuestionTreeView 1435345,1478923…и тд.
в QuestionList 0,1,2,3… .

Вопрос как с этим бороться? Может кому-то попадалось что-то подобное? Если будет небольшой пример, буду очень рад.

<Цитата>
mdw © (28.12.09 13:27) [1]

Читайте документацию. В ТриВью не индексы а хендлы узлов.

<Цитата>
RusSun © (28.12.09 19:23) [2]

Добрый вечер. Хорошо пусть хедлы.
"Роза пахнет розой,
хоть розой назови
хоть нет"
вот код :

program Project1;
uses
windows,
messages,
kol;
type
PQuestion=^TQuestion;
TQuestion=record
Name: String[255];
ResultQCount:Integer;
ResultCount:Integer;
ResiltText: array[0..10] of String[255];
ResiltValue: array[0..10] of boolean;
end;
{$R *.res}
var
form,Toolbar1,QuestionTreeView,
ResultView:PControl;
QuestionList:pList;ProjectName:String[255];
Dialog:pOpenSaveDialog;f:file; QCount,j,k,index,ResultQ:integer;
//область для процедур
procedure FormShow(DummySelf,Sender: PControl);
begin
QuestionList:= NewList;
end;
procedure FormDestroy(DummySelf,Sender: PControl);
begin
QuestionList.Free;
end;
procedure Add(Sender:PControl);
var
i:Integer;
NewQuest:PQuestion;
begin
NewQuest:=New(PQuestion); k:=k+1;
NewQuest.Name:='в '+int2str(k);
NewQuest.ResultCount:=k;
ResultQ:=ResultQ+1;
NewQuest.ResultQCount:= ResultQ;
for i:= 0 to NewQuest.ResultCount-1 do
begin
NewQuest.ResiltText[i]:='otv № '+int2str(i);
end;
QuestionList.Add(NewQuest);

with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name);
TVItemData[j]:=NewQuest;
Font.FontStyle:=[fsunderline];
end;
end;
procedure QuestionTreeViewSelChange(Sender:pcontrol);
var i:integer;
begin
ResultView.Clear;
QuestionTreeView.Cursor:=LoadCursor(0,IDC_HAND);
SendMessage(ResultView.Handle,lVM_SETTEXTCOLOR,0,LParam(clblue));
index:=QuestionTreeView.TVSelected;
for i:=0 to PQuestion(QuestionTreeView.TVItemData[index]).ResultCount-1 do begin
if PQuestion(QuestionTreeView.TVItemData[index]).ResiltValue[i]=true then begin
ResultView.LVItemAdd(PQuestion(QuestionTreeView.TVItemData[index]).ResiltText[i] );
ResultView.LVItems[i,1]:='Да';
end else begin ResultView.LVItemAdd(PQuestion(QuestionTreeView.TVItemData[index]).ResiltText[i] );
ResultView.LVItems[i,1]:='Нет';
end;
end;
end;
procedure LoadFile(Sender: PControl);
var
fs:PStream;
i, Count:Integer;
Str:String[5];
NewQuest:PQuestion;
begin
QuestionList.Clear;
fs:=NewReadFileStream( Dialog.Filename );
fs.Seek( 0, spBegin );
fs.read(Str, SizeOf(Str));
if Str='Тест' then
begin
fs.Read(QCount, sizeof(QCount));
fs.Read(ProjectName, sizeof(ProjectName));
form.Caption:=ProjectName;
try
fs.Read(Count, sizeof(Count));
for i:=0 to Count-1 do
begin
NewQuest:=New(PQuestion);
fs.Read(NewQuest^, sizeof(TQuestion));
QuestionList.Add(NewQuest);

with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name);
TVItemData[j]:=NewQuest;
Font.FontStyle:=[fsunderline];
end;
end;
finally
fs.Free;
end;
end;
end;
procedure Open(Sender:pcontrol);
begin
Dialog:=NewOpenSaveDialog('','',[]) ;
Dialog.Filter := 'Файлы тестов|*.tst';
Dialog.title := 'Открыть';
Dialog.OpenDialog := true;
if Dialog.Execute then begin
assign(f,Dialog.Filename);
LoadFile(Sender);
end else exit;
end;
procedure SaveFile(Sender: PControl);
var
fs:PStream;
i,Count:Integer;
Str:String[5];
begin
fs:=NewWriteFileStream( Dialog.Filename );
Str:='Тест';
fs.write(Str, SizeOf(Str));
fs.write(QCount, sizeof(QCount));
ProjectName:=form.Caption;
fs.write(ProjectName, sizeof(ProjectName));
try
Count:=QuestionList.Count;
fs.write(Count, sizeof( Count));
for i:=0 to Count-1 do
fs.Write(QuestionList.Items[i]^, sizeof(TQuestion));
finally
//Закрываю файл
fs.Free;
end;//finally end
end;
procedure Save(Sender:pcontrol);
begin
Dialog:=NewOpenSaveDialog('','',[]) ;
Dialog.Filter := 'Файлы тестов|*.tst';
Dialog.title := 'Сохранить';
Dialog.OpenDialog := false;
if Dialog.Execute then begin
assign(f,Dialog.Filename);
SaveFile(Sender);
end else exit;
end;
procedure DoWorkToolBar1(Sender:pcontrol);
begin
case toolbar1.CurIndex of
0:begin {Open}
QuestionTreeView.Clear;
Open(Sender);
end;
1:begin {Add}
add(Sender);
end;
2:begin {Del}
if QuestionTreeView.TVSelected=0 then exit;
if MessageBoxA(0,pchar('Вы действительно хотите удалить - '+QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]),'Внимание!!!',MB_OKCAN CEL+MB_ICONQUESTION)=IDCANCEL then exit;
ResultQ:=ResultQ-1;
QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
index:=QuestionTreeView.TVSelected;
QuestionList.Delete(index);
ResultView.Clear;
if QuestionTreeView.TVRoot=0 then exit;
QuestionTreeViewSelChange(Sender);
end;
3:begin {Save}
Save(Sender);
end;
5:Applet.Close;{Exit}
end;{case}
end;
Begin
form:=NewForm(form,'тест').SetClientSize( 396,255 ).SetPosition( 367, 248 );
form.Style := Form.Style and not (WS_MAXIMIZEBOX);
form.Font.FontName := 'MS Sans Serif';
form.Font.FontCharset := 0;
Toolbar1 := NewToolbar( form, caTop, [], LoadMappedBitmapEx(Toolbar1, hInstance, 'FORM1_TBBMP5002', [ clFuchsia, Color2RGB( clBtnFace ) ] ), [ 'open', 'add', 'del', 'save', '-', 'exit' ], [ 0, 1, 2, 3, -2, 4 ] ).SetAlign ( caTop );
QuestionTreeView := NewTreeView( form, [tvoLinesRoot], nil, nil ).SetPosition(2, 34 ).SetSize( 150,246);{.SetAlign ( caLeft )}
QuestionTreeView.Color := TColor(clWindow);
SendMessage(QuestionTreeView.Handle,TVM_SETTEXTCOLOR,0,LParam(clblue));
ResultView := NewListView( form, lvsDetail, [lvoGridLines ,lvonoscroll],nil, nil, nil ).SetPosition(154, 34 ).SetSize( 248,246 );
ResultView.LVColAdd( 'Вариант ответа', taLeft, 120);
ResultView.LVColAdd( 'Верно?', taLeft,60);
SendMessage(QuestionTreeView.Handle,lVM_SETTEXTCOLOR,0,LParam(clblue));
//область для работы
QuestionTreeView.OnSelChange:=TonEvent(MakeMethod(nil,@QuestionTreeViewSelChange ));
Toolbar1.OnTBClick:=TonEvent(MakeMethod(nil,@DoWorkToolBar1));
form.OnShow:=TOnevent(MakeMethod(nil,@FormShow));
form.OnDestroy:=TOnevent(MakeMethod(nil,@FormDestroy));
Run(form);
end.

<Цитата>
Vladimir Kladov © (29.12.09 19:11) [3]

QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );

- удалили текущий

index:=QuestionTreeView.TVSelected;

- взяли новый текущий? нет, взяли число, равное хэндлу нового текущего.

QuestionList.Delete(index);

- из списка QuestionList пытаетесь удалить строку со случайным индексом. Скорее всего, индекс за пределами границ, команда игнорируется.

...

<Цитата>
Vladimir Kladov © (29.12.09 19:27) [4]

Подсказка, наверное, нужна. Для привязки индекса в списке QuestionList к узлу дерева используйте treeview1.TVItemData[tree_tem] := Pointer( index_in_list ); для получения index_in_list := treeview1.TVItemData[tree_item]; где tree_item = , например, treeview1.TVSelected .

<Цитата>
RusSun © (30.12.09 16:14) [5]

Добрый вечер, С Наступающим Новым годом!
2Vladimir Kladov Спасибо за подсказку.

Выкладываю то, что смог и что не выходит.
Наверно не успею доделать в этом году и пойду на каникулы:).
Изменения:

Var
…
mi: array[0..2000000] of byte; //массив хендлы\индексы
…
procedure FormShow(DummySelf,Sender: PControl);
begin
QuestionList:= NewList;
k:=0;//обнуляю k
end;
…
//в добавлении запоминаю хендлы\индексы
procedure Add(Sender:PControl);
…
NewQuest.Name:='в '+int2str(k);
NewQuest.ResultCount:=k;
ResultQ:=ResultQ+1; k:=k+1;
…
with QuestionTreeView^ do begin
j:=TVInsert( 0,0,NewQuest.Name); mi[j]:=k;
…
//в загрузке запоминаю хендлы\индексы
with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name); k:=k+1;
TVItemData[j]:=NewQuest; mi[j]:=k;

…
procedure newmassiv;//наметка на упорядычивание индексов
//после удаления элта
//var hnd:Thandle;
var f:integer;
begin
for f:=0 to QuestionList.count-1 do
//mi[QuestionTreeView.TVItemParent[hnd]]:=j;
showmessage(int2str(f));
end;

…
begin {Del}// удаление
if QuestionTreeView.TVSelected=0 then exit;
if MessageBoxA(0,pchar('Вы действительно хотите удалить - '+QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]),'Внимание!!!',MB_OKCAN CEL+MB_ICONQUESTION)=IDCANCEL then exit;
ResultQ:=ResultQ-1;
QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
index:=QuestionTreeView.TVSelected; showmessage('текущий элт - '+int2str(index)+' '+QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]);
QuestionList.Delete(mi[index]);// QuestionList.Delete(2); <= здесь ошибка
showmessage('удаляем - '+int2str(mi[index]));k:=k-1;
newmassiv;
ResultView.Clear;
if QuestionTreeView.TVRoot=0 then exit;
QuestionTreeViewSelChange(Sender);
end;
…

Происходит следующие
Если загружаю ранее сохранённое и удаляю с конца, то
Всё нормально. Сохраняю и загружаю для проверки.

Если удаляю не последний элемент

index:=QuestionTreeView.TVSelected; showmessage('текущий элт - '+int2str(index)+' '+QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]);

То TVSelected не меняется и удаляется последний элемент.

Не знаю это глюк?? или так задумано???

<Цитата>
RusSun © (03.02.10 21:46) [6]

Доброе время суток, уважаемые мастера.
вариант с массивом просто тренировка.

> Подсказка, наверное, нужна. Для привязки индекса в списке
> QuestionList к узлу дерева используйте treeview1.TVItemData[tree_tem]
> := Pointer( index_in_list ); для получения index_in_list
> := treeview1.TVItemData[tree_item]; где tree_item = , например,
> treeview1.TVSelected .

Не получается вот из-за этих строк:

with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name); k:=k+1;
TVItemData[j]:=NewQuest;

Задавая вопрос на форуме хотел наити наилучшее решение.
Но пока его нет,если нет удаления, то нет и редактирования.:(

как сделать? пример, если не трудно.

<Цитата>
MTsv DN (04.02.10 00:22) [7]

А если:
TVItemData[j]:=Pointer(NewQuest);

А в оборатку:
NewQuest := PQuestion(TVItemData);

<Цитата>
RusSun © (05.02.10 19:37) [8]

Доброе время суток. Вообщем не выходит.:(

В проекте ещё много не доделок.
код по ссылке http://narod.ru/disk/17619123000/%D0%A0%D0%B5%D0%B4%D0%B0%D0%BA%D1%82%D0%BE%D1%80%2B%D1%82%D0%B5%D1%81%D1%82%D0%B5%D1%80%2B%D1%82%D0%B5%D1%81%D1%82.rar.html

в архиве редктор,тестер и два теста.

в первом тесте 3 вопроса.
пытаюсь удалить 2-ой вопрос, сохраняю.
открываю посмотреть удалился 1-ый:(

и редактирование?

<Цитата>
MTsv DN (08.02.10 17:43) [9]

2 RusSun
1. Я извиняюсь, может очень грубо выражусь. И чё делать с проектом??? Куда смотреть, че тыкать?

2. Сразу на вскидку в Вашем коде:
mi: array[0..2000000] of byte; //массив хендлы\индексы
...
QuestionList.Delete(mi[index]);// QuestionList.Delete(2); <= здесь ошибка

не думаете, что byte - это маловато для хендлов?

3. Ну и наконец (код тот же):

mi: array[0..2000000] of THandle;
...
QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
index:=QuestionTreeView.TVSelected;
showmessage('текущий элт - '+int2str(index) + QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]);
QuestionList.Delete(mi[index]);// QuestionList.Delete(2); <= здесь ошибка

Естесссна ошибка. У Вас index = TVSelected, и Вы по такому индексу ищете в массиве.

Если я правильно задумку понял, то должно быть так (вариант не оптимизированный, а просто понятный):

mi: array[0..2000000] of THandle;
i : integer;
...
QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
index:=QuestionTreeView.TVSelected;
showmessage('текущий элт - '+int2str(index) + QuestionTreeView.TVItemText[QuestionTreeView.TVSelected]);
for i := 0 to 2000000 do
if mi[i] = index then QuestionList.Delete(i);// QuestionList.Delete(2); <= здесь ошибка

З.Ы. Вглубь кода не лез, ни о какой оптимизации ни по скорости ни по размеру речи не идет... Вариантов решения задачи, навскидку уйма...например, как уже говорили, через TVData, через указатели, использование LV вместо TV (т.к. необходимости в TV не вижу) и прочее...

<Цитата>
MTsv DN (08.02.10 17:46) [10]

Кстати, а на кой Вам 2000000 элементов? Или Вы под хендлы размер подгоняли, так THandle = 2^32 если мне склероз не изменяет. Лучше пересмотрите свой алгоритм, мне кажется Вы сами запутались уже...

<Цитата>
RusSun © (08.02.10 20:44) [11]

Доброе время суток.

Прошу прощения, что пришлось отнять ваше время.

Вариант с массивом не рассматривался уже тогда. Нужен был только для
наглядности с byte всё верно маловато, намудрил вот и мучаюсь.

''Кстати, а на кой Вам 2000000 элементов? Или Вы под хендлы размер подгоняли,.."
Эт.. новогодние причуды от нечего делать. Не на трезвую голову.

Вот пробую вот так:

QuestionList.Add(NewQuest);

//Создаю новый элемент в дереве
with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name);
TVItemData[j]:=Pointer(NewQuest);

Дальше не соображу как
Должно быть что-то на подобе

H := Pointer(...)
Integer(@H)

Каким должен быть в моём случае?
удаление:

index:=QuestionTreeView.TVSelected;//число, равное хэндлу нового текущего.

QuestionList.Delete( integer(...@...));//из списка QuestionList пытаетесь удалить //строку

<Цитата>
RusSun © (08.02.10 20:45) [12]

Доброе время суток.

Прошу прощения, что пришлось отнять ваше время.

Вариант с массивом не рассматривался уже тогда. Нужен был только для
наглядности с byte всё верно маловато, намудрил вот и мучаюсь.

''Кстати, а на кой Вам 2000000 элементов? Или Вы под хендлы размер подгоняли,.."
Эт.. новогодние причуды от нечего делать. Не на трезвую голову.

Вот пробую вот так:

QuestionList.Add(NewQuest);

//Создаю новый элемент в дереве
with QuestionTreeView^ do begin
j:=TVInsert( 0, 0,NewQuest.Name);
TVItemData[j]:=Pointer(NewQuest);

Дальше не соображу как
Должно быть что-то на подобе

H := Pointer(...)
Integer(@H)

Каким должен быть в моём случае?
удаление:

index:=QuestionTreeView.TVSelected;//число, равное хэндлу нового текущего.

QuestionList.Delete( integer(...@...));//из списка QuestionList пытаетесь удалить //строку

<Цитата>
Дмитрий К © (08.02.10 21:36) [13]

В TVItemData хранить нужно не указатель на объект, а индекс указателя в списке, как подсказывал Владимир в [4]. Тогда удаление из списка может выглядеть следующим образом:
QuestionList.Delete(Integer(TV.TVItemData[TV.TVSelected]));

<Цитата>
MTsv DN (08.02.10 21:49) [14]

Т.е.:
QuestionList.Add(NewQuest);

with QuestionTreeView^ do
begin
j := TVInsert( 0, 0, NewQuest.Name);
TVItemData[j] := Pointer(QuestionList.Count - 1); // Коль уж Вы Add используете
Font.FontStyle := [fsUnderline];
end;
end;

А удаление, так как написал Дмитрий К

<Цитата>
RusSun © (09.02.10 16:14) [15]

Делаю следующее:

with QuestionTreeView^ do
begin
j := TVInsert( 0, 0, NewQuest.Name);
TVItemData[j] := Pointer(QuestionList.Count - 1); // Коль уж Вы Add используете
Font.FontStyle := [fsUnderline];
end;
end;

Дальше делаю так:

index:=QuestionTreeView.TVSelected;
QuestionList.Delete( integer(QuestionTreeView.TVItemData[index]));

Компилится.
Пытаюсь создасть новый тест
перехожу к добавлению вопроса
хоп Компилятор ругается на строку

for i:=0 to PQuestion(QuestionTreeView.TVItemData[index]).ResultCount-1 do

и пишет Debugger fault Notification
идёт ошибка 'access violation' Как быть?

<Цитата>
Дмитрий К © (09.02.10 16:23) [16]

for i := 0 to PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resul tCount - 1 do

<Цитата>
RusSun © (10.02.10 16:24) [17]

делаю замену
for i := 0...

и где надо соответсвенно:
for i := 0 to PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resul tCount - 1 do begin
if PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resil tValue[i]=true then begin
ResultView.LVItemAdd(PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVIte mData[index])])).ResiltText[i]);

ругается на строку
ResultView.LVItemAdd(PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVIte mData[index])])).ResiltText[i]);

Компилятор пишет
[Error] Project1.dpr(234): Incompatible types: 'String' and 'PQuestion'

<Цитата>
RusSun © (10.02.10 20:08) [18]

Прошу прощения, то моё упущение.
поправился.)
for i := 0 to PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resul tCount - 1 do begin
if PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resil tValue[i]=true then begin
ResultView.LVItemAdd(PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVIte mData[index])]).ResiltText[i]);

Но если попытаться удалить вопрос, то возникает
Debugger fault Notification
идёт ошибка 'access violation'.:(
жалуется туда же:
for i := 0 to PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resul tCount - 1 do

тоже самое если сохранить и попытаться загрузить тест.

<Цитата>
RusSun © (16.02.10 05:41) [19]

Доброе время суток.

> QuestionList.Add(NewQuest);
>
> with QuestionTreeView^ do
> begin
> j := TVInsert( 0, 0, NewQuest.Name);
> TVItemData[j] := Pointer(QuestionList.Count - 1); // Коль
> уж Вы Add используете
> Font.FontStyle := [fsUnderline];
> end;
> end;

вариант
TVItemData[j] := Pointer(QuestionList.Count - 1);

// Коль уж Вы Add используете
не очень удачный так как вконечном итоге ссылается на
окно создания нового теста, которое после не вызывается
отсюда 'access violation'.
Есть ли другие рабочие варианты? С тем же
NewQuest := PQuestion(TVItemData);

Может и лучше.
Зарание Спасибо.

<Цитата>
RusSun © (21.02.10 21:30) [20]

Доброе время суток, уважаемые мастера.

Всё закончил.
в удалении есть один нюанс его в моем
случае сначала нужно делать в List'e и
потом уже в TV;)
Благодарности :)
2MTsv DN Зато что натолкнул на вариант, который меня устраивает.

2Дмитрий К пользуясь его советом по TreeView
из темы http://pda.delphimaster.net/?id=1242650049&n=10
доделал.

2Vladimir Kladov
Как зачинщику KOL за совет.

последний вопрос в этой теме:
вот на рисунке ListView
http://narod.ru/disk/18129387000/%D0%B2%20%D0%BA%D0%BE%D0%BB%20ResultView.JPG.html
у него колонка в кол не продолжается.
Как это поправить?

<Цитата>
RusSun © (23.02.10 09:06) [21]

Доброе время суток;)

Вообщем виновник найден.
это опция {,lvonoscroll} без неё всё становится нормальным.
ResultView := NewListView( QRez, lvsDetail, [lvoGridLines {,lvonoscroll}], ImageList3, nil, nil ).SetAlign(caClient);

Тема закрыта.

<Цитата>