LiveBindingを試してみる。

DelphiXE2のLiveBindingの機能を使って、現在時刻を更新する処理を

チュートリアルを参考作ってみた。

処理としては、時刻が更新されると、登録した通知先（作った例場合はフォーム）の

表示を更新する処理になっています。

以下ソース

まずは、時計のソース、タイマーを使って定周期で時刻を更新し、登録先の

更新通知を行っています。

また、変更通知先を登録する処理を書いています。

unit Unit4;

interface

uses
 System.SysUtils, System.Classes,Vcl.ExtCtrls, Data.Bind.EngExt,
 Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs, Vcl.Bind.Editors,
 Data.Bind.Components,
 System.Bindings.EvalProtocol,
 System.Bindings.Expression,
 System.Bindings.ObjEval,
 System.Bindings.Helper;

type
 TDataModule4 = class(TDataModule)
   FTimer: TTimer;
   procedure FTimerTimer(Sender: TObject);
   procedure DataModuleCreate(Sender: TObject);
   procedure DataModuleDestroy(Sender: TObject);
 private
   { Private 宣言 }
   FNowString : String;
   BindingExpression1: TBindingExpression;
 public
   procedure AddBindingList(const InputScopes: array of IScope; const BindExprStr: string; const OutputScopes: array of IScope; const OutputExpr: string);
   published
   { Public 宣言 }
   property NowString : String read FNowString;
 end;

var
 DataModule4: TDataModule4;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

uses Unit1;

{$R *.dfm}

procedure TDataModule4.AddBindingList(const InputScopes: array of IScope;
 const BindExprStr: string; const OutputScopes: array of IScope;
 const OutputExpr: string);
begin

 BindingExpression1 :=  TBindings.CreateManagedBinding(
       InputScopes,
       BindExprStr,
       OutputScopes,
       OutputExpr,
       nil);

end;

procedure TDataModule4.DataModuleCreate(Sender: TObject);
begin
 //BindScope1.Active := true;
end;

procedure TDataModule4.DataModuleDestroy(Sender: TObject);
begin
 //BindScope1.Active := false;
end;

procedure TDataModule4.FTimerTimer(Sender: TObject);
begin
 FNowString := DateTimeToStr(Now);
 TBindings.Notify(Self, 'NowString');

end;

end.

次に、時計を表示するソース。比較のためにポーリング処理で上記のソースのプロパティを使って
タイムスタンプを更新する処理もあります。

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
 Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs,
 Unit4,
 System.Bindings.Expression,
 System.Bindings.ObjEval,
 System.Bindings.Helper,
 Vcl.Bind.Editors, Data.Bind.Components;


type
 TForm1 = class(TForm)
   Label1: TLabel;
   Label3: TLabel;
   Timer1: TTimer;
   Label2: TLabel;
   Label4: TLabel;
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
   { Private 宣言 }
   FSakaClock : TDataModule4;
 public
   { Public 宣言 }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 //FSakaClock.Free;
 FSakaClock.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FSakaClock := TDataModule4.Create(Self);
 FSakaClock.AddBindingList(
      { inputs }
     [TBindings.CreateAssociationScope([
       Associate(FSakaClock, 'I1')
     ])],
     'I1.NowString',
     { outputs }
     [TBindings.CreateAssociationScope([
       Associate(Label3, 'O1')
     ])],
     'O1.Caption');

 //FSakaClock := TSakaClock.Create(Self);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Label1.Caption := FSakaClock.NowString;
end;

end.

CPUのコア数を数える。

Delphiのドキュメントによれば、System.CPUCount変数を参照すればCPUのコア数が
表示できるようだ。

たとえば、

Label1.Caption := IntToStr(System.CpuCount)

でラベルにCPUのコア数が表示できる。

自分のPCで試したけど、シングルコアのCPUなので

当然のことながら1と表示された。

指定したウインドウを最前面にもってくる

VBAから指定したアプリが起動してない場合は起動し、既に起動済みの場合は、最前面に持ってくる
という処理が必要になったので、Delphiで作成してみた。

