| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Не соответствие индексов. [Delphi, Windows]
RusSun © (2009-12-25 22:23:00)Добрый день, уважаемые мастера.
Что есть: 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… .
Вопрос как с этим бороться? Может кому-то попадалось что-то подобное? Если будет небольшой пример, буду очень рад.
RusSun (2010-02-23 09:06:00) [1]Доброе время суток;)
Вообщем виновник найден.
это опция {,lvonoscroll} без неё всё становится нормальным.
ResultView := NewListView( QRez, lvsDetail, [lvoGridLines {,lvonoscroll}], ImageList3, nil, nil ).SetAlign(caClient);
Тема закрыта.
RusSun (2010-02-21 21:30:00) [2]Доброе время суток, уважаемые мастера.
Всё закончил.
в удалении есть один нюанс его в моем
случае сначала нужно делать в List'e и
потом уже в TV;)
Благодарности :)
2MTsv DN Зато что натолкнул на вариант, который меня устраивает.
2Дмитрий К пользуясь его советом по TreeView
из темы http://www.delphimaster.ru/cgi-bin/forum.pl?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 (2010-02-16 05:41:00) [3]Доброе время суток.
> 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 (2010-02-10 20:08:00) [4]Прошу прощения, то моё упущение.
поправился.)
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 (2010-02-10 16:24:00) [5]делаю замену
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'
Дмитрий К (2010-02-09 16:23:00) [6]
for i := 0 to PQuestion(QuestionList.Items[Integer(QuestionTreeView.TVItemData[index])]).Resul tCount - 1 do
RusSun (2010-02-09 16:14:00) [7]Делаю следующее:
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' Как быть?
MTsv DN (2010-02-08 21:49:00) [8]Т.е.:
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;
А удаление, так как написал Дмитрий К
Дмитрий К (2010-02-08 21:36:00) [9]В TVItemData хранить нужно не указатель на объект, а индекс указателя в списке, как подсказывал Владимир в [4]. Тогда удаление из списка может выглядеть следующим образом:
QuestionList.Delete(Integer(TV.TVItemData[TV.TVSelected]));
RusSun (2010-02-08 20:45:00) [10]Доброе время суток.
Прошу прощения, что пришлось отнять ваше время.
Вариант с массивом не рассматривался уже тогда. Нужен был только для
наглядности с 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 (2010-02-08 20:44:00) [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 пытаетесь удалить //строку
MTsv DN (2010-02-08 17:46:00) [12]Кстати, а на кой Вам 2000000 элементов? Или Вы под хендлы размер подгоняли, так THandle = 2^32 если мне склероз не изменяет. Лучше пересмотрите свой алгоритм, мне кажется Вы сами запутались уже...
MTsv DN (2010-02-08 17:43:00) [13]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 не вижу) и прочее...
RusSun (2010-02-05 19:37:00) [14]Доброе время суток. Вообщем не выходит.:(
В проекте ещё много не доделок.
код по ссылке 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 (2010-02-04 00:22:00) [15]А если:
TVItemData[j]:=Pointer(NewQuest);
А в оборатку:
NewQuest := PQuestion(TVItemData);
RusSun (2010-02-03 21:46:00) [16]Доброе время суток, уважаемые мастера.
вариант с массивом просто тренировка.
> Подсказка, наверное, нужна. Для привязки индекса в списке
> 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;
Задавая вопрос на форуме хотел наити наилучшее решение.
Но пока его нет,если нет удаления, то нет и редактирования.:(
как сделать? пример, если не трудно.
RusSun (2009-12-30 16:14:00) [17]Добрый вечер, С Наступающим Новым годом!
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 не меняется и удаляется последний элемент.
Не знаю это глюк?? или так задумано???
Vladimir Kladov (2009-12-29 19:27:00) [18]Подсказка, наверное, нужна. Для привязки индекса в списке QuestionList к узлу дерева используйте treeview1.TVItemData[tree_tem] := Pointer( index_in_list ); для получения index_in_list := treeview1.TVItemData[tree_item]; где tree_item = , например, treeview1.TVSelected .
Vladimir Kladov (2009-12-29 19:11:00) [19]
QuestionTreeView.TVDelete(QuestionTreeView.TVSelected );
- удалили текущий
index:=QuestionTreeView.TVSelected;
- взяли новый текущий? нет, взяли число, равное хэндлу нового текущего.
QuestionList.Delete(index);
- из списка QuestionList пытаетесь удалить строку со случайным индексом. Скорее всего, индекс за пределами границ, команда игнорируется.
...
RusSun (2009-12-28 19:23:00) [20]Добрый вечер. Хорошо пусть хедлы.
"Роза пахнет розой,
хоть розой назови
хоть нет"
вот код :
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.
| |
Страницы: 