faqs.org.ru

 Главная > Программирование > Языки Pascal/Delphi >

RU.DELPHI FAQ

Секция 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 - Предыдущая - Следующая

Вернуться в раздел "Языки Pascal/Delphi" - Обсудить эту статью на Форуме
Главная - Поиск по сайту - О проекте - Форум - Обратная связь

© faqs.org.ru