tag:blogger.com,1999:blog-38683388659891339862024-03-14T15:57:34.285+09:00Delphiッこ倶楽部東京出張所CoodGearさんおよびDelphiに関することを
適当に書きます。
News Sourceのほとんどを他のブログに依存している他力本願ブログです。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.comBlogger189125tag:blogger.com,1999:blog-3868338865989133986.post-18469859551478939762018-05-19T01:43:00.002+09:002018-05-19T01:43:55.557+09:00TokyoでDictionaryを要素にもつJson形式のファイルの読み書きをしてみた。<a href="http://nonothoughtman.blogspot.jp/2018/05/tokyojson.html">前回</a>、LIST構造を持つJSON形式のファイルを読み書きしたので、今回はDictionary構造を持つファイルを読み書きしてみた。<br />
(プロジェクトは、https://bitbucket.org/OldTPFun/delphitest/src/master/JsonTest/Proj2/ に配置してあります。)<br />
<br />
今回読み書きするのは以下のようなファイル。<br />
<br />
<pre class="JSON" name="code">{"TownName":"木組みの家と石畳の街",
"Shops":{
"ラビットハウス":
{"ShopName":"ラビットハウス",
"Clerks":[
{"Name":"ココア","Age":17},
{"Name":"チノ","Age":15},
{"Name":"リゼ","Age":17}
]
},
"甘兎庵":
{"ShopName":"甘兎庵",
"Clerks":[
{"Name":"チヤ","Age":17}
]
}
}
}
</pre>
<br />
<br />
先ずは書き込みから。<br />
<br />
今回は、Keyが文字列で、ValueがTCoffeeShop型のTDictionaryをシリアライズ・デシリアライズすればよいので、<a href="http://nonothoughtman.blogspot.jp/2018/05/tokyojson.html">前回</a>にならって、TDictionary<string tcoffeeshop="">用のコンバータ</string><br />
<br />
<pre class="Delphi" name="code"> TCoffieShopDicConverter = class(TJsonDictionaryConverter<string, TCoffeeShop>);
</pre>
<br />
を作成して、上記のJSON文字列にシリアライズするためのクラスを作成して、TDictionary<v>型の変数にTCoffieShopDicConverter属性を設定
<br />
</v><br />
<pre class="Delphi" name="code"> [JsonSerialize(TJsonMemberSerialization.&Public)]
TCofeeShopList = class
private
FTownName: String;
FShops: TObjectDictionary<string, TCoffeeShop>;
procedure SetTownName(const Value: String);
procedure SetShops(const Value: TObjectDictionary<string, TCoffeeShop>);
public
property TownName : String read FTownName write SetTownName;
[JsonConverter(TCoffieShopDicConverter)]
property Shops : TObjectDictionary<string, TCoffeeShop> read FShops write SetShops;
constructor Create;
end;
</pre>
<br />
で、シリアライズするためのコード<br />
<br />
<pre class="Delphi" name="code">procedure TForm1.Button1Click(Sender: TObject);
var
CoffeeShop1,CoffeeShop2 : TCoffeeShop;
serializer: TJsonSerializer;
CofeeShopList : TCofeeShopList;
s : string;
begin
CofeeShopList := TCofeeShopList.Create;
CoffeeShop1 := TCoffeeShop.Create;
CoffeeShop2 := TCoffeeShop.Create;
try
CoffeeShop1.ShopName := 'ラビットハウス';
CoffeeShop1.Clerks.Add(TClerk.Create('ココア',17));
CoffeeShop1.Clerks.Add(TClerk.Create('チノ',15));
CoffeeShop1.Clerks.Add(TClerk.Create('リゼ',17));
CoffeeShop2.ShopName := '甘兎庵';
CoffeeShop2.Clerks.Add(TClerk.Create('チヤ',17));
CofeeShopList.TownName := '木組みの家と石畳の街';
CofeeShopList.Shops.Add(CoffeeShop1.ShopName,CoffeeShop1);
CofeeShopList.Shops.Add(CoffeeShop2.ShopName,CoffeeShop2);
serializer := TJsonSerializer.Create;
try
s := serializer.Serialize(CofeeShopList);
Memo1.Text := s;
TFile.WriteAllText('CoffeeShop.Json',s);
finally
serializer.Free;
end;
finally
CofeeShopList.Shops.Clear;
CofeeShopList.Free;
end;
end;
</pre>
<br />
を書いて実行すると、見事に成功と思いきや・・・・
<br />
<br />
<div>
<span style="color: red; font-size: large;">例外クラスEAbstractError (メッセージ'抽象エラー')を送出しました。</span></div>
<br />
と例外が発生。ありゃりゃ。
<br />
<br />
デバッグ実行した結果、PropertyToKeyの呼び出し時に例外が発生していることが分かったので、System.JSON.Converters.pasのTJsonDictionaryConverter<k,v>の定義を調べてみると、
<br />
<pre class="Delphi" name="code">TJsonDictionaryConverter<k,v> = class(TJsonConverter)
protected
function CreateDictionary: TDictionary<k,v>; virtual;
function PropertyToKey(const APropertyName: string): K; virtual; abstract;
function KeyToProperty(const AKey: K): string; virtual; abstract;
function ReadKey(const AReader: TJsonReader; const ASerializer: TJsonSerializer): string;
function ReadValue(const AReader: TJsonReader; const ASerializer: TJsonSerializer): V; virtual;
procedure WriteValue(const AWriter: TJsonWriter; const AValue: V; const ASerializer: TJsonSerializer); virtual;
public
procedure WriteJson(const AWriter: TJsonWriter; const AValue: TValue; const ASerializer: TJsonSerializer); override;
function ReadJson(const AReader: TJsonReader; ATypeInf: PTypeInfo; const AExistingValue: TValue;
const ASerializer: TJsonSerializer): TValue; override;
function CanConvert(ATypeInf: PTypeInfo): Boolean; override;
end;
</pre>
<br />
と、PropertyToKey,とKeyToPropertyにabstractがついているので、この2つは、継承先のコンバーターで実装しないといけなかったのね。
<br />
<br />
System.JSON.Converters.pasに、TJsonDictionaryConverterを継承した、キーが文字列のTJsonStringDictionaryConverter<V>の定義が
あるので、中身をみてみると、
<br />
<br />
<pre class="Delphi" name="code"> TJsonStringDictionaryConverter<V> = class(TJsonDictionaryConverter<string, V>)
protected
function PropertyToKey(const APropertyName: string): string; override;
function KeyToProperty(const AKey: string): string; override;
end;
</pre>
<br />
とあって、実装が
<br />
<br />
<pre class="Delphi" name="code">function TJsonStringDictionaryConverter<V>.KeyToProperty(const AKey: string): string;
begin
Result := AKey;
end;
function TJsonStringDictionaryConverter<V>.PropertyToKey(const APropertyName: string): string;
begin
Result := APropertyName;
end;
</pre>
<br />
となっているので、Dictionaryのコンバーターを作成する時は、TJsonDictionaryConverterから、キーの型を決めた派生型を作成し、KeyToPropertyにはキーから文字列に変換、PropertyToKeyには文字列からキーの型のインスタンスへの変換を自前で実装すれば、良いわけですね。
<br />
例えば、キーが整数型のDictionaryのコンバータは
<br />
<br />
<pre class="Delphi" name="code"> TJsonIntegerDictionaryConverter<V> = class(TJsonDictionaryConverter<Integer, V>)
protected
function PropertyToKey(const APropertyName: string): Integer; override;
function KeyToProperty(const AKey: Integer): string; override;
end;
function TJsonStringDictionaryConverter<V>.KeyToProperty(const AKey: Integer): string;
begin
Result := AKey.ToString;
end;
function TJsonStringDictionaryConverter<V>.PropertyToKey(const APropertyName: string): Integer;
begin
Result := APropertyName.ToInteger;
end;
</pre>
<br />
とすれば、良いわけだ。
<br />
<br />
今回は、定義済みの、TJsonStringDictionaryConverterを使用して先ほどの<br />
<br />
<pre class="Delphi" name="code"> TCoffieShopDicConverter = class(TJsonDictionaryConverter<string, TCoffeeShop>);
</pre>
<br />
を
<br />
<pre class="Delphi" name="code"> TCoffieShopDicConverter = class(TJsonStringDictionaryConverter<TCoffeeShop>);
</pre>
<br />
に修正し実行すれば、目的のJSON形式の文字列のファイルが作成できます。
<br />
<br />
ファイルの読み込みは<a href="http://nonothoughtman.blogspot.jp/2018/05/tokyojson.html">前回</a>と同様、次のコードになります。(確認用に読み込んだものメモに列挙しております。)<br />
<br />
<pre class="Delphi" name="code">procedure TForm1.Button2Click(Sender: TObject);
var
CoffeeShop : TCoffeeShop;
CofeeShopList : TCofeeShopList;
serializer: TJsonSerializer;
s : string;
Clerk : TClerk;
begin
s := TFile.ReadAllText('CoffeeShop.Json',TEncoding.UTF8);
serializer := TJsonSerializer.Create;
try
CofeeShopList := serializer.Deserialize<tcofeeshoplist>(s);
try
Memo1.Clear;
Memo1.Lines.Add(CofeeShopList.TownName);
for CoffeeShop in CofeeShopList.Shops.Values do
begin
Memo1.Lines.Add(CoffeeShop.ShopName);
for Clerk in CoffeeShop.Clerks do
begin
Memo1.Lines.Add(Clerk.Name + '(' + Clerk.Age.ToString() + ')');
end;
end;
finally
CoffeeShop.Clerks.Clear();
CoffeeShop.Free;
end;
finally
serializer.Free
end;
</pre>
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-48833747078819051212018-05-03T10:39:00.000+09:002018-05-03T12:18:26.640+09:00TokyoでJson形式のファイルの読み書きをして見た。唐突ですが、Json.NET良いですよね。高度なこともできますが、Json形式の文字列のシリアル化/デシリアライズ化がだけで良いな簡単にできますしね。<br />
Delphi(Tokyo)でJson形式のファイルを読み込む必要が出てきたので、Json.NETのような書き方ができなか調べていたところもう1年くらい前の記事になりますが、<br />
<br />
<a href="https://twitter.com/lynatan">@lynatan</a> さんのTJsonSerializerの記事<br />
<br />
<a href="http://d.hatena.ne.jp/tales/20170331/1490975195">TJsonSerializerの使い方。</a><br />
<a href="http://d.hatena.ne.jp/tales/20170402/1491141694">TJsonSerializerの実用例</a><br />
<br />
エンバカデロさんのブログ<br />
<br />
<a href="https://community.embarcadero.com/blogs/entry/tjsonserializer-json-japan">TJsonSerializerでJSONに変換する[JAPAN]</a>
<br />
<br />
DelphiでもTokyoになって、Json.NETのような書き方ができるようになっているとのことでしたので、試して見ました。<br />
<br />
読み書きするのは、以下のような内容のファイル<br />
<br />
<div style="background-color: #1e1e1e; color: #d4d4d4; font-family: Consolas, "Courier New", monospace; font-size: 14px; line-height: 19px; white-space: pre;">
<div>
{<span style="color: #9cdcfe;">"ShopName"</span>:<span style="color: #ce9178;">"ラビットハウス"</span>,</div>
<div>
<span style="color: #9cdcfe;">"Clerks"</span>:[</div>
<div>
{<span style="color: #9cdcfe;">"Name"</span>:<span style="color: #ce9178;">"ココア"</span>,<span style="color: #9cdcfe;">"Age"</span>:<span style="color: #b5cea8;">17</span>},</div>
<div>
{<span style="color: #9cdcfe;">"Name"</span>:<span style="color: #ce9178;">"チノ"</span>,<span style="color: #9cdcfe;">"Age"</span>:<span style="color: #b5cea8;">15</span>},</div>
<div>
{<span style="color: #9cdcfe;">"Name"</span>:<span style="color: #ce9178;">"リゼ"</span>,<span style="color: #9cdcfe;">"Age"</span>:<span style="color: #b5cea8;">17</span>}</div>
<div>
]</div>
<div>
}</div>
</div>
<br />
上記の構造にマップできるクラスを作成します。<br />
先ずは、従業員(Clerk)クラス。<br />
パブリックメンバーをシリアライズ対象のするのでクラスに[JsonSerialize(TJsonMemberSerialization.&Public)]<br />
属性を付加しています。<br />
(余談ですが、予約語、指令と被るワードを使う場合、その前に"&"が必要です。)<br />
<br />
<pre class="delphi" name="code">unit Unit1;
//パブリックメンバーをシリアライズ対象にする属性
[JsonSerialize(TJsonMemberSerialization.&Public)]
TClerk = class
private
FName: string;
FAge: integer;
procedure SetAge(const Value: integer);
procedure SetName(const Value: string);
public
property Name : string read FName write SetName;
property Age : integer read FAge write SetAge;
constructor Create; overload;
constructor Create(const vName : string; const vAge : integer); overload;
end;
</pre>
<br />
次に喫茶店(CoffeeShop)クラスの定義
<br />
<pre class="delphi" name="code"> [JsonSerialize(TJsonMemberSerialization.&Public)]
TCoffeeShop = class
private
FClerks: TList<TClerk>;
FShopName: string;
procedure SetClerks(const Value: TList<TClerk>);
procedure SetShopName(const Value: string);
public
property ShopName : string read FShopName write SetShopName;
//TClerkクラスのジェネリックリスト用のコンバーターを登録
[JsonConverter(TJsonClerkListConverter)]
property Clerks : TList<TClerk> read FClerks write SetClerks;
public constructor Create;
end;
</pre>
<br />
メンバーは、喫茶店名と、従業員のリスト(ジェネリックのリスト)です。<br />
こちらも、パブリックメンバーをシリアル化の対象とします。
<br />
ジェネリックのリストは、そのままではシリアライズできないので、Json.Converterユニットに定義済みの TJsonListConverter<v>からTClerk型用の派生クラス</v><br />
<br />
<pre class="delphi" name="code"> //TClerk型のリスト用のコンバーター
TJsonClerkListConverter = class(TJsonListConverter<TClerk>);
</pre>
<br />
を作成し、TClerk型のジェネリックリスト型のメンバーClerks用のコンバーター属性を付加しています。<br />
<br />
クラス定義の全体は、以下とおりです。<br />
<pre class="delphi" name="code">unit Unit2;
interface
uses
//Json.SerializersとConverterを使用する。
System.JSON.Serializers
, System.JSON.Converters
//TList<t>を使用する
, System.Generics.Collections
;
type
//パブリックメンバーをシリアライズ対象にする属性
[JsonSerialize(TJsonMemberSerialization.&Public)]
TClerk = class
private
FName: string;
FAge: integer;
procedure SetAge(const Value: integer);
procedure SetName(const Value: string);
public
property Name : string read FName write SetName;
property Age : integer read FAge write SetAge;
constructor Create; overload;
constructor Create(const vName : string; const vAge : integer); overload;
end;
//TClerk型のリスト用のコンバーター
TJsonClerkListConverter = class(TJsonListConverter<TClerk>;);
[JsonSerialize(TJsonMemberSerialization.&Public)]
TCoffeeShop = class
private
FClerks: TList<TClerk>;
FShopName: string;
procedure SetClerks(const Value: TList<TClerk>);
procedure SetShopName(const Value: string);
public
property ShopName : string read FShopName write SetShopName;
//TClerkクラスのジェネリックリスト用のコンバーターを登録
[JsonConverter(TJsonClerkListConverter)]
property Clerks : TList<TClerk> read FClerks write SetClerks;
public constructor Create;
end;
implementation
{ TClerk }
constructor TClerk.Create(const vName: string; const vAge: integer);
begin
FName := vName;
FAge := vAge;
end;
constructor TClerk.Create;
begin
end;
procedure TClerk.SetAge(const Value: integer);
begin
FAge := Value;
end;
procedure TClerk.SetName(const Value: string);
begin
FName := Value;
end;
{ TCoffeeShop }
constructor TCoffeeShop.Create;
begin
FClerks := TList<TClerk>.Create;
end;
procedure TCoffeeShop.SetClerks(const Value: TList<TClerk>);
begin
FClerks := Value;
end;
procedure TCoffeeShop.SetShopName(const Value: string);
begin
FShopName := Value;
end;
end.
</pre>
<br />
上記で定義したクラスに対で、冒頭で示した内容のJson形式の定義ファイルCoffeeShop.Jsonを読み込み、デシリアライズする処理は、以下のとおりとなります。<br />
<br />
<pre class="delphi" name="code">procedure TForm1.Button2Click(Sender: TObject);
var
CoffeeShop : TCoffeeShop;
serializer: TJsonSerializer;
s : string;
Clerk : TClerk;
begin
s := TFile.ReadAllText('CoffeeShop.Json',TEncoding.UTF8);
serializer := TJsonSerializer.Create;
try
CoffeeShop := serializer.Deserialize<TCoffeeShop>(s);
try
Memo1.Clear;
Memo1.Lines.Add(CoffeeShop.ShopName);
for Clerk in CoffeeShop.Clerks do
begin
Memo1.Lines.Add(Clerk.Name + '(' + Clerk.Age.ToString() + ')');
end;
finally
CoffeeShop.Clerks.Clear();
CoffeeShop.Free;
end;
finally
serializer.Free
end;
</pre>
<br />
ファイルを読み込み、シリアライザーを生成し、読み込んだJson文字列をデシリアライズして、ショップ名と、店員の情報をメモに表示しています。
(余談ですが、クラス定義で属性を使用しないで、TJsonSerializerインスタンスのConverterリストにTJsonClerkListConverterのインスタンスを登録してもデシリアライズできます。)
<br />
<br />
冒頭で示した内容のJson形式の定義ファイルを作成する場合は、以下の処理でできます。<br />
<br />
<pre class="delphi" name="code">procedure TForm1.Button1Click(Sender: TObject);
var
CoffeeShop : TCoffeeShop;
serializer: TJsonSerializer;
s : string;
begin
CoffeeShop := TCoffeeShop.Create;
try
CoffeeShop.ShopName := 'ラビットハウス';
CoffeeShop.Clerks.Add(TClerk.Create('ココア',17));
CoffeeShop.Clerks.Add(TClerk.Create('チノ',15));
CoffeeShop.Clerks.Add(TClerk.Create('リゼ',17));
serializer := TJsonSerializer.Create;
try
s := serializer.Serialize(CoffeeShop);
Memo1.Text := s;
TFile.WriteAllText('CoffeeShop.Json',s);
finally
serializer.Free;
end;
finally
CoffeeShop.Clerks.Clear();
CoffeeShop.Free;
end;
end;
</pre>
<br />
TCoffeeShop型のインスタンスを生成し、メンバーを設定後、シリアライザーを生成しシリアライズ後、ファイルに保存しています。<br />
(確認の為、画面上のメモにも表示しています。)<br />
<br />
<br />
プロジェクト一式は、<a href="https://bitbucket.org/OldTPFun/delphitest/src/master/JsonTest/Proj1/">https://bitbucket.org/OldTPFun/delphitest/src/master/JsonTest/Proj1/</a><br />
に配置しております。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-31274704231004118202014-01-25T11:38:00.000+09:002014-01-25T12:23:15.248+09:00GExpertsのMove to Matching Delimiter 機能数日前、@_fm2さんが、ツイッターで<br />
<br />
"<a href="https://twitter.com/_fm2/status/425502520140521473">DelphiのIDEで begin 対する end を検索する、ショートカットなんぞはありませんか?</a>"<br />
<div>
<br /></div>
<div>
とのつぶやかれてまた。</div>
<div>
<br /></div>
<div>
これ、IDEの標準機能では、出来なさそうだけど、<a href="http://www.gexperts.org/">GExperts</a> のEditor Exports機能で</div>
<div>
できます。</div>
<div>
<br /></div>
<div>
GExperts自体は、有名なツールなので、ご存知の方も多いと思います。</div>
<div>
<br /></div>
<div>
先ずは、GExpertsのインストール。</div>
<div>
<br /></div>
<div>
XE4までは、<a href="http://www.gexperts.org/download/">GExperts のサイトにインストーラ</a>があるので、インストラーを使って</div>
<div>
セットアップできます。</div>
<div>
<br /></div>
<div>
XE5は、残念ながら、インストーラがないので手動インストールが必要です。</div>
<div>
インストール方法は、以下のとおりです。(Delphi XE5が必要です。)</div>
<div>
<br /></div>
<div>
1) <a href="http://sourceforge.net/p/gexperts/code/HEAD/tree/">SourceForgeのリポジトリ</a>からソースを入手します。</div>
<div>
<br /></div>
<div>
2) XE5用のプロジェクトを開きビルドします。</div>
<div>
ビルドすると、GExpertsRSXE5.dllができます。</div>
<div>
<br /></div>
<div>
3) レジストリ登録を行います。</div>
<div>
レジストリエディターで、</div>
<div>
<br /></div>
<div>
HKEY_CURRENT_USER\Software\Embarcadero\BDS\12.0\Experts\</div>
<div>
<br /></div>
<div>
に、文字列キーGExpertsを作成し、値にGExpertsRSXE5.dllをフルパスで</div>
<div>
設定します。</div>
<div>
<br /></div>
<div>
インストールに成功すれば、Delphi ( RadStudio )を起動するとメニューに</div>
<div>
GExpertsが表示されます。</div>
<div>
<br /></div>
<div>
この状態で、Delphiのソースコードを開き"begin"のところにカーソルをあてて</div>
<div>
[CTRL] + [ALT] + [右矢印キー]を押すと、対応する"end"に移動します。</div>
<div>
この位置で、もう一回[CTRL] + [ALT] + [右矢印キー]を押すと、"begin"に</div>
<div>
戻ります。(このショートカットキーは変更可能です。)</div>
<div>
<br /></div>
<div>
GExpertsのメニューから、Configurationを選択し、設定用のダイアログを開き、</div>
<div>
Editor Expertsタブを選択し、Move to Matching Delimiterのところにカーソルを</div>
<div>
あてると、機能の説明が確認できます。</div>
<div>
説明には、</div>
<div>
<br /></div>
<div>
" This expert enables you to quickly move to a matching beginning/ending delimiter for the following Delphi tokens: begin, try, case, repeat, for, with, while, asm, do, if, then, else, class, record, array, interface, implementation, uses, private, protected, public, published, until, end, try, finally, except, (/), and [/], .</div>
<div>
It also supports the following C++ tokens: {/}, (/), and [/]</div>
<div>
The following steps are taken to match delimiters:</div>
<div>
- Beginning at the current cursor position, the expert looks to the left on the current line for a delimiter token such as "begin".</div>
<div>
- If a delimiter token is found, the expert scans for the matching token, such as "end" in the above instance.</div>
<div>
- If no delimiter is found to the left, as in the case "if|(i=0)" (where '|' represents the cursor), the expert attempts to find a delimiter token to the right of the current cursor position. In the mentioned example, this will identify the opening parenthesis, and an attempt is made to locate the closing parenthesis. "</div>
<div>
<br /></div>
<div>
とありますので、指定したトークンとペアになるトークンがあれば、その位置に</div>
<div>
移動するようです。</div>
<div>
<br /></div>
<div>
試しに、try 〜 finally 〜 end で試した場合、finallyの位置でこの機能を使用した</div>
<div>
場合の移動先は状況に依存するようでした。</div>
<div>
(tryからはfinallyに、endからはfinallyにそれぞれ移動します。)</div>
<div>
<br /></div>
<div>
ソースも公開されてますので、GX_eFindDelimiter.pas等を書き換えれば<br />
動きのカスタマイズも可能かと思います。</div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
<br /></div>
<div>
</div>
<div>
<br /></div>
OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-30779680778210646432012-12-13T23:50:00.000+09:002012-12-14T00:07:12.668+09:00publishedなメソッドを隠す(ネストした型宣言使用編)<a href="http://nonothoughtman.blogspot.jp/2012/12/published.html">前回</a>の続きです。<br />
<br />
さて、最近のDelphiでは、<a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/%E3%83%8D%E3%82%B9%E3%83%88%E3%81%97%E3%81%9F%E5%9E%8B%E5%AE%A3%E8%A8%80">ネストした型宣言</a>が可能で、クラス宣言の中にクラスの宣言ができます。<br />
<br />
この機能を使って、クラスの使用者からpublishedなメソッドを隠すことを試してみました。<br />
<br />
以下、ソースです。<br />
<br />
先ず、
【関数名でメソッドが呼び出されるクラスのサンプル】<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
親クラスのprivateセクションにpublishedなメソッドを持つ子クラスを宣言しています。<br />
これで、ユニットの使用者からは、子クラスのメソッドの宣言が見えなくなり、直接呼び出す<br />
ことができなくなります。<br />
ユニットの使用者には、publicセクションにメソッドを宣言することで、間接的に目的の<br />
メソッドが呼び出せるようにします。<br />
<br />
次に上記のクラスを使用するコード<br />
<br />
<pre class="delphi" name="code">
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.
</pre>
<br />
ユニットを使用する側からは子クラスが見えませんので、親クラスのpublicなメソッドのみが<br />
使用できます。<br />
<br />
<br />
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-59708547990628858182012-12-13T00:29:00.000+09:002012-12-13T00:29:08.769+09:00publishedなメソッドを隠す<a href="http://nonothoughtman.blogspot.jp/2012/12/blog-post_12.html">前回</a>の続きです。<br />
<br />
TObjectのMethodAddressメソッドを使用すれば関数名(文字列)でメソッドをコールできます。<br />
<br />
しかし、 MethodAddressメソッドでメソッドのアドレスを取得するには、可視性をpublishedに<br />
する必要があり、 publishedにした瞬間にメソッドの存在が丸わかりになってしまいます。<br />
<br />
前回の例のような単純な演算であればまあ良いかと思うのですが、いわゆるFactoryメソッド<br />
とかだと、使用者にその存在を隠したい場合があり、このままではちょっと不完全です。<br />
<br />
さて、どうしようか?というのが今回のテーマになります。(2010以降の拡張Rttiを使えば良い<br />
というのはあるのですが、今回は別の方法を考えます。)<br />
<br />
ところで、<a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0%E3%81%A8%E3%83%A6%E3%83%8B%E3%83%83%E3%83%88">DelphiのUnitのimplementationセクションで定義した型(クラスを含む)は別のユニット</a><br />
<a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0%E3%81%A8%E3%83%A6%E3%83%8B%E3%83%83%E3%83%88">から参照できない仕様</a>となっています。<br />
<br />
したがって、クラスの定義を implementation で行えば、外部から処理の存在を隠したうえで<br />
MethodAddressメソッド が使用可能なクラスができそうです。<br />
<br />
で、実際に、作ってみました。<br />
<br />
先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】<br />
<pre class="delphi" name="code">
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.
</pre>
<br />
publishedの可視性を持つクラスをimplementationセクションに定義しています。<br />
但し、そのままでは、外部のユニットからメソッドをコールできませんので、<br />
外部からのアクセスようにラッパー関数を定義しています。<br />
<br />
次に、【関数名を文字列で指定して処理を呼び出すサンプル】<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
unit2のinterfaceセクションに定義したラッパーを使って処理を呼び出しています。<br />
<br />
<br />
implementationセクションにクラスを定義することで、外部からその存在を隠しつつ<br />
メソッド名を文字列で指定してメソッドをコールすることが可能です。<br />
<br />
但し、この方法ですとクラスそのものも隠れてしまいすのでもう少しなんとかしたい<br />
ところです。<br />
<br />
<a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/%E3%83%8D%E3%82%B9%E3%83%88%E3%81%97%E3%81%9F%E5%9E%8B%E5%AE%A3%E8%A8%80">ネストした型宣言</a>が可能なバージョンのDelphiであれば、何とかできそうな気が<br />
しますが、その検証はまた後日・・・OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-73502064539939017692012-12-12T23:38:00.001+09:002012-12-13T00:12:04.575+09:00メソッドを名前で呼び出す<a href="http://nonothoughtman.blogspot.jp/2012/12/blog-post.html">前回</a>の続きです。<br />
<br />
関数(function)のメソッドポインタが定義できれば、TObjectのMethodAddressを使って<br />
関数名を(文字で)指定してコールすることが可能です。<br />
<br />
以下、サンプルソース。<br />
<br />
先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
MethodAddressを使用するためにpublishedを指定してることに注意願います。<br />
<br />
次に、【関数名を文字列で指定して処理を呼び出すサンプル】<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
ボタンのキャプション名が名前のメソッドが定義されているという前提で、ボタンのキャプションを<br />
使って関数をコールして、結果を求めています。<br />
<br />
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-73215629379474881022012-12-12T01:10:00.000+09:002012-12-12T05:26:36.147+09:00関数のメソッドポインタメソッドポインタでfunctionを使った例のサンプルです。<br />
あまり見当たらなかったので、備忘録がわりに公開しときます。<br />
<br />
<br />
【メソッドポインタ経由でfunctionを呼び出すサンプル】<br />
<br />
<pre class="delphi" name="code">
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.</pre>
<br />
<br />
【メソッドポインタ経由で呼び出されるクラスのサンプル】
<br />
<br />
<pre class="delphi" name="code">
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.
</pre>
<br />
メソッドポインタは<a href="http://docwiki.embarcadero.com/RADStudio/XE3/ja/%E6%89%8B%E7%B6%9A%E3%81%8D%E5%9E%8B">ヘルプ</a>にもあるように、<br />
<br />
Type 型名 = "メソッドの定義" of object<br />
<br />
のように宣言します。<br />
<br />
ここで、"メソッドの定義"は、通常の手続き(関数)の名前を抜いたものになるので、<br />
例えば、TObject型のSenderを引数に持ち、戻り値がない"メソッドの定義"は、<br />
<br />
procedure(Sender : TObject)<br />
<br />
同様に、Double型のaとbを引数に持ち、Double型の戻り値がある"メソッドの定義"は<br />
<br />
function(a,b : Double) : Double<br />
<br />
となります。<br />
<br />
上記のサンプル1では、ボタンのキャプションに応じてif分で関数を切り替えています。<br />
<br />
この例では、関数が2つだけなので、メソッドポインタ経由ではなく、直接目的の関数を<br />
コールしたほうが良いのですが、<br />
同じ型の引数を持つ関数が多数ある場合、メソッドポインタと、TObject.MethodAddressを<br />
組み合わるとコード量を減らせる可能性があります。(上の例だとボタンのCaptionと関数名を<br />
合わせおくことによりif文(あるいは、Case文)を無くすことが可能です。)<br />
<br />
そのへんの話はまた後日・・・<br />
<br />
<br />
<br />
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-2118832762822710612012-11-10T23:05:00.002+09:002012-11-10T23:05:23.174+09:00TZipFile.ZipDirectoryContentsのCOMラッパー仕事で、VB6でフォルダーを圧縮する必要が出てきて、どうしようかと迷ってた時<br />
<a href="http://ht-deko.minim.ne.jp/tech072.html">DEKOさんが以前フォルダごと圧縮してZipファイルを作成するデモ</a>を紹介してたのを<br />
思い出したのでCOM化してVB6,VBAから呼び出せるようにしてみた。<br />
<br />
以下、ソース<br />
<br />
<br />
<pre class="delphi" name="code">unit DirZipImp;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, SimpleDirZip_TLB, StdVcl;
type
TDirZip = class(TAutoObject, IDirZip)
protected
procedure Compress(const SrcDirName, ZipFileName: WideString); safecall;
procedure Extract(const ZipFileName, DestDirName: WideString); safecall;
end;
implementation
uses ComServ,System.Zip;
procedure TDirZip.Compress(const SrcDirName, ZipFileName: WideString);
begin
TZipFile.ZipDirectoryContents(ZipFileName,SrcDirName);
end;
procedure TDirZip.Extract(const ZipFileName, DestDirName: WideString);
begin
TZipFile.ExtractZipFile(ZipFileName,DestDirName);
end;
initialization
TAutoObjectFactory.Create(ComServer, TDirZip, Class_DirZip,
ciMultiInstance, tmApartment);
end.
</pre>
<br />
<br />
Delphiが作成したタイプライブラリーは
<br />
<pre class="delphi" name="code">// ************************************************************************ //
// 警告
// -------
// このファイルはタイプ ライブラリ インポータまたはタイプ ライブラリ エディタで生成されています。
// 構文エラーがない場合には、エディタはファイルへの変更を構文解析します。
// ただし、エディタで変更したときは、このファイルは再生成され、
// コメントやフォーマットの変更は失われます。
// ************************************************************************ //
// 2012/11/10 20:48:27 に生成されたファイル (- $Rev: 12980 $, 52614628)
[
uuid(A77B985B-35E5-49A6-91CB-5BCD38D54C22),
version(1.0)
]
library SimpleDirZip
{
importlib("stdole2.tlb");
interface IDirZip;
coclass DirZip;
[
uuid(2CCEF7D7-0EF5-467E-BFEC-F4574049C00D),
helpstring("DirZip Object のディスパッチ インターフェイス"),
dual,
oleautomation
]
interface IDirZip: IDispatch
{
[id(0x000000C9)]
HRESULT _stdcall Compress([in] BSTR SrcDirName, [in] BSTR ZipFileName);
[id(0x000000CA)]
HRESULT _stdcall Extract([in] BSTR ZipFileName, [in] BSTR DestDirName);
};
[
uuid(2B59D5EC-076B-4577-8C09-F3968AEFF615),
helpstring("DirZip Object")
]
coclass DirZip
{
[default] interface IDirZip;
};
};
unit SimpleDirZip_TLB;
// ************************************************************************ //
// 警告
// -------
// このファイルで宣言されている型はタイプ ライブラリから読み取られたデータから
// 生成されています。このタイプ ライブラリが明示的あるいは(このタイプ ライブラ
// リを参照しているほかのタイプ ライブラリ経由で)間接的に再インポートされた
// り、タイプ ライブライブラリの編集中にタイプ ライブラリ エディタの[更新]コマ
// ンドを実行した場合、このファイルの内容はすべて再生成され、手動で加えた変更
// はすべて失われます。
// ************************************************************************ //
// $Rev: 52393 $
// 下に説明されたタイプ ライブラリから 2012/11/10 20:48:24 に生成されたファイル。
// ************************************************************************ //
// タイプ ライブラリ: C:\Users\saka_xps\Documents\Saka_Develop\DelProj\SimpleDirZip (1)
// LIBID: {A77B985B-35E5-49A6-91CB-5BCD38D54C22}
// LCID: 0
// ヘルプファイル:
// ヘルプ文字列:
// 依存関係リスト:
// (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// SYS_KIND: SYS_WIN32
// ************************************************************************ //
{$TYPEDADDRESS OFF} // ポインタの型チェックをオフにしてコンパイルすること
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
interface
uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
// *********************************************************************//
// タイプ ライブラリで宣言される GUID. 以下のプレフィックスを使う:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// タイプ ライブラリのメジャー バージョンとマイナー バージョン
SimpleDirZipMajorVersion = 1;
SimpleDirZipMinorVersion = 0;
LIBID_SimpleDirZip: TGUID = '{A77B985B-35E5-49A6-91CB-5BCD38D54C22}';
IID_IDirZip: TGUID = '{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}';
CLASS_DirZip: TGUID = '{2B59D5EC-076B-4577-8C09-F3968AEFF615}';
type
// *********************************************************************//
// タイプ ライブラリで宣言される前方参照
// *********************************************************************//
IDirZip = interface;
IDirZipDisp = dispinterface;
// *********************************************************************//
// タイプ ライブラリで宣言される CoClass
// (注意: ここで各 CoClass とデフォルトのインターフェイスをマッピングする)
// *********************************************************************//
DirZip = IDirZip;
// *********************************************************************//
// インターフェイス: IDirZip
// フラグ: (4416) Dual OleAutomation Dispatchable
// GUID: {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}
// *********************************************************************//
IDirZip = interface(IDispatch)
['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']
procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); safecall;
procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); safecall;
end;
// *********************************************************************//
// DispIntf: IDirZipDisp
// フラグ: (4416) Dual OleAutomation Dispatchable
// GUID: {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}
// *********************************************************************//
IDirZipDisp = dispinterface
['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']
procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); dispid 201;
procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); dispid 202;
end;
// *********************************************************************//
// クラス DirZip は、Create および CreateRemote メソッドを使用して
// CoClass DirZip が公開するデフォルトのインターフェイス IDirZip の
// インスタンスを作成する。このタイプ ライブラリのサーバーによって
// 公開された CoClass オブジェクトに対し、オートメーションを行いたい
// クライアントが用いるために、これらの関数が存在する。
// *********************************************************************//
CoDirZip = class
class function Create: IDirZip;
class function CreateRemote(const MachineName: string): IDirZip;
end;
implementation
uses System.Win.ComObj;
class function CoDirZip.Create: IDirZip;
begin
Result := CreateComObject(CLASS_DirZip) as IDirZip;
end;
class function CoDirZip.CreateRemote(const MachineName: string): IDirZip;
begin
Result := CreateRemoteComObject(MachineName, CLASS_DirZip) as IDirZip;
end;
end.
</pre>
VB6,VBAの呼び出しのサンプルは、<br />
<br />
<br />
<pre class="VB" name="code">Private Sub CommandButton1_Click()
Dim DirZip As SimpleDirZip.DirZip
Set DirZip = New SimpleDirZip.DirZip
Call DirZip.Compress("C:\Users\ppp", "C:\Users\pp\ppp.zip")
Set DirZip = Nothing
End Sub
Private Sub CommandButton2_Click()
Dim DirZip As SimpleDirZip.DirZip
Set DirZip = New SimpleDirZip.DirZip
Call DirZip.Extract("C:\Users\pp\ppp.zip", "C:\Users\pp\p")
Set DirZip = Nothing
End Sub
</pre>
C#とかでComを作るより簡単かも。<br />
<br />
ところで、タイプライブラリでインターフェイスのメソッド名を編集時にメソッド名が全部消せないのは<br />
仕様なんかしら・・・。<br />
とりあえず2007では消せたんだけど・・・・。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-44318289749472442912012-11-10T11:14:00.001+09:002012-11-10T11:14:41.721+09:00AnsiExtractQotedStrQuotedStr関数の存在は、知ってたけど、AnsiExtrctQuotedStrの存在は知らなかった。(^^ゞ<br />
ってことで、使ってみた。<br />
以下ソース<br />
<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
<br />
AnsiExtractQuitedStr内のsrcのとこで、直接キャストしようとすると
コンパイルエラーが出るので、一度変数受けでキャスト。
<br />
で実行結果は、
<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3Vf_9QCe894fqciab2K0LO7bTiykNJ6P1PkrZymWq6Sz2v2waKoBf3FF8dHhlM8ky7BaEIU7Cuq61fNkBRGa82zqvhIe-YKH5johKE9gYda3yaT1QoJkkfD0gKfLm76Lz8809NErheRth/s1600/AnsiExtractQuotedStr.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj3Vf_9QCe894fqciab2K0LO7bTiykNJ6P1PkrZymWq6Sz2v2waKoBf3FF8dHhlM8ky7BaEIU7Cuq61fNkBRGa82zqvhIe-YKH5johKE9gYda3yaT1QoJkkfD0gKfLm76Lz8809NErheRth/s1600/AnsiExtractQuotedStr.png" height="232" width="320" /></a></div>
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-76823449168821310212012-11-08T23:53:00.002+09:002012-11-09T00:14:52.827+09:00指定したフォルダの特定のファイルをSJISからUTF8に変更する今の仕事で使用した、SJIS→UTF8のチャラツール。<br />
ファイル数がすくなければ、手作業でするけど、ファイル数が多いのファイルが<br />
サブディレクトリにわたるので、作ってみた。<br />
諸般の事情により、Delphi2007で作ったので、UTF8への変換にはjclUnicodeの<br />
TWideStringList、ファイルの走査にはJclFileUtilsのTJclFileEnumeratorを利用した。<br />
(変換元ファイルのディレクトリ、変換先のディレクトリの指定にJvclの
TJvDirectoryEdit
<br />
を使用した。)<br />
<br />
以下ソースコード。<br />
<br />
<br />
<pre class="delphi" name="code">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.
</pre>
<br />
TJclFileEnumeratorは、ファイル検索の条件を設定したうえで、検索条件に該当するファイルが<br />
見つかった場合に呼び出すメソッドを指定してForEcahメソッドを実行すれば、都度、指定した<br />
メソッドを呼び出してくれるので、ForEachに指定しメソッドにSJIS→UTF8の変換処理を<br />
書けばよい。(ソース上ではAddFile)
<br />
<br />
TStringListを使ってファイルを読み込み、そのテキストをTWideStringListに<br />
渡して、 をTWideStringListでUTF-8を指定して保存することにより、UTF-8変換を<br />
実施した。(このへんは、Delphi 2009以降ならもっとスマートにできる思う。)<br />
<br />
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-85012871794433920632012-09-11T02:25:00.002+09:002012-09-11T02:25:54.753+09:00JoinのオーバーロードJoinのオーバーロードを試してみた。<br />
但し、
<br />
<div id="globalWrapper" sizcache07736431666782502="1.0.0" sizset="false">
<div id="column-content" sizcache07736431666782502="1.0.0" sizset="false">
<div id="content" sizcache07736431666782502="1.0.0" sizset="false">
<div id="bodyContent" sizcache07736431666782502="1.0.0" sizset="false">
<div id="codesig">
<div class="delphi sig">
<div class="thesig">
<div class="mw-geshi" dir="ltr" style="text-align: left;">
<div class="delphi source-delphi" style="font-family: monospace;">
<pre class="de1"><span class="kw1">class</span> <span class="kw1">function</span> Join<span class="br0">(</span><span class="kw1">const</span> Separator<span class="sy1">:</span> <span class="kw4">string</span><span class="sy1">;</span> <span class="kw1">const</span> Values<span class="sy1">:</span> IEnumerable<string><span class="br0">)</span><span class="sy1">:</span> <span class="kw4">string</span><span class="sy1">;</span> <span class="kw1">overload</span><span class="sy1">;</span> static<span class="sy1">;</span>
</string></pre>
</div>
</div>
</div>
</div>
</div>
</div>
</div>
</div>
</div>
以外です。<br />
詳細はプログラム中のコメントに記述しました。<br />
以下、プログラム<br />
<br />
<br />
<br />
<pre class="delphi" name="code">program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Variants;
var
s : string;
a,b : single;
s1,S2: string;
elm : TArray<string>;
//sh : TStringHelper;
begin
try
{ TODO -oUser -cConsole メイン : ここにコードを記述してください }
//sh : TStringHelper
//オーバーロードの1つ目
//オープン配列を使用した形です。
writeln('overload1:オープン配列');
s := s.Join(',',['ミリー','ハイネ']);
write('OK:');
writeln(s);
writeln;
s1 := '2.17'; s2 := '9.19';
s := s.Join(',',[s1,s2]);
write('OK:');
writeln(s);
writeln;
//文字列以外の型だとうまく出力できないようです。
//空文字が出力されます。
a := 2.17; b := 9.19;
s := s.Join(',',[a,b]);
write('NG');
writeln(s);
writeln;
//オーバーロードの2つ目
//文字列配列の結合開始位置(0基数)と数を指定
//この例では、ニーナ,ベルト・サタンと表示します。
//文字列配列作成の為にとりあえず分割
s := 'ドッペ,パックン,ニーナ,ベルト・サタン,キノッピー';
elm := s.Split([',']);
writeln('overload2:開始位置と数を指定');
writeln('元の文字列配列');
for s1 in elm do
begin
writeln(s1);
end;
writeln('0基数で2番目の文字列から2個の文字列を結合');
s := s.Join(',',elm,2,2);
writeln(s);
writeln;
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
</string></pre>
<br />
実行結果は<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjHhC701V3cj5txuBoA5K6WsB6r4L6VPIt9P56y7ZSZusU_IJZSsO9xbnXcSFQzGLjqoXNa3Ox6S6gXrsxcjjZoaq4Xn9UU2pdoLq6TdetzrPCcbV6SgEbHVJVqjkM7jZQtGGvPWZarZikn/s1600/JoinResult2.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="232" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjHhC701V3cj5txuBoA5K6WsB6r4L6VPIt9P56y7ZSZusU_IJZSsO9xbnXcSFQzGLjqoXNa3Ox6S6gXrsxcjjZoaq4Xn9UU2pdoLq6TdetzrPCcbV6SgEbHVJVqjkM7jZQtGGvPWZarZikn/s320/JoinResult2.png" width="320" /></a></div>
です。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-30949973301190933212012-09-10T22:33:00.004+09:002012-09-10T22:33:54.309+09:00SplitのオーバーロードDelphi XE3のオーバーロードを試してみた。<br />
各オーバーロードの内容はプログラム中のコメントに<br />
記載しました。<br />
<br />
<pre class="delphi" name="code">program Project2;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
var
s,s1 : string;
elm : TArray<string>;
elm2 : TArray<string>;
//sh : TStringHelper;
begin
try
{ TODO -oUser -cConsole メイン : ここにコードを記述してください }
//sh : TStringHelper
s := 'ドッペ,パックン,ニーナ,,ベルト・サタン,,キノッピー';
//Writeln(s);
//カンマで分割
//オーバーロードの1つ目、第二引数に正の整数を入れると
//先頭から指定した個数だけ分割します。
//分割できる数以上の数を指定すると無視します。
//この場合は、ドッペとパックンだけを切り出します。
elm := s.Split([','],2);
write('overload1:');writeln(s);
//分割した要素を表示
for s1 in elm do
begin
writeln(s1);
end;
writeln;
//結合(念のため文字列を初期化)
//s := '';
//Writeln(s);
//s := s.Join(',',elm);
//Writeln(s);
//オーバーロードの2つ目、第二引数に
//TStringSplitOptions.ExcludeEmptyを指定すると
//空文字を無視して切り出します。
//TStringSplitOptionsを指定しない場合、あるいは
//TStringSplitOptions.Noneを指定した場合は
//空文字も1つとして切り出します。
elm2 := s.Split([','],TStringSplitOptions.None);
write('overload2-1:');writeln(s);
for s1 in elm2 do
begin
writeln(s1);
end;
writeln;
elm2 := s.Split([','],TStringSplitOptions.ExcludeEmpty);
write('overload2-2:');writeln(s);
for s1 in elm2 do
begin
writeln(s1);
end;
writeln;
//オーバーロードの3つ目、第二引数に正の整数を入れると
//先頭から指定した個数だけ分割します。
//このときTStringSplitOptions.ExcludeEmptyを指定すると
//空文字を無視して切り出します。
//TStringSplitOptionsを指定しない場合、あるいは
//TStringSplitOptions.Noneを指定した場合は
//空文字も1つとして切り出します。
//この場合はベルト・サタンも切り出します。
elm2 := s.Split([','],4,TStringSplitOptions.ExcludeEmpty);
write('overload3:');writeln(s);
for s1 in elm2 do
begin
writeln(s1);
end;
writeln;
//オーバーロードの4つ目、セパレータに文字列を指定する
//こともできます。
//この場合は、ドッペ,パッと,ニーナ,,ベルト・サタン,,キノッピー
//に分割されます。
//(セパレータにCRLFを指定することが可能です。)
elm2 := s.Split(['クン'],TStringSplitOptions.None);
write('overload4:');writeln(s);
for s1 in elm2 do
begin
writeln(s1);
end;
writeln;
//オーバーロードの5つ目、セパレータに文字列を指定したうえで
//分割した結果を取り出すことも可能です。
//この場合は、ドッペ,パッだけを取り出します。
//に分割されます。
elm2 := s.Split(['クン'],1,TStringSplitOptions.None);
write('overload5:');writeln(s);
for s1 in elm2 do
begin
writeln(s1);
end;
writeln;
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
</string></string></pre>
<br />
で実際に実行した結果のビットマップが<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhS3vga0_0cEmKGij3N3o8wngqkV75CXYGN0Ha_TKBgQSDcF8KbctmwLWcYghUwfAgh1w6bFPbrl0GF6l7AKrcvJUcqWpeWbQdZKzomY-GBdbuvXNhtJc8bOm_Mm83otc4d2m9ahKMUi4ih/s1600/ResultSplit.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="317" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhS3vga0_0cEmKGij3N3o8wngqkV75CXYGN0Ha_TKBgQSDcF8KbctmwLWcYghUwfAgh1w6bFPbrl0GF6l7AKrcvJUcqWpeWbQdZKzomY-GBdbuvXNhtJc8bOm_Mm83otc4d2m9ahKMUi4ih/s320/ResultSplit.png" width="320" /></a></div>
<br />
です。<br />
<br />
追伸:サンプルに使用した文字列がマイナーすぎたようなので、ちょっとだけわかりやすい<br />
ものにしました。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-5849790710951664762012-09-05T22:16:00.002+09:002012-09-05T22:17:27.347+09:00SplitとJoinDelphi XE3で新たに導入されたStringHelperを使ってみた。
使ったのはJoinとSplit。<br />
それぞれ一番簡単な呼び出し形式です。
<br />
以下、プログラム<br />
<br />
<br />
<br />
<pre class="delphi" name="code">unit Unit1;
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
var
s : string;
elm : TArray<string>;
//sh : TStringHelper;
begin
try
{ TODO -oUser -cConsole メイン : ここにコードを記述してください }
//sh : TStringHelper
s := 'キャサリン,さをり,ツネアキ,ハゲミーナ,ヒデオ';
Writeln(s);
//カンマで分割
elm := s.Split([',']);
//分割した要素を表示
for s in elm do
begin
writeln(s);
end;
//結合(念のため文字列を初期化)
s := '';
s := s.Join(',',elm);
Writeln(s);
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
</string></pre>
<br />
で実際に実行した結果が、<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgNIaVxyCYtOx-Xp8Gwkc3Z0r8GcTb1OeGpOXvj7XrMuW4jkrnne4z-CwN_euE7pYlBUwCVYTwE5aPG5Kah33p4K69HG0Qap6yWOTGoTZGalrRzMQrJ16Ki9jRwd9PJ3pn9N-oA2VUnUevD/s1600/ResultJoin.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="232" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgNIaVxyCYtOx-Xp8Gwkc3Z0r8GcTb1OeGpOXvj7XrMuW4jkrnne4z-CwN_euE7pYlBUwCVYTwE5aPG5Kah33p4K69HG0Qap6yWOTGoTZGalrRzMQrJ16Ki9jRwd9PJ3pn9N-oA2VUnUevD/s320/ResultJoin.png" width="320" /></a></div>
です。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-57969819549590750602012-06-07T06:41:00.000+09:002012-06-07T06:41:29.266+09:00DelphiでExcelブック内のシート一覧を取得し表示する(dbGo経由)前のブログで、ExcelのTypeライブラリーを使ってシート一覧を取得しましたが<br />
ついでといっては、なんですが、dbGo(Ado)を使って、シート一覧を取得してみます。<br />
<br />
TAdoQueryを使ってSQL文で、テーブル一覧を取得できないか、ちょっと調べたましたが<br />
無理そうだったので、ここでは、<br />
<br />
TADOConnection.OpenSchema<span class="br0"> (</span><br />
<span class="br0"> </span><span class="kw1">const</span> Schema<span class="sy1">:</span> TSchemaInfo<span class="sy1">;</span> <span class="kw1"> </span><br />
<span class="kw1"> const</span> Restrictions<span class="sy1">:</span> OleVariant<span class="sy1">;</span><br />
<span class="kw1">const</span> SchemaID<span class="sy1">:</span> OleVariant<span class="sy1">;</span><br />
DataSet<span class="sy1">:</span> TADODataSet<span class="br0">)</span><span class="sy1">;</span><br />
<br />
メソッドを使ってテーブルを取得します。<br />
<br />
方法は、簡単で、<br />
<br />
OpenSchema関数のパラメータ<br />
<br />
Schemaに<span class="sy1"> </span>TSchemaInfo.siTables<br />
DataSet<span class="sy1">に スキーマ取得結果の書き込み先のレコードセットを指定します。</span><br />
<br />
<span class="sy1"> </span> <br />
また、今回は、Restrictions<span class="sy1">と</span>SchemaID<span class="sy1">は使用しませんのでEmptyParamを指定します。</span><br />
<br />
<br />
<span class="sy1">さて、やってみます。</span><br />
<br />
<span class="sy1">フォームにTADOConnectionを配置し、ConnectionStringの</span><br />
<br />
<span class="sy1"> </span><span class="sy1">Providerに</span><span class="sy1">Microsoft.ACE.OLEDB.12.0</span><br />
<span class="sy1"> </span><span class="sy1">Data SourceにExcelのワークブックのパス</span><br />
<span class="sy1"> Extended PropertiesにExcel 12.0(Excel2010の場合)</span><br />
<br />
<span class="sy1">を指定します。</span><br />
<br />
<span class="sy1">(ConnectionStringについては、http://connectionstrings.com/ が参考になります。) </span><br />
<br />
<br />
<span class="sy1">次に結果格納先としての TADODataSetコンポーネントを配置し、Connectionプロパティに</span><br />
<span class="sy1">上記の </span><span class="sy1">TADOConnectionコンポーネントを指定します。</span><br />
<br />
<span class="sy1">あとは、通常の操作で、DataSource,DbGridを配置し、それぞれ接続します。</span><br />
<br />
<span class="sy1">あとはボタンなどを配置しそのイベントハンドラに</span><br />
<br />
<span class="sy1"> ADOConnection1.Connected := true;<br /> ADOConnection1.OpenSchema(siTables, EmptyParam, EmptyParam,ADODataSet1);<br /> </span><br />
<span class="sy1">のようなコードを書きます。</span><br />
<br />
<span class="sy1">で実行すれば、</span><br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEidIJOeYG-dAb1HLb8xnUfaCMfL94GnLw6t63H_EcbMvXeZk6APTkF403pmsqthLGX5xfhpYYDZjhyphenhyphen1eqhVcDSGsqa-kl6Ygyu62YBQ_85BO0KSOg2YFAIMlR4TZAPEPIlyhDOtMlRuwGYb/s1600/ResultAdo.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="211" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEidIJOeYG-dAb1HLb8xnUfaCMfL94GnLw6t63H_EcbMvXeZk6APTkF403pmsqthLGX5xfhpYYDZjhyphenhyphen1eqhVcDSGsqa-kl6Ygyu62YBQ_85BO0KSOg2YFAIMlR4TZAPEPIlyhDOtMlRuwGYb/s320/ResultAdo.png" width="320" /></a></div>
<br />
<br />
<br />
<br />
<span class="sy1">のように結果が得られます(右側) </span><br />
<br />
<span class="sy1"> </span><br />
<span class="sy1"> </span><span class="sy1"> </span><br />
なお、torry's Delphiのページにもうちょっと詳しいサンプルがあります。http://www.swissdelphicenter.ch/torry/showcode.php?id=1433<br />
<br />
また、Adoでの<span class="sy1">ExcelのSchema</span>,については、MSのHELP<br />
<span class="sy1">http://support.microsoft.com/kb/257819/ja</span><br />
<span class="sy1"><br /></span><br />
<span class="sy1">が参考になります。</span>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-84267835086302565082012-06-03T01:09:00.000+09:002012-06-03T01:09:41.433+09:00DelphiでExcelブック内のシート一覧を取得し表示する先日、DelphiでExcelのWorkSheetを列挙しながらSheetを編集する処理を作成したとき、<br />
思いもよらずはまったので、自分メモとして保存。<br />
<br />
DelphiからExcelを操作する方法としては、<br />
<br />
<ol>
<li>Excelのタイプライブラリーをインポート</li>
<li>dbGoを使用する</li>
<li>サードパーティのコンポーネントを使用する</li>
<li>・・・</li>
</ol>
などの方法があげらるが、<br />
<br />
今回は、1.タイプタイプライブラリーをインポートしてExcelを操作しシート名を一覧表示する<br />
処理をつかった。<br />
<br />
以下、ソース<br />
<br />
<pre class="delphi" name="code">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. </pre>
for ~ in doの構文が使えると、基数のこと意識しなくても良いが、コンパイルすると<br />
<br />
E2431 for-in ステートメントはコレクション型 'Sheets' で動作できません('Sheets' に 'GetEnumerator' のメンバが含まれていないかアクセスできないため)<br />
<br />
のメッセージが、出てEXEが作れないため、従来のfor文で列挙している。<br />
<br />
<b> </b><b> Excelのコレクションが1基数なので、for 文は、1からシート数まででにしていのが</b><br />
<b> ポイントです。(</b><b>ポイントというもののものではありませんが・・・)</b><b> </b><br />
<br />
まあ、Excelに限らず、Win32版のVisual Basic(VB6,VB5)とか、VBAのコレクションInterface<br />
は基本1基数なのですが・・・ <br />
<br />
下図のようなブックに対して<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiFI5bCc8qU2KJJMzUsHWmPEJXL7uHVOETIVthrO8tgG1n0gyxgsnxAp7xWJAZ-Nd3UVXpLULwD9Y7-ZEvq5RMnqlN887X_rgWbNmD_-s14tLE0zAX6ImLc6xEt66ZxMlrEECmQ2okWcnOZ/s1600/Sheet.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="245" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiFI5bCc8qU2KJJMzUsHWmPEJXL7uHVOETIVthrO8tgG1n0gyxgsnxAp7xWJAZ-Nd3UVXpLULwD9Y7-ZEvq5RMnqlN887X_rgWbNmD_-s14tLE0zAX6ImLc6xEt66ZxMlrEECmQ2okWcnOZ/s320/Sheet.png" width="320" /></a></div>
<br />
<br />
<br />
<br />
上のような処理を実行すると<br />
<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjzZ8p63oFT09XBQYp0lFJQX6X520OYL90yHnkWvLLfDzv0IVuvZLwc7gKTr3AWFo4Vu6ermOEH9qBRZBmHK1Cjst_ocqDMkyk0bpDUV5MaW96YUJ-aBpOOw-KYtD3KVXmkQoW9Tm0-U84Q/s1600/Result.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="320" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjzZ8p63oFT09XBQYp0lFJQX6X520OYL90yHnkWvLLfDzv0IVuvZLwc7gKTr3AWFo4Vu6ermOEH9qBRZBmHK1Cjst_ocqDMkyk0bpDUV5MaW96YUJ-aBpOOw-KYtD3KVXmkQoW9Tm0-U84Q/s320/Result.png" width="218" /></a></div>
のような結果がえられます。<br />
<br />
<br />
以下は、余談ですが、<br />
<br />
自分 、Excelのコレクションが1基数だということをすっかり忘れていて、結果、午前中つぶしちゃいました。<br />
<br />OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-20276340033186054132012-03-05T22:30:00.005+09:002012-03-05T22:57:32.181+09:00Unified Interbaseコンポーネントをつかってみた(番外編:Delphi Xe2で使う)<a href="http://sourceforge.net/projects/uib/">Unified Interbase</a>の<a href="http://uib.svn.sourceforge.net/viewvc/uib/">リポジトリ</a>には、Delphi Xe2用のパッケージ(プロジェクト)がありますので<br /><br />Unified InterbaseのコンポーネントはDelphi Xe2にインストール可能です。<br /><br />Xe2のバージョン管理リポジトリから開く機能を使って<a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgxoeVQv4tVJt0O0hO2fdi5Ax2L-13hbp39YUDbHPmf-l5YJSMOFOrZWMgfIwmbphRtG524lpwW7BeX3Gm6WHpFk-RG8NzPPtgGLI0P_JChEB4CXhgcK94K5vN_Slbamz08N5k5-bD34Chz/s1600/UIB.png"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 173px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgxoeVQv4tVJt0O0hO2fdi5Ax2L-13hbp39YUDbHPmf-l5YJSMOFOrZWMgfIwmbphRtG524lpwW7BeX3Gm6WHpFk-RG8NzPPtgGLI0P_JChEB4CXhgcK94K5vN_Slbamz08N5k5-bD34Chz/s320/UIB.png" alt="" id="BLOGGER_PHOTO_ID_5716407306472559058" border="0" /></a><br />としてソースをダウンロードし、<br />ダウンロード先、packagesフォルダから、UIBD16Win32.groupprojを開いて<br />ビルドすればインストールできます。<br /><br />インストールしたコンポーネントは、<br /><br /><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh8qUv12AhmQjA2X8f_tCSm92KHsa3BXZHtua9M_QpqX_EzjRDr4-MEXBWDSKg2q1iC8ikXkDl0r-4FSJshaG3shc6A4Pxf3qNWBgAwaCSutwijuzHhIMHo8M8MtQCy0qLNseEsWnsbtejo/s1600/UIB2.png"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 276px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh8qUv12AhmQjA2X8f_tCSm92KHsa3BXZHtua9M_QpqX_EzjRDr4-MEXBWDSKg2q1iC8ikXkDl0r-4FSJshaG3shc6A4Pxf3qNWBgAwaCSutwijuzHhIMHo8M8MtQCy0qLNseEsWnsbtejo/s320/UIB2.png" alt="" id="BLOGGER_PHOTO_ID_5716410481997621458" border="0" /></a>な感じになります。(64ビットもサポートされたてます。)<br /><br />あとは、<a href="http://nonothoughtman.blogspot.com/2011/01/unified-interbase.html">Unified Interbaseコンポーネントをつかってみた(その1)</a>と同様にして<br />Firebirdと接続が可能です。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-70950057212375113852011-09-24T12:03:00.003+09:002011-09-24T12:20:39.033+09:00LiveBindingを試してみる。DelphiXE2のLiveBindingの機能を使って、現在時刻を更新する処理を<div><a href="http://docwiki.embarcadero.com/RADStudio/ja/%E3%83%81%E3%83%A5%E3%83%BC%E3%83%88%E3%83%AA%E3%82%A2%E3%83%AB%EF%BC%9ALiveBinding_%E3%82%92%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0%E3%81%A7%E4%BD%BF%E7%94%A8%E3%81%99%E3%82%8B">チュートリアル</a>を参考作ってみた。<div><br /></div><div><div><div>処理としては、時刻が更新されると、登録した通知先(作った例場合はフォーム)の</div><div>表示を更新する処理になっています。</div><div><br /></div><div>以下ソース</div><div><br /></div><div>まずは、時計のソース、タイマーを使って定周期で時刻を更新し、登録先の</div><div>更新通知を行っています。</div><div>また、変更通知先を登録する処理を書いています。</div><div><br /><br /><pre class="delphi" name="code">unit Unit4;<br /><br />interface<br /><br />uses<br /> System.SysUtils, System.Classes,Vcl.ExtCtrls, Data.Bind.EngExt,<br /> Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs, Vcl.Bind.Editors,<br /> Data.Bind.Components,<br /> System.Bindings.EvalProtocol,<br /> System.Bindings.Expression,<br /> System.Bindings.ObjEval,<br /> System.Bindings.Helper;<br /><br />type<br /> TDataModule4 = class(TDataModule)<br /> FTimer: TTimer;<br /> procedure FTimerTimer(Sender: TObject);<br /> procedure DataModuleCreate(Sender: TObject);<br /> procedure DataModuleDestroy(Sender: TObject);<br /> private<br /> { Private 宣言 }<br /> FNowString : String;<br /> BindingExpression1: TBindingExpression;<br /> public<br /> procedure AddBindingList(const InputScopes: array of IScope; const BindExprStr: string; const OutputScopes: array of IScope; const OutputExpr: string);<br /> published<br /> { Public 宣言 }<br /> property NowString : String read FNowString;<br /> end;<br /><br />var<br /> DataModule4: TDataModule4;<br /><br />implementation<br /><br />{%CLASSGROUP 'Vcl.Controls.TControl'}<br /><br />uses Unit1;<br /><br />{$R *.dfm}<br /><br />procedure TDataModule4.AddBindingList(const InputScopes: array of IScope;<br /> const BindExprStr: string; const OutputScopes: array of IScope;<br /> const OutputExpr: string);<br />begin<br /><br /> BindingExpression1 := TBindings.CreateManagedBinding(<br /> InputScopes,<br /> BindExprStr,<br /> OutputScopes,<br /> OutputExpr,<br /> nil);<br /><br />end;<br /><br />procedure TDataModule4.DataModuleCreate(Sender: TObject);<br />begin<br /> //BindScope1.Active := true;<br />end;<br /><br />procedure TDataModule4.DataModuleDestroy(Sender: TObject);<br />begin<br /> //BindScope1.Active := false;<br />end;<br /><br />procedure TDataModule4.FTimerTimer(Sender: TObject);<br />begin<br /> FNowString := DateTimeToStr(Now);<br /> TBindings.Notify(Self, 'NowString');<br /><br />end;<br /><br />end.<br /></pre><br /><br />次に、時計を表示するソース。比較のためにポーリング処理で上記のソースのプロパティを使って<br />タイムスタンプを更新する処理もあります。<br /><br /><br /><pre class="delphi" name="code">unit Unit1;<br /><br />interface<br /><br />uses<br /> Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,<br /> Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,<br /> Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs,<br /> Unit4,<br /> System.Bindings.Expression,<br /> System.Bindings.ObjEval,<br /> System.Bindings.Helper,<br /> Vcl.Bind.Editors, Data.Bind.Components;<br /><br /><br />type<br /> TForm1 = class(TForm)<br /> Label1: TLabel;<br /> Label3: TLabel;<br /> Timer1: TTimer;<br /> Label2: TLabel;<br /> Label4: TLabel;<br /> procedure Timer1Timer(Sender: TObject);<br /> procedure FormCreate(Sender: TObject);<br /> procedure FormClose(Sender: TObject; var Action: TCloseAction);<br /> private<br /> { Private 宣言 }<br /> FSakaClock : TDataModule4;<br /> public<br /> { Public 宣言 }<br /> end;<br /><br />var<br /> Form1: TForm1;<br /><br />implementation<br /><br />{$R *.dfm}<br /><br /><br />procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);<br />begin<br /> //FSakaClock.Free;<br /> FSakaClock.Free;<br />end;<br /><br />procedure TForm1.FormCreate(Sender: TObject);<br />begin<br /> FSakaClock := TDataModule4.Create(Self);<br /> FSakaClock.AddBindingList(<br /> { inputs }<br /> [TBindings.CreateAssociationScope([<br /> Associate(FSakaClock, 'I1')<br /> ])],<br /> 'I1.NowString',<br /> { outputs }<br /> [TBindings.CreateAssociationScope([<br /> Associate(Label3, 'O1')<br /> ])],<br /> 'O1.Caption');<br /><br /> //FSakaClock := TSakaClock.Create(Self);<br />end;<br /><br />procedure TForm1.Timer1Timer(Sender: TObject);<br />begin<br /> Label1.Caption := FSakaClock.NowString;<br />end;<br /><br />end.<br /></pre><br /></div></div></div></div>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-6451059724951515022011-08-17T20:56:00.002+09:002011-08-17T21:01:50.255+09:00CPUのコア数を数える。<a href="http://docwiki.embarcadero.com/VCL/ja/System.CPUCount">Delphiのドキュメントによれば、System.CPUCount変数</a>を参照すればCPUのコア数が
<br />表示できるようだ。<div>
<br /></div><div>たとえば、</div><div>
<br /></div><div><pre class="delphi" name="code">Label1.Caption := IntToStr(System.CpuCount)
<br /></pre></div>
<br />でラベルにCPUのコア数が表示できる。<div>
<br /></div><div>自分のPCで試したけど、シングルコアのCPUなので</div><div>当然のことながら1と表示された。</div><div>
<br /></div>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-35763533944408969322011-07-07T23:36:00.000+09:002011-07-07T23:36:15.486+09:00指定したウインドウを最前面にもってくるVBAから指定したアプリが起動してない場合は起動し、既に起動済みの場合は、最前面に持ってくる<br />
という処理が必要になったので、Delphiで作成してみた。<br />
<br />
以下、指定したアプリを前面に持ってくるサンプル。<br />
<br />
<pre class="delphi" name="code">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.
</Pre>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-33250749067737139002011-07-07T22:59:00.000+09:002011-07-07T22:59:53.481+09:00プロセスリストを表示する(その2)Project jediのJclのJclSysInfoユニットにある。RunningProcessesList関数を使用すると<br />
プロセスリストが簡単にとれます。<br />
<br />
以下、サンプル<br />
<br />
<pre class="delphi" name="code">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;
</pre><br />
RunningProcessesListは、引数で指定したTStringsを継承した型インスタンスに<br />
プロセスのリストを返してくれます。<br />
<br />
このJclSysInfoユニット、ざっと見た感じで、便利そうなものが一杯あった。<br />
サンプルプログラムを元にもうチョットみてみよう。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-7590696364879031812011-04-07T23:16:00.003+09:002011-04-07T23:20:51.405+09:00VBスクリプトを動かす(動画付き)先日、ツイッターでMicrosoft Scriptコントロールの話題がでたのでDelphiでMicrosoft Scriptコントロールを<br />
使うサンプルを作ってみた。<br />
<br />
Microsoft ScriptコントールをDelphiに取り込む必要がある。<br />
<br />
Microsoft Scriptコントール取り込むには、コンポーネントの取り込みを選択し<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQBny73ZpkxOrHAMiwa32XmOTSAFd_EmsdQ3qJ8GvPzczsAqUsRj4IDNasX0ERqytiEo68Mh0GRelE8Jmds39fzbDEU_8VL5EWvs1NdDqdBlVhSVUvSho00QkbD8QZh3_pN-nllBw8GPwd/s1600/Com.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="199" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQBny73ZpkxOrHAMiwa32XmOTSAFd_EmsdQ3qJ8GvPzczsAqUsRj4IDNasX0ERqytiEo68Mh0GRelE8Jmds39fzbDEU_8VL5EWvs1NdDqdBlVhSVUvSho00QkbD8QZh3_pN-nllBw8GPwd/s320/Com.png" width="320" /></a></div><br />
ActiveXコントールの取り込みを選択する。<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEieJF-JvT4Spl1NCnb_K8X9KvwP8tuOUTLwc2PVMWU4yvR-FvnwOeWoX4ajh8NI7ITKi36naI8oPSM34YvyLpEFKrvOYh5nE-xmBmttxqU2HjX2U2ZkCz89ieaJEiRUycRzqsyVOGw-J1uL/s1600/acx.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="197" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEieJF-JvT4Spl1NCnb_K8X9KvwP8tuOUTLwc2PVMWU4yvR-FvnwOeWoX4ajh8NI7ITKi36naI8oPSM34YvyLpEFKrvOYh5nE-xmBmttxqU2HjX2U2ZkCz89ieaJEiRUycRzqsyVOGw-J1uL/s320/acx.png" width="320" /></a></div><br />
(ここでタイプライブラリの取り込みを選択するとクラスがつくられないみたい<br />
なので要注意)<br />
<br />
コントロールの一覧からMicroSoft Scriptコントロールを選択する。<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXCRwRxNKB083YBlhbLhIK6vStjGg51bWcbfeCEEgIhcjrNVCu9Nc266uiXFDga9pOCfeEd_O8Ll4t47dBJ4nNVzKDW1LlPlNm_O3KW_Znvax_ospI1GbOdew98YG7DVS_t_-VwWQ8gAsY/s1600/msc.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="182" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXCRwRxNKB083YBlhbLhIK6vStjGg51bWcbfeCEEgIhcjrNVCu9Nc266uiXFDga9pOCfeEd_O8Ll4t47dBJ4nNVzKDW1LlPlNm_O3KW_Znvax_ospI1GbOdew98YG7DVS_t_-VwWQ8gAsY/s320/msc.png" width="320" /></a></div><br />
<br />
あとは、画面の支持にしたがってファイルを作成し、Microsoft Scriptコントールを<br />
組み込みたいプロジェクトに読み込む。<br />
<br />
ここから、実際につくったサンプル。<br />
<br />
サンプルは、<br />
<br />
1) a,b二つの引数を持つVBSのFUNCTIONプロシージャを実行する。<br />
2) VBSはメモコンポーネントに記述する。<br />
3) メモコンポーネントに記述したFUNCTIONのリストをListBoxに表示する。<br />
4) ListBoxから選んだFUNCTIONを実行し結果をラベルに表示する。<br />
<br />
とゆうものです。<br />
<br />
以下、ソースファイル<br />
<br />
<pre class="delphi" name="code">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.
</pre><br />
以下、コントロールの取り込みと上記プログラムを実行しているところのデモ動画<br />
<div class="separator" style="clear: both; text-align: -webkit-auto;"><br />
</div><div class="separator" style="clear: both; text-align: -webkit-auto;"><br />
<iframe allowfullscreen='allowfullscreen' webkitallowfullscreen='webkitallowfullscreen' mozallowfullscreen='mozallowfullscreen' width='320' height='266' src='https://www.youtube.com/embed/g5CyNIspDAY?feature=player_embedded' frameborder='0'></iframe></div>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-52207874382351900092011-04-03T22:34:00.003+09:002011-04-03T23:18:19.328+09:00Guid文字列を得るDelphiで、Guidを得るには、通常の場合CreateGuid手続きを使用します。<br />
また、Guid文字列を得るする場合には、GuidToString手続きを使用して文字列に変換します。<br />
<br />
<pre class="delphi" name="code">procedure TForm1.Button1Click(Sender: TObject);
var
guid : TGuid;
begin
CreateGuid(guid);
LabeledEdit1.Text := GuidToString(guid);
end;
</pre><br />
Delphi XEでは、TGuid型に対して、TGuidHelperクラスが実装されているので<br />
このHelperを利用してもGuidを得ることができます。<br />
(Helperは.Net FrameworkのGuid構造体と同じ動きをするように実装されている<br />
ようです。但し、.Net側のToStringメソッドでは文字列が中括弧で囲まれないので<br />
注意が必要かなぁ?)<br />
<br />
<pre class="delphi" name="code">procedure TForm1.Button2Click(Sender: TObject);
var
guid:TGUID;
S:String;
begin
guid := TGUID.NewGuid;
LabeledEdit1.Text := guid.ToString;
end;
</pre><br />
TGuidHelperクラスにはGuidの表現形式に応じていくかのCreate関数が用意されていますで<br />
プログラム中で使用している表現形式からGUDIの生成が可能です。<br />
<br />
下記の例は、文字列で表現されたGUIDからTGuid型の変数を得る例です。<br />
<br />
<pre class="delphi" name="code">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;
</pre>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-47553096927606317132011-04-03T01:01:00.000+09:002011-04-03T01:01:59.181+09:00TSingletonImplementationクラスDelphi XEのHelpを見ていて、TSingletonImplementationというクラスがあるのに気づいた。<div><br />
</div><div>HELPをみると、IInterface の基本実装が必要で参照カウントが無効なシンプルなクラスの基底クラスなそうな。</div><div><br />
</div><div>ということは、COMでなインターフェイスについては、このクラスを使えばよいのかぁ~。</div><div><br />
</div><div>でも、何故Generics.Defaultsに配置してあるのだろう。</div>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-82187137242599308982011-04-01T00:48:00.004+09:002011-04-02T14:18:18.055+09:00ClientDatasetのでもBuleberry社のFlashBack ExpressのテストでClientDataSetのチョットしたサンプル動画(スクリーンキャプチャー)を<br />
作ってみた。<br />
<br />
サンプルの内容は、IDE上でクライアントデータセットのフィールドを作成し<br />
<br />
Delphiのプログラムでデータをセットするものです。<br />
<br />
編集もなにもしてないので、チョットまのびした動画になっちゃてます。<br />
<br />
<div class="separator" style="clear: both; text-align: center;"><br />
</div><div class="separator" style="clear: both; text-align: center;"><iframe allowfullscreen='allowfullscreen' webkitallowfullscreen='webkitallowfullscreen' mozallowfullscreen='mozallowfullscreen' width='480' height='360' src='https://www.youtube.com/embed/YDszFD5H6Us?feature=player_embedded' frameborder='0'></iframe></div>OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0tag:blogger.com,1999:blog-3868338865989133986.post-21667959306756197652011-03-01T00:09:00.002+09:002011-03-01T00:24:09.493+09:00Null許容型<a href="http://code.google.com/p/delphilhlplib/">delphilhlplib</a>の中にNull許容型が容易されてるのでちょっと試してみた。<br />
<br />
delpjihlplibは上記のリンクから最新のモジュールをダウンロードして<br />
パッケージをインストールすることで使用可能になります。<br />
<br />
以下試したソースコード<br />
<br />
<pre class="delphi" name="code">unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
Uses DeHL.Nullable;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i : Nullable <integer>
begin
//値を代入する前はNULL
if i.IsNull then
begin
Label1.Caption := 'Null';
end;
//値を代入すると普通の型のように扱える
i.Value := 100;
Label2.Caption := IntToStr(i);
//MakeNullでNullをセットできるようだ。
i.MakeNull;
if i.IsNull then
begin
Label3.Caption := 'Null';
end;
end;
end.
</pre><br />
delphihelplibには、そのほかにもいろいろなクラスがあるようなので、追々試してみようと思う。OldTPFunhttp://www.blogger.com/profile/01113552963854795286noreply@blogger.com0