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

Выпуск № 529
от 11.07.2006, 21:05

Вопрос № 48.281

Добрый вечер, уважаемые! Помогите разобраться вот в каком вопросе: если эти функции находятся непосредственно в модуле, то все они работают. Но если их поместить в DLL, то GetProcessors и GetBIOSDate вызывают ошибку, а GetProcessorID работает нормально и там, и там. Подскажите что не так... :( Приложение: {---------------------------------------------------------------} { количество процессоров } {---------------------------------------------------------------} function GetProcessors: byte; export; stdcall; var Reg: TRegistry; RegPath: string; N: byte; begin Result:= 0; Reg:= TRegistry.Create; for N:= 0 to High(byte) do begin Reg.rootkey:= HKEY_LOCAL_MACHINE; RegPath:= 'HARDWAREDESCRIPTIONSystemCentralProcessor' + IntToStr(N); if (Reg.Openkey(RegPath,false) = true) then Result:= Result + 1; end; Reg.Free; end; {----------------------------------------------------------------} { дата BIOS } {----------------------------------------------------------------} function GetBIOSDate: string; export; stdcall; var Reg: TRegistry; RegPath: string; begin RegPath := 'HARDWAREDESCRIPTIONSystem'; Reg:= TRegistry.Create; Reg.Rootkey:= HKEY_LOCAL_MACHINE; try Reg.Openkey(RegPath, true); Result:= Reg.ReadString('SystemBiosDate'); except end; Reg.Free; end; {---------------------------------------------------------------} { идентификатор процессора } {---------------------------------------------------------------} function GetProcessorID: string; export; stdcall; var Reg: TRegistry; RegPath: string; begin RegPath:= 'HARDWAREDESCRIPTIONSystemCentralProcessor Reg:= TRegistry.Create; Reg.Rootkey:= HKEY_LOCAL_MACHINE; try Reg.Openkey(RegPath,false); Result:= Reg.ReadString('Identifier'); except end; Reg.Free; end;

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

Отвечает: Решетник Д Здравствуйте, Савенко Вадим Иванович! По привденному коду вижу, что у Вас работает только GetProcessors. В интернете очень много статей относительно решения Вашей проблемы. суть такая: динамические структуры (включая строки) создаются в ДЛЛ-области памяти, поэтому доступа главной программы к ним нет. Выход из ситуации Вы и сами часто видели, используя функции АПИ - использование процедур с передачей указателей на переменные. procedure proc(var s: PChar); при этом за выделение и освобождение памяти должна следить часть кода, вызывающая такую процедуру. то есть Вам нужно в главном модуле выделить память - getmem...., вызвать процедуру из ДЛЛ, использовать данные и очистить память freemem. --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: Студент) Ответ отправлен: 05.07.2006, 22:29

Отвечает: Coupler Здравствуйте, Савенко Вадим Иванович! Что-то я ничего не понял насчет"не работают". Функции-то идентичны. Поэтому dll-ка собирается и работает как надо, так же, как и использующий ее проект.В приложении - код самой dll и проекта, думаю, посмотрите, разберетесь. Но, конечно, не забывайте про ответ эксперта Решетник Д. Приложение: library dllllll; uses SysUtils, Classes, Registry, Windows; {$R *.res} function GetProcessors: byte; export; stdcall; var Reg: TRegistry; RegPath: string; N: byte; begin Result := 0; Reg := TRegistry.Create; for N := 0 to High(byte) do begin Reg.rootkey := HKEY_LOCAL_MACHINE; RegPath := 'HARDWAREDESCRIPTIONSystemCentralProcessor' + IntToStr(N); if (Reg.Openkey(RegPath, false) = true) then Result := Result + 1; end; Reg.Free; end; function GetBIOSDate: string; export; stdcall; var Reg: TRegistry; RegPath: string; begin RegPath := 'HARDWAREDESCRIPTIONSystem'; Reg := TRegistry.Create; Reg.Rootkey := HKEY_LOCAL_MACHINE; try Reg.Openkey(RegPath, true); Result := Reg.ReadString('SystemBiosDate'); except end; Reg.Free; end; function GetProcessorID: string; export; stdcall; var Reg: TRegistry; RegPath: string; begin RegPath := 'HARDWAREDESCRIPTIONSystemCentralProcessor Reg := TRegistry.Create; Reg.Rootkey := HKEY_LOCAL_MACHINE; try Reg.Openkey(RegPath, false); Result := Reg.ReadString('Identifier'); except end; Reg.Free; end; exports GetProcessorID, GetBIOSDate, GetProcessors; begin end. unit test; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function GetProcessors: byte; stdcall external 'dllllll.dll'; function GetBIOSDate: string; stdcall external 'dllllll.dll'; function GetProcessorID: string; stdcall external 'dllllll.dll'; procedure TForm1.Button1Click(Sender: TObject); begin showmessage('Кол-во процев - ' + inttostr(GetProcessors) + ' Дата BIOS - ' + GetBIOSDate + ' ID проца - ' + GetProcessorID); end; end.

