2. Основные причины создания невизуальных компонентов

Исторически так уж получилось, что важнейшей причиной создания невизуальных компонентов является причина создания компонентов вообще – это необходимость установки свойств во время проектирования.

Второй причиной является необходимость использования инкапсулируемой функции.

Рассмотрим пример инкапсуляции вызова API функции в компонент.

2.1. Установка значений для вызова API функций во время выполнения

Вам известен невизуальный компонент TTimer, с помощью которого легко во время проектирования устанавливается обработчик периодически возникающего события.

Давайте посмотрим, как он устроен.

Пример 10.1. Исходный код компонента TTimer

  TTimer = class(TComponent)
  private
    FInterval: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

{ TTimer }

constructor TTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 1000;
{$IFDEF MSWINDOWS}   
  FWindowHandle := Classes.AllocateHWnd(WndProc);
{$ENDIF}
{$IFDEF LINUX}   
  FWindowHandle := WinUtils.AllocateHWnd(WndProc);
{$ENDIF}   
end;

destructor TTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
{$IFDEF MSWINDOWS}   
  Classes.DeallocateHWnd(FWindowHandle);
{$ENDIF}
{$IFDEF LINUX}
  WinUtils.DeallocateHWnd(FWindowHandle);
{$ENDIF}   
  inherited Destroy;
end;

procedure TTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
end;

procedure TTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

В конструкторе устанавливаются значения по умолчанию – внутренне поле Enabled устанавливается в True, тем самым таймер считается активным. Кроме того интервал (в миллисикунтах) устанавливается во внутренне поле FInterval.

Пример 10.2.

constructor TTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 1000;
  FWindowHandle := Classes.AllocateHWnd(WndProc);
end;

Примечание

Обратите внимание, что в конструкторе нет кода, фактически активизирующего таймер. Дело в том, что таймер в действительности работает только тогда, когда у него установлен обработчик события OnTimer. В противном случае в таймере просто нет смысла.

Это видно из исходного кода метода SetOnTimer, в котором независимо от старого значения внутреннего поля устанавливается новое и вызывается метод UpdateTimer.

Пример 10.3.

procedure TTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

В методе UpdateTimer выполняется основная работа по инициализации системного таймера – с помощью API функции KillTimer уничтожается ранее возможно установленный компонентом таймер, а затем после ряда необходимых проверок помощью API функции SetTimer устанавливается новый системный таймер.

Примечание

Принадлежность таймера компоненту определяется по дескриптору окна.

Пример 10.4.

procedure TTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
end;

В документации Windows SDK написано, что четвертым параметром функции SetTimer передается адрес процедуры, выполняемой при срабатывании таймера, если этот параметр равен nil, то приложению будет посылаться сообщение WM_TIMER. Как известно (из лекции о системных сообщениях) за обработку принятых сообщений отвечает процедура WndProc.

Пример 10.5.

procedure TTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try Timer; except
        Application.HandleException(Self);
      end
    else Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

Как видно, в процедуре анализируется, пришло ли сообщение от системного таймера и если да, то вызывается метод Timer. В противном случае вызывается обработчик сообщений по умолчанию DefWindowProc.

А метод Timer совсем прост – в нем проверяется, установлен ли обработчик события OnTimer. Если да, то обработчик вызывается.

Пример 10.6.

procedure TTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

Из анализа исходного кода компонента можно сделать вывод, что ничего внутри него не делается такого, чего нельзя бы сделать без компонентной оболочки. Однако использование инкапсуляции функции внутри компонента делает ее использование предельно простым – нужно просто поместить компонент на форму и установить обработчик события. Программист избавлен от необходимости знать все тонкости вызова функций API для манипуляции системными таймерами.

Рассмотрим еще один пример инкапсуляции API функции.

2.1.1. Компонент TRzLauncher

Одной из API-функций, позволяющей запустить внешний процесс и предоставляющей богатые возможности по управлению процессом запуска, является ShellExecuteEx.

Примечание

