(12/10/01~)

12/10/01

SkRegExp 1.4.5 リリース
 小宮さん作の正規表現ライブラリ SkRegExp の version 1.4.5 がリリースされました。

FMX.Sensors (XE3)
 VCL でセンサーを使う時に、手抜きして FMX.Sensors のクラスを使わないでください。確かに TSensorManager.Current.Active を True にしてから FMX.Sensors にあるセンサークラスを使えば一応は動作しますが、FMX.Sensorsuses しただけでメモリリークを起こします (ReportMemoryLeaksOnShutdown を True にしてみると判ります)。

 FMX.Sensors のセンサークラスのような使い勝手を望むなら、多少手間が掛かっても独自に VCL 用クラスを定義した方がいいでしょう。しかし、何故に Vcl.Sensors が用意されていないのだろう?


12/10/04

汎用ビットフィールド操作レコード
 高度なレコード型を使って、汎用ビットフィールド操作レコード TBitFieldRec を作ってみました。

 定義はこんな感じです。

  { TBitFieldRec }
  TBitFieldRec = packed record
    // 型変換 (代入時)
    class operator Implicit(a: DWORD): TBitFieldRec;                            // 暗黙の型変換: TBitFieldRec に DWORD を代入 (レコードが左辺)
    class operator Implicit(a: TBitFieldRec): DWORD;                            // 暗黙の型変換: DWORD に TBitFieldRec を代入 (レコードが右辺)
    // 算術演算子 (単項)
    class operator Negative(a: TBitFieldRec): TBitFieldRec;                     // 符号反転: -
    class operator Positive(a: TBitFieldRec): TBitFieldRec;                     // 符号恒等: +
    // 算術演算子
    class operator Add(a, b: TBitFieldRec): TBitFieldRec;                       // 加算: +
    class operator Subtract(a, b: TBitFieldRec): TBitFieldRec;                  // 減算: -
    class operator Multiply(a, b: TBitFieldRec): TBitFieldRec;                  // 乗算: *
    class operator IntDivide(a, b: TBitFieldRec): TBitFieldRec;                 // 整数除算: div
    class operator Modulus(a, b: TBitFieldRec): TBitFieldRec;                   // 剰余: mod
    // 論理演算子
    class operator LogicalNot(a: TBitFieldRec): TBitFieldRec;                   // 否定: not
    class operator LogicalAnd(a, b: TBitFieldRec): Boolean;                     // 論理積: and
    class operator LogicalOr(a, b: TBitFieldRec): Boolean;                      // 論理和: or
    class operator LogicalXor(a, b: TBitFieldRec): Boolean;                     // 排他的論理和: xor
    // 論理(ビット)演算子
    class operator BitwiseAnd(a, b: TBitFieldRec): TBitFieldRec;                // ビット and: and
    class operator BitwiseOr(a, b: TBitFieldRec): TBitFieldRec;                 // ビット or: or
    class operator BitwiseXor(a, b: TBitFieldRec): TBitFieldRec;                // ビット xor: xor
    class operator LeftShift(a, b: TBitFieldRec): TBitFieldRec;                 // ビット単位の左シフト: shl
    class operator RightShift(a, b: TBitFieldRec): TBitFieldRec;                // ビット単位の右シフト: shr
    // 関係演算子
    class operator Equal(a, b: TBitFieldRec): Boolean;                          // 等しい: =
    class operator NotEqual(a, b: TBitFieldRec): Boolean;                       // 等しくない: <>
    class operator LessThan(a, b: TBitFieldRec): Boolean;                       // より小さい: <
    class operator GreaterThan(a, b: TBitFieldRec): Boolean;                    // より大きい: >
    class operator LessThanOrEqual(a, b: TBitFieldRec): Boolean;                // 以下: <=
    class operator GreaterThanOrEqual(a, b: TBitFieldRec): Boolean;             // 以上: >=
    // インクリメント / デクリメント
    class operator Inc(a: TBitFieldRec): TBitFieldRec;                          // インクリメント: Inc()
    class operator Dec(a: TBitFieldRec): TBitFieldRec;                          // デクリメント: Dec()
    {$IFDEF CONDITIONALEXPRESSIONS}
    {$IF CompilerVersion >= 20.0}
    // Include / Exclude
    class operator Include(a: TBitFieldRec; b: TBits32): TBitFieldRec;          // 含める: Include()  (2009 or later)
    class operator Exclude(a: TBitFieldRec; b: TBits32): TBitFieldRec;          // 含めない: Exclude()  (2009 or later)
    // 集合演算子
    class operator In(a: TBit32; b: TBitFieldRec): Boolean;                     // メンバかどうか: in  (2009 or later)
    {$IFEND}
    {$ENDIF}
  private
    function GetBit(Index: TBit32): Boolean;
    procedure SetBit(Index: TBit32; const aValue: Boolean);
  public
    function GetBitField(aStartBit: TBit32; aCount: TCnt32): DWORD;             // ビットフィールドの値を取得
    procedure SetBitField(aStartBit: TBit32; aCount: TCnt32; aValue: DWORD);    // ビットフィールドへ値を設定
    function ToString: string;                                                  // 10 進数文字列へ変換
    function ToHexString(Digits: Integer = 1): string;                          // 16 進数文字列へ変換
    function ToBinString(Digits: Integer = 1): string;                          // 2 進数文字列へ変換
    property Bits[Index: TBit32]: Boolean read GetBit write SetBit; default;    // ブール型ビット値 (bit0..bit31)
  case BYTE of                                                                  // ペイロード共用体
    0: (Value: DWORD);                                                          //  - DWORD
    1: (Words: array [0..1of WORD);                                           //  - ワード配列
    2: (LoWord, HiWord: WORD);                                                  //  - Lo / Hi ワード
    3: (Bytes: array [0..3of BYTE);                                           //  - バイト配列
  end;

 使い方については、"133.ビットフィールドを操作する (Delphi 2006 以降...フル機能は 2009 以降)" に詳細があります。XE3 だと record helper for <Simple Type> が使えるので、演算子のオーバーロードとか書かずに済むんですけどね。

 See Also:

in 演算子のオーバーロード
 "Delphi 2006 以降で動くぜ!" とドヤ顔...してたかどうかは知りませんが、in 演算子のオーバーロードができるのは XE 以降のようです。

 コンパイルエラーにならないように修正したものを同名でアップしました。XE 以降でないと in による集合演算はできませんが、Bits[] プロパティを調べる事でも似たような事ができるので問題ないかと。

続・in 演算子のオーバーロード
 ...いやマテ。本当に 2010 では in 集合演算子がオーバーロードできないのか?

  (確認中)

 動くじゃん!ヘルプの記載漏れかよ...違うな、英語版の DocWiki は正しいようだ。2007 で in 集合演算子がオーバーロードできないのは確認してるから、こうなったら 2009 も確認すべきだな。

  (確認中)

 2009 でも動くじゃん!...という事で、さらに修正したものを同名でアップしました。"in 集合演算子のオーバーロードは 2009 以降で使える" と。2009 は英語版のヘルプも記載漏れしているようだ。


12/10/05

BitwiseNot
 汎用ビットフィールド操作レコード では、LogicalNot (論理否定) の戻りが Boolean ではありません。内部も "ビット Not" で実装されています。LogicalNot は True / False を返す必要があるので、この実装は間違っている事になります。

 何故このような実装になっているかと言うと、BitwiseNot (ビット Not) が存在しないからです。2006 ~ 2010 のヘルプには BitwiseNot が記載されていると思いますが、(恐らく) マトモに動いた事はありません。

 QC にある演算子のうち、BitwiseNot だけは未だに動作しません。ビット Not から論理否定にするのは簡単ですが、その逆は無理なのであのような実装になっています。むしろ、LogicalAnd / LogicalOr / LogicalXor の実装は要らないんじゃないかと思えてきました...これらのオーバーロード演算子が使われることがあるのか?と。

 追記: イロイロテストしてみましたが、Delphi では LogicalAnd / LogicalOr / LogicalXor のオーバーロードされた演算子が呼び出される事はありませんでした。そのくせ、ビット Not の演算で LogicalNot が呼び出されます。


12/10/06

Windows 8 と Delphi 2010 以降で気になる事
 個人的に気になっている事ですが、XE3 の FireMonkey の注意書きにサラっとヘビーな事を書いてある箇所がありました。

 思ったことは大きく分けて 2 つあります。

 VCL ではジェスチャエンジン初期化時に、Windows 固有のジェスチャ方式で最適なものを自動で選択します。これは Vcl.Touch.Gestures.TPlatformGestureEngine の説明に記載があります。 フォームに Touch プロパティがあったり OnGesture イベントがあるという事は、特に何もしなくともタッチやジェスチャが使える...つまり、Touch API や RealTimeStylus API での初期化は自動的に行われる事を意味します。

 Windows 8 搭載のタブレット PC (スレート PC ではなく) があったとして、それがマルチタッチとスタイラス両対応だったとします。この場合、VCL アプリケーションは RealTimeStylus を有効にして初期化されるのだと思いますが、タッチ操作を行っても Touch イベントは発生しない事になります (スタイラスでのみ反応するという事)。

 ...これってマズくないですか?

 マルチタッチとスタイラス両対応な Windows 8 搭載機を持っていないので確かな事が言えないのがアレですが、最悪の場合 "タッチ操作でマウスイベントが通知されない (スタイラスでのみマウスイベントが発生する) 可能性" があるような気がします。もちろん、それがマルチタッチを意識したアプリケーションでなかったとしてもです。

"Windows 8 と Delphi 2010 以降で気になる事" の回避方法
 XE3 の FireMonkey の実装と同様に RealTimeStylus を状況に応じてオフにすればいいのですよ...鬼門の COM 使いますけど。RTSCom.h の IDL は Windows SDK に含まれていないのだけれど、EMBT がトランスレートした RtsCom.pas / Winapi.RtsCom.pas があるので楽勝だと思います。ブラザーの力を借りるまでもないぜ!

 心配は杞憂に終わればそれでいいし、実際に起きたとしても対処方法が判っているので気が楽ですね。


12/10/07

Delphi で InkEdit を使ってみる...要は手書き入力する
 RealTimeStylus で思い出しました。知ってるヒトには何を今更ですが InkEdit ってコントロールがありまして。これを使って手書き入力をやってみようという事です。

 InkEdit は Windows API / ActiveX / .NET で使えます。RichEdit 4.5 のスーパーセットなので、VCL の TCustomRichEdit / TRichEdit をパクって作ればいいのですが、Delphi のバージョンによって少なからず内部構造が異なります。バージョンの差異を考慮しながらメンテするのは大変ですので、今回は ActiveX を使ってみようと思います。

 で、これをフォームに貼ると手書き入力ができるようになります。

 "DEKO" まで書いて確定させ、"のアヤシイ" と手書きして確定待ちな場面のスクリーンショットです...どうでもいい事ですが、このサイトは "DEKO のアヤシお部屋" です。手書き文字は 1 文字単位で確定させる必要はありません。書けるだけ書き殴ってください。また、InkEdit はジェスチャに対応しており、例えば左フリック "右から左" のジェスチャは BackSpace となっています。

 タッチディスプレイやスタイラスで手書き入力できない場合には、代替としてマウスを使う事もできます。その際には UseMouseForInput プロパティを True にする必要があります。文章のフォントを変更するには SetFontName / SetFontSize プロパティ等を使います (メソッドではありません)。詳細についてのリンクを幾つか貼っておきますので、興味のある方は参考にしてみて下さい。

 See Also:

 ※ InkEdit は Windows XP Tablet PC Edition または Windows Vista 以降で動作します。Tablet PC Edition の発売は 2002 年ですから、10 年前から使えた機能という事になります。

 追記: フォームを閉じたときにエラーになる場合にはフォームを閉じる (or 破棄する) タイミングで "InkEdit1.Parent := nil;" してやればよいようです (参考: [Delphi Qamp;A] Delphi XE3 ActiveX InkEditのInkObj.dllのエラー)。

汎用ビットフィールド操作レコード
 らいなタンさんのトコの記事を見て、Include() / Exclude() を実装した...こんなんもあったのか。詳細は、"133.ビットフィールドを操作する (Delphi 2006 以降...フル機能は 2009 以降)" にて。他に実装できると便利なのは True / False なのだけれど、これは実装しなかった。

 True / False が実装できると便利...ってのは、C++ の論理演算 (ビット演算ではない) が実装できるから。

  unsigned int a, b, c;

  a = 0x0002;
  b = 0x0004;

  // Bitwise AND
  c = a & b;
  printf("a & b: 0x%08x\n", c);

  // Logical AND
  if (a && b)
    printf("a && b: True");
  else
    printf("a && b: False");

 このコードを (可能な限り忠実に) Delphi で書き直すとこうなる。

var
  a, b, c: DWORD;
begin
  a := $0002;
  b := $0004;

  // Bitwise AND
  c := a and b;
  Writeln(Format('a & b: %.8x', [c]));

  // Logical AND / Boolean AND
  if LongBool(a) and LongBool(b) then
    Writeln('a && b: True')
  else
    Writeln('a && b: False');
end;

 LongBool のキャストを外すとエラーになる。Delphi での論理式はブール式なので、"この文脈の" if 文で使われる and はオペランドにブール型しか受け付けないからだ。先の True / False をオーバーロードすれば、LongBool でのキャストが不要になる。

 ...ハズなのだが、らいなタンさんも書いているように False のオーバーロードは実行されないし、優先順位の関係か if a and b then と書いても、結局 BitwiseAnd が呼び出されるのでまるでメリットがない。

var
  a, b: TBitFieldRec;
begin
  a := $0002;
  b := $0004;

  // こう書きたい!
  if a and b then
    ShowMessage('True')
  else
    ShowMessage('False');
end;

 BitwiseAnd が呼び出されるという事は、やはり LongBool でのキャストが必要になるという事だからだ。

var
  a, b: DWORD;
begin
  a := $0002;
  b := $0004;

  // LongBool 1 - Logical And / Boolean And
  if LongBool(a) and LongBool(b) then
    Writeln('LongBool1: True')
  else
    Writeln('LongBool1: False');

  // LongBool 2 - Bitwise And
  if LongBool(a and b) then
    Writeln('LongBool2: True')
  else
    Writeln('LongBool2: False');
end;

 1 の方の LongBool のキャストをやらなくていいように True / False をオーバーロードしたいのに、いざ実装してみると 2 の方で実行されてしまうという事だ (1. と 2. の違いは実行してみると解ります)。この True / False のオーバーロード演算子は "実装はしてみたけど実際には使い道がない" という事で非公開なのかもしれない。論理演算子 (ブール演算子) とビット演算子がカブってる時点でどうしようもないのかもしれないけれど。

var
  a, b, c: TBitFieldRec;
  d: Boolean;
begin
  a := $0002;
  b := $0004;

  c := a and b; // ビット演算したつもり
  d := a and b; // 論理演算 (ブール演算) したつもり
end;

 ...うん、判断できないね (w


12/10/15

画像処理等でサイコロの個数の算出に挑むプログラムコンテストで「人力で数えた」宇部高専が優勝(※上位6チーム中4チームが人力で数えてた)(市況かぶ全力2階建)
 この記事に対し、twitter で

 というツイートがあったので、素数を求める関数を書いてみた..."エラトステネスのふるい" な、よくあるアルゴリズムのコードだけど。

uses
  ..., Types;

// TIntegerDynArray = array of Integer;  
// TBooleanDynArray = array of Boolean;

function PrimeNumber(const MaxValue: Integer): TIntegerDynArray;
var
  Tbl: TBooleanDynArray;
  i, j, Cnt: Integer;
begin
  // 負数や 2 以下の場合は抜ける
  if MaxValue < 2 then
    begin
      SetLength(result, 0);
      Exit;
    end;

  // 素数テーブルを初期化
  SetLength(Tbl, MaxValue + 1);

  // 2 を素数に設定、2 の倍数以外を対象に
  Tbl[2] := True;
  for i:=3 to High(Tbl) do
    if Odd(i) then
      Tbl[i] := True;

  // 3 以降の素数を求める
  for i:=3 to Trunc(Sqrt(MaxValue)) do
    begin
      if not Tbl[i] then
        Continue;
      for j:=2 to (MaxValue div i) do
        Tbl[i*j] := False;
    end;

  // 素数の数を求め、戻り値の配列数を設定
  Cnt := 0;
  for i:=2 to High(Tbl) do
    if Tbl[i] then
      Inc(Cnt);
  SetLength(result, Cnt);

  // 戻り値として素数の動的配列を返す
  Cnt := 0;
  for i:=2 to High(Tbl) do
    begin
      if not Tbl[i] then
        Continue;
      result[Cnt] := i;
      Inc(Cnt);
    end;
end;

 この関数は以下のようなコードで検証できる。フォームにボタンとメモを一つ貼って、ボタンの OnClick イベントハンドラを記述する。

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  PN: TIntegerDynArray;
begin
  //      10 以下の素数:     4
  //     100 以下の素数:    25
  //    1000 以下の素数:   168
  //   10000 以下の素数:  1229
  //  100000 以下の素数:  9592
  // 1000000 以下の素数: 78498
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  try
    PN := PrimeNumber(StrToIntDef(Edit1.Text, 0));
    Caption := Format('素数の数: %d', [Length(PN)]);
    if Length(PN) > 0 then
      begin
        for i:=Low(PN) to High(PN) do
          Memo1.Lines.Add(IntToStr(PN[i]));
      end;
  finally
    Memo1.Lines.EndUpdate;
  end;
end;

 「落ち着くためには素数を数えるといい」 と、どこかの神父さんも言っていたしね。


12/10/19

Delphi で ^ は "べき乗" の演算子ではないけれど?
 Delphi での ^ は "べき乗" の演算子ではありません。一つ目の使い方は "ポインタの逆参照を行う演算子" としてです。

var
  S: String;
  C: PChar;
begin
  S := 'ABC';      // S に文字列を代入
  C := @S[1];      // C に String データの先頭アドレスを指定
  ShowMessage(C^); // C が指すアドレスのデータ (Char) を表示
end;

 よくやりますね。もう一つの使い方は型に対するポインタ型を定義する場合です。

type
  TTestRec =
    record
      Code: Integer;
      Name: String;
    end;
  PTestRec = ^TTestRec;

 TTestRec のポインタ型である PTestRec を定義しています。これもよくやりますね。

 では、3 つ目の使い方です。

var
  S: String;
  C: Char;
begin
  S := 'ABC';
  C := ^S;
  ShowMessage(Format('%x', [Ord(C)]));
end;

 一見冗談のように見えるコードですが、このソースは実際にコンパイル可能です。古参の Delphi 使いの方でも忘れてしまった書き方かもしれませんね。

 「実行した結果が何故そう表示されるのか?」 については下の方に答えがあります。答えをまだ知りたくないヒトはスクロールしちゃダメですヨ (w





























































 ^S は変数 S を逆参照しているのではなく、コントロールコード (制御コード) を表しているのです。

    0 1 2 3 4 5 6 7 8 9 A B C D E F
 0  NUL
^@
SOH
^A
STX
^B
ETX
^C
EOT
^D
ENQ
^E
ACK
^F
BEL
^G
BS
^H
HT
^I
LF/NL
^J
VT
^K
FF/NP
^L
CR
^M
SO
^N
SI
^O
 1  DLE
^P
DC1
^Q
DC2
^R
DC3
^S
DC4
^T
NAK
^U
SYN
^V
ETB
^W
CAN
^X
EM
^Y
SUB/EOF
^Z
ESC
^[
FS
^\
GS
^]
RS
^^
US
^_
 2  SP
^`
!
 
"
 
#
 
$
 
%
 
&
 
'
 
(
 
)
 
*
 
+
 
,
 
-
 
.
 
/
 
 3  0
 
1
 
2
 
3
 
4
 
5
 
6
 
7
 
8
 
9
 
:
 
;
^{
<
^|
=
^}
>
^~
?
 
 ⁝ 
 6  `
^ (SP)
a
^!
b
^"
c
^#
d
^$
e
^%
f
^&
g
^'
h
^(
i
^)
j
^*
k
^+
l
^,
m
^-
n
^.
o
^/
 7  p
^0
q
^1
r
^2
s
^3
t
^4
u
^5
v
^6
w
^7
x
^8
y
^9
z
^:
{
^;
|
^<
}
^=
~
^>
DEL
^?

 ^S は Ctrl+S...つまり、DC3 なので、Char 型の変数 C に 0x13 を代入しているコードだった訳です。変数 S は引っ掛けのためだけに用意しました (^^;A

 先のコードを制御文字で書き直すとこうなります。

var
  S: String;
  C: Char;
begin
  S := 'ABC';
  C := #19// #$13
  ShowMessage(Format('%x', [Ord(C)]));
end;

 このような記述も可能です。

var
  S: String;
begin
  S := 'ABC'^M^J'DEF';
  ShowMessage(s);
end;

 ^M=CR、^J=LF なので、以下のコードと等価となります。

var
  S: String;
begin
  S := 'ABC'#13#10'DEF';
//S := 'ABC'#$0D#$0A'DEF';
  ShowMessage(s);
end;

 ちょっとしたネタでした。


12/10/20

SkRegExp 1.5.0 リリース
 小宮さん作の正規表現ライブラリ SkRegExp の version 1.5.0 がリリースされました。

汎用ビットフィールド操作レコード
 コードをちょっとだけ整理しました。使い方に変更はありません。


12/10/27

SkRegExp 1.5.1 リリース
 小宮さん作の正規表現ライブラリ SkRegExp の version 1.5.1 がリリースされました。

Delphi のデフォルトアイコンとそのサイズ
 Delphi Q&A 掲示板ネタです。Delphi のデフォルトアイコン (プロジェクト) のサイズと種類は次のようになっています。懐かしいのもありますね。

  256x256 48x48 32x32 24x24 16x16 Size
1, 2 1 (4bit) 766B
3, 4 1 (4bit) 1 (4bit) 1.05KB
5, 6 1 (4bit) 1 (4bit) 1.05KB
7 1 (8bit) 1 (8bit) 1.05KB
8 2 (8 / 4bit) 2 (8 / 4bit) 4.59KB
2005

2010
3 (32 / 24 / 8bit) 3 (32 / 24 / 8bit) 3 (32 / 24 / 8bit) 33.1KB
XE 1 (32bit) 1 (32bit) 1 (32bit) 1 (32bit) 1 (32bit) 88.9KB
XE2, XE3 1 (32bit) 2 (32 / 8bit) 2 (32 / 8bit) 2 (32 / 8bit) 2 (32 / 8bit) 290KB

 XE2 以降のアイコンは巨大ですね。恐らく OSX 用にコンバートできるように、256x256 アイコンが ARGB ビットマップなのだと思います (それ以外の理由が思いつかない)。XE にも 256x256 アイコンが含まれていますが、こちらは PNG 形式です。

 $(BDS)\bin にあるアイコンを直接いじるのはアレなのでコピーして 256x256 アイコンを PNG 形式にしてみたら、86.3KB になりました。XE 並ですね。XE2 以降ではこのようにして作ったアイコンをプロジェクトに指定すると、それだけで EXE のサイズが 200KB 程小さくなります。

Axialis IconWorkshop Lite
 前の記事で使っているアイコンエディタです。VisualStudio 2008 Standard 以上の SKU を所持していると無料で利用する事ができます。Express ではダメです。2010 も 2012 もダメです。

Visual Studio 2012 Express for Windows Desktop
 そういえば、なんだかんだで旧来のデスクトップアプリ開発環境の Express 版が用意されたのでしたね。


12/10/28

ルーチンワークで FTP 転送しなくてはならない場合 (Windows)
 以下のようなスクリプトを "送る (SendTo)" に登録 (ショートカットを登録) しておくと、エクスプローラの "送る" からファイル転送できます。

@echo off
cls
::==============================================================================
:: 環境設定
::==============================================================================
set SCRIPTNAME=upload.ftp
:: -----------------------------------------------------------------------------
set SERVERNAME=FTP サーバ名
set USERNAME=FTP ユーザ名
set PASSWORD=FTP パスワード
set HOSTDIR=/
::==============================================================================

if "%1" == "" goto EXIT

:: -----------------------------------------------------------------------------
:: FTP 用スクリプト作成
:: -----------------------------------------------------------------------------
echo open %SERVERNAME%>%SCRIPTNAME%
echo %USERNAME%>>%SCRIPTNAME%
echo %PASSWORD%>>%SCRIPTNAME%
echo bin>>%SCRIPTNAME%
echo cd %HOSTDIR%>>%SCRIPTNAME%
echo put %1>>%SCRIPTNAME%
echo quit>>%SCRIPTNAME%

:: -----------------------------------------------------------------------------
:: FTP コマンド実行
:: -----------------------------------------------------------------------------
ftp -s:%SCRIPTNAME%

:: -----------------------------------------------------------------------------
:: 終了
:: -----------------------------------------------------------------------------
:EXIT

 FTP クライアントをイチイチ起動するのが面倒な場合にどうぞ。


12/10/30

TGoogleMapBrowser (VCL)
 TWebBrowser を継承して適当に作ってみました。API を使わずに GoogleMap を表示します。最近の Delphi の機能を使っている訳でもないので Delphi 7 でコンパイル可能です (多分 6 とかでも Ok)。

 以下定義部です。

type
  // ズーム範囲
  TGM_ZoomRange = 0..22;

  // 検索方法 (文字列 / 緯度・経度)
  TGM_SerchType = (gmstString, gmsLocation);

  // 地図の種類 (地図 / 写真 / 地図 + 写真 / Google Earth / 地形)
  TGM_MapType = (gmmtMap, gmmtSatellite, gmmtHybrid, gmmtGoogleEarth, gmmtTerrain);

  { TGoogleMapBrowser }
  TGoogleMapBrowser = class(TWebBrowser)
  private
    FDescription: string;
    FHostLanguage: string;
    FLatitude: Double;
    FLongitude: Double;
    FMapType: TGM_MapType;
    FParam: string;
    FSearchString: String;
    FSearchType: TGM_SerchType;
    FURL: string;
    FZoomLevel: TGM_ZoomRange;
    procedure BuildParams;
    function GetURL: string;
    function Getparent: TWinControl;
    procedure InitURL;
    procedure SetParent(const Value: TWinControl); reintroduce;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowBlank;                                                                      // 空白ページを表示する
    procedure ShowMap;                                                                        // Google Map を表示
    procedure PageSetup;                                                                      // ページ設定ダイアログを表示
    procedure Print(ShowDialog: Boolean = True);                                              // 印刷 (ShowDialog = False で即印刷)
    property Parent: TWinControl read Getparent write SetParent;                              // Parent を再定義し、TOleControl(WebBrowser).Parent のようなキャストを不要にする。
    property URL: string read GetURL;                                                         // 構築された URL (ReadOnly)
  published
    property Description: string read FDescription write FDescription;                        // 情報ウィンドウに表示される説明
    property HostLanguage: string read FHostLanguage write FHostLanguage;                     // ホストの言語を指定 (Ex.ja)
    property Latitude: Double read FLatitude write FLatitude;                                 // 緯度 (SearchType = gmsLocation 時)
    property Longitude: Double read FLongitude write FLongitude;                              // 経度 (SearchType = gmsLocation 時)
    property MapType: TGM_MapType read FMapType write FMapType default gmmtMap;               // 表示する地図の種類
    property SearchString: string read FSearchString write FSearchString;                     // 検索文字列 (SearchType = gmstString 時)
    property SearchType: TGM_SerchType read FSearchType write FSearchType default gmstString; // 検索方法
    property ZoomLevel: TGM_ZoomRange read FZoomLevel write FZoomLevel default 14;            // ズームレベル
  end;

 コンポーネントとしても使えるようになっています ([Internet] カテゴリに登録されます)。

 住所および名称、或いは緯度・経度から GoogleMap を表示できます。

 以下、使い方です。コンポーネントとしてではなく、動的作成して使うやり方を載せておきます。

uses
  ..., uGoogleMapBrowser{$IFDEF WIN64}, Math{$ENDIF};

// フォーム作成時
procedure TForm1.FormCreate(Sender: TObject);
begin
  {$IFDEF WIN64}
  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
  {$ENDIF}
  GoogleMapBrowser := TGoogleMapBrowser.Create(Self);
  GoogleMapBrowser.Parent := Self;
  GoogleMapBrowser.Align := alClient;
end;

// 住所または名称から検索
procedure TForm1.Button1Click(Sender: TObject);
begin
  with GoogleMapBrowser do
    begin
      HostLanguage := 'ja';        // ホスト言語: 日本
      MapType      := gmmtMap;     // 地図種類: 地図
      SearchType   := gmstString;  // 検索方法: 文字列
      SearchString := Edit1.Text;  // 検索文字列
//    Description  := 'ここです';
      ShowMap;
    end;
end;

// 緯度・経度から検索
procedure TForm1.Button2Click(Sender: TObject);
begin
  with GoogleMapBrowser do
    begin
      HostLanguage := 'ja';                         // ホスト言語: 日本
      MapType      := gmmtHybrid;                   // 地図種類: 地図 + 写真
      SearchType   := gmsLocation;                  // 検索方法: 緯度・経度
      Latitude     := StrToFloatDef(Edit2.Text, 0); // 緯度
      Longitude    := StrToFloatDef(Edit3.Text, 0); // 経度
//    Description  := 'ここです';
      ShowMap;
    end;
end;

 エディットコントロール (Edit1, Edit2, Edit3) とボタンコントロール (Button1, Button2) はパネルコントロール (Panel1) に貼り付けて、Align = alBottom としてあります。緯度・経度指定もできるので、こないだ紹介した XE3 のロケーションセンサー (VCL) と連動できますね。

 TGoogleMapBrowser は TWebBrowser を継承しているため、64bit アプリケーションとしてコンパイルすると、そのままでは実行時にエラーが発生します。これを回避するために SetExceptionMask() を記述してあります。詳しくは "TWebBrowserを含むフォームを64bitコンパイルして動作させるには? (Delphi Q&A)" を参照してください。

 詳細な使い方はソースを読んでください。大して長くないので難しくないと思います。


 BACK   古いのを読む   新しいのを読む