2012年10月31日水曜日

Explorer への Drop


流行りに乗っかったわけではないですが、必要に駆られて OLE Drag and Drop (アプリケーションからエクスプローラーへデータをドロップ)を実装しようとしました

しかし!
「仮想ファイル(存在しないファイル)」を「IStream」で書き出していく IDataObject の良いサンプルが無く、非常に悩みました。

ちなみに、どんな時に存在しないファイルの書き出しが必要かというと、例えば FTP でファイル名だけ判っているファイルをエクスプローラにドロップする時です。
選択されているファイルを先にダウンロードする訳にもいかないので、IDataObject.GetData が来たときに IStream インターフェースを実装しているストリームを返してやります。

そんな実装がしたかっただけなのですが、さっぱり上手く行きません。
そこで、サンプルを探していたら

The Drag and Drop Component Suite for Delphi

というコンポーネントを発見したので、早速導入してみました。

……しかし、コンパイルが通りません。
Delphi 2010 用で更新が止まってるため、いくつか不整合が起きたようです。

まず DragDrop.pas の 2483 行目の
const
sClipNames: array[CF_TEXT..CF_MAX-1] of string =
('CF_TEXT', 'CF_BITMAP', 'CF_METAFILEPICT', 'CF_SYLK', 'CF_DIF', 'CF_TIFF',
'CF_OEMTEXT', 'CF_DIB', 'CF_PALETTE', 'CF_PENDATA', 'CF_RIFF', 'CF_WAVE',
'CF_UNICODETEXT', 'CF_ENHMETAFILE', 'CF_HDROP', 'CF_LOCALE');



const
sClipNames: array[CF_TEXT..CF_MAX-1] of string =
(
'CF_TEXT',
'CF_BITMAP',
'CF_METAFILEPICT',
'CF_SYLK',
'CF_DIF',
'CF_TIFF',
'CF_OEMTEXT',
'CF_DIB',
'CF_PALETTE',
'CF_PENDATA',
'CF_RIFF',
'CF_WAVE',
'CF_UNICODETEXT',
'CF_ENHMETAFILE',
'CF_HDROP',
'',
'CF_LOCALE'
);

と変えてやります。

次に DragDropContext の101 行目

function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
 
{ IContextMenu2 }
function HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult; stdcall;
 
{ IContextMenu3 }
function HandleMenuMsg2(uMsg: UINT; wParam, lParam: Integer;
var lpResult: Integer): HResult; stdcall;



function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
 
{ IContextMenu2 }
function HandleMenuMsg(uMsg: UINT; WParam: WPARAM; LParam: LPARAM): HResult; stdcall;
 
{ IContextMenu3 }
function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM; var lpResult: LRESULT): HResult; stdcall;

と変更します。
実装部も同じように引数を変更します。

次に DragDropSource, DragDropTarget の中で TThread.Resume を使っている部分があるので

{$ifndef VER21_PLUS}
procedure TDropSourceThread.Start;
begin
{$WARNINGS OFF}
Resume;
{$WARNINGS ON}
end;
{$endif}

{$ifndef VER21_PLUS}
procedure TDropTargetTransferThread.Start;
begin
{$WARNINGS OFF}
Resume;
{$WARNINGS ON}
end;
{$endif}

こんな風に {$WARNINGS} で囲ってやります。

これで、コンパイルが通るので同梱の DragDropD2011.dpk を開いてビルド&インストールします。
すると、これらのコンポーネントが登録されます。



では、元々やりたかった仮想ファイルのコピーを実装します。
Demo も入っている(\Demos\AsyncSource)のですが、プロジェクト規模が無駄に大きくて判りづらいです。
「AsyncSource with Filestreams」にいたっては Indy を使って FTP を実装しています……
必要なところが見えなくて非常に判りづらい!

ということで、最も簡単なデモを作りました。

まず、Form に、TDataFormatAdapter と TDropEmptySource を置きます。



次にオブジェクトインスペクタで TDataFormatAdapter と TDropEmptySource を結びつけます。



画像の様に DataFormatName は TVirtualFileStreamDataFormat とし、Enabled を True にしておきます。

Enabled プロパティは DataFormatName と DragDropComponent が設定されていないと変更できません。

そして DataFormatAdapter1 にイベントハンドラを設定し、その中身を作ります。

procedure TForm1.FormCreate(Sender: TObject);
begin
// イベントハンドラを設定する
(DataFormatAdapter1.DataFormat as TVirtualFileStreamDataFormat).OnGetStream
:= OnGetStream;
end;
 
procedure TForm1.OnGetStream(
Sender: TFileContentsStreamOnDemandClipboardFormat;
Index: integer;
out AStream: IStream);
var
Data: TVirtualFileStreamDataFormat;
begin
// ここは非同期で別スレッドから呼ばれるので、
// ここでファイルのダウンロードなどをし、ファイルを一旦生成する
// 生成した一時ファイルは TDropEmptySource.OnAfterDrop イベントなどの
// タイミングで適宜削除する
 