Наряду с функцией ShellExecuteEx внешние процессы могут быть запущены с помощью функций ShellExecute, CreateProcess и ряда других схожих по назначению функций, а также с помощью устаревшей функции WinExec (предназначенной для совместимости со старыми программами и не рекомендуемой Microsoft SDK к использованию).

Функция ShellExecuteEx является очень мощной, но она требует для использования заполнения сложной структуры TShellExecuteInfo.

Пример 10.7. Описание структуры TShellExecuteInfo

  _SHELLEXECUTEINFOA = record
    cbSize: DWORD;
    fMask: ULONG;
    Wnd: HWND;
    lpVerb: PAnsiChar;
    lpFile: PAnsiChar;
    lpParameters: PAnsiChar;
    lpDirectory: PAnsiChar;
    nShow: Integer;
    hInstApp: HINST;
    { Optional fields }
    lpIDList: Pointer;
    lpClass: PAnsiChar;
    hkeyClass: HKEY;
    dwHotKey: DWORD;
    hIcon: THandle;
    hProcess: THandle;

  TShellExecuteInfoA = _SHELLEXECUTEINFOA;
  TShellExecuteInfo = TShellExecuteInfoA;

Это обстоятельство отпугивает начинающих программистов от использования столь мощного средства в пользу выбора более простых, но и более скромных по своим возможностям функций.

Более того, если даже для программиста не составляет труда правильно заполнить сложную структуру, то делать это в каждом новом приложении вряд ли является рациональным.

Поэтому идея о создании компонента, позволяющего запускать внешние приложения, является вполне разумной. В настоящее время таких компонентов много, но одним из первых является TRzLauncher Рея Конопки, исходный код которой приведен в его книге "Building Custom Delphi Components". Рассмотрим код компонента, слегка адаптированного мной для Delphi 7 версии.

Пример 10.8. Полный текст компонента TRzLauncher

{==============================================================================}
{= RzLaunch Unit                                                              =}
{=                                                                            =}
{= This unit implements the TRzLauncher component. This component is used to  =}
{= launch an application from within a Delphi applicationt. To actually run   =}
{= the desired program, the ShellExecute function is used.                    =}
{=                                                                            =}
{= Building Custom Delphi Components - Ray Konopka                            =}
{= Copyright © 1995 by Raize Software Solutions, Inc.                         =}
{= Ported by Delphi7 © 2006 S.Yushinin for IICT special.                      =}
{==============================================================================}

{$I RAIZE.INC}

unit RzLaunch;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, ShellApi;

type
  ELaunchError = class( Exception )                   
    ErrorCode : Integer;
  end;

  TShowMode = ( smNormal, smMaximized, smMinimized );

const
  ShowWindowModes : array[ TShowMode ] of Integer =
    ( sw_Normal, sw_ShowMaximized, sw_ShowMinimized );

type
  TRzLauncher = class(TComponent)
  private
    FHInstance : THandle;
    FProcessHnd : THandle;
    FProgramName : string;
    FParameters : string;
    FShowMode : TShowMode;
    FStartDir : string;
    FTimer : TTimer;
    FOnFinished : TNotifyEvent;
  protected
    procedure Finished; dynamic;
    function AppHasTerminated : Boolean;
    procedure TimerExpired( Sender : TObject );
  public
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
    procedure Launch;
    property HInstance : THandle read FHInstance;
  published
    property ProgramName : string read FProgramName write FProgramName;
    property Parameters : string read FParameters write FParameters;
    property ShowMode : TShowMode read FShowMode write FShowMode default smNormal;
    property StartDir : string read FStartDir write FStartDir;
    property OnFinished : TNotifyEvent read FOnFinished write FOnFinished;
  end;

procedure Register;

implementation


uses LnchMsgs;


function CreateLaunchError( ErrCode : Integer ) : ELaunchError;
begin
  Result := ELaunchError.Create( LoadStr( SLaunchOutOfMemory + ErrCode ) );
  Result.ErrorCode := ErrCode;
end;

constructor TRzLauncher.Create( AOwner : TComponent );
begin
  inherited Create( AOwner );
  FShowMode := smNormal;
  FTimer := TTimer.Create( Self );
  FTimer.Enabled := False;
  FTimer.OnTimer := TimerExpired;
  FHInstance := 0;
end;


destructor TRzLauncher.Destroy;
begin
  FTimer.Enabled := False;
  inherited Destroy;
end;


procedure TRzLauncher.Finished;
begin
  if Assigned( FOnFinished ) then FOnFinished( Self );
end;


function TRzLauncher.AppHasTerminated : Boolean;
var
  ExitCode : DWord;
begin
  GetExitCodeProcess( FProcessHnd, ExitCode );
  Result := ExitCode <> still_Active;
end;


procedure TRzLauncher.TimerExpired( Sender : TObject );
begin
  if AppHasTerminated then
  begin
    FHInstance := 0;
    FTimer.Enabled := False;
    Finished;
  end;
end;

procedure TRzLauncher.Launch;
var
  ShellInfo : TShellExecuteInfo;
begin
  FHInstance := 0;

  FillChar( ShellInfo, SizeOf( TShellExecuteInfo ), 0 );
  ShellInfo.cbSize := SizeOf( TShellExecuteInfo );
  ShellInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
  ShellInfo.Wnd := HWnd_Desktop;
  ShellInfo.lpFile := PChar(FProgramName);
  ShellInfo.lpParameters := PChar(FParameters);
  ShellInfo.lpDirectory := Pchar(FStartDir);
  ShellInfo.nShow := ShowWindowModes[ FShowMode ];

  if ShellExecuteEx( @ShellInfo ) then
  begin
    FHInstance := ShellInfo.hInstApp;
    FProcessHnd := ShellInfo.hProcess;
    FTimer.Enabled := True;    
  end
  else
    raise CreateLaunchError( ShellInfo.hInstApp )
end;


procedure Register;
begin
  RegisterComponents( 'Лекция 9', [ TRzLauncher ] );
end;

end.

Не будем рассматривать весь исходный код компонента, остановимся подробно только на его основном методе Launch, с помощью которого собственно и запускается внешняя программа.

Пример 10.9.

procedure TRzLauncher.Launch;
var
  ShellInfo : TShellExecuteInfo;
begin
  FHInstance := 0;

  FillChar( ShellInfo, SizeOf( TShellExecuteInfo ), 0 );
  ShellInfo.cbSize := SizeOf( TShellExecuteInfo );
  ShellInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
  ShellInfo.Wnd := HWnd_Desktop;
  ShellInfo.lpFile := PChar(FProgramName);
  ShellInfo.lpParameters := PChar(FParameters);
  ShellInfo.lpDirectory := Pchar(FStartDir);
  ShellInfo.nShow := ShowWindowModes[ FShowMode ];

  if ShellExecuteEx( @ShellInfo ) then
  begin
    FHInstance := ShellInfo.hInstApp;
    FProcessHnd := ShellInfo.hProcess;
    FTimer.Enabled := True;    
  end
  else
    raise CreateLaunchError( ShellInfo.hInstApp )
end;

Из приведенного кода метода видно, что основная его часть посвящена заполнению структуры TShellExecuteInfo, затем происходит собственно вызов внешней программы и запоминание результата во внутренних полях компонента.

Какой же выигрыш дает использование такого довольно простого компонента в программе? Выигрыш в том, что вызов внешней программы теперь выглядит примерно следующим образом:

Пример 10.10.

procedure TForm1.Button1Click(Sender: TObject);
begin
  RzLauncher1.ProgramName:=ComboBox1.Text;
  RzLauncher1.Launch;
end;

Почему в коде нет комментариев? Потому что в данном случае "комментарии излишни"!

Однако возможности невизуальных компонентов не сводятся к созданию оболочек вокруг функций. Напротив, возможно написание компонента, выполняющего множество функций в нужный момент вообще без участия программиста и без единой строчки кода в программе!