Go to Qiita Advent Calendar 2024 Top
LoginSignup
7
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

DelphiAdvent Calendar 2021Day 21
@ht_deko(Hideaki Tominaga)

<9> 非同期プログラミングライブラリ (APL) (Delphi コンカレントプログラミング)

Last updated at Posted at 2021-12-20

9. 非同期プログラミングライブラリ (APL)

恐らく、ドキュメントを読んだだけでは、非同期プログラミングライブラリ (Asynchronous Programming Library) 1 が何をするものかサッパリ解らないと思います。

9.1. TComponent.BeginInvoke / EndInvoke

BeginInvoke() メソッドで呼び出された手続き (あるいは関数) は、実質 TThread.Queue() として動作します。

var AR := Edit1.BeginInvoke(
            procedure 
            begin
            end, nil);

上記コードは、次のコードと同等です。

TThread.Queue(nil, 
  procedure 
  begin 
  end);

結果の AR は IAsyncResult 型で、これを使って処理をキャンセルする事もできます。

  AR.Cancel;

終了を待つには EndInvoke() メソッドを使います。

  Edit1.EndInvoke(AR);

つまりは何らかのスレッドに組み込んで使うものです。

See also:

9.2. デモプログラム

アレン・バウワー氏のブログにあったデモ 2 を実行してみます。

VCL アプリケーションを新規作成し、フォームに Edit、ListBox、Button を一つずつ貼ります。

image.png

コードは次のようになります。

unit1.pas
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    type
      TSearchThread = class(TThread)
      private
        FForm: TForm1;
        FFolder: string;
      protected
        procedure Execute; override;
      public
        constructor Create(aForm: TForm1; aFolder: String);
      end;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   ListBox1.Items.Clear;
   TSearchThread.Create(Self, Edit1.Text).Start;
end;

{ TForm1.TSearchThread }

constructor TForm1.TSearchThread.Create(aForm: TForm1; aFolder: String);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FForm := aForm;
  FFolder := aFolder;
end;

procedure TForm1.TSearchThread.Execute;
begin
  if not Terminated then
  begin
    var SR: TSearchRec;
    var AR := FForm.BeginInvoke<string>(TFunc<string>(
      function: string
      begin
        Result := FForm.Edit1.Text;
      end));
    FFolder := FForm.EndInvoke<string>(AR);
    var SH := FindFirst(IncludeTrailingPathDelimiter(FFolder) + '*.*', faAnyFile, SR);
    while (SH = 0) and not Terminated do
    begin
      //Sleep(10); // this makes the background thread go a little slower.
      AR := FForm.BeginInvoke(
        procedure
        begin
          if not Terminated then
            FForm.ListBox1.Items.Add(SR.Name);
        end);
      FForm.EndInvoke(AR);
      SH := FindNext(SR);
    end;
  end;
end;

end.
unit1.dfm
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 304
  ClientWidth = 291
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 15
  object Button1: TButton
    Left = 206
    Top = 264
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 8
    Top = 8
    Width = 273
    Height = 23
    TabOrder = 1
    Text = 'Edit1'
  end
  object ListBox1: TListBox
    Left = 8
    Top = 37
    Width = 273
    Height = 221
    ItemHeight = 15
    TabOrder = 2
  end
end

実行するとこんな感じになります。検索中でもフォームを移動させる事ができます。

image.png

9.3. デモプログラム 2

アレン・バウワー氏のブログにあったもうひとつのデモ 3 を実行してみます。

先のサンプルとフォームは同じでコードだけが違います。異なるパラメータを持つ BeginInvoke() メソッドをクラスヘルパーを使って追加しています。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  System.Types, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TAsyncProcedureResult<T1> = class sealed (TBaseAsyncResult)
  private
    FAsyncProcedure: TProc<T1>;
    FParam: T1;
  protected
    procedure AsyncDispatch; override;
    constructor Create(const AAsyncProcedure: TProc<T1>; const Param: T1);
  end;

  TControlHelper = class helper for TControl
    function BeginInvoke<T1>(const AProc: TProc<T1>; const Param: T1): IASyncResult; overload;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    type
      TSearchThread = class(TThread)
      private
        FForm: TForm1;
        FFolder: string;
      protected
        procedure Execute; override;
      public
        constructor Create(aForm: TForm1; aFolder: String);
      end;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   ListBox1.Items.Clear;
   TSearchThread.Create(Self, Edit1.Text).Start;
end;

{ TForm1.TSearchThread }

constructor TForm1.TSearchThread.Create(aForm: TForm1; aFolder: String);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FForm := aForm;
  FFolder := aFolder;
end;

procedure TForm1.TSearchThread.Execute;
begin
  if not Terminated then
  begin
    var SR: TSearchRec;
    var AR := FForm.ListBox1.BeginInvoke<string>(TFunc<string>(
      function: string
      begin
        Result := FForm.Edit1.Text;
      end));
    FFolder := FForm.ListBox1.EndInvoke<string>(AR);
    var SH := FindFirst(IncludeTrailingPathDelimiter(FFolder) + '*.*', faAnyFile, SR);
    while (SH = 0) and not Terminated do
    begin
      //Sleep(10); // this makes the background thread go a little slower.
      AR := FForm.ListBox1.BeginInvoke<string>(TProc<string>(
        procedure (SRName: string)
        begin
          if not Terminated then
            FForm.ListBox1.Items.Add(SRName);
        end),
        SR.Name); // Pass the value of SR.Name on through.
//      FForm.ListBox1.EndInvoke(AR); { this call can be safely removed since SR isn't
//                                      touched inside the anonymous method body}
      SH := FindNext(SR);
    end;
  end;
end;

{ TControlHelper }

function TControlHelper.BeginInvoke<T1>(const AProc: TProc<T1>;
  const Param: T1): IASyncResult;
begin
  Result := TAsyncProcedureResult<T1>.Create(AProc, Param).Invoke;
end;

{ TAsyncProcedureResult<T1> }

procedure TAsyncProcedureResult<T1>.AsyncDispatch;
begin
  FAsyncProcedure(FParam);
end;

constructor TAsyncProcedureResult<T1>.Create(const AAsyncProcedure: TProc<T1>;
  const Param: T1);
begin
  inherited Create(nil);
  FAsyncProcedure := AAsyncProcedure;
  FParam := Param;
end;

end.

レコード SR を直接使わず、クラスヘルパーで追加した BeginInvoke() メソッドの定数パラメータに値として SR.Name を渡しているので、EndInvoke() メソッドを省略できるよ (終了待ちしなくていいのでちょっと速くなるよ)、という事のようです。TComponent クラスの定義と実装を眺めると、やっている事がなんとなく解ると思います。

APL にはサンプルもなく、オーバーロードされた BeginInvoke() メソッドをどういった用途で使う事が想定されているのかすらよくわかりません。

See also:

#参考

索引

[ ← 8. イベント (同期オブジェクト) ] [ ↑ 目次へ ] [ → 10. ファイバー ]

  1. 非同期プログラミングライブラリ (APL) は Delphi XE8 以降で利用可能です。 ↩

  2. 日付が 2008 年...つまり、Delphi 2009 の頃に書かれた記事であり、APL が実装されるよりもずっと前の記事であることに注意してください。 ↩

  3. 記事中の TBaseAsyncResult と、実際に Delphi に実装された TBaseAsyncResult は若干仕様が異なるようです。 ↩

7
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
7
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?