Секция 3 из 5 - Предыдущая - Следующая
Все секции
- 1
- 2
- 3
- 4
- 5
------------------------------------------------------------
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (Sender is TDrawGrid) and
not (gdFixed in State) then
TDrawGrid(Sender).Canvas.Draw(Rect.Left, Rect.Top,
Image1.Picture.Graphic);
end;
------------------------------------------------------------
Q-82: Как использовать DirectX в своей программе?
------------------------------------------------------------
Модули для работы с DirectX находятся на Delphi Super Page, в пакете
DelphiX. Также на http://www.geocities.com/SiliconValley/1142/ лежит модули
для работы с DirectSound. Информацию по программированию DirectX можно взять
на MSDN и в книге Чарльза Калверта "Delphi 2: Энциклопедия пользователя".
-------------------------------------------------------
PA> Самая прелесть, и забыта:
PA> http://www.yks.ne.jp/~hori/index-e.html - DelphiX by Hiroyuki Hori
PA> - лучший набор инструментов для работы с DirectX
Учтите существование эхи RU.DIRECTX.
Pavel Anufrikov
------------------------------------------------------
AP: Обидно за Хироюки, вроде как первый был.
------------------------------------------------------------
Q-83: Как дождаться завершения программы, запущенной ShellExecute?
------------------------------------------------------------
uses
ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
ProcInfo: PShellExecuteInfo;
begin
(Sender as TControl).Enabled := False;
GetMem(ProcInfo, SizeOf(ProcInfo^));
ZeroMemory(ProcInfo, SizeOf(ProcInfo^));
with ProcInfo^ do begin
Wnd := Handle;
cbSize := SizeOf(ProcInfo^);
lpFile := PChar('notepad.exe');
// lpParameters := nil;
lpVerb := 'open';
nShow := SW_SHOW;
fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
end;
try
Win32check(ShellExecuteEx(ProcInfo));
while not Application.Terminated and
(WaitForSingleObject(ProcInfo.hProcess, 100)=WAIT_TIMEOUT) do
Application.ProcessMessages;
finally
if ProcInfo.hProcess <> 0 then CloseHandle(ProcInfo.hProcess);
Dispose(ProcInfo);
(Sender as TControl).Enabled := True;
end;
end;
------------------------------------------------------------
Q-84: Как использовать OpenGL в своей программе?
------------------------------------------------------------
Модули для работы с OpenGL можно взять на
http://www.signsoft.com/opengl. Информацию -- на http://www.opengl.org.
Также есть книга Ю. Тихомирова "OpenGL: программирование трехмерной
графики".
Еще загляните на http://reality.sgi.com/mjk за примерами и
http://www.scitechsoft.com за библиотекой MesaGL.
Учтите существование эхи RU.OPENGL.
------------------------------------------------------------
Q-85: Как в TMemo вставить дату в позицию каретки?
------------------------------------------------------------
Memo1.SetSelTextBuf(PChar(DateToStr(Date)));
------------------------------------------------------------
Q-86: Как отловить системную ошибку при операциях с файлами?
------------------------------------------------------------
Для Паскаль функций, например, BlockWrite, можно использовать такую
конструкцию:
try
BlockWrite(f, buf, count); //См.также хелп: параметр AmtTransferred
..
except
on E:EInOutError do
begin
ShowMessage('Произошла ошибка записи ' + E.Message);
..// пытаемся что-то поправить
if {не удалось} then
raise; //Повторно возбуждаем исключение, чтобы не удалить файл
end;
end;
..
CloseFile(..);
DeleteFile(..);
------------------------------------------------------------
Q-87: Где достать процедуру типа "сумма прописью"?
------------------------------------------------------------
(Vladimir Gaitanoff, 2:5020/880.5), http://www.tsinet.ru/~vg. Здесь лежит
библиотека vgLib, содержащая еще массу полезных вещей.
------------------------------------------------------------
Q-88: Как узнать, была ли создана ли определенная форма?
------------------------------------------------------------
function IndexOfForm (const AClassName: String; const FromIndex:
Word):Integer;
var
i : Integer;
begin
Result := -1;
for i := FromIndex to Screen.FormCount-1 do
if (CompareText(Screen.Forms[i].ClassName, AClassName) = 0) then
begin
Result := i;
Break;
end;
end;
------------------------------------------------------------
Q-89: Какие инструменты можно применить для коллективной разработки
проекта?
------------------------------------------------------------
CVS. http://www.cyclic.com. С его помощью разрабатывается весьма львиная
доля программного обеспечения в Internet. Интеграция с Delphi -- нулевая ;)
Крайне рекомендуется. Я лично пользуюсь ею ощутимое время и не представляю
себе более разработки без этого средства. "Введение в CVS" можно прочитать
на http://alexm.here.ru.
Microsoft Visual Source Safe. Проигрывает в функциональности, может
выигрывать в "привычности".
------------------------------------------------------------
Q-90: Что такое Handle окна, и как его полyчить?
------------------------------------------------------------
Handle - это число - уникальный идентификатор окна (в данном случае) в
системе.
Получить его можно, например, так:
hwnd := FindWindow (nil, 'Form1'); //ищем окнo с заголовком "Form1"
if hwnd <> 0 then {нашлось};
------------------------------------------------------------
Q-91: Как можно обнаружить утечки памяти и ресурсов в программе?
------------------------------------------------------------
MSDebug Макса Русова. Находится на http://www.dic.ru/users/rusov/.
Поддерживает Delphi 3 и выше, ловит только утечки памяти, но делает это
хорошо.
В данное время эта ссылка не действующая!
На http://www.numega.com можно купить BoundsChecker for Delphi. Он проверяет
также и утечки ресурсов.
Рекламировался также "MemProof", информацию о котором можно получить на
http://www.listsoft.ru/programs/pr1520.htm.
------------------------------------------------------------
Q-92: Как проиграть midi файл?
------------------------------------------------------------
uses
MPlayer;
var
mp : TMediaPlayer;
procedure TForm1.Button1Click(Sender: TObject);
begin
with Sender as TButton do
case Tag of
0 :
begin
Tag := 1;
mp := TMediaPlayer.CreateParented(Handle);
mp.DeviceType := dtSequencer;
mp.FileName := 'c:\winnt\media\Canyon.mid';
mp.Wait:= True;
mp.Open;
mp.Play;
end;
1 :
begin
Tag := 0;
mp.Wait := True;
mp.Stop;
mp.Free;
end;
end;
end;
------------------------------------------------------------
Q-93: Мне нужно заниматься разбором математических выражений
------------------------------------------------------------
Мне нужно заниматься разбором математических выражений, например, строить
график функции, заданной пользователем во время работы программы.
В rxLib есть компонент TrxMathParser, достаточно мощный для большого
количества применений.
------------------------------------------------------------
Q-94: Как обратиться к свойству по его имени?
------------------------------------------------------------
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
f1 : Integer; // Это приватное поле хранит значение
published
{К свойству p1 мы будем обращаться по его имени}
property p1 : Integer read f1 write f1;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
TypInfo;
procedure TForm1.Button1Click(Sender: TObject);
var
PInfo : PPropInfo;
begin
p1 := GetTickCount; // Здесь свойству что-то присвоили
PInfo:= GetPropInfo(TForm1.ClassInfo, 'p1'); // Получаем описание свойства
// из описания класса
if PInfo = nil then
raise Exception.Create('Property not exist');
Caption := IntToStr(GetOrdProp(Form1, PInfo)); // Получаем значение
свойства
end;
+++++++++++++++++++++++++++++++++++++++++
uses
TypInfo;
function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
Result := GetPropInfo(AObject.ClassInfo, PropName);
if Result = nil then
raise Exception.Create('Property not exist');
end;
procedure SetOrdProperty( AObject: TObject; const PropName:String; const
Value: Longint);
begin
SetOrdProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
function GetOrdProperty(AObject: TObject; const PropName:String):Longint;
{см. также TypInfo: GetStrProp, GetFloatProp, GetEnumValue etc.}
begin
Result:= GetOrdProp(AObject, ObjPropInfo(AObject, PropName));
end;
procedure SetStrProperty( AObject: TObject; const PropName:String; const
Value: String);
begin
SetStrProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetFloatProperty( AObject: TObject; const PropName:String; const
Value: Extended);
begin
SetFloatProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetVariantProperty( AObject: TObject; const PropName:String; const
Value: Variant);
begin
SetVariantProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetMethodProperty( AObject: TObject; const PropName:String; const
Value: Pointer);
var
AMethod: TMethod;
begin
AMethod.Code := Value;
AMethod.Data := AObject;
SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AFont: TFont;
begin
SetOrdProperty(Button1, 'Width', 100); // целое
AFont := TFont.Create;
AFont.Style := [fsBold];
SetOrdProperty(Button1, 'Font', Longint(AFont)); // объект
AFont.Free;
SetMethodProperty(Button1, 'OnClick', @TForm1.Button2Click); // метод
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage((Sender as TButton).Caption);
end;
Leonid Troyanovsky <lv.t@eco-pro.ru>
------------------------------------------------------------
Q-68: Как узнать и поменять разрешение экрана?
------------------------------------------------------------
Поменять:
procedure ChangeDisplayResolution(x, y : word);
var
dm : TDEVMODE;
begin
ZeroMemory(@dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;
Узнать можно также с помощью объекта Screen
Screen.Width
Screen.Height
------------------------------------------------------------
Q-69: Какое событие происходит при минимизации окна?
------------------------------------------------------------
OnResize
Для MainForm : Application.OnMinimize
------------------------------------------------------------
Q-70: Как во время выполнения программы создать так называемый "array of
const"
------------------------------------------------------------
В библиотеке Technical Information на сайте Inprise есть документ за нумером
TI582D.txt, посвященный этой проблеме. Вкратце, в качестве array of const
можно использовать массив типа TVarRec.
------------------------------------------------------------
Q-71: Как сохранить в ini файле настройки TFont?
------------------------------------------------------------
uses
IniFiles;
procedure TForm1.Button1Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin
Name := ReadString ('Font','Name','MS Mans Serif');
Charset := ReadInteger('Font','Charset',RUSSIAN_CHARSET);
Color := ReadInteger('Font','Color', clWindowText);
Height := ReadInteger('Font','Height',-11);
Size := ReadInteger('Font','Size',8);
Style := TFontStyles(Byte(ReadInteger('Font','Style',0)));
end;
IniFile.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin;
WriteString ('Font','Name', Name);
WriteInteger('Font','Charset', Charset);
WriteInteger('Font','Color', Color);
WriteInteger('Font','Height', Height);
WriteInteger('Font','Size', Size);
WriteInteger('Font','Style',Byte(Style));
end;
IniFile.Free;
end;
------------------------------------------------------------
Q-72: Как обратиться к определенному адресу физической памяти?
------------------------------------------------------------
Как обратиться к определенному адресу физической памяти? А как прочитать
значение из порта? Где мой любимый массив Port[]?
Прочитайте какую-нибудь книжку про программирование под Win32. Вкратце --
забудьте про все эти глупости.
P.S. Q155 содержит несколько методов работы с портами, как легальных, так и
не вполне. В статье также содержится несколько ссылок на наиболее известные
драйвера.
------------------------------------------------------------
Q-73: Как закрыть внешнюю программу?
------------------------------------------------------------
Например, Блокнот можно закрыть так:
procedure TForm1.Button1Click(Sender: TObject);
var
phandle : HWND;
begin
phandle := FindWindow('Notepad', nil);
if phandle = 0 then
RaiseLastWin32Error;
SendMessage(phandle, WM_CLOSE, 0, 0);
end;
------------------------------------------------------------
Q-74: Как загрузить из ImageList иконку приложения?
------------------------------------------------------------
ImageList1.GetIcon(Idx, Application.Icon);
------------------------------------------------------------
Q-75: Как использовать в качестве обработчика сообщения обычную процедуру,
а не метод объекта?
------------------------------------------------------------
У этой процедуры должен быть еще один дополнительный параметр.
В метод класса кpоме паpаметpов, обьявленных в заголовке, пеpедаётся ещё
паpаметp Self
procedure MyRegularProc(ASelf, Sender: TObject);
begin
ShowMessage(ASelf.ClassName + ' ' + Sender.ClassName);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
amethod: TMethod;
begin
amethod.Code := @MyRegularProc;
amethod.Data := Self;
Button1.OnClick := TNotifyEvent(amethod);
end;
Leonid Troyanovsky <lv.t@eco-pro.ru>
------------------------------------------------------------
Q-76: Как отловить нажатие Enter в TEdit?
------------------------------------------------------------
IMHO, чтобы сделать в духе Windows, то добавь к Edit один TButton, с
свойством default := True, обработчик OnClick которой будет делать нужную
работу.
Другие варианты, чреваты тем, что может сработать не то, что ожидается.
Вот последовательность как будут вызываться обработчики при нажатии Enter
1. OnClick кнопки default
2. OnClick формы, если у нее KeyPreview := True;
3. OnKeyDown/KeyPress/KeyUp контрола имеющего фокус ввода.
Это особенность роли, которую этой клавише обычно назначают в win
приложениях. Обрати также внимание на свойство TButton Cancel - оно
заставляет срабатывать кнопку при нажатии Esc
Для того чтобы разобраться в этих моментах попробуй неколько вариантов,
снимая комментарии:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Button1.Default := True;
ShowMessage('Key1');
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
//KeyPreview := True;
if Key = #13 then
begin
ShowMessage('Key2');
Key := #0;
end;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
ShowMessage('Key3');
end;
------------------------------------------------------------
Q-77: В какой позиции Memo находится каретка?
------------------------------------------------------------
var
LineNum, Charnum: Integer;
....
LineNum := Memo1.Perform(EM_LINEFROMCHAR, -1, 0);
CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);
------------------------------------------------------------
Q-78: Как работать с графическими форматами, хотя бы самыми известными?
------------------------------------------------------------
На [32]http://www.imagelib.com лежит библиотека ImageLib.
На компакте с Delphi 3 в каталоге EXTRAS есть библиотека JPEG. Если сказать
в модуле uses jpeg; то можно работать с .jpg как с TPicture.
Еще есть freeware-библиотека Nishita ViewLib. JPG, JFIF, GIF, BMP, DIB, RLE,
TGA, PCX. http://einstein.ae.eng.ua.edu/nishita/index.htm.
------------------------------------------------------------
Q-79: Почему после RichEdit1.Lines.SaveToFile(name) в файле, кроме моего
текста, ещё всякий бред написан?
------------------------------------------------------------
Таким образом в RTF сохраняется информация об оформлении текста. Если
сохранять нужно только текст, перед записью сделай
RichEdit1.PlainText := True;
------------------------------------------------------------
Q-80: Как работать с файлами архивов, хотя бы самыми распространенными?
------------------------------------------------------------
Воспользуйтесь библиотекой ExceedZip 3.0 (http://www.exceedsoft.com).
------------------------------------------------------------
Q-81: Как вставить картинку в TDrawGrid?
------------------------------------------------------------
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (Sender is TDrawGrid) and
not (gdFixed in State) then
TDrawGrid(Sender).Canvas.Draw(Rect.Left, Rect.Top,
Image1.Picture.Graphic);
end;
------------------------------------------------------------
Q-82: Как использовать DirectX в своей программе?
------------------------------------------------------------
Модули для работы с DirectX находятся на Delphi Super Page, в пакете
DelphiX. Также на http://www.geocities.com/SiliconValley/1142/ лежит модули
для работы с DirectSound. Информацию по программированию DirectX можно взять
на MSDN и в книге Чарльза Калверта "Delphi 2: Энциклопедия пользователя".
-------------------------------------------------------
PA> Самая прелесть, и забыта:
PA> http://www.yks.ne.jp/~hori/index-e.html - DelphiX by Hiroyuki Hori
PA> - лучший набор инструментов для работы с DirectX
Учтите существование эхи RU.DIRECTX.
Pavel Anufrikov
------------------------------------------------------
AP: Обидно за Хироюки, вроде как первый был.
------------------------------------------------------------
Q-83: Как дождаться завершения программы, запущенной ShellExecute?
------------------------------------------------------------
uses
ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
ProcInfo: PShellExecuteInfo;
begin
(Sender as TControl).Enabled := False;
GetMem(ProcInfo, SizeOf(ProcInfo^));
ZeroMemory(ProcInfo, SizeOf(ProcInfo^));
with ProcInfo^ do begin
Wnd := Handle;
cbSize := SizeOf(ProcInfo^);
lpFile := PChar('notepad.exe');
// lpParameters := nil;
lpVerb := 'open';
nShow := SW_SHOW;
fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
end;
try
Win32check(ShellExecuteEx(ProcInfo));
while not Application.Terminated and
(WaitForSingleObject(ProcInfo.hProcess, 100)=WAIT_TIMEOUT) do
Application.ProcessMessages;
finally
if ProcInfo.hProcess <> 0 then CloseHandle(ProcInfo.hProcess);
Dispose(ProcInfo);
(Sender as TControl).Enabled := True;
end;
end;
------------------------------------------------------------
Q-84: Как использовать OpenGL в своей программе?
------------------------------------------------------------
Модули для работы с OpenGL можно взять на
http://www.signsoft.com/opengl. Информацию -- на http://www.opengl.org.
Также есть книга Ю. Тихомирова "OpenGL: программирование трехмерной
графики".
Еще загляните на http://reality.sgi.com/mjk за примерами и
http://www.scitechsoft.com за библиотекой MesaGL.
Учтите существование эхи RU.OPENGL.
------------------------------------------------------------
Q-85: Как в TMemo вставить дату в позицию каретки?
------------------------------------------------------------
Memo1.SetSelTextBuf(PChar(DateToStr(Date)));
------------------------------------------------------------
Q-86: Как отловить системную ошибку при операциях с файлами?
------------------------------------------------------------
Для Паскаль функций, например, BlockWrite, можно использовать такую
конструкцию:
try
BlockWrite(f, buf, count); //См.также хелп: параметр AmtTransferred
..
except
on E:EInOutError do
begin
ShowMessage('Произошла ошибка записи ' + E.Message);
..// пытаемся что-то поправить
if {не удалось} then
raise; //Повторно возбуждаем исключение, чтобы не удалить файл
end;
end;
..
CloseFile(..);
DeleteFile(..);
------------------------------------------------------------
Q-87: Где достать процедуру типа "сумма прописью"?
------------------------------------------------------------
(Vladimir Gaitanoff, 2:5020/880.5), http://www.tsinet.ru/~vg. Здесь лежит
библиотека vgLib, содержащая еще массу полезных вещей.
------------------------------------------------------------
Q-88: Как узнать, была ли создана ли определенная форма?
------------------------------------------------------------
function IndexOfForm (const AClassName: String; const FromIndex:
Word):Integer;
var
i : Integer;
begin
Result := -1;
for i := FromIndex to Screen.FormCount-1 do
if (CompareText(Screen.Forms[i].ClassName, AClassName) = 0) then
begin
Result := i;
Break;
end;
end;
------------------------------------------------------------
Q-89: Какие инструменты можно применить для коллективной разработки
проекта?
------------------------------------------------------------
CVS. http://www.cyclic.com. С его помощью разрабатывается весьма львиная
доля программного обеспечения в Internet. Интеграция с Delphi -- нулевая ;)
Крайне рекомендуется. Я лично пользуюсь ею ощутимое время и не представляю
себе более разработки без этого средства. "Введение в CVS" можно прочитать
на http://alexm.here.ru.
Microsoft Visual Source Safe. Проигрывает в функциональности, может
выигрывать в "привычности".
------------------------------------------------------------
Q-90: Что такое Handle окна, и как его полyчить?
------------------------------------------------------------
Handle - это число - уникальный идентификатор окна (в данном случае) в
системе.
Получить его можно, например, так:
hwnd := FindWindow (nil, 'Form1'); //ищем окнo с заголовком "Form1"
if hwnd <> 0 then {нашлось};
------------------------------------------------------------
Q-91: Как можно обнаружить утечки памяти и ресурсов в программе?
------------------------------------------------------------
MSDebug Макса Русова. Находится на http://www.dic.ru/users/rusov/.
Поддерживает Delphi 3 и выше, ловит только утечки памяти, но делает это
хорошо.
В данное время эта ссылка не действующая!
На http://www.numega.com можно купить BoundsChecker for Delphi. Он проверяет
также и утечки ресурсов.
Рекламировался также "MemProof", информацию о котором можно получить на
http://www.listsoft.ru/programs/pr1520.htm.
------------------------------------------------------------
Q-92: Как проиграть midi файл?
------------------------------------------------------------
uses
MPlayer;
var
mp : TMediaPlayer;
procedure TForm1.Button1Click(Sender: TObject);
begin
with Sender as TButton do
case Tag of
0 :
begin
Tag := 1;
mp := TMediaPlayer.CreateParented(Handle);
mp.DeviceType := dtSequencer;
mp.FileName := 'c:\winnt\media\Canyon.mid';
mp.Wait:= True;
mp.Open;
mp.Play;
end;
1 :
begin
Tag := 0;
mp.Wait := True;
mp.Stop;
mp.Free;
end;
end;
end;
------------------------------------------------------------
Q-93: Мне нужно заниматься разбором математических выражений
------------------------------------------------------------
Мне нужно заниматься разбором математических выражений, например, строить
график функции, заданной пользователем во время работы программы.
В rxLib есть компонент TrxMathParser, достаточно мощный для большого
количества применений.
------------------------------------------------------------
Q-94: Как обратиться к свойству по его имени?
------------------------------------------------------------
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
f1 : Integer; // Это приватное поле хранит значение
published
{К свойству p1 мы будем обращаться по его имени}
property p1 : Integer read f1 write f1;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
TypInfo;
procedure TForm1.Button1Click(Sender: TObject);
var
PInfo : PPropInfo;
begin
p1 := GetTickCount; // Здесь свойству что-то присвоили
PInfo:= GetPropInfo(TForm1.ClassInfo, 'p1'); // Получаем описание свойства
// из описания класса
if PInfo = nil then
raise Exception.Create('Property not exist');
Caption := IntToStr(GetOrdProp(Form1, PInfo)); // Получаем значение
свойства
end;
+++++++++++++++++++++++++++++++++++++++++
uses
TypInfo;
function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
Result := GetPropInfo(AObject.ClassInfo, PropName);
if Result = nil then
raise Exception.Create('Property not exist');
end;
procedure SetOrdProperty( AObject: TObject; const PropName:String; const
Value: Longint);
begin
SetOrdProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
function GetOrdProperty(AObject: TObject; const PropName:String):Longint;
{см. также TypInfo: GetStrProp, GetFloatProp, GetEnumValue etc.}
begin
Result:= GetOrdProp(AObject, ObjPropInfo(AObject, PropName));
end;
procedure SetStrProperty( AObject: TObject; const PropName:String; const
Value: String);
begin
SetStrProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetFloatProperty( AObject: TObject; const PropName:String; const
Value: Extended);
begin
SetFloatProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetVariantProperty( AObject: TObject; const PropName:String; const
Value: Variant);
begin
SetVariantProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetMethodProperty( AObject: TObject; const PropName:String; const
Value: Pointer);
var
AMethod: TMethod;
begin
AMethod.Code := Value;
AMethod.Data := AObject;
SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AFont: TFont;
begin
SetOrdProperty(Button1, 'Width', 100); // целое
AFont := TFont.Create;
AFont.Style := [fsBold];
SetOrdProperty(Button1, 'Font', Longint(AFont)); // объект
AFont.Free;
SetMethodProperty(Button1, 'OnClick', @TForm1.Button2Click); // метод
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage((Sender as TButton).Caption);
end;
Leonid Troyanovsky <lv.t@eco-pro.ru>
------------------------------------------------------------
Q-111: Чем отличаются TLabel и TStaticText?
------------------------------------------------------------
TLabel is TGraphicControl
TStaticText is TWinControl
То есть у последнего есть окно, это дает возможность управлять этим
контролом с помощью сообщений Windows.
------------------------------------------------------------
Q-112: Как издать звук через PC Speaker?
------------------------------------------------------------
// Для НТ вызов функции из ОС, для 9x прямое обращение к портам
Procedure BeepEx(Freq: Word; Duration: Integer);
var
Ver: TOsVersionInfo;
begin
Ver.dwOSVersionInfoSize := SizeOf(Ver);
GetVersionEx(Ver);
if Ver.dwPlatformId = VER_PLATFORM_WIN32_NT then
Windows.Beep(Freq, Duration)
else begin
asm
movzx ecx, Freq
mov eax, 1193180 // тактовая частота
sub edx, edx
div ecx // преобразование частоты в делитель
mov ecx, eax
mov al,0b6H
out 43H,al // управляющие слово
mov al,cl
out 42h,al // младший байт делителя
mov al,ch
out 42h,al // старший байт делителя
in al,61H
or al,03H
out 61H,al // включить звук
end;
sleep(Duration); // пауза на время звучани
asm
in al,61H
and al,0fcH
out 61H,al // выключить звук по окончанию Duration
end;
end;
end;
------------------------------------------------------------
Q-113: Как корректнее завершать приложение- Terminate или MainForm.Close?
------------------------------------------------------------
Terminate очень грубый метод. Если вызывать Application.Terminate, то не
сработают обработчики OnCloseQuery, OnClose главной формы.
------------------------------------------------------------
Q-114: Как узнать версию Windows?
------------------------------------------------------------
Использовать функцию API GetVersionEx
function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;
stdcall;
Аргумент функции - структура TOSVersionInfo, содержит
dwVersionInfoSize:DWORD - заполняется как sizeof TOSVersionInfo) перед
вызовом функции
dwMajorVersion:DWORD - старшая цифра версии Windows
Windows 95 - 4
Windows 98 - 4
Windows Me - 4
Windows NT 3.51 - 3
Windows NT 4.0 - 4
Windows 2000 - 5
Windows XP - 5
dwMinorVersion: DWORD - младшая цифра версии
Windows 95 - 0
Windows 98 - 10
Windows Me - 90
Windows NT 3.51 - 51
Windows NT 4.0 - 0
Windows 2000 - 0
Windows XP - 1
dwBuildNumber: DWORD
Win NT 4 - номер билда
Win 9x - старший байт - старшая и младшая цифры версии / младший - номер
билда
dwPlatformId: DWORD
VER_PLATFORM_WIN32s Win32s on Windows 3.1.
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 9x
VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000
szCSDVersion:DWORD
NT - содержит PСhar с инфо о установленном ServicePack
9x - доп. инфо, может и не быть
Alexander Kramarenko <kram@beep.ru>
++++++++++++++++++++++++++++++++++++++++++++++++++++
type
TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP);
function DetectWinVersion : TWinVersion;
var
OSVersionInfo : TOSVersionInfo;
begin
Result := wvUnknown;
OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
case OSVersionInfo.DwMajorVersion of
3: Result := wvNT3;
4: case OSVersionInfo.DwMinorVersion of
0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT
then Result := wvNT4
else Result := wv95;
10: Result := wv98;
90: Result := wvME;
end;
5: case OSVersionInfo.DwMinorVersion of
0: Result := wvW2K;
1: Result := wvXP;
end;
end;
end;
end;
function DetectWinVersionStr : string;
const
VersStr : array[TWinVersion] of string = (
'Unknown',
'Windows 95',
'Windows 98',
'Windows ME',
'Windows NT 3',
'Windows NT 4',
'Windows 2000',
'Windows XP');
begin
Result := VersStr[DetectWinVersion];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Ver := DetectWinVersion;
Label1.Caption := IntToStr(Ord(DetectWinVersion));
Label2.Caption := DetectWinVersionStr;
end;
Анатолий Подгорецкий
+++++++++++++++++++++++++++++++
глобальные переменные Win32Platform (в справке),
Секция 3 из 5 - Предыдущая - Следующая
© faqs.org.ru