/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 515
от 27.06.2006, 14:05

Вопрос № 46.947

Здраствуйте! Определена переменная типа record ! Как из этой переменной по смещению (offset) и размеру данных вытащить данные?! Есть код на C++ в приложении! Приложение: HCALL hCall; LPLINECALLINFO pLineCallInfo; LPSTR pPhoneNumber; DWORD dwSize, i; LONG r; . . . (здесь должно быть какое-нибудь получение hCall) dwSize = sizeof(LINECALLINFO); pLineCallInfo = (LPLINECALLINFO)GlobalAlloc(GPTR, dwSize); if(!pLineCallInfo) { . . . (грязная ругань) } pLineCallInfo->dwTotalSize = dwSize; r = lineGetCallInfo(hCall, pLineCallInfo); if( r!=0 && r!=LINEERR_STRUCTURETOOSMALL) { . . . (см. выше) } dwSize = pLineCallInfo->dwNeededSize; GlobalFree(pLineCallInfo); pLineCallInfo = (LPLINECALLINFO)GlobalAlloc(GPTR, dwSize); if(!pLineCallInfo) { . . . } pLineCallInfo->dwTotalSize = dwSize; r = lineGetCallInfo(hCall, pLineCallInfo); if(r) { . . . } if(pLineCallInfo->dwCallerIDFlags & LINECALLPARTYID_UNAVAIL) { . . . (при таком раскладе CallerID вообще недоступен) } else if(pLineCallInfo->dwCallerIDFlags & LINECALLPARTYID_UNKNOWN) { . . . (CallerID еще не получен, но есть надежда... ) } else if(pLineCallInfo->dwCallerIDFlags & LINECALLPARTYID_ADDRESS) { // здесь есть CallerID. По вкусу можно проверить // флаг LINECALLPARTYID_PARTIAL, говорящий о том, // что данные о номере неполные pPhoneNumber = (LPSTR)GlobalAlloc(GPTR, pLineCallInfo->dwCallerIDSize+1); if(!pPhoneNumber) { . . . } for(i=0;i<pLineCallInfo->dwCallerIDSize;i++) { pPhoneNumber[i] = *(LPSTR)(((DWORD)pLineCallInfo)+ pLineCallInfo->dwCallerIDOffset+i); } pPhoneNumber[i]=0; } else { . . . // всякие варианты типа BLOCKED и т.п. } . .

Отправлен: 21.06.2006, 16:56 Вопрос задал: chikanok (статус: 2-ой класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: mvp Здравствуйте, chikanok! Ваш код не смотрел, поэтому приведу свой пример - думаю разберётесь. Только есть одна проблема в компиляторе: Projects->Options->Compiler->Record Field Aligment - нужно выбрать 1, т. к. иначе элементы записи будут прилегать не плотно друг к другу и вам придётя ещё числа подбирать. Итак, x : record i : integer; v : byte; x : real end; где-то они определены, например: x.i := 1; x.v := 3; x.x := 4.5; т. к. мы знаем тип элементов записи (ведь знаем, судя по постановке вопроса?), то определим указатели на этот тип i1 = ^integer; v1 = ^byte; x1 = ^real; теперь вот как организовать доступ и показать элементы записи (см. приложение). P. S. Смещения зависят от указанной опции компилятора. P. P. S. Может есть решение попроще, но что-то за полчаса проще не нашёл :( Приложение: var a : pchar; begin a := @x; showmessage(intTOStr(i1(a)^)); inc(a, sizeof(integer)); showmessage(intTOStr(v1(a)^)); inc(a, sizeof(byte)); showmessage(FloatTOstr(x1(a)^)) end; --------- Моя совесть чиста - не бывшая в употреблении

Ответ отправил: mvp (статус: Студент) Ответ отправлен: 21.06.2006, 17:57

Отвечает: Татьяна Здравствуйте, chikanok! В принципе самое простое, это создать структуру record или packed record с идентичными полями (главное чтобы порядок полей и их размеры совпадали) После чего создать указатель на структуру и работать с этим куском памяти. Чтобы ничего не повредить, есть хорошая функция CopyMemory (описание в приложении) Она копирует необходимый кусок памяти по адресу sourse В принципе с помощью нее вы сможете как скопировать всю структуру, так и определенные поля, если известно смещение Приложение: The CopyMemory function copies a block of memory from one location to another. VOID CopyMemory ( PVOID Destination, // address of copy destination CONST VOID *Source, // address of block to copy DWORD Length // size, in bytes, of block to copy ); Parameters Destination Points to the starting address of the copied block's destination. Source Points to the starting address of the block of memory to copy. Length Specifies the size, in bytes, of the block of memory to copy. Return Values This function has no return value. Remarks If the source and destination blocks overlap, the results are undefined. For overlapped blocks, use the MoveMemory function. --------- Возможно все. И ничего возможно тоже.

Ответ отправила: Татьяна (статус: Студент) Ответ отправлен: 21.06.2006, 19:35

Вопрос № 46.978

Добрый вечер. Столкнулся с интересной задачей, не могу решить. Кинул на форму Edit1, ListBox, и кнопку "Сохранить" Принцип какой. Записываю название в Edit1, скажем "Задача" Нажимаю кнопку "Сохранить". открывается файл text.ini, происходит сохранение в таком виде: <begin name="Задача"> // т.е. подставляется слово из Edit1 Все строчки с ListBox </end> пробел Файл может быть не пустой, и содержать подобный текст, но естественно с другими параметрами. С Уважением, Максим

Отправлен: 21.06.2006, 20:10 Вопрос задал: Maximus (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Shady Здравствуйте, Maximus! Вам не ini файл нужен, а xml или база данных. Это будет и удобнее и проще в реализации. В Delphi есть такой замечательный компонент XmlDocument, позволяющий работать с xml. Если заинтересует - могу помочь примерами. Если конечно я правильно понял суть вашего вопроса. По xml материала очень много. Куча материала в любом поисковике.

Ответ отправил: Shady (статус: 4-ый класс) Ответ отправлен: 21.06.2006, 21:53

Отвечает: Bochvarov NikB Здравствуйте, Maximus! OnClick: ListBox.Items.Insert(0,'<begin name="+Edit1.Text+'">'; ListBox.Items.Add('</end>'; ListBox.Items.SaveToFile(extractfilepath(application.exename)+'text.ini);

Ответ отправил: Bochvarov NikB (статус: 9-ый класс) Ответ отправлен: 21.06.2006, 22:08 Оценка за ответ: 4 Комментарий оценки: Почти то что нужно, немного подправлю. Спасибо

Отвечает: Евгения Здравствуйте, Maximus! procedure TForm1.Button1Click(Sender: TObject); var i: integer; f: textfile; begin assignfile(f,'text.ini'); rewrite(f); writeln(f,'<begin name='+ Edit1.Text +'>'); for i:=0 to ListBox1.Count-1 do writeln(f,ListBox1.Items[i]); writeln(f,'</end>'); writeln(f); closefile(f); end; Счастливо! --------- Я не волшебник, я только учусь... А разве кто-то обещал, что будет легко?

Ответ отправила: Евгения (статус: 7-ой класс) Ответ отправлен: 21.06.2006, 22:56

Вопрос № 46.991

Уважаемые Експерты. Покажите как правильно в листбоксе перемещать элементы списка. Если можно чтоб перемещая на одном елемент, перемещапся и на втором. Знаю что: procedure Exchange(Indexl, Index2: Integer); procedure Move(CurIndex, Newlndex: Integer) ; Если не ошибаюсь. Заранее большущее С П А С И Б О.

Отправлен: 22.06.2006, 02:46 Вопрос задал: Venom56r (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: mvp Здравствуйте, Venom56r! Непонятно, что имелось ввиду под "перемещался и на втором". См. приложение Приложение: procedure Exchange(lb : TListBox; Index1, Index2: Integer); var _ : String; begin if not((index1 < 0) or (index1 >= lb.count) or (index2 = index1) or (index2 < 0) or (index2 >= lb.count)) then begin _ := lb.items[index1]; lb.items[index1] := lb.items[index2]; lb.items[index2] := _ end end; procedure Move(lb : TListBox; CurIndex, Newlndex: Integer); var _: integer; begin if not((CurIndex < 0) or (CurIndex >= lb.count) or (Newindex = CurIndex) or (NewIndex < 0) or (NewIndex >= lb.count)) then begin _:= CurIndex; while _<> NewIndex do if _< NewIndex do begin Exchange(lb, _, _+ 1); inc(_) end else begin Exchange(lb, _, _- 1); dec(_) end end end; --------- Моя совесть чиста - не бывшая в употреблении

Ответ отправил: mvp (статус: Студент) Ответ отправлен: 22.06.2006, 03:17

Отвечает: Shady Здравствуйте, Venom56r! Не совсем понятен Ваш вопрос. Если вы хотите при изменении содержания одного listbox, чтобы содержание второго было таким же, не проще ли сделать так: listbox1.items:=listbox2.items; А если вы хотите, чтобы выделенные строки тоже передавались используйте свойство selected.

Ответ отправил: Shady (статус: 4-ый класс) Ответ отправлен: 22.06.2006, 12:13

Вопрос № 46.996

Здравствуйте, уваажемые эксперты! Подскажите, пожалуйста, как проверить, является ли строка правильной строкой вида '#444#123#456#444#544'. Т.е. начинается с символа решетки, потом идут три любые цифры, потом снова решетка, потом еще три цифры, потом снова решетка. Я не дам юзеру вводить буквы, поэтому не следует проверять, являются ли символы между решетками цифрами. Т.е. мне нужно чтобы первым символом, а затем и каждым четвертым была решетка, чтобы не пропустить, например, строки '#4444#445' , '#214##'. Заранее благодарен!

Отправлен: 22.06.2006, 05:27 Вопрос задал: Андрющенко Вячеслав Васильевич (статус: 1-ый класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Ерёмин Андрей Здравствуйте, Андрющенко Вячеслав Васильевич! Немного непонятна задча. Сначала между решётками было 3 символа, а потом уже 4. Впрочем, здесь сами разберётесь, как вам лучше. В случае с 3-мя символами просто замените цифру 6 в функции на 5. Функция возвращает True, если строка удовлетворяет данному условию. Сама функция в приложении. Приложение: function CheckLattice(str: String): Boolean; var i: Integer; begin result:=true; for i:=1 to length(str) do if (i mod 6 = 0) or (i = 1) then if (str[i] <> '#') then result:=false; end; --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессор) Россия, Тула WWW: Программирование на DELPHI: Всё для программиста. ICQ: 286837644 ---- Ответ отправлен: 22.06.2006, 07:49

Отвечает: Gh0stik Здравствуйте, Андрющенко Вячеслав Васильевич! Вот я предлагаю немного другую функцию (обращаю Ваше внимание это не переделанная функция Ерёмина Андрея - а лично написанная): function proverka(x:string; dl:integer):boolean; var i:integer; begin proverka:=true; for i:=1 to length(x) do begin if (i mod dl=1) and (x[i]='#') then if pos('#',copy(x,i+1,dl-1))<>0 then begin proverka:=false; break; end; end; end; Пример использования: procedure TForm1.Button1Click(Sender: TObject); var s:string; begin s:='#4435#1333#4356#3444#5444'; ShowMessage(BoolToStr(proverka(s,5),true)); end; Обращаю Ваше внимание на то что в функции вторым параметром выступает число - длина последовательности (#4435 - длина=5; #443 - длина=4). Удачи!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Студент) Ответ отправлен: 22.06.2006, 10:46 Оценка за ответ: 5

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Андрющенко Вячеслав Васильевич! По-моему, все предложенные вам варианты жирны по коду и неоптимальны по быстродействию. Вы можете выполнять некоторе операции умножения/деления на более быстрые их эквиваленты - побитовые операции l mod 4 - l and 3 l div 4 - l shr 2 i * 4 - i shl 2 А зачем перебирать все буквы в строке, если проверять надо только каждую 4-ую, я что-то не понимаю. А даже если и в общем случае - замените все цифры 4 в коде на z и добавьте ф-ии параметр z:integer; Приложение: function CheckLattice(str: String): Boolean; var i, l: integer; begin result := true; l := length(str); if (l mod 4 = 0) then // если длина строки не делится на 4, то строка точно "неправильная" for i := 1 to (l div 4) do result := result and (str[i * 4] <> '#') else result := false; end;

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Студент) Ответ отправлен: 22.06.2006, 12:28 Оценка за ответ: 5

Отвечает: METALLDOCTOR Здравствуйте, Андрющенко Вячеслав Васильевич! Я делал подобное, только у меня начинается с цифры и между блоками цифр - пробелы, но принцип тот же. см. прил. По идее при неправильном наборе вернётся хальт с номером символа, не соответствующего маске. Приложение: AssignFile(F, 'txt.txt'); ReSet(F); ReadLn(F, Str); CloseFile(F); FOR I := 1 TO 8 DO IF ( Str[ I * 10 ] <> ' ' ) THEN Halt( I * 10 ); FOR I := 0 TO 8 DO FOR J := 1 TO 9 DO IF ( NOT ( Str[ I * 10 + J ] IN [#48..#57] ) ) THEN Halt( I * 10 + J ); --------- Ни о чём не жалею!

Ответ отправил: METALLDOCTOR (статус: 3-ий класс) Ответ отправлен: 23.06.2006, 12:07

Вопрос № 47.019

Извиняюсь, к вопросу 47018 процедуры-то забыл написать! :) Приложение: procedure TMainForm.FileListLCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); begin if (FileListL.Items.Item[0].Caption <> '') then begin if (AnsiLowerCase(Item.SubItems[0]) = '.exe') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clGreen; end; if (AnsiLowerCase(Item.SubItems[0]) = '.zip') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.rar') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.cab') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.txt') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clBlue; end; end; end; procedure TMainForm.FileListLCustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); begin if (FileListL.Items.Item[0].Caption <> '') then begin if (AnsiLowerCase(Item.SubItems[0]) = '.exe') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clGreen; end; if (AnsiLowerCase(Item.SubItems[0]) = '.zip') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.rar') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.cab') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.txt') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clBlue; end; end; end; procedure TMainForm.FileListRCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); begin if (FileListR.Items.Item[0].Caption <> '') then begin if (AnsiLowerCase(Item.SubItems[0]) = '.exe') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clGreen; end; if (AnsiLowerCase(Item.SubItems[0]) = '.zip') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.rar') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.cab') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.txt') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clBlue; end; end; end; procedure TMainForm.FileListRCustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); begin if (FileListR.Items.Item[0].Caption <> '') then begin if (AnsiLowerCase(Item.SubItems[0]) = '.exe') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clGreen; end; if (AnsiLowerCase(Item.SubItems[0]) = '.zip') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.rar') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.cab') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.txt') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clBlue; end; end; end;

Отправлен: 22.06.2006, 09:56 Вопрос задал: Савенко Вадим Иванович (статус: 2-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Melamed Здравствуйте, Савенко Вадим Иванович! Если я правелно понял Ваш код, то я заменил бы 4 метода одним следующим: Приложение: procedure TMainForm.FileListLCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); begin if (Sender.Items.Item[0].Caption <> '') then begin if (AnsiLowerCase(Item.SubItems[0]) = '.exe') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clGreen; end; if (AnsiLowerCase(Item.SubItems[0]) = '.zip') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.rar') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.cab') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clRed; end; if (AnsiLowerCase(Item.SubItems[0]) = '.txt') then begin Sender.Canvas.Font.Style := [fsBold]; Sender.Canvas.Font.Color := clBlue; end; end;

Ответ отправил: Melamed (статус: 1-ый класс) Ответ отправлен: 22.06.2006, 12:34 Оценка за ответ: 5 Комментарий оценки: Вот эта строчка помогла if (Sender.Items.Item[0].Caption <> '') then begin

© 2001-2006, Портал RusFAQ.ru, Россия, Москва. Идея, дизайн, программирование: Калашников О.А. Email: adm@rusfaq.ru, Тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале Версия системы: 4.34 от 01.06.2006