// 追加しておいたファイルを取り出す
Data := TVirtualFileStreamDataFormat(DataFormatAdapter1.DataFormat);
 
// 追加してある何番目のファイルかが Index に入っている
if (Index < Data.FileNames.Count) then
AStream :=
// TStreamAdapter を使うと IStream の実装が得られる
TStreamAdapter.Create(
TFileStream.Create(
Data.FileNames[Index],
fmOpenRead or fmShareDenyNone),
soOwned
);
end;

これで、非同期にファイルをコピーする仕組みは整いました。
実際にファイルの Drop を実行するためには TDropEmptySource.Execute を使います。

procedure TForm1.DropExecute;
var
Data: TVirtualFileStreamDataFormat;
begin
// OnMouseMove から呼ばれる(煩雑になるため機能を分けた)
 
// TVirtualFileStreamDataFormat.FileNames にコピーするファイル名を追加する
Data := TVirtualFileStreamDataFormat(DataFormatAdapter1.DataFormat);
Data.FileNames.Clear;
 
// 今回は自分をコピーしてみる
Data.FileNames.Add(Application.ExeName);
 
if (Data.FileNames.Count > 0) then
DropEmptySource1.Execute(True); // True を渡すと非同期で実行する
end;
ここでは「存在しないファイル」を用意するのが面倒なので「自分自身」をコピーするようにしました。
サンプルでは、フォームのどこでもドラッグすると、エクスプローラーにドロップできます。



是非お試しあれ。

2012年10月30日火曜日

deprecated 指令

Delphi-ML で紹介したテクニックなんですけど、たまに役に立つのでご紹介。

Delphi は言語仕様として一度広げた可視性を狭めることはできません
つまり、
type
TFoo = class
public
procedure Test; virtual;
end;
 
TBar = class(TFoo)
protected
procedure Test; override;
end;
XE3 で確認した所、可視性が低くなった事を示すヒントが出なくなっていました。
ヒントのデフォルトスイッチが変わった可能性があります。
……と思ったら、このヒントは「unit」の「interface 部」にのみ出力されるとリンク先にありました。

としても、Test メソッドは依然として public のままです。

そのため、クラスを継承した際に不都合がでる場合があります。
例えば、既存のライブラリクラスを継承して、新たに配布するためのクラスを作る場合などです。
自分やチームだけが使うクラスなら「このメソッドではなく、こちらを使ってください」と伝えるだけで済みます。
しかし、広範に配布するライブラリなどを作る場合では、利用者全員が利用方法を読んでくれる訳ではありません。

では、どうすれば良いかというと、使って欲しくないメソッドを Override しつつ deprecated を付けてしまえ、という事です。

deprecated 指令を付けると、コンパイラは「非推奨」という警告を出すようになります。
警告を一切気にしないユーザーには効果がありませんが、一般的なユーザーは、この警告に気づくでしょう。

具体的には以下のようにします。

type
TFoo = class
public
procedure Test; virtual;
end;
 
TBar = class(TFoo)
public
// TFoo.Test を override しつつ 非推奨化
procedure Test; override; deprecated 'Test2 メソッドを使って下さい';
procedure Test2;
end;
 
{ TFoo }
 
procedure TFoo.Test;
begin
Writeln('Hello, TFoo !');
end;
 
{ TBar }
 
procedure TBar.Test;
begin
inherited; // 元の TFoo.Test を呼ぶようにする
end;
 
procedure TBar.Test2;
begin
Writeln('Hello, TBar !');
end;
 
var
Baz: TBar;
begin
Baz := TBar.Create;
try
//「W1000 シンボル 'Test' を使用することは推奨されていません」が発生する
// 追加メッセージ 'Test2 メソッドを使って下さい' も表示される
Baz.Test;
finally
Baz.Free;
end;
 
Readln;
end.

ただし、静的メソッドの場合と final が指定されている場合は対処できません。
隠蔽で対策できる様に思いますが、下記の様に継承元の型が指定されている場合に隠蔽の効果が無くなるためです。

type
TFoo2 = class
public
procedure Sample; // 静的メソッド
end;
 
TBar2 = class(TFoo2)
public
// TFoo2.Sample を隠蔽する
procedure Sample; deprecated 'Sample2 メソッドを使って下さい';
procedure Sample2;
end;
 
var
Baz: TFoo2; // TFoo2 型で定義する
begin
Baz := TBar2.Create; // TBar2 を生成する
try
// Baz の中身は TBar2 のインスタンスなのに TFoo2.Sample が呼ばれる!
Baz.Sample;
finally
Baz.Free;
end;
 
Readln;
end.
Delphi 言語では、継承元と同じメソッド名を定義することで、継承元のメソッドを見ることができなくなります。
これを「隠蔽」と呼びます。
virtual, dynamic を隠蔽する場合 reintroduce 指令が必要です。

