ラベル ちょっとしたデモ の投稿を表示しています。 すべての投稿を表示
ラベル ちょっとしたデモ の投稿を表示しています。 すべての投稿を表示

2012年12月13日木曜日

publishedなメソッドを隠す(ネストした型宣言使用編)

前回の続きです。

さて、最近のDelphiでは、ネストした型宣言が可能で、クラス宣言の中にクラスの宣言ができます。

この機能を使って、クラスの使用者からpublishedなメソッドを隠すことを試してみました。

以下、ソースです。

先ず、 【関数名でメソッドが呼び出されるクラスのサンプル】

unit Unit2;

interface

  type TMyCallCalc = class
    public
      function CallCalc(CalcName : string; a, b: double) : double;
    private
      type TMyCalc = class
        published
          function Add(a,b : double) : double;
          function Subtract(a,b : double) : double;
      end;

  end;


implementation
{ TMyCalc }

function TMyCallCalc.TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCallCalc.TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;


type TMyCalcFunc = function(a,b : double) : double of object;

function TMyCallCalc.CallCalc(CalcName : string; a, b: double) : double;
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(CalcName);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      Result := MyCalcFunc(a,b);
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

親クラスのprivateセクションにpublishedなメソッドを持つ子クラスを宣言しています。
これで、ユニットの使用者からは、子クラスのメソッドの宣言が見えなくなり、直接呼び出す
ことができなくなります。
ユニットの使用者には、publicセクションにメソッドを宣言することで、間接的に目的の
メソッドが呼び出せるようにします。

次に上記のクラスを使用するコード


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  CallCalc : TMyCallCalc;
begin
  CallCalc := TMyCallCalc.Create;
  try
    StaticText2.Caption := FloatToStr(CallCalc.CallCalc(
                                    TButton(Sender).Caption,
                                    StrToFloat(LabeledEdit1.Text),
                                    StrToFloat(LabeledEdit2.Text)));
  finally
    CallCalc.Free;
  end;

end;

end.

ユニットを使用する側からは子クラスが見えませんので、親クラスのpublicなメソッドのみが
使用できます。



publishedなメソッドを隠す

前回の続きです。

TObjectのMethodAddressメソッドを使用すれば関数名(文字列)でメソッドをコールできます。

しかし、 MethodAddressメソッドでメソッドのアドレスを取得するには、可視性をpublishedに
する必要があり、 publishedにした瞬間にメソッドの存在が丸わかりになってしまいます。

前回の例のような単純な演算であればまあ良いかと思うのですが、いわゆるFactoryメソッド
とかだと、使用者にその存在を隠したい場合があり、このままではちょっと不完全です。

さて、どうしようか?というのが今回のテーマになります。(2010以降の拡張Rttiを使えば良い
というのはあるのですが、今回は別の方法を考えます。)

ところで、DelphiのUnitのimplementationセクションで定義した型(クラスを含む)は別のユニット
から参照できない仕様となっています。

したがって、クラスの定義を  implementation で行えば、外部から処理の存在を隠したうえで
 MethodAddressメソッド が使用可能なクラスができそうです。

で、実際に、作ってみました。

先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】

unit Unit2;

interface

  function CallCalc(CalcName : string; a, b: double) : double;

implementation

  type TMyCalc = class
  published
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

  type TMyCalcFunc = function(a,b : double) : double of object;

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;


function CallCalc(CalcName : string; a, b: double) : double;
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(CalcName);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      Result := MyCalcFunc(a,b);
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

publishedの可視性を持つクラスをimplementationセクションに定義しています。
但し、そのままでは、外部のユニットからメソッドをコールできませんので、
外部からのアクセスようにラッパー関数を定義しています。

次に、【関数名を文字列で指定して処理を呼び出すサンプル】

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
begin
  StaticText2.Caption := FloatToStr(CallCalc(
                                    TButton(Sender).Caption,
                                    StrToFloat(LabeledEdit1.Text),
                                    StrToFloat(LabeledEdit2.Text)));
end;

end.

unit2のinterfaceセクションに定義したラッパーを使って処理を呼び出しています。


implementationセクションにクラスを定義することで、外部からその存在を隠しつつ
メソッド名を文字列で指定してメソッドをコールすることが可能です。

但し、この方法ですとクラスそのものも隠れてしまいすのでもう少しなんとかしたい
ところです。

ネストした型宣言が可能なバージョンのDelphiであれば、何とかできそうな気が
しますが、その検証はまた後日・・・

2012年12月12日水曜日

メソッドを名前で呼び出す

前回の続きです。

関数(function)のメソッドポインタが定義できれば、TObjectのMethodAddressを使って
関数名を(文字で)指定してコールすることが可能です。

以下、サンプルソース。

先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】

unit Unit2;

interface

  type TMyCalc = class
  published
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

implementation

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;

end.

MethodAddressを使用するためにpublishedを指定してることに注意願います。

次に、【関数名を文字列で指定して処理を呼び出すサンプル】

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

type TMyCalcFunc = function(a,b : double) : double of object;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(TButton(Sender).Caption);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

ボタンのキャプション名が名前のメソッドが定義されているという前提で、ボタンのキャプションを
使って関数をコールして、結果を求めています。


関数のメソッドポインタ

メソッドポインタでfunctionを使った例のサンプルです。
あまり見当たらなかったので、備忘録がわりに公開しときます。


【メソッドポインタ経由でfunctionを呼び出すサンプル】


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

type TMyCalcFunc = function(a,b : double) : double of object;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  Method: TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    //Method.Data := MyCalc;
    if TButton(Sender).Caption = 'Add' then
    begin
      MyCalcFunc := MyCalc.Add;
    end
    else
    begin
      MyCalcFunc := MyCalc.Subtract;
    end;
    StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));
  finally
    MyCalc.Free;
  end;

end;

end.


【メソッドポインタ経由で呼び出されるクラスのサンプル】


unit Unit2;

interface

  type TMyCalc = class
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

implementation

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;

end.


メソッドポインタはヘルプにもあるように、

Type 型名 = "メソッドの定義" of object

のように宣言します。

ここで、"メソッドの定義"は、通常の手続き(関数)の名前を抜いたものになるので、
例えば、TObject型のSenderを引数に持ち、戻り値がない"メソッドの定義"は、

procedure(Sender : TObject)

同様に、Double型のaとbを引数に持ち、Double型の戻り値がある"メソッドの定義"は

function(a,b : Double) : Double

となります。

上記のサンプル1では、ボタンのキャプションに応じてif分で関数を切り替えています。

この例では、関数が2つだけなので、メソッドポインタ経由ではなく、直接目的の関数を
コールしたほうが良いのですが、
同じ型の引数を持つ関数が多数ある場合、メソッドポインタと、TObject.MethodAddressを
組み合わるとコード量を減らせる可能性があります。(上の例だとボタンのCaptionと関数名を
合わせおくことによりif文(あるいは、Case文)を無くすことが可能です。)

そのへんの話はまた後日・・・




2012年11月10日土曜日

AnsiExtractQotedStr

QuotedStr関数の存在は、知ってたけど、AnsiExtrctQuotedStrの存在は知らなかった。(^^ゞ
ってことで、使ってみた。
以下ソース


program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s :String;
  src : PWideChar;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
    s := 'ミリアリア';
    Writeln(s);
    s := QuotedStr(s);
    Writeln(s);
    src := PwideChar(s);
    s := AnsiExtractQuotedStr(src,'''');
    Writeln(s);

    readln;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


AnsiExtractQuitedStr内のsrcのとこで、直接キャストしようとすると コンパイルエラーが出るので、一度変数受けでキャスト。
で実行結果は、


2012年11月8日木曜日

指定したフォルダの特定のファイルをSJISからUTF8に変更する

今の仕事で使用した、SJIS→UTF8のチャラツール。
ファイル数がすくなければ、手作業でするけど、ファイル数が多いのファイルが
サブディレクトリにわたるので、作ってみた。
諸般の事情により、Delphi2007で作ったので、UTF8への変換にはjclUnicodeの
TWideStringList、ファイルの走査にはJclFileUtilsのTJclFileEnumeratorを利用した。
(変換元ファイルのディレクトリ、変換先のディレクトリの指定にJvclの TJvDirectoryEdit
を使用した。)

以下ソースコード。


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,JclStrings, JclFileUtils, StdCtrls, Mask, JvExMask, JvToolEdit,jclUnicode;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    JvDirectoryEdit1: TJvDirectoryEdit;
    JvDirectoryEdit2: TJvDirectoryEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    FFileEnumerator: TJclFileEnumerator;
    FDirCount: Integer;
    FTaskID: TFileSearchTaskID;
    FT0: TDateTime;
    procedure DirectoryEntered(const Directory: string);
    procedure AddFile(const Directory: string; const FileInfo: TSearchRec);
    procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses Types,StrUtils, VBLikeString;
{$R *.dfm}

{ TForm1 }

procedure TForm1.AddFile(const Directory: string; const FileInfo: TSearchRec);
var
  SourceFileName,TargetFileName : String;
  TargetDir : String;
  SourceText : TStringList;
  TargetText : TWideStringList;
  LineCount : Integer;
  WorkStrings : TStringDynArray;
  //RevArray : Array of String;
  RevisionString : String;
  IsHeaderArea : Boolean;
begin
  SourceFileName := Directory + FileInfo.Name;

  //変換後ファイルの書き込み先フォルダは、元ファイルのフルパスの変換元フォルダに指定した
  //文字列を変換後に指定したフォルダに置換すれば良い
  TargetFileName := ReplaceText(SourceFileName,JvDirectoryEdit1.Text,JvDirectoryEdit2.Text);
  TargetDir := ExtractFileDir(TargetFileName);

  //ディレクトリがなければ作成する
  if not(DirectoryExists(TargetDir)) then ForceDirectories(TargetDir);

  SourceText := TStringList.Create;
  try
    SourceText.LoadFromFile(SourceFileName);
    TargetText := TWideStringList.Create;
    try
      //TargetText.Text := ReplaceStr(SourceText.Text,'@CRLF',sLineBreak);
      TargetText.Text := SourceText.Text;
      TargetText.SaveUnicode := true;
      TargetText.SaveFormat := sfUTF8;
      TargetText.SaveToFile(TargetFileName);
    finally
      TargetText.Free;
    end;
  finally
    SourceText.Free;
  end;
  Memo1.Lines.Add(SourceFileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  RootDirectories: TStrings;
begin

  FFileEnumerator.SearchOption[fsLastChangeAfter] := false;
  FFileEnumerator.SearchOption[fsLastChangeBefore] := false;

  RootDirectories := TStringList.Create;
  try
    StrToStrings(JvDirectoryEdit1.Text, DirSeparator, RootDirectories, False);
    FFileEnumerator.RootDirectories := RootDirectories;
  finally
    RootDirectories.Free;
  end;
  FFileEnumerator.FileMask := '*.c;*.h';
  FFileEnumerator.SearchOption[fsMinSize] := false;
  FFileEnumerator.SearchOption[fsMaxSize] := false;
  FFileEnumerator.IncludeSubDirectories := true;
  FFileEnumerator.IncludeHiddenSubDirectories := true;
  FFileEnumerator.CaseSensitiveSearch := false;
  FDirCount := 0;

  FT0 := Now;
  FTaskID := FFileEnumerator.ForEach(AddFile);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FFileEnumerator.StopTask(FTaskID);
end;

procedure TForm1.DirectoryEntered(const Directory: string);
begin
  Inc(FDirCount);
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileEnumerator := TJclFileEnumerator.Create;
  FFileEnumerator.OnEnterDirectory := DirectoryEntered;
  FFileEnumerator.OnTerminateTask := TaskDone;

end;

procedure TForm1.TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
begin
  //
end;

end.

TJclFileEnumeratorは、ファイル検索の条件を設定したうえで、検索条件に該当するファイルが
見つかった場合に呼び出すメソッドを指定してForEcahメソッドを実行すれば、都度、指定した
メソッドを呼び出してくれるので、ForEachに指定しメソッドにSJIS→UTF8の変換処理を
書けばよい。(ソース上ではAddFile)

TStringListを使ってファイルを読み込み、そのテキストをTWideStringListに
渡して、 をTWideStringListでUTF-8を指定して保存することにより、UTF-8変換を
実施した。(このへんは、Delphi 2009以降ならもっとスマートにできる思う。)


2012年6月3日日曜日

DelphiでExcelブック内のシート一覧を取得し表示する

先日、DelphiでExcelのWorkSheetを列挙しながらSheetを編集する処理を作成したとき、
思いもよらずはまったので、自分メモとして保存。

DelphiからExcelを操作する方法としては、

  1. Excelのタイプライブラリーをインポート
  2. dbGoを使用する
  3. サードパーティのコンポーネントを使用する
  4. ・・・
などの方法があげらるが、

今回は、1.タイプタイプライブラリーをインポートしてExcelを操作しシート名を一覧表示する
処理をつかった。

以下、ソース

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;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Excel_TLB,System.Win.ComObj;
const
  LCID = LOCALE_SYSTEM_DEFAULT;


procedure TForm1.Button1Click(Sender: TObject);
Var
  ExcelApp : Excel_TLB.ExcelApplication;
  ExcelBook : Excel_TLB.ExcelWorkbook;
  ExcelSheet : Excel_TLB.ExcelWorksheet;
  BookPath : String;
  i : integer;
begin
  ListBox1.Clear;
  ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;
  ExcelApp.DisplayAlerts[LCID] := false;

  BookPath := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test.xlsx';

  ExcelBook := ExcelApp.Workbooks.Add(BookPath, LCID);

  (* このように書きたいが
    'GetEnumerator' のメンバが含まれていないかアクセスできないため)
      通常では使用不可   
  for  ExcelSheet in  ExcelBook.Worksheets do
  begin
     ListBox1.Items.Add(ExcelSheet.Name);
  end;
  *)


  // Excelのコレクションは1基数なので1からカウントを始める。
  for i := 1 to ExcelBook.Worksheets.Count do
  begin
    ExcelSheet := ExcelBook.Worksheets.Item[i] As  Excel_TLB.ExcelWorksheet;
    ListBox1.Items.Add(ExcelSheet.Name);
  end;

  ExcelSheet := nil;
  ExcelBook.Close(false,BookPath,false,LCID);
  ExcelBook := nil;

  if Assigned(ExcelApp) then
  begin
    ExcelApp.Quit;
    ExcelApp := nil;
  end;


end;

end. 
for ~ in doの構文が使えると、基数のこと意識しなくても良いが、コンパイルすると

 E2431 for-in ステートメントはコレクション型 'Sheets' で動作できません('Sheets' に 'GetEnumerator' のメンバが含まれていないかアクセスできないため)

のメッセージが、出てEXEが作れないため、従来のfor文で列挙している。

  Excelのコレクションが1基数なので、for 文は、1からシート数まででにしていのが
 ポイントです。(ポイントというもののものではありませんが・・・)

 まあ、Excelに限らず、Win32版のVisual Basic(VB6,VB5)とか、VBAのコレクションInterface
 は基本1基数なのですが・・・

 下図のようなブックに対して





 上のような処理を実行すると

 のような結果がえられます。


以下は、余談ですが、

自分 、Excelのコレクションが1基数だということをすっかり忘れていて、結果、午前中つぶしちゃいました。