Ответ отправил: Coupler (статус: Студент) Ответ отправлен: 06.07.2006, 06:40

Вопрос № 48.297

Здравствуйте! Подскажите пожалуйста, нет ли у кого компонента для выделения части картинки? Чтоб выделив часть картинки, мы могли изменить размер выделения, или положение выделения? Пытался это реализовать через TImage, OnMouseMove, OnMouseUp, OnMouseDown, но ничего не выходит. Когда рисуешь на канве Имейджа, то прямоугодьник не выводиться на экран. Эсли после каждой перерисовки обновлять Имейдж, то получается сильное мерцание. Я думаю, что можно реализовать такой компонент. Не знаете ли Вы, может быть уже есть готовый компонент? Или пример кода?

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

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Xsid! Вам надо к стандартному TImage "добавить" 2 bitmap-а (bmpClear, bmpWRect) такого же размера, как и исходное изображение В одном (bmpClear) сохранить исходное изображение, а дальше производить рисование следующим образом: bmpWRect.Draw(bmpClear, 0, 0); bmpWRect.Rectangle(...); Image1.Draw(bmpWRect, 0, 0); Возможно, это поможет вам избавиться от мерцания. Всю обработку с изменением размера области выделения, я так понимаю, вы уже написали =)

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Студент) Ответ отправлен: 06.07.2006, 03:37

Отвечает: Решетник Д Здравствуйте, Xsid! Насколько я помню, есть несколько методов рисования на канве. один из них - исключающий (в название входит xor). при таком режиме при повторном отображении линии на старом месте (если два раза нарисовать линию на одном месте), она пропадает. попробуйте использовать это, чтобы избежать мерцание - при перерисовке отображайте прямоугольник сначала на старом месте, а потом на новом. удачи --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: Студент) Ответ отправлен: 06.07.2006, 09:02

Вопрос № 48.325

Здравствуйте! Помогите разобраться. Я в Delphi токо начинаю. Поставил длма Delphi 2006. Пытаюсь создать свой компонент. В меню Component выбираю новый. Далье как положено. В редакторе кода делаю что необходимо. Но не знаю как установить этот компонет. В Delphi 7 было в меню Component команда Install Component - а в Delphi 2006 нету такого пункта меню. Ведь както же можно устанавливать новый компонент или создавать и потом установить. Помогите разобраться. Зараннее спасибо

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

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, Vasiliy! Для этого нужно создать пакет (package), и в него подключить свежесозданный модуль, в котором компонент. Откомпилировать пакет, и в его контекстном меню (в project manager) есть команда Install

Ответ отправил: Лукьяненко Алексей Валериевич (статус: 4-ый класс) Ответ отправлен: 06.07.2006, 10:58 Оценка за ответ: 5 Комментарий оценки: Спасибо за быстрый ответ!

Вопрос № 48.330

В Delphi 2006есть компонет OpenTextFileDialog/SaveTextFileDialog (по памяти наберал). помогие пожалуйста реализовать этот компонент для Delphi 7. Нашол исходные коды его но всёравно ничего не получается.