以下、指定したアプリを前面に持ってくるサンプル。

procedure TForm1.Button1Click(Sender: TObject);
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    LabeledEdit1: TLabeledEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation
Uses JclSysInfo;

{$R *.dfm}
function AllowSetForegroundWindow(dwProcessID: Cardinal): BOOL; stdcall; external 'user32.DLL';


procedure TForm1.Button1Click(Sender: TObject);
var
  ProcessList : TStringList;
  i : Integer;
  Pid : Cardinal;
  Wnd: THandle;
begin

  ProcessList := TStringList.Create;
  try
    //起動するアプリは、自前のものではないので
    //プロセスがいるかどうかは、プロセスのリストを総当りで
    //確認
    JclsysInfo.RunningProcessesList(ProcessList,true);
    i := -1;
    ProcessList.Find(LabeledEdit1.Text,i);
    if i >= 0 then
    begin
      Pid := GetPidFromProcessName(ProcessList.Strings[i]);
      Wnd :=GetMainAppWndFromPid(Pid);
      //いつぞやのバージョンのwindowsから前面に出す許可を
      //しておくことが必要
      AllowSetForegroundWindow(Pid);
      //最小化されているのでアイコンからもとのサイズに
      //戻す
      if IsIconic(Wnd) then
      begin
        OpenIcon(Wnd);
      end
      else
      begin
        //指定したウインドウを前面に
        SetForegroundWindow(wnd);
        //場合によっては、AttachThreadInputで
        //前面に出したいウインドのスレッドにあタッチが必要
      end;
    end;

  finally
  　ProcessList.Free;
　　end;
end;

end.

プロセスリストを表示する（その２）

Project jediのJclのJclSysInfoユニットにある。RunningProcessesList関数を使用すると
プロセスリストが簡単にとれます。

以下、サンプル

procedure TForm1.Button1Click(Sender: TObject);
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    LabeledEdit1: TLabeledEdit;
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation
Uses JclSysInfo;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
　ProcessList : TStringList;
  i : Integer;
  Pid : Cardinal;

begin
　ListBox1.Clear;
  ProcessList := TStringList.Create;
  try
　　JclsysInfo.RunningProcessesList(ProcessList,true);
    for i := 0 to ProcessList.Count-1 do
    begin
      Pid := GetPidFromProcessName(ProcessList.Strings[i]);
      ListBox1.Items.Add('(' + IntToStr(Pid) + ')' + ProcessList.Strings[i]);
    end;

  finally
  　ProcessList.Free;
  end;

end;

RunningProcessesListは、引数で指定したTStringsを継承した型インスタンスに
プロセスのリストを返してくれます。

このJclSysInfoユニット、ざっと見た感じで、便利そうなものが一杯あった。
サンプルプログラムを元にもうチョットみてみよう。

VBスクリプトを動かす（動画付き）

先日、ツイッターでMicrosoft Scriptコントロールの話題がでたのでDelphiでMicrosoft Scriptコントロールを
使うサンプルを作ってみた。

Microsoft ScriptコントールをDelphiに取り込む必要がある。

Microsoft Scriptコントール取り込むには、コンポーネントの取り込みを選択し

ActiveXコントールの取り込みを選択する。

（ここでタイプライブラリの取り込みを選択するとクラスがつくられないみたい
なので要注意）

コントロールの一覧からMicroSoft Scriptコントロールを選択する。

あとは、画面の支持にしたがってファイルを作成し、Microsoft Scriptコントールを
組み込みたいプロジェクトに読み込む。

ここから、実際につくったサンプル。

サンプルは、

1) a,b二つの引数を持つVBSのＦＵＮＣＴＩＯＮプロシージャを実行する。
  2) VBSはメモコンポーネントに記述する。
3) メモコンポーネントに記述したFUNCTIONのリストをListBoxに表示する。
4) ListBoxから選んだFUNCTIONを実行し結果をラベルに表示する。

とゆうものです。

以下、ソースファイル

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MSScriptControl_TLB, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    スクリプトを登録: TButton;
    ListBox1: TListBox;
    選択した関数を実行: TButton;
    実行結果: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure スクリプトを登録Click(Sender: TObject);
    procedure 選択した関数を実行Click(Sender: TObject);
  private
    { Private 宣言 }
    FScriptControl:TScriptControl;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ActiveX,VarUtils;

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 FScriptControl.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FScriptControl := TScriptControl.Create(Self);
  {Jscriptを使用するときは、'VBSCRIPT'を'JScript'に変更する。}
  FScriptControl.Language := 'VBSCRIPT';
end;

procedure TForm1.スクリプトを登録Click(Sender: TObject);
var
  i : Integer;
begin

  ListBox1.Clear;
  
　{Scriptコントロールにコードを追加}
　FScriptControl.AddCode(WideString(Memo1.Text));

  {プロシージャコレクションを操作することでプロシージャーのリストを得る}
  for i := 0  to FScriptControl.Procedures.Count -1 do
  begin

    {VB(VB6,VBA)用のCOMのコレクションは1基数のものが多いので注意}
    ListBox1.Items.Add(FScriptControl.Procedures.Item[i+1].Name);
  end;

end;
procedure TForm1.選択した関数を実行Click(Sender: TObject);
var
  ResultStr : OleVariant;
  ParamArray : Variant;
  PParamArray : PVarArray;
  MyParams : PIntegerArray;
begin
  
  {パラメータはヴァリアント型の配列で渡す必要がある}
  ParamArray := VarArrayCreate([0, 1], varVariant);
  ParamArray[0] := 3;
  ParamArray[1] := 5;
  
  PParamArray := VarArrayAsPSafeArray(ParamArray);
  ResultStr := FScriptControl.Run(WideString(ListBox1.Items[ListBox1.ItemIndex]),
                              PSafeArray(PParamArray));
  Label2.Caption := VarToStr(ResultStr);

end;

end.

以下、コントロールの取り込みと上記プログラムを実行しているところのデモ動画

Guid文字列を得る

Delphiで、Guidを得るには、通常の場合CreateGuid手続きを使用します。
また、Guid文字列を得るする場合には、GuidToString手続きを使用して文字列に変換します。

procedure TForm1.Button1Click(Sender: TObject);
var
  guid : TGuid;
begin
  CreateGuid(guid);
  LabeledEdit1.Text := GuidToString(guid);

end;

Delphi XEでは、TGuid型に対して、TGuidHelperクラスが実装されているので
このHelperを利用してもGuidを得ることができます。
(Helperは.Net FrameworkのGuid構造体と同じ動きをするように実装されている
ようです。但し、.Net側のToStringメソッドでは文字列が中括弧で囲まれないので
注意が必要かなぁ？)

procedure TForm1.Button2Click(Sender: TObject);
var
  guid:TGUID;
  S:String;
begin
  guid := TGUID.NewGuid;
  LabeledEdit1.Text := guid.ToString;
end;

TGuidHelperクラスにはGuidの表現形式に応じていくかのCreate関数が用意されていますで
プログラム中で使用している表現形式からGUDIの生成が可能です。

下記の例は、文字列で表現されたGUIDからTGuid型の変数を得る例です。

procedure TForm1.Button3Click(Sender: TObject);
var
  guid:TGUID;
begin
　guid := TGUID.Create('{1F447130-60E2-40A0-9A00-EB94C1C7D691}');
  label1.Caption := guid.Tostring; //{1F447130-60E2-40A0-9A00-EB94C1C7D691}が表示される
end;

TSingletonImplementationクラス

Delphi XEのHelpを見ていて、TSingletonImplementationというクラスがあるのに気づいた。

HELPをみると、IInterface の基本実装が必要で参照カウントが無効なシンプルなクラスの基底クラスなそうな。

ということは、COMでなインターフェイスについては、このクラスを使えばよいのかぁ～。

でも、何故Generics.Defaultsに配置してあるのだろう。