final 指定はまだしも、静的メソッドに deprecated を付けられないので汎用性は下がりますが、依然として有効な時もあるのでは無いでしょうか?

なお、静的メソッドや final を隠したい場合は、ラッパークラスを作る事で回避します。

小ネタでした。

2012年10月25日木曜日

クラス宣言でのネスト

TStyleProvider で、さらりとクラス内レコードを使ってみました。

type
TStyleProvider = class(TObject)
strict private
type
TStyleData = record
private
(略)
end;
var
FStyles: TList<TStyleData>;
(略)
end;

以前の Delphi ではクラス内でクラス・構造体を宣言できなかったため、クラスが内部で管理する特に外に見せる必要の無いクラスまで、クラスの宣言は見えていました。

上の例で言えば

type
TStyleData = record
private
(略)
end;
TStyleProvider = class(TObject)
private
FStyles: TList<TStyleData>;
(略)
end;

となっていました。
TStyleProvider だけが必要な他のコードから、TStyleData も見えていたわけです。

クラス内でレコードやクラスを宣言できるようになった(Delphi 2007 から?)ことや、strict private が導入された(Delphi 2005 から?)おかげで見せたくないデータを断固見せないように実装できるので、すっきりしますね。

2012年10月24日水曜日

クラスを for in do に対応させる

TStyleProvider を作成する過程で、やったことの無かった for in do に対応させてみようとコードを組んでみました。

IEnumeratorIEnumerable の2つを実装しようとして、はまってしまいました。
それぞれに同じ名前の GetCurrent メソッドがあるためのようです。

そこで、とりあえずインターフェースを継承しないことにしました。
というのは docwiki に


という記述があり、必ずしもインターフェースを実装しなくても良いからです。
この場合、コンパイラはメソッドの名前から判断しているようです。

つまり、クラスを for in do に対応させるためには
  1. GetEnumerator メソッドの実装
  2. GetCurrent メソッドの実装
  3. MoveNext メソッドの実装
  4. Current プロパティの実装
という4つの実装が必要で、場合によってはさらに Reset メソッドの実装も必要です。

このうち、1は実際に for in に渡されるクラスで実装します。
2以降は、通常別のクラスに記載します。

TStyleProvider で言うと1は

TStyleProvider = class(TObject)
(省略)
public
function GetEnumerator: TStyleEnumerator;
end;
(省略)
function TStyleProvider.GetEnumerator: TStyleEnumerator;
begin
Result := TStyleEnumerator.Create(Self);
end;

のように TStyleProvider で実装しています。
ここで返している TStyleEnumerator が2以降を実装しています。

TStyleEnumerator の宣言と実装は以下のようになっています。

TStyleEnumerator = class(TObject)
private
FProvider: TStyleProvider;
FIndex: Integer;
public
constructor Create(const iProvider: TStyleProvider);
function GetCurrent: String;
function MoveNext: Boolean;
procedure Reset;
property Current: String read GetCurrent;
end;
implementation
{ TStyleProvider.TStyleEnumerator }
constructor TStyleProvider.TStyleEnumerator.Create(
const iProvider: TStyleProvider);
begin
inherited Create;
FProvider := iProvider;
FIndex := -1;
end;
function TStyleProvider.TStyleEnumerator.GetCurrent: String;
begin
Result := FProvider[FIndex];
end;
function TStyleProvider.TStyleEnumerator.MoveNext: Boolean;
begin
Inc(FIndex);
Result := (FIndex < FProvider.Count);
end;
procedure TStyleProvider.TStyleEnumerator.Reset;
begin
FIndex := -1;
end;

つまり、MoveNext でインデックスを1つ進め、GetCurrent で、そのインデックスが示すデータを返す、というだけです。
ただ注意しないといけないのは、インデックスの初期値は -1 にしておくということです。
それは、
  1. Create
  2. MoveNext
  3. GetCurrent
という順番でメソッドが呼ばれるからです。

つまり最初の要素の取得だとしても MoveNext が呼ばれてから GetCurrent が呼ばれるので、インデックスの初期値を -1 にしておくと、都合が良い、ということです。

また、もう一つ疑問点があります。
GetEnumerator で渡す TStypleEnumerator は TInterfacedObject などにして解放する必要があるのではないか?ということです。

しかし、TStringList の IEnumerator の実装である System.Classes.TStringsEnumerator のコードを見てみると、特に解放している様子はありませんでした。
コンパイラが自動的にやっているようです。

TStringsEnumerator のようにデフォルトで用意されている Enumerator もありますし、自前で Enumerator を実装するのも簡単なので、これから作成するクラスでは対応すると良いかも知れません。

2012年10月23日火曜日

Style を外部ファイルから読み込む


VCL / FireMonkey の Style は、非常に簡単に見目麗しいアプリケーションを制作できます。
その反面、Style を Exe ファイルに入れるとファイルサイズが大きくなってしまいます。
Style はアプリケーションの本質とは関係ないため、Style によってファイルサイズが大きくなるのは避けたい所です。

すぐに思いつく簡単な解決策は、Style ファイルを外部に持つ、ということです。
こうすれば、Exe ファイルに取り込まれないのでファイルサイズが大きくなるのを防ぐ事ができる上、新しいスタイルの配布も簡単です。

しかし、デフォルトの vsf ファイルを配布しても良いのか?という懸念があります。
そこで、dockwiki を見てみると下記のようにあり
また、これらのスタイル(VCL スタイルまたは FireMonkey スタイル)はどれも、作成したアプリケーションと一緒に再配布することができます。この再配布可能なスタイル ファイルは、作成した製品のインストール ディレクトリ内の次の場所に置きます。
\Redist\styles
デフォルトの vsf ファイルも再配布可能なようです。

では、実際に外部の Style ファイルを読むコードは、どうするかというと…次のようにします。

TStyleManager.LoadFromFile('VSFファイル');
TStyleManager.TrySetStyle('スタイルの名前');

非常に簡単です。
とはいえ、毎回このコードを書くのは面倒なので StyleProvider というクラスを作ってみました。

このクラスを使うと指定のディレクトリにあるファイルを全部読み取り、スタイルをリストとして持ちます。
後は、Apply / ApplyByName メソッドを呼ぶだけです。

下記は、簡単な使用例です。

procedure TForm1.FormCreate(Sender: TObject);
var
Name: String;
begin
// ディレクトリを指定して生成する
// ここでは Exe と同じディレクトリを指定しているので
// Debug / Release それぞれに style ファイルを置かねばならない
StyleProvider :=
TStyleProvider.Create(
ExtractFilePath(Application.ExeName) + '\Redist\styles');
// スタイルの名前を ListBox1 に追加
for Name in StyleProvider do
ListBox1.Items.Add(Name);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
Index: Integer;
begin
Index := ListBox1.ItemIndex;
// ListBox1 がクリックされたとき、スタイルを変える
if (Index > -1) and (Index < ListBox1.Items.Count) then
StyleProvider.ApplyByName(ListBox1.Items[Index]);
end;

良かったら使ってみてください。

2012年10月22日月曜日

interface と implementation

割と知られている事だと思いますが、メソッドの宣言がしてあれば、メソッドの実装では、引数リストと戻値の型は省略できます。

01 type
02  TForm1 = class(TForm)
03  procedure FormCreate(Sender: TObject);
04  private
05  procedure Test(const iMsg: String);
06  function Test2(const iMsg: String): Boolean;
07  public
08  end;
09 
10 var
11  Form1: TForm1;
12 
13 implementation
14 
15 {$R *.dfm}
16 
17 { TForm1 }
18 
19 procedure TForm1.Test;
20 begin
21  ShowMessage(iMsg);
22 end;
23 
24 function TForm1.Test2;
25 begin
26  Result := True;
27  ShowMessage(iMsg);
28 end;

上記のリスト 5, 6 行目のように宣言さえしておけば、19, 24 の実現部では引数リストと戻値の型は省略できます。

ただ、普段は Shift + Ctrl + C を使って自動的に宣言部⇔実現部を作っていると思いますので、このような書き方は「できる」というだけで、使ってる人は居ないのではないでしょうか?
そもそもメリットが特に思いつかないし……

ちなみに、下記の様にメソッドだけではなく普通の手続きや関数でも同じ事ができます。

01 var
02  Form1: TForm1;
03 
04 function Test3(const iMsg: String): Boolean;
05 
06 implementation
07 
08 function Test4(const iMsg: String): Boolean; forward;
09 
10 function Test3;
11 begin
12  Result := Test4(iMsg);
13 end;
14 
15 function Test4;
16 begin
17  Result := True;
18  ShowMessage(iMsg);
19 end;

2012年10月19日金曜日

TEdit に数字のみ入れる

TEdit に数字だけ入力だけしたい、そんな時がきっとあるはず!
だからといって、TMaskEditTUpDown とか TNumberBox を使うまでもないって時に、下のような関数を用意して使っています。

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (not CharInSet(Key, [#8, '0'.. '9'])) then
Key := #0;
end;

一般的すぎるテクニックで記事を更新!

簡単に解説すると、'0'.. '9' は、普通に数字を表しているだけなので判ると思います。
#8 は、バックスペースです。
これがないと、バックスペースで文字を消せなくなるので注意が必要です。

2012年10月18日木曜日

閑話

昔、お絵かきチャットを作っていた事がありました。
いま自分のサイトが無くなってしまったので、実行ファイルは配っていない(GitHub にアップしました)のですが、いまだにスレがあるようで、ありがたいことです。

そのお絵かきチャット v1 は、こんな感じでした。



これ!VCL / FireMonkey のスタイル使ってるわけじゃなくて、全部自前でスタイル作ってるんですよ!!
今にして思えば、まあまあスゴイ(自画自賛)

echat1 の実行ファイルはこちら(GitHub)

そして、v1 を発展させた v2 というのを 2003 年頃作っていたみたいです。
過去の僕が。
それが↓これです。



「簡易 Photoshop +チャット」を目指していたので、レイヤーも自前で実装したり、色々やってます。Delphi 6 で FireMonkey もまだ存在してなかったのに!(自画自賛2)

試みに実行ファイルをアップしておきますが、これをもしもオープンソース化したら、誰か喜ぶ人いるのかな?

実行ファイルはこちら(GitHub)

※Vista/7 前なので exe と同じ所に ini ファイル作ろうとするので、別の場所で実行するといいと思います。あと、エラーが出まくるみたいです。

2012年10月16日火曜日

then の後


1~2年前に気づいたんですけど、then の後は空文でも構わないんですね。
つまり、↓こいうことです。

procedure Test;
begin
if (False) then
// 何もしない
else
Writeln('Hello, Delphi !');
Readln;
end;

出力結果
Hello, Delphi !

使い道は特に思いつきませんが……

2012年10月15日月曜日

VCL と FMX の Color 2


前回は VCL の TColor について書きました。
今回は FireMonkey の TAlphaColor についてです。

TAlphaColor は、その名が示す通り、透明度(α)付きのカラーを表す型です。
TAlphaColor は TColor と同じく System.UITypes に定義されています。

TAlphaColor = type Cardinal;
各バイトの並びは AARRGGBB となっています。
いわゆる ARGB の並びです。
例えば↓こうなります。

$ffff0000
黄色$ffffff00
半透明の赤$80ff0000

VCL でいう clWindow といったシステム定義の色はありませんが、定義済みの色はあります。
TAlphaColorRec 構造体から TAlphaColorRec.Red などとして取得できます。
TAlphaColorRec 構造体の色は claXXXX としても取得できます。
docwiki には「FMX.Types にある定数名は、'cla' を~」と書いてありますが、これは間違いで XE3 では System.UIConsts ユニットに定義されています。
System.UIConsts ユニットを uses しておけば、claRed といった色定数を利用できます。

なお、エンバカデロ Team Japan ブログに書かれていますが、MacOS と iOS 上では「ABGR」の並びが必要ですので、VCL の時と同じような変換ルーチンが必要になります。
この変換には System.UIConsts.RGBtoBGR が使えます。
Team Japan ブログには、条件コンパイルを使って MacOS と Windows で別々の変換を施すようにしたスマートなやり方が記載されていますので、参照してみてください。

それでは、透過率を実際に使って四角形を描画してみます。

procedure TForm1.FormPaint(
Sender: TObject;
Canvas: TCanvas;
const ARect: TRectF);
procedure FillRect(
const iColor: TAlphaColor;
const iPos: Integer;
const iRect: TRectF);
begin
Canvas.Fill.Color := iColor;
Canvas.FillRect(iRect, 0, 0, [], 1);
end;
procedure Fill(const iColor: TAlphaColor; const iPos: Integer);
begin
FillRect(iColor, iPos, TRectF.Create(iPos, iPos, iPos + 100, iPos + 100));
end;
begin
FillRect($ffffffff, 0, ARect); // フォームを白で塗りつぶす
Fill($80ff0000, 10); // 50% の透過率で赤を塗る
Fill($cc0000ff, 60); // 80% の透過率で青を塗る
end;

↓結果です。
アルファ付きで描画されています。


2012年10月12日金曜日

VCL と FMX の Color 1

VCL の TColor は 4byte です。
定義は System.UITypes にあります。

TColor = -$7FFFFFFF-1..$7FFFFFFF;

各バイトの並びは BBGGRR となっています。
いわゆる RGB の並びにはなっていません。

Windows の COLORREF 型が BBGGRR になっているためだと思われます。

例えば↓こうなります。

$0000FF
黄色$00FFFF

最上位は特別なフラグです。
最上位に $FF が入っていると Windows の設定色を示します。

例えば↓こうなっています。

clWindow$FF000005
clBtnFace$FF00000F

他にもいくつか特別な色があります。
これらの特別な色は Vcl.Graphics.ColorToRGB; を使えば BGR 形式に変換できます。
ColorToRGB という名前ですが返ってくるのは TColor と同じ並びの BGR 形式です。
なお、RGB 形式にするのは下記の様にバイトを変換する関数が必要です。

function BGRtoRGB(const iColor: TColor): LongInt;
begin
Result := ColorToRGB(iColor);
Result :=
RGB(
(Result and $ff0000) shr 16,
(Result and $00ff00) shr 8,
(Result and $0000ff) shr 0
);
end;
Winapi.Windows.GetRValue などを使う方法もあります。

FMX の色指定は TAlphaColor です。
これについては、次回!

2012年10月11日木曜日

String での Low, High

昨日の記事で、なんか String のインデックスが他の言語と同じように「0」始まりになるのではないか?ということを書きました。
既存リソースは仕方ないとして、今後は
procedure Test;
var
i: Integer;
Str: String;
begin
Str := 'Hello, NEXTGEN !';
for i := 1 to Length(Str) do
Write(Str[i]);
end;

とは書かず

procedure Test;
var
i: Integer;
Str: String;
begin
Str := 'Hello, NEXTGEN !';
for i := Low(Str) to High(Str) do
Write(Str[i]);
end;

と書いた方が良さそうです。
ちなみに、XE3 以降から、この書き方ができるっぽいです。

エンバカデロの某スタッフに「Low と High は使っておいたいいよ」と言われたのですが、これも含んでの事なんですかね……
配列関係では、0 から始まるの知っていても Low を使っていたのですが、これは対応できなかった!

record helper から、こんな所まで話が広がるとは思ってもみませんでした。
個人的には、とても楽しめた "record helper saga" でした。

2012年10月10日水曜日

String のインデックス…!?

昨日の記事で、ふーさんに ZEROBASEDSTRINGS について教えて貰いました。

コンパイラ指令 $ZEROBASEDSTRINGS に ON を渡すと Index 0 番目からアクセスできるようです。

{$ZEROBASEDSTRINGS ON}
procedure Test;
var
Str: String;
i: INteger;
begin
i := 0;
Str := 'Hello, helper !';
Writeln(Str[0]); // H が出力される!!!
end;
ちなみに ZEROBASESTRINGS OFF の状態だと Str[0] にアクセスしてるとコンパイルエラーが出ます。

[dcc32 エラー] Project1.dpr(18): E2157 0 番目の要素は参照できません - Length または SetLength を使ってください

で、大事なのはその先です。その先。

ZEROBASESTRINGS ON って、どこで使ってるんだろう?と思って \Embarcadero\RAD Studio\10.0\source\ に対して Grep してみました。
すると fmx\FMX.ASE.Lexer.pas に次のような記述が出てきました。

{$IFDEF NEXTGEN}
{$ZEROBASEDSTRINGS ON}
LHash := BobJenkinsHash(FString[0], FString.Length * SizeOf(FString.Chars[0]), 2004);
{$ZEROBASEDSTRINGS OFF}
{$ELSE}
LHash := BobJenkinsHash(FString[1], FString.Length * SizeOf(FString.Chars[0]), 2004);
{$ENDIF}

NEXTGEN という識別子で条件コンパイルしていました。

……
……!?

NEXTGEN !!!!!

これって噂の新型コンパイラのことでしょうか。
そして、新コンパイラになると String の開始インデックスが 0 になる……?
そう考えると TStringHelper が 0 インデックス初めなのも全て納得がいきます。

oh…!
なんってこった!
もし、そうなら、こいつは大変なことだ!
今までの資産の移行、Unicode 化の比では無い気がする……。
場所を見つけづらいという意味で。
そのための ZEROBASESTRINGS なのか。

NEXTGEN で \Embarcadero\RAD Studio\10.0\source\ に対して Grep すると大量にひっかかります。



一人興奮してるけど、皆さん知ってる事だったりするのかな……?

追記
↓下記のブログに ZEROBASEDSTRINGS について書かれているよ、と教えて貰いました。

XE3 RTL Changes: A closer look at TStringHelper

英語なので良く判らないのですが
Hopefully, you’ve inferred from what I’ve covered so far that zero based strings are something new in the compiler
って書いてある!!ひゃー!

2012年10月9日火曜日

TStringHelper.substring

TStringHelper が、色々便利なので使いまくっているのですが、引っかかった事を1つ。

それは、TStringHelper.Substring です。
TStringHelper には Copy 関数とは別の Copy メソッド(from DEKO さん)があります。
Copy メソッドがあるから、TStringHelper だと一般的名称の Substring に置き換わったんだなーなんて気楽に構えていると死にます!
というか死んだ!

下記の様に TStringHelper.substring を Copy 関数の代わりに使ったとします。

1 procedure Test;
2 var
3  Str: String;
4 begin
5  Str := 'Hello, helper !';
6  Writeln(Str.Substring(1, 5)); // 期待する出力 'Hello'
7 end;

期待する出力は↓ですが

Hello

実際には

ello,

こうなります。

つまり、Substring の開始 index は "0" なのです!

Delphi の String 型は歴史的経緯により、index は 1 から始まります

C++Builder のために一般的な index に合わせたのかな……。
と、そんな訳で TStringHelper.Substring を使うときはお気を付けを。

……index が 1 始まりの Copy 関数的なメソッド追加されないかな。混乱するだろうけど。

2012年10月5日金曜日

三項演算子

僕が C 系の言語でうらやましいなと思う機能があります。


それが上記の2つです。
列挙の件は、仕方ないとして三項演算子は BooleanHelper 作ったらいけるんじゃね!?と思いましたが全くいけないし、IfThen 関数があるので必要ありません。

IfThen 関数は3つの引数を取ります。

IfThen(条件式、真の時の値、偽の時の値)

です。
例えば↓こんな風に使います。

uses
  System.SysUtils, System.Math;

var
  i: Integer;
begin
  // 3の倍数の時 0 が返る
  for i := 1 to 100 do
    Writeln(IfThen(i mod 3 = 0, 0, i));
end.

uses に System.Math を指定すると Integer, Double など数値系の IfThen オーバーロード関数が使えるようになります。

System.StrUtils を追加すると、文字列に対する IfThen 関数が使えるようになります。

文字列版のサンプルは↓こうなります。

uses
  System.SysUtils, System.StrUtils;

var
  i: Integer;
begin
  // 3の倍数の時 Fizz が返る
  for i := 1 to 100 do
    Writeln(IfThen(i mod 3 = 0, 'Fizz', IntToStr(i)));
end.

少なくとも Delphi 7 の頃からある関数ですが、あまり知られていない感じがしたので、紹介してみました。

2012年10月4日木曜日

record helper を逆アセンブル

record helper が、どんなコードにコンパイルされるのか、興味があって試してみました。
program Project1;
uses
  System.SysUtils;

type
  TIntegerHelper = record helper for Integer
    function ToString: String;
  end;

function TIntegerHelper.ToString: String;
begin
  Result := IntToStr(Self);
end;

var
  i: Integer;
begin
  i := $ff
  Writeln(i.ToString); // ここ
end.

上記のコード "ここ" とコメントしている部分は

lea eax, [iのアドレス]
call TIntegerHelpder.ToString

こんな風になってるかなと思ったのですが、さて。

mov  [$00423ed8], $000000ff
lea  edx, [ebp - $14]
mov  eax, $00423ed8           // ここ
call TIntegerHelper.ToString
mov  edx, [ebp - $14]
mov  eax, [$0041e618]
call @Write0UString
call @WriteLn
call @_IOTest

こうなっていました。
lea ではなく、普通に eax にアドレスを代入していました。
これは、 i がグローバル変数だからだと思います。多分。(実効アドレスを計算する必要がない)

↓こんな風に procedure を呼ぶようにしてやると

procedure Test;
var
  i: Integer;
begin
  i := $ff;
  Writeln(i.ToString);
end;

begin
  Test;
end.

こうなってました。

lea  eax, [ebp - $04]         // ここ
call TIntegerHelper.ToString

大体予想通りです。
ただ、これらの結果は全部 debug ビルドなので、release にすると少し変わってるかもしれません。

ということで、record helper は Self (= eax) に、変数の値を入れて、関数を呼んでいる、という実装でした。

2012年10月3日水曜日

record / class helper のスコープについて

record helper / class helper のスコープ(適用順序)について調べみます。
同じユニット内に次のような2つの helper があった場合

type
  TIntegerHelperA = record helper for Integer
    function foo: String;
  end;

  TIntegerHelperB = record helper for Integer
    function bar: String;
  end;

function TIntegerHelperA.foo: String;
begin
  Result := 'A';
end;

function TIntegerHelperB.bar: String;
begin
  Result := 'B';
end;

begin
  Writeln(1000000.foo);  // コンパイルエラー
  Writeln(1000000.bar);  // OK
end.

直近の helper が有効になります。
メソッド名が違っても関係ありません。

それは helper が別のユニットにあったとしてもです。

unit Unit1;

interface

type
  TIntegerHelperA = record helper for Integer
    function foo: String;
  end;

(略)
unit Unit2;

interface

type
  TIntegerHelperB = record helper for Integer
    function bar: String;
  end;

(略)

uses するとき Unit2 を後にすると、TIntegerHelperA がエラーに。
uses
  Unit1, Unit2;

begin
  Writeln(1000000.foo);  // コンパイルエラー
  Writeln(1000000.bar);  // OK
end.

Unit1 を後にすると、TIntegerHelperB がエラーになります。
uses
  Unit2, Unit1;

begin
  Writeln(1000000.foo);  // OK
  Writeln(1000000.bar);  // コンパイルエラー
end.
同じメソッド名を持つ helper が定義してあると、直近の helper メソッドが呼ばれます。
意図していないメソッドが呼ばれる事が無いよう注意が必要です。

では、次のような場合はどうなるでしょう?

type
  TTest = class(TObject);

  TObjectHelper = class helper for TObject
    function Hello: String;
  end;

  TTestHelper = class helper for TTest
    function Hello: String;
  end;

{ TObjectHelper }

function TObjectHelper.Hello: String;
begin
  Result := 'Hello, TObjectHelper';
end;

{ TTestHelper }

function TTestHelper.Hello: String;
begin
  Result := 'Hello, TTestHelper';
end;

var
  Test: TTest;
begin
  Test := TTest.Create;
  try
    Writeln(Test.Hello);
  finally
    Test.Free;
  end;
end.

この場合、コンパイルエラーにはなりません。
helper は、1つの class / record につき1つ有効なので、継承元と継承先のクラスは別個に helper を持てるからです。

上の場合、出力される値は

Hello, TTestHelper

となります。
では、さらに下記の様にキャストした場合は、どうなるでしょう?

var
  Test: TTest;
begin
  Test := TTest.Create;
  try
    Writeln(TObject(Test).Hello); // TObject にキャスト
  finally
    Test.Free;
  end;
end.

結果は

Hello, TObjectHelper

と出力されます。 これらの事から helper はコンパイル時に決定される機構であることが判ります。

ヘルプにも
ヘルパは、識別子を解決するときに、コンパイラが使用するスコープの範囲を広げる機能です (from DocWiki)
と書いてありますしね。

2012年10月2日火曜日

FizzBuzzHelper


Delphi XE3 で導入されたプリミティブ型への record helper を弄ってみます。

※この記事を書いてから、そういえば Team Japan で高橋さんが書いていたのを思い出しました!
高橋さんの記事のほうが詳しいです!必見!

ヘルパは、継承を使用せずにクラスを拡張する方法であり、継承がまったく許可されないレコードにとっても便利なものです。ヘルパは、識別子を解決するときに、コンパイラが使用するスコープの範囲を広げる機能です。(引用元:Delphi ヘルプ)

上記の引用の通り、record helper / class helper は、構造体 / Class を「後から」拡張する仕組みです。
後から変更しづらいクラスや構造体を拡張できます。
特に構造体は、継承出来ないので record helper は有用な方法といえます。

そして!
record helper は record という名前が付いていますが、XE3 からプリミティブ型に適用できるようになりました。

例えば↓こんな風に定義できます。

TStringHelper = record helper for String
end;

TBooleanHelper = record helper for Boolean
end;

この機構を採り入れた事により、Delphi 言語もモダンな書き方ができるようになりました。

例えば↓こんな風にです。

// 文字列の長さを表示
// (Team Japan ブログにある TIntegerHelper.ToString を実装してあるとして)
ShowMessage('文字列'.Length.ToString); 
Delphi 言語では String 型はプリミティブ型です。クラスで実装されているわけではないので、このような書き方はできませんでした。

今回は、record helper を利用して、Integer 型自身に、自分が Fizz なのか Buzz なのかを判定させてみます。

FizzBuzz とは、3で割り切れる数字の時 Fizz を、5で割り切れる数字の時 Buzz を、3と5で割り切れる時 Fizz Buzz と出力する非常に簡単なプログラムのことです。

コードは↓こんな感じです。
program FizzBuzzHelper;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TFizzBuzzHelper = record helper for Integer
    function ToFizzBuzz: String;
  end;

function TFizzBuzzHelper.ToFizzBuzz: String;
begin
  Result := '';

  if (Self mod 3 = 0) then
    Result := 'Fizz ';

  if (Self mod 5 = 0) then
    Result := Result + 'Buzz';

  if (Result = '') then
    Result := IntToStr(Self);
end;

var
  i: Integer;
begin
  for i := 1 to 100 do
    Writeln(i.ToFizzBuzz);
end.

ここで注目すべきは Self です。
プリミティブ型の Self は、それ自身の値を示します。
StringHelper なら、Self は String 型の値、IntegerHelper なら Self は Integer 型の値になります。

record helper を使えば、色々面白いことができそうです。

2012年10月1日月曜日

コードにタグを付けるツールを作ってみた


ブログにコードを載せるのが非常にメンドクサイので、タグを自動的に付けてくれるツールを作ってみました。
……まあ、多分探せばあったんでしょうが。



例えば、↓こんな風に一発で変換してくれます。

// ユニークなファイル名を得る
function GetUniqueFileName(
  iPath, iExt: String;
  iSeparater: String = '-'): String;
var
  TimeStamp: TTimeStamp;
  tmpNow: TDateTime;
begin
  iPath := IncludeTrailingPathDelimiter(iPath);

  if (iExt <> '') and (iExt[1] <> '.') then
    iExt := '.' + iExt;

  repeat
    tmpNow := Now;
    TimeStamp := DateTimeToTimeStamp(tmpNow);

    Result :=
      iPath +
      FormatDateTime('yyyymmdd' + iSeparater, tmpNow) +
      IntToStr(TimeStamp.Time) +
      iExt;
  until (not FileExists(Result));
end;

便利!

タグ指定や予約語の指定などは全部 IniFile に記述します。

きちんとチェックしてないけど、不具合を見つけたら直していく方向で。 あと「指令」は、コンテキストチェックがメンドクサイので、全部予約語扱いです。

 ……凄い適当に作ったけど、ちゃんとパースしてオートマトン組んでやれば良かったな、と反省。
今のバージョン、遅いし!

ちなみに XE2 で作ったのですが、既に XE3 じゃないと組めない体になってた!
record helper 使いたいし!