Отправлен: 06.07.2006, 11:00 Вопрос задал: Vasiliy (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, Vasiliy! А в чем проблема? береш ExtDlgs.pas, ExtDlgs.res, копируеш к делфи 7, переименовываеш модуль (такой уже есть), грохаеш TOpenPictureDialog и TSavePictureDialog (они есть), пишеш процедуру Register для регистрации компонентов - и все будет работать

Ответ отправил: Лукьяненко Алексей Валериевич (статус: 4-ый класс) Ответ отправлен: 06.07.2006, 11:37 Оценка за ответ: 5

Вопрос № 48.333

Помогите разобраться: Delphi Media Player на одних компьютерах проигрывает видео файлы (AVI, MPEG), на других отказывается, выводит черный экран, хотя звук слышен. Возможно, это кодаки? Какие кодаки держит Delphi? Спасибо.

Отправлен: 06.07.2006, 11:45 Вопрос задал: Michael_1 (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Melamed Здравствуйте, Michael_1! Delphi не содержит ни каких кодеков. Чтобы проигровался нужный вам AVI файл нужно на компьтер поставить неободимый кодек. Для того, чтобы узнать, какой кодек необходим для просмотра того или инего файла, советую воспользоваться программой VideoInspector или подобной программой.

Ответ отправил: Melamed (статус: 2-ой класс) Ответ отправлен: 06.07.2006, 12:09

Отвечает: PheanixN Здравствуйте, Michael_1! Дело в том, что компонент Media Player в Delphi не имеет кодеков. Да и сам Delphi никогда их не содержал... Аналогию можно провести если использовать какой-то проигрыватель на другом компьютере без установленных кодеков. Компонент Media Player использует только те кодеки, что установлены в Вашей системе.

Ответ отправил: PheanixN (статус: 1-ый класс) Ответ отправлен: 06.07.2006, 12:17

Отвечает: Савенко Вадим Иванович Здравствуйте, Michael_1! Поищите программу K-Lite Codec Pack - она содержит большой набор разных кодеков.

Ответ отправил: Савенко Вадим Иванович (статус: 3-ий класс) Ответ отправлен: 06.07.2006, 19:09

Вопрос № 48.352

Приветствую! Вот и назрела у меня новая проблема, помогите если не трудно будет. Работаю ужо с локальной БД. Все отлично. Чтение данных, болб поля, отчеты. Ну тут стала необходимость простого редактирования данных. Пишу IbDataSet1.Edit; IbDataSet1.FieldByName('NAME').AsString:='Кирилл'; IbDataset1.Post; Name - имя поля. Запускаю, выделяю нужное поле, выполню код кликом буттона. Все вроде отлично. Обновляю таблицу и О Боже, все записи в моей таблице стали абсолютно одинковыми, т.е. сравнялись. Все вроде делаю по примера книги Мир InterBase. Добавил такой набор символов :) в RefreshSQl select N, FAMILY, NAME, OTCHESTVO, PHOTO from PEOPLE WHERE N=:N Результат нулевый.

Отправлен: 06.07.2006, 14:32 Вопрос задал: CJ (статус: Практикант) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Проходящий Мимо Здравствуйте, CJ! Что у Вас находится в UpdateSQL? UPDATE PEOPLE SET N=:N, FAMILY = :FAMILY, NAME = :NAME, OTCHESTVO = :OTCHESTVO, PHOTO = :PHOTO WHERE N = :OLD_N Последнее условие обязательно, если оно отсутствует, получим Ваш результат. --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 6-ой класс) Ответ отправлен: 06.07.2006, 15:15

Вопрос № 48.360

Здравствуйте! Как написать такой код,чтобы: в edit1 имеется комбинация цифр:123 12 1 0 3 нужно во второй эдит написать из 1-123 в третий-12 в четвертый-1 в пятый-0 тоесть в каждый едит записываются цифры,отделенные пробелом. Как это сделать?

Отправлен: 06.07.2006, 15:51 Вопрос задал: SA2006 (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Ерёмин Андрей Здравствуйте, SA2006! См. пример в приложении. Если содержимое Edit1 нужно сохранить при выполнении операции, то просто работайте не с ним, а с переменной, в которую заранее сохраните исходный текст. Единственное условие - компоненты Edit[n] (Edit2, Edit3, ...) должны существовать для кол-ва чисел, которые вводятся в Edit1, иначе может возникнуть ошибка. Приложение: procedure TForm1.Button1Click(Sender: TObject); Var N: Integer; Str: String; begin N:=2; While Pos(' ',Edit1.Text) > 0 Do Begin Str:=Copy(Edit1.Text,1,Pos(' ',Edit1.Text)-1); TEdit(FindComponent('Edit'+IntToStr(N))).Text:=Str; Edit1.Text:=Copy(Edit1.Text,Length(Str)+2,Length(Edit1.Text)); Str:=''; Inc(N); End; TEdit(FindComponent('Edit'+IntToStr(N))).Text:=Edit1.Text; Edit1.Text:=''; end; --------- Нет правила без исключений. Правило без исключений - исключение из правил.

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

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, SA2006! Код в приложении. Вообще, если у вас кол-во пробелов заранее неизвестно, то лучше создавать Edit-ы по ходу выполнения программы. По этому поводу можно почитать в инете. Поищите по словам: создание компонентов в run-time Или просто посмотрите на delhpiworld.narod.ru Приложение: uses StrUtils var p: integer; s: string; begin s := Edit1.Text; p := Pos(' ', s); Edit2.Text := LeftStr(s, p-1); Delete(s, p); p := Pos(' ', s); Edit3.Text := LeftStr(s, p-1); Delete(s, p); p := Pos(' ', s); Edit4.Text := LeftStr(s, p-1); Delete(s, p); p := Pos(' ', s); Edit5.Text := LeftStr(s, p-1); Delete(s, p); end;

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Студент) Ответ отправлен: 06.07.2006, 16:10

Отвечает: Проходящий Мимо Здравствуйте, SA2006! В приложении функция, которая возвращает подстроку с порядковым номером TokenNum и разделителем SepChar: st1:=StripStr('123 12 1 0 3', 1, ' '); st2:=StripStr('123 12 1 0 3', 2, ' '); st3:=StripStr('123 12 1 0 3', 3, ' '); И т.д., можно в цикле. Приложение: function StripStr(aString: string; TokenNum: byte; SepChar: char): string; var Token: string; StrLen: Byte; TNum: Byte; TEnd: Byte; begin StrLen := Length(aString); TNum := 1; TEnd := StrLen; while ((TNum <= TokenNum) and (TEnd <> 0)) do begin TEnd := Pos(SepChar, aString); if TEnd <> 0 then begin Token := Copy(aString, 1, TEnd - 1); Delete(aString, 1, TEnd); Inc(TNum); end else begin Token := aString; end; end; if TNum >= TokenNum then begin result := Token; end else begin result := ''; end; end; --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 6-ой класс) Ответ отправлен: 06.07.2006, 16:14

Отвечает: Physicist Здравствуйте, SA2006! Первое, что пришло в голову (см. вложение). Если Edit'ов очень много, то проще организовать это все в виде цикла. Приложение: procedure TForm1.Edit1Change(Sender: TObject); var str,substr:string; len,p:integer; begin str:=Edit1.Text; len:=Length(str); p:=Pos(' ',str);if p=0 then begin Edit2.Text:=str;Exit; end; Edit2.Text:=Copy(str,1,p-1); len:=len-p;if len=0 then Exit; str:=Copy(str,p+1,len); p:=Pos(' ',str);if p=0 then begin Edit3.Text:=str;Exit; end; Edit3.Text:=Copy(str,1,p-1); len:=len-p;if len=0 then Exit; str:=Copy(str,p+1,len); p:=Pos(' ',str);if p=0 then begin Edit4.Text:=str;Exit; end; Edit4.Text:=Copy(str,1,p-1); len:=len-p;if len=0 then Exit; str:=Copy(str,p+1,len); // и т.д. end;

Ответ отправил: Physicist (статус: 3-ий класс) Ответ отправлен: 06.07.2006, 16:19

Вопрос № 48.380

Уважаемые эксперты, внимание вопрос: Есть компонент RadioGroup, как сделать чтобы в зависимости от выбранного элемента менялся цвет выбранного элемента(цвет шрифта) (извините за тавтологию)??? Например. RadioGroup заполнен такими строками: "1 - красный", "2 - желтый", "3- зеленый". Нужно сделать так чтобы при выборе первого пункта цвет шрифта в первом пункте стал красным; - при выборе второго - желтым; - при выборе третьего - зеленым. А элементы которые не выбраны становились снова черными.

Отправлен: 06.07.2006, 17:29 Вопрос задал: Gh0stik (статус: Студент) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Physicist Здравствуйте, Gh0stik! По-моему, так в Delphi сделать нельзя (если не изменять процедуру прорисовки этого контрола). Более простым решением будет создание GroupBox'а c RadioButton'ами, а цвет текста каждого из них уже можно менять через свойство Font.Color

Ответ отправил: Physicist (статус: 3-ий класс) Ответ отправлен: 06.07.2006, 18:05 Оценка за ответ: 4 Комментарий оценки: Не совсем то что я просил...

Отвечает: Устинов Сергей Евгеньевич Здравствуйте, Gh0stik! Сделай так: RadioGroup1.Buttons[RadioGroup1.ItemIndex].Font.Color:=clred; Как создать массив цветов и связать цвета с номером Item-а я думаю объяснять не нужно :) Item-ы нумеруются начиная с 0 :) Удачи! --------- Ответы на все вопросы - на сайте www.ya.ru ☺

Ответ отправил: Устинов Сергей Евгеньевич (статус: Студент) Ответ отправлен: 06.07.2006, 19:45 Оценка за ответ: 5 Комментарий оценки: Это именно то что я искал. Спасибо!!!

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