Windows 界では何年も前から「やれ .Netだ、マネージドコードだ」と盛んなようだが、必要に迫られちょっとだけ VB.NET を弄ってみた。
お粗末な言語仕様の奥には .NET が鎮座するようで、マネージドコードたる物、面倒なだけにしか思えない…
警告されない。
C や C++ のように引数の型だけ書いておいて引数名を省略する、なんて事が出来ない。
未使用でも警告されないので、不要なパラメータと判っている場面でも大抵は放置されている。
言語失格 > VB
実は正しい呼び方を知らない。複数条件書いた場合、条件を満たそうが満たすまいが、全部評価しちゃうという規則。
VB界の常識と言うか伝統なんだろうけど、確か、.NET 出始めの頃、MSDN に短絡評価するようになった、と書かれてあったのを思い出した。
知らない人にはバグの素であり、本当に評価しているのか見てみる。
len の長さと str が Nothing でないか検査するコード例：
If len <= 0 Or str Is Nothing Then
00000029 cmp ebx,0
0000002c setle al
0000002f movzx eax,al
00000032 cmp dword ptr [esi],0
00000035 sete dl
00000038 movzx edx,dl
0000003b or eax,edx
0000003d je 00000052
...
End If
00000052 nop
はぁ～、短絡じゃない。過去のソースが動かなくなるせいか変わってない。当時の MSDN は何だったんだ？
最適化オプションででも対応してくれて良い気がするが…
と思っていたら、AndAlso、OrElse なるキーワードが有るそうで、こちらが望み通りになる。
しかしまぁ何とも不恰好な構文。
If len <= 0 OrElse str Is Nothing Then
00000010 cmp edi,0
00000013 jle 00000019
00000015 test ebx,ebx
00000017 jne 00000020
Return 1
00000019 mov esi,1
0000001e jmp 00000025
End If
00000020 nop
一方、Select Case にて OR 条件（カンマ使用）を書いてみると、こちらは条件を満たした処で止め、以降の余計な評価はしない。
場合に拠っては if の代用として使えるかも…
Case &H81 To &H9F, &HE0 To &HFC ' == _ismbblead
000000e1 nop
000000e2 cmp dword ptr [ebp-18h],81h
000000e9 jl 000000F6
000000eb cmp dword ptr [ebp-18h],9Fh
000000f2 jg 000000F6
000000f4 jmp 00000108
000000f6 cmp dword ptr [ebp-18h],0E0h
000000fd jl 0000011C
000000ff cmp dword ptr [ebp-18h],0FCh
00000106 jg 0000011C
...
End Select
0000011c nop
これまた基本中の基本だが、C/C++言語のノリで書いていると痛い目に逢う。
VB（.NET）では Integer のような整数型変数を If Not xxx Then のように評価しては駄目。
例えば hoge が０かどうか判定しようと次のように書くと、
not 命令で EAX = FFFFFFFE となり、test 命令で０にならないので真にはならない。
Protected hoge As Integer = 1
Private Sub xxx(...
...
If Not hoge Then
0000000d mov eax,dword ptr [esi+000000E8h]
00000013 not eax
00000015 test eax,eax
00000017 je 00000029
MsgBox("偽！")
...
End If
00000029 nop
End Sub
コードを踏襲するなら次のように書くべきだろう。
If Not (hoge <> 0) Then
0000000d cmp dword ptr [esi+000000E8h],0
00000014 jne 00000026
MsgBox("偽！")
...
End If
00000026 nop
尤も、MSDN には
2 つのブール式の論理否定を求めます。また、2 つの数式のビットごとの否定を求めます。
とあり、ブール型 (Boolean) または数式を指定しなきゃならない。
VBのルールと言えばそれまでだが、C#とバックエンドを共通化したのだから、せめて警告を出すべきだ。
良く間違えるのでメモ。
PointToScreen や RectangleToScreen はクライアント座標をスクリーン座標へ変換すると言う事。
例えばフォームに於いて (100,100) の位置に確実に子ウィンドウが存在する状況で、そのスクリーン座標を得るには↓のようにする。
Dim c As System.Windows.Forms.Control = _
GetChildAtPoint(New System.Drawing.Point(100, 100))
Dim pt As System.Drawing.Point = Me.PointToScreen(c.Location)
Dim rc As System.Drawing.Rectangle = _
Me.RectangleToScreen(New System.Drawing.Rectangle(c.Location, c.Size))
Debug.WriteLine("PointToScreen " & pt.ToString)
Debug.WriteLine("RectangleToScreen " & rc.ToString)
もう１つ、矩形と言えば (x1,y1)-(x2,y2) をイメージするが、VB の Rectangle は右下隅でなく、幅, 高さを保持する事。ToString もそう表示する。
Win32 API で御馴染みの RECT とは異なる。
フォーム内のコントロールが子を持つならば、そのコントロールの RectangleToScreen を呼ぶ。
例えば GroupBox 内のラベルコントール。
Dim rc As System.Drawing.Rectangle = _
Me.GroupBox1.RectangleToScreen( _
New System.Drawing.Rectangle(lbl.Location, lbl.Size))
Debug.WriteLine("RectangleToScreen " & rc.ToString)
ラベル lbl を GroupBox1.lbl のように書かなくても構わない処が紛らわしい。と言うか余計なお節介だ。
フォームの直接の子の座標へ変換する手も有り。
Dim pt As System.Drawing.Point = lbl.Location
pt.Offset(Me.GroupBox1.Location.X, _
Me.GroupBox1.Location.Y)
Dim rc As System.Drawing.Rectangle = _
Me.RectangleToScreen( _
New System.Drawing.Rectangle(pt, lbl.Size))
C ではポインター、アドレス演算子(&)、間接演算子(*)が使え、C++ なら参照も使える。
int c = 5;
int *p = &c;
printf("%d\n", *p);
VB ではポインターが無いのでアドレスを関数へ渡すには ByRef と書く。所謂、参照。
VB 界に骨を埋めるつもりなら無問題だが、現実には WinAPI や C の DLL を呼ぶ場面も少なくない。
そこで問題となるのが参照では NULL ポインタを渡せないって事（多分）。
そんなの言語仕様で幾らでも対応出来るように思うのだが…
仕方ないので ByVal で数値０を渡さねばならぬ。つまり宣言を ByVal p As IntPtr とするもの。
簡単だが実に○鹿馬○しい。何の為のコンパイラか？
そんな宣言の関数呼び出しに０と書くのもアレなので相応しい定数を探すと IntPtr.Zero プロパティが良さげ。MSDN でも見かけたのでこれがデフォだろう。
func(IntPtr.Zero) 又は Dim nul As IntPtr func(nul)
VB 界のみ
次のような ByRef 宣言の関数に即値を与えて呼び出して問題無いのだろうか？
Private Function func(ByRef n As Integer) As Integer
n += 2
Return n
End Function
呼び出しコードを見ると、スタックに自動変数を宣言したかの如く生成されるので問題は無さそうだ。
00000004 xor eax,eax
00000006 mov dword ptr [ebp-4],eax
00000009 nop
func(9)
0000000a mov dword ptr [ebp-4],9
00000011 lea ecx,[ebp-4]
00000014 call dword ptr ds:[00A55324h]
尤も、適切に ByVal 宣言しておくのが無駄が無い。
func(9)
00000004 mov ecx,9
00000009 call dword ptr ds:[00A55324h]
文字列に対する既定のマーシャリング - 固定長の文字列バッファ より：
StringBuilder バッファを初期化してその容量を N にする際、マーシャラはバッファのサイズを (N+1) 文字に設定する。+1 は...
--> 勿論これは C文字列の事を指している。
VB は C終端文字なんぞ気にしなくて良い事を示唆する一方、Win32 GetWindowText の例はそうでも無い事を示してある。
Public Function GetText() As String
Dim sb As New StringBuilder(256)
Win32API.GetWindowText(h, sb, sb.Capacity + 1)
Return sb.ToString()
End Function
StringBuilder(256) と書けば最大 256文字格納出来る訳だけど、 GetWindowText は格納領域サイズを引数に要求している（終端文字を含めて）。 だから 256 + 1 = 257 を渡すべし！ と言う例。 汎用的に sb.Capacity + 1 と書いてある処は、面倒くさがりなのか説明無し。
但し、StringBuilder の Capacity は変動するんじゃないかと思う。
何故なら、例えば引数無しで StringBuilder を生成すると Capacity は16である。
しかし sb.Append によって16文字以上代入出来ない訳じゃない。
手元でやってみると Capacity は 32 へ拡大されたので、必要に応じて倍々に増加させている節がある。
この辺はバージョンによって動きが異なるいい加減な作りなよう。
と言う按配で、Capacity が縮小されない限り sb.Capacity + 1 を渡せば問題は起きないはずだが初期化時と異なる値が渡る時も有る。
さて、Capacity ==? StringBuilder のバッファサイズを超えて書き込まれると
どうなるか？
デバッガでは次のようなメッセージを食らう。
'System.IndexOutOfRangeException' のハンドルされていない例外が xxx.exe で発生しました。
追加情報 : 警告 : StringBuilder のバッファがアンマネージ コードにより
オーバーフローしました。
処理が不安定になる可能性があります。
集成を行う前に、StringBuilder に十分な領域を割り当てましたか?
この辺もバージョンによって動きが異なるようで、例外キャッチしないのも有った。
さらに、アンマネージ側が MBCS だと StringBuilder.Capacity の倍までは例外にならない例も有り、相当にいい加減な仕様／作りみたいだ。
否、「ちゃんとした仕様だ！」と言われ兼ねないが、仕様がどんどん変わっているらしき処が「い い 加 減」。
これを MS流 で進歩と呼ぶらしいが…
VBのウォッチ等は VC のそれと比べて貧弱。
ebp などのレジスタは扱えないし、変数のアドレスも表示してくれない。
必要性が低いのかも知れないが、手を抜く事も有るまいに…
String を自動変数に定義するとこんなコードになる。
Dim s As String = "ぶいびー"
00000016 mov eax,dword ptr ds:[061C156Ch]
0000001c mov dword ptr [ebp-10h],eax
この時の EAX = 051DF66C
そのアドレスを（メモリで）覗いてみると String の実体らしき内容が見える。
0x051DF66C f8 9a bf 79 05 00 00 00 o鬨
0x051DF674 04 00 00 00 76 30 44 30 ....v0D0
0x051DF67C 73 30 fc 30 00 00 00 00 s0u0....
0x051DF684 00 00 00 80
f8 9a bf 79 ...o鬨
0x051DF68C 69 00 00 00 68 00 00 00 i...h...
0x051DF694 4d 00 69 00 63 00 72 00 M.i.c.r.
0x051DF69C 6f 00 73 00 6f 00 66 00 o.s.o.f.
先頭 4 byte はお決まりっぽい。もしくはアドレスか…
その後の 4 byte は文字数+1 のようだが？
その後の 4 byte は文字数らしい。
その後にユニコード文字列が並んでいる。
"ぶいびー" のユニコード値は
76 30 44 30 73 30 FC 30
その後の 8 byte が String の内容なのか不明なので、適当に文字列を追加して新しいインスタンスへ入れ替えてみる…
s += "a"
00000019 mov edx,dword ptr ds:[061C1570h]
0000001f mov ecx,esi
00000021 call 788F0DF0
00000026 mov edi,eax
00000028 mov esi,edi
0x051E22D8 f8 9a bf 79 06 00 00 00 o鬨
0x051E22E0 05 00 00 00 76 30 44 30 ....v0D0
0x051E22E8 73 30 fc 30 61 00 00 00 s0u0a...
0x051E22F0 00 00 00 00 00 00 00 00 ........
0 の羅列に変わったのでユニコード文字列の後には何も無さそう。否、00 が付くとも見かけた気がするが…
書籍に拠ると次の構造らしい。
| 同期インデックス | ？不明 |
| 容量 | 文字数+1 じゃない場合も有る？ |
| 文字数 | |
| 16bit Unicode文字… |
後半は WTypes.h に有る次の構造体のよう。
typedef struct tagBSTRBLOB
{
ULONG cbSize; /* ... 文字数 */
/* [size_is] */ BYTE *pData;
} BSTRBLOB;
BSTR の構造を知らないが String はそれらしく、 cbSize の b は文字数であってバイト数じゃない処が紛らわしい。
MSDN に図解説明が載っており、それを参考に試す。
まず、C で作成した DLL へ String を渡してみる。
次のように Unicode で ByRef とする。
Declare Unicode Function xxx Lib "xxx.dll" (ByRef s As String) As Integer
VB 呼び出しでアドレス（レジスタ）を見ておく。
Dim s As String = "ぶいびー"
00000010 mov eax,dword ptr ds:[061C12B4h]
00000016 mov dword ptr [ebp-8],eax
Dim r As Integer = xxx(s)
00000019 lea ecx,[ebp-8]
0000001c call dword ptr ds:[00A55328h]
EAX = 051CA558 ... String s の実体
EBX = 00000000
ECX = 0013F68C ... 051CA558 を指すポインタ
0x051CA558 f8 9a bf 79
0x051CA55C 05 00 00 00 ....
0x051CA560 04 00 00 00 ....
0x051CA564 76 30 44 30 v0D0
0x051CA568 73 30 fc 30 s0u0
0x051CA56C 00 00 00 00
0x051CA570 00 00 00 80
0x0013F68C 58 a5 1c 05
DLL 関数で見ると 0013F68C ではなく、少しずれた 0013f61c が渡されていた。
- s,32 0x0013f61c "d&" char * [0x0] 0x64 [0x1] 0x26 [0x2] 0x18 [0x3] 0x00 |
参照型なのでその先を見ると確かに "ぶいびー" だ。
0x00182664 76 30 44 30 v0D0 0x00182668 73 30 fc 30 s0u0 0x0018266C 00 00 ad ba |
Declare で Unicode 指定しなければ日本語版ではマーシャラーが Shift-JIS に変換する。
- s,32 0x0013f60c "・" char * [0x0] 0x8c [0x1] 0x08 [0x2] 0x18 [0x3] 0x00 |
手前の文字数が 8 を示すのは偶然か、または bytes を示しているのか？…
0x00180880 f4 f5 13 00 oo.. 0x00180884 0d f0 ad ba .d-o 0x00180888 08 00 00 00 .... 0x0018088C 82 d4 82 a2 ?O?￠ 0x00180890 82 d1 81 5b ?N?[ 0x00180894 00 22 00 00 .".. |
最後の文字 81 5b を 30 31 (="01")へ書き換え、VB側が変更されるか？
0x00180888 08 00 00 00 .... 0x0018088C 82 d4 82 a2 ?O?￠ 0x00180890 82 d1 30 31 ?N01 0x00180894 00 22 00 00 .".. |
VB 側へ制御が戻ると新しい String インスタンスへ置き換わっている。
s "ぶいび01" String 0x051CD28C f8 9a bf 79 06 00 00 00 o??y.... 0x051CD294 05 00 00 00 76 30 44 30 ....v0D0 0x051CD29C 73 30 30 00 31 00 00 00 s00.1... |
図は MSDN の物にマーシャラーを書き加えたものだけど、2 次バッファ云々の処が判らない。2 次バッファにコピーする時に文字セットを変換し、その参照を呼び出し先に渡す、とあるので、アンマネージ ヒープ内の事だろうと思うが…
どの道、String の参照渡しは扱い難いので使う事は無いだろう。
次は値渡し。
Declare Unicode Function xxx Lib "xxx.dll" (ByVal s As String) As Integer
一見、何も問題無いように見えるが、実は関数呼び出し後に String オブジェクトは新たに生成され、その変数 s（ポインタ）は新たな String オブジェクトを指すようになる。
げげぇ！
Dim s As String = "ぶいびー"
00000013 mov eax,dword ptr ds:[061D12B4h]
00000019 mov dword ptr [ebp-8],eax
Dim r As Integer = xxx(s)
0000001c lea ecx,[ebp-8]
0000001f call dword ptr ds:[00A65328h]
00000025 mov esi,eax
変数 s を見る為に ebp を見る。
EBP = 0012F694
call の直前：
0x0012F68C 58 a5 1d 05 String オブジェクト
0x0012F690 7b 52 a6 00
0x0012F694 9c f6 12 00 ebp
0x051DA558 f8 9a bf 79 o??y
0x051DA55C 05 00 00 00 ....
0x051DA560 04 00 00 00 ....
0x051DA564 76 30 44 30 v0D0
0x051DA568 73 30 fc 30 s0u0
0x051DA56C 00 00 00 00 ....
call の直後：
0x0012F68C 8c d2 1d 05 新しい String オブジェクト
0x0012F690 7b 52 a6 00 {R|.
0x0012F694 9c f6 12 00 ebp
0x051DD28C f8 9a bf 79 o??y
0x051DD290 05 00 00 00 ....
0x051DD294 04 00 00 00 ....
0x051DD298 76 30 44 30 v0D0
0x051DD29C 73 30 fc 30 s0u0
0x051DD2A0 00 00 00 00 ....
驚くのはこれからで、Declare の Unicode を外し、マルチバイトで渡すと call の後の String は悲惨になる。
0x051CD28C f8 9a bf 79 o??y 0x051CD290 05 00 00 00 .... 0x051CD294 04 00 00 00 .... 0x051CD298 76 30 44 30 v0D0 0x051CD29C 00 00 00 00 .... ←消えた！
何となく４文字ではなく４bytesで切り取られた様子。
最新版はどうなってるか知らないが、知ってか知らずか出荷している時点で「駄目だ、こりゃ」。
尤も、巷の噂ではマーシャル属性だかを指定すれば回避されるらしいが…
VB で書き戻しを防ぐ方法が無さそうで、かなり「イタイ」作りに思う。
なお、書き戻しと言っても渡した String オブジェクトが破棄される訳では無さそうなので、渡す前にもう１つ、例えば
Dim s2 As String = s
のように元の String オブジェクトを見失わないよう参照を記憶しておくか、あるいは
Dim r As Integer = xxx((s))
のように渡す変数（参照）を括弧で囲んで（複製して）呼ぶのが簡単かも知れない。
Let It Be じゃなく昔の LeftB 関数。
探せばネットにゴロゴロしているが、少々違った用途に使いたいので改造。
VB だと何故か goto 使う方がすっきり書ける。:-)
' str : [in/out] 指定文字列
' len : [in] 取得バイト数（先頭から）、あるいは最大バイト数。
'
' 戻り値 : 文字列 str をクリップしたか否かを返す。
'
' 文字列（ユニコード）を Shift-JIS バイト配列へ変換して指定バイト数を得る。
' バイト配列長が len より短かい場合は何もしないが、str が Nothing であったな
' ら String.Empty を代入する。
'
' この関数の目的は Left 関数と言うよりは、Shift-JIS バイト列へ変換した際に最
' 大バイト数を超えないようにクリップする事を想定している。
' 尤も、ユニコード文字数のバイト換算は高々２倍なので、その比較結果によっては
' バイト列変換は省かれる。
'
Public Function xxxxxx(ByRef str As String, ByVal len As Integer) As Integer
Dim clip As Integer = 0
If str Is Nothing Then GoTo EmptyReturn
If len <= 0 Then
clip = str.Length ' 文字数の有無がクリップ。
GoTo EmptyReturn
End If
If str.Length() <= (len >> 1) Then ' クリップは起こらない。
Return 0
End If
' Shift-JIS バイト列
Dim arr As Byte() = System.Text.Encoding.GetEncoding(932).GetBytes(str)
If arr.Length() <= len Then ' クリップ不要。
Return 0
End If
clip = 1
' 先行バイトで終わりそうなら切り詰める。
' もし、先行バイト1文字を要求されたら空文字になる。
Select Case arr(len - 1)
Case &H81 To &H9F, &HE0 To &HFC ' == _ismbblead
If len <= 1 Then GoTo EmptyReturn
len -= 1
End Select
' バイト列から指定バイトだけユニコードに戻して終わる。
str = System.Text.Encoding.GetEncoding(932).GetString(arr, 0, len)
Return clip
EmptyReturn: ' 空文字を返して終わるケース。
str = String.Empty
Return clip
End Function
Shift-JIS 先行バイト判定は VC の _ismbblead 実装を模倣したかったのだけれど、テーブルを動的に作っているのか、不明な為、マニュアルと試した結果で範囲を決めた。また、先頭文字から順になめて判断しなくて良いのか不安だが、壊れた文字が VB ユニコード文字列に入り込んでいる状況は想定してないので悪しからず。
ListBox は Windows 創世記に作られただけあって中々質実剛健。
いやパクられたと言うべきか…
何も知らずに見た目だけ優先してリストビューなんかへ替えちゃったりするとユーザーから怒りが届いたりする。
いやぁ、見栄えも重要ですから、と言う人の為に
問題になりがちなのが複数項目を持つテキストでの桁揃え。
古くは項目間を適当な空白で埋める小細工で良かったのだけれど、プロポーショナルフォントが当り前な今では通用しない。
となればエディタでお馴染み「タブ揃え」。
意地悪な VB にはメソッドが無さそう。然るべきメッセージを送ればいいだけ…
Public Class xxx
Public Shared Sub Tabs(ByRef lst As System.Windows.Forms.ListBox, _
ByVal ParamArray pos() As Integer)
Dim count As Integer = UBound(pos)
For i As Integer = 0 To count
pos(i) *= 4
Next
SendMessageW(lst.Handle, LB_SETTABSTOPS, count + 1, pos)
' lst.Refresh()
End Sub
Public Declare Unicode Function SendMessageW Lib "user32" ( _
ByVal hWnd As IntPtr, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam() As Int32) As Int32
'Public Declare Unicode Function GetDialogBaseUnits Lib "user32" () As Integer
Public Const LB_SETTABSTOPS As Integer = &H192
End Class
ネットで見つけたコードに手を加えて class に閉じ込めた。
こんな感じ↓で呼ぶ。
xxx.Tabs(lst, 21, 25) lst.Refresh()
21文字と25文字辺りに揃える。「辺り」と言うのは平均文字幅で決まるから。
等幅フォントならピッタリいくはず。
処で、このタブストップ位置を知るにはどうするの？
TEXTMETRIC 構造体の tmAveCharWidth メンバがそのようだ。
VB グラフィクスに明るくないので Windows SDK の手順でやってみよう。
毎度ネットのお世話になり宣言類をば。
Public Declare Unicode Function GetDC Lib "user32" ( _
ByVal hwnd As System.IntPtr) As System.IntPtr
Public Declare Unicode Function SelectObject Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByVal hgdiobj As IntPtr) As System.IntPtr
Public Declare Unicode Function GetTextMetricsW Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByRef lptm As TEXTMETRICW) As Integer
< Serializable(), StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode) > _
Public Structure TEXTMETRICW
Public tmHeight As Int32
Public tmAscent As Int32
Public tmDescent As Int32
Public tmInternalLeading As Int32
Public tmExternalLeading As Int32
Public tmAveCharWidth As Int32
Public tmMaxCharWidth As Int32
Public tmWeight As Int32
Public tmOverhang As Int32
Public tmDigitizedAspectX As Int32
Public tmDigitizedAspectY As Int32
Public tmFirstChar As UInt16
Public tmLastChar As UInt16
Public tmDefaultChar As UInt16
Public tmBreakChar As UInt16
Public tmItalic As Byte
Public tmUnderlined As Byte
Public tmStruckOut As Byte
Public tmPitchAndFamily As Byte
Public tmCharSet As Byte
End Structure
tmAveCharWidth を手に入れるにも一苦労だ。
' extern "C" {
Dim tm As TEXTMETRICW
Dim hDC As System.IntPtr = GetDC(lst.Handle())
Dim old As System.IntPtr = SelectObject(hDC, lst.Font.ToHfont)
Dim h As Integer = GetTextMetricsW(hDC, tm)
SelectObject(hDC, old)
If h Then
tm.tmAveCharWidth ...
' }
VB で書くには○カ○カしいので、皮肉を込めてコメントに extern "C" を書いておいた。
まんざら冗談でもなく、可能なら使いたいものだ。
VB グラフィクスを使えば簡素になるかも知れないが、さっさと C 流儀で書いた方が確実、且つ手っ取り早い。
一般的には Graphics.MeasureString で得るらしい。DOBON.NET に色々な方法が載せられている。
んが、多少余白が含まれたり、太字なんかでは正確でないそうな。
また、空白は文字でないとでも思っているのか、デフォでは無視するそうな。
（んじゃ何で空白に文字コード割り当ててるんだ？）
と言う訳で、StringFormat を引数に取る書式を呼ぶ必要有り。
ラベル lbl の１行表示のテキストサイズを測る質素な例：
幅０を指定すれば１行を意味すると思われるが念の為に NoWrap も指定（暗黙的に指定されると説明されてはいるが）。
また、気持ち分、Clip 不要の意思表示で NoClip も加えてみた。
Dispose() しちゃって良いのだろうか等、丸で理解してないが…
Dim fmt As New StringFormat( _
StringFormatFlags.MeasureTrailingSpaces Or _
StringFormatFlags.NoClip Or _
StringFormatFlags.NoWrap)
Dim g As Graphics = lbl.CreateGraphics
Dim size As SizeF = g.MeasureString(lbl.Text, lbl.Font, 0, fmt)
g.Dispose()
' size.Width ...
' size.Height ...
何となく DrawText API に DT_CALCRECT を指定した雰囲気なので、そっちでも試す。
Public Declare Unicode Function DrawTextW Lib "user32" ( _
ByVal hDC As IntPtr, _
ByVal lpStr As String, _
ByVal nCount As Integer, _
ByRef lpRect As System.Drawing.Rectangle, _
ByVal uFormat As Integer) As Integer
Public Const DT_CALCRECT = &H400
Public Const DT_NOPREFIX = &H800
Public Const DT_NOCLIP = &H100
Public Const DT_SINGLELINE = &H20
Rectangle は RECT 構造体と互換有り。
ListBox のコード拝借。
Dim rc As System.Drawing.Rectangle
Dim hDC As System.IntPtr = GetDC(lbl.Handle())
Dim old As System.IntPtr = SelectObject(hDC, lbl.Font.ToHfont)
Dim cy As Integer = DrawTextW(hDC, lbl.Text, -1, rc, _
DT_CALCRECT Or DT_SINGLELINE)
SelectObject(hDC, old)
' rc.right ...
' rc.bottom ...
図形描画ではなくボタンコントロールを角丸化。
色んな処で解説有り、何を今更と思ったがコントロールの見た目を変更する（特に既存を）手法として有用と思い書き留め。
ただ、ボタンにしては味気無く、テキストがセンタリングしてない等、実用には遠い。
さて、コントロールにカスタムな要素を取り入れるにはサブクラスが代表的なんだが、もっと独立性を高められるコーディング方法が有るのを発見。次の２ステップがそれ。
1. はこんな感じ。先にベースの WndProc を呼んでるのは、そうしないといけないコントロールが有った為。必要か否か？
Public Class XXX : Inherits NativeWindow
Private Const WM_PAINT As Integer = &HF
Protected target As System.Windows.Forms.Button
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_PAINT Then
Dim g As Graphics = target.CreateGraphics
g.FillRectangle(Brushes.MediumVioletRed, 0, 0, target.Width, target.Height)
Dim fmt As New StringFormat
fmt.HotkeyPrefix = System.Drawing.Text.HotkeyPrefix.Show
g.DrawString(target.Text, target.Font, Brushes.Lime, 0, 0, fmt)
m.Result = IntPtr.Zero
Return
End If
End Sub
End Class
塗りつぶしとテキスト描画だけなので、これで角丸にはならない。それにはリージョンをセットした。これが中々曲者で後で解説する。
また、呼び出しを簡素化したいので、これらをまとめて Attach 関数と名付けた。
Public Shared Sub Attach(ByVal src As System.Windows.Forms.Button)
' XXX の生成と保存、初期化。
Dim cls As New XXX
cls.target = src ' 参照用にセット。
cls.AssignHandle(src.Handle) ' これが大事。
src.Tag = cls ' インスタンスを保存。既に使われているなら他に保存せざるを得ないが…
' リージョン設定
Dim R As New Size(30, 30)
Dim rc As New Rectangle(0, 0, src.Width, src.Height)
Dim path As New System.Drawing.Drawing2D.GraphicsPath
'path.FillMode = System.Drawing.Drawing2D.FillMode.Winding
path.AddArc(rc.Right - R.Width, rc.Top, R.Width, R.Height, 270, 90)
path.AddArc(rc.Right - R.Width, rc.Bottom - R.Heigh, R.Width, R.Height, 0, 90)
path.AddArc(rc.Left, rc.Bottom - R.Height, R.Width, R.Height, 90, 90)
path.AddArc(rc.Left, rc.Top, R.Width, R.Height, 180, 90)
src.Region = New Region(path)
End Sub
2. は上記を呼ぶだけ。Button1 がボタン。
XXX.Attach(Button1)
さて、GraphicsPath の AddArc は MSDN サンプルを見て書いたのだが、中々癖がある。
パスとは描画の道筋の意味なのだろう。
矩形なボタンの四隅に円弧を指定し変形させる訳だが、
まず角度。これは時計の３時が基点。なので右下の指定が０°になる。
次に座標。これはどうやら円弧を囲む矩形の左上隅を与えるらしい。赤い点がそれ。
何故そういう指定方法なのか、何処かに解説有った気がするが失念。
例えば、フォーム直下に有るコントロール ctrl をコンテナ（例えばタブページコントロール等）へ移動するには、次のように書けば良いようだ。
Remove が必要な気がしたのだが、コレクションの Count を見ても減少するので不要なのだろう。
Me.TabPage1.Controls.Add(ctrl) ' Me.Controls.Remove(ctrl)
但し、親ウィンドウが変わる為か、移動後の相対位置・サイズは出鱈目な値になるようだ。再設定しないといけない。
その他の状態は移動前と変わらないように思える。
でも、ListBox を移動させてみるとウィンドウ ハンドルが変化する。WM_DESTROY を受け、項目関係のメッセージ LB_xxx を受けている。移動後の見た目は変わったように見えないが…
適当なフォームで WndProc をオーバーライドして Form_Load まで観た。
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Debug.WriteLine(m.ToString())
MyBase.WndProc(m)
End Sub
Protected Overrides Sub OnHandleCreated(ByVal e As System.EventArgs)
Debug.WriteLine("OnHandleCreated")
MyBase.OnHandleCreated(e)
End Sub
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
Debug.WriteLine("OnResize")
MyBase.OnResize(e)
End Sub
初めに OnResize が２回も呼ばれている。
0x127 と 129 は予想。
WM_SHOWWINDOW は既に届いている。
OnResize OnResize msg=0x0024 (WM_GETMINMAXINFO) hwnd=0x9b0882 wparam=0x0 lparam=0x13e5f8 result=0x0 msg=0x0081 (WM_NCCREATE) hwnd=0x9b0882 wparam=0x0 lparam=0x13e5f0 result=0x0 msg=0x0083 (WM_NCCALCSIZE) hwnd=0x9b0882 wparam=0x0 lparam=0x13e618 result=0x0 msg=0x0001 (WM_CREATE) hwnd=0x9b0882 wparam=0x0 lparam=0x13e5e0 result=0x0 msg=0x0127 WM_CHANGEUISTATE ? hwnd=0x9b0882 wparam=0x3 lparam=0x0 result=0x0 OnHandleCreated msg=0x000c (WM_SETTEXT) hwnd=0x9b0882 wparam=0x0 lparam=0x51dd8b8 result=0x0 msg=0x0080 (WM_SETICON) hwnd=0x9b0882 wparam=0x0 lparam=0x0 result=0x0 msg=0x0080 (WM_SETICON) hwnd=0x9b0882 wparam=0x1 lparam=0x0 result=0x0 msg=0x000e (WM_GETTEXTLENGTH) hwnd=0x9b0882 wparam=0x0 lparam=0x0 result=0x0 msg=0x000d (WM_GETTEXT) hwnd=0x9b0882 wparam=0x6 lparam=0x13ea50 result=0x0 msg=0x007c (WM_STYLECHANGING) hwnd=0x9b0882 wparam=0xfffffffffffffff0 lparam=0x13f390 result=0x0 msg=0x007d (WM_STYLECHANGED) hwnd=0x9b0882 wparam=0xfffffffffffffff0 lparam=0x13f390 result=0x0 msg=0x007c (WM_STYLECHANGING) hwnd=0x9b0882 wparam=0xffffffffffffffec lparam=0x13f390 result=0x0 msg=0x007d (WM_STYLECHANGED) hwnd=0x9b0882 wparam=0xffffffffffffffec lparam=0x13f390 result=0x0 msg=0x0046 (WM_WINDOWPOSCHANGING) hwnd=0x9b0882 wparam=0x0 lparam=0x13f3d0 result=0x0 msg=0x0083 (WM_NCCALCSIZE) hwnd=0x9b0882 wparam=0x1 lparam=0x13f3a4 result=0x0 msg=0x0047 (WM_WINDOWPOSCHANGED) hwnd=0x9b0882 wparam=0x0 lparam=0x13f3d0 result=0x0 msg=0x0018 (WM_SHOWWINDOW) hwnd=0x9b0882 wparam=0x1 lparam=0x0 result=0x0 msg=0x0210 (WM_PARENTNOTIFY) hwnd=0x9b0882 wparam=0x87a0001 lparam=0x1e087a (WM_CREATE) result=0x0 msg=0x0055 (WM_NOTIFYFORMAT) hwnd=0x9b0882 wparam=0x1ed0842 lparam=0x3 result=0x0 msg=0x0129 WM_QUERYUISTATE ? hwnd=0x9b0882 wparam=0x0 lparam=0x0 result=0x0 msg=0x0210 (WM_PARENTNOTIFY) hwnd=0x9b0882 wparam=0x10001 lparam=0x1ed0842 (WM_CREATE) result=0x0 msg=0x0210 (WM_PARENTNOTIFY) hwnd=0x9b0882 wparam=0x85a0001 lparam=0x5b085a (WM_CREATE) result=0x0 msg=0x0210 (WM_PARENTNOTIFY) hwnd=0x9b0882 wparam=0x90a0001 lparam=0x19090a (WM_CREATE) result=0x0 msg=0x0210 (WM_PARENTNOTIFY) hwnd=0x9b0882 wparam=0x8580001 lparam=0x340858 (WM_CREATE) result=0x0 msg=0x000e (WM_GETTEXTLENGTH) hwnd=0x9b0882 wparam=0x0 lparam=0x0 result=0x0 msg=0x000d (WM_GETTEXT) hwnd=0x9b0882 wparam=0x6 lparam=0x13e24c result=0x0 Form1_Load
Module Module1
Public Sub Main(ByVal args As String())
Application.Run(New Form1)
End Sub
End Module
VB に限る話題ではないが…
日本語訳では「所有されているウィンドウ」となっていた。
古い Win32 API プログラマーズ リファレンス に拠ると次のように書かれてある。
オーナー ウィンドウになれるのは､ オーバーラップ ウィンドウとポップアップ ウィンドウだけです。子ウィンドウはオーナー ウィンドウにはなれません。
CreateWindowEx 関数辺りで仮引数名が hwndParent となっているのがそれ。ちゃんと /* 親ウィンドウまたはオーナー ウィンドウのハンドル */ と書かれてある。
ここで困るのが、ウィンドウ作成した後でオーナーを変更出来そうに無い事。
SetWindowLong なんかで、と思うが、GWL_HWNDPARENT は有効な引数になっていない。
それに次のようにはぐらかした文が書かれている。
子ウィンドウの親を変更するときは、GWL_HWNDPARENT を指定して SetWindowLong 関数を呼び出すのではなく、SetParent 関数を使ってください。
何故？どうして？ 子ウィンドウじゃなくて、オーナーを変えるにはどうなのよ？ と言いたい（MS の文章ってのは大抵こんなだ orz）…挙句には「保証しません」とか出して来る。
でもやってる人は居るようだ。問題有りとは書かれていない（参考）。
Public Declare Unicode Function SetParent Lib "user32" ( _
ByVal hWndChild As System.IntPtr, _
ByVal hWndNewParent As System.IntPtr) As System.IntPtr
例えばフォームの移動をスクリーン左端から 100 ピクセル以上に制限するとしたら…
簡単には Left プロパティへそれなりの値をセットすれば良い訳ですが、シビアに考えると一時的に移動してから戻るので面白くない。
ここはひとつ、移動を許さない方法は無いのか？
と SDK ベースで考えていたら WM_WINDOWPOSCHANGING に阻止出来そうな内容が書かれてある。
アプリケーションは､ WINDOWPOS構造体のflagsメンバの適切なビットをセットまたはクリアすることにより､ ウィンドウに対して変更が行われないようにすることができます。
ほほぅ、VB で確かめるにはもどかしいが、やってみる。
Imports System.Runtime.InteropServices
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Select Case m.Msg
Case WM_WINDOWPOSCHANGING
Dim wp As WINDOWPOS
#If 0 Then
CopyFromWindowPos(wp, m.LParam, Len(wp))
#Else
wp = CType(m.GetLParam(wp.GetType()), WINDOWPOS)
#End If
If wp.flags And SWP.SWP_NOMOVE Then
ElseIf wp.x < 100 Then
wp.x = 100
wp.flags = wp.flags Or SWP.SWP_NOSIZE
#If 0 Then
CopyToWindowPos(m.LParam, wp, Len(wp))
#Else
Marshal.StructureToPtr(wp, m.LParam, False)
#End If
Return
End If
End Select
MyBase.WndProc(m)
End Sub
SWP_NOMOVE が付いてればスルー（移動だけに注目するのだから…）、
限界位置より大きければスルー、
領海侵犯が起こりそうなら SWP_NOMOVE を付加すれば良い。
が、やってみると違和感有るので、限界位置でクリップし、サイズ変更を（許すスタイルの場合の為に）禁止してみた。
ここでは移動かサイズ変更か判らないので二者択一するしか無さそうである。
従って、最大化時に最大化しない orz
定義類はパクり物だが、ここで面倒なのは lParam ポインタと WINDOWPOS 構造体との読み書きする処。
ダイナミックに ByRef なんて出来ないので memcpy する例が多いが、モダン？に見えた書き方にした。
しかし GetLParam は有っても SetLParam は無い。
PtrToStructure も用意されてはいるが、いい加減参照させたらどうか？
何をするにも VB は面倒だ。
Public Const WM_WINDOWPOSCHANGING As Integer = &H46
< StructLayout(LayoutKind.Sequential) > _
Public Structure WINDOWPOS
Public hwnd As Integer
Public hwndInsertAfter As Integer
Public x As Integer
Public y As Integer
Public cx As Integer
Public cy As Integer
Public flags As SWP
End Structure
Enum SWP As Integer
SWP_NOSIZE = &H1
SWP_NOMOVE = &H2
SWP_NOZORDER = &H4
SWP_NOREDRAW = &H8
SWP_NOACTIVATE = &H10
SWP_FRAMECHANGED = &H20
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_NOCOPYBITS = &H100
SWP_NOOWNERZORDER = &H200
End Enum
Public Declare Sub CopyFromWindowPos Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef dst As WINDOWPOS, _
ByVal src As IntPtr, _
ByVal cBytes As Int32)
Public Declare Sub CopyToWindowPos Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal dst As IntPtr, _
ByRef src As WINDOWPOS, _
ByVal cBytes As Int32)
WM_WINDOWPOSCHANGING を見ているだけでは最大化しようとしているのかどうか判りそうに無い。
WM_SYSCOMMAND メッセージで SC_MAXIMIZE コマンドを記憶しておいて、その内に WM_WINDOWPOSCHANGING がやって来る、と考えるか…
尤も、WM_GETMINMAXINFO でセットするのが賢明。
なお、ptMaxSize なんかの値にタスクバーのサイズは含まれてないようだ。
良くワカラン…
DLL でなく EXE のままでも関数呼び出しは可能、と何処かで見かけた。
ほぅ、そうですかい、ではやってみよう。
単純なフォームクラスに自身を表示する Shared 関数を追加する。
おまけで Owner を渡す。これを hoge.exe とする。
Public Class VBexe : Inherits System.Windows.Forms.Form
Public Shared Sub Exec(ByRef owner As System.Windows.Forms.Form)
Dim frm = New VBexe
frm.Owner = owner
frm.Show()
End Sub
...
Load ではなく LoadFile や LoadFrom でないと失敗する。
これで呼び出した方のプロセス、スレッドでフォームが表示される。
Try
Dim asm As System.Reflection.Assembly = _
System.Reflection.Assembly.LoadFile( _
"C:\...\hoge.exe")
Dim myType As Type = asm.GetType("hoge.VBexe")
Dim myMethod As MethodInfo = myType.GetMethod("Exec")
Dim obj As Object = Activator.CreateInstance(myType)
myMethod.Invoke(obj, New Object() {Me})
Catch e As Exception
Debug.WriteLine(e)
End Try
アプリケーション内で共有できる仕組みが無いか探していた処で見つけた。
プロセスとも違う、もやもやした単位。
これに名前付けて保持できるそうな。
フォーム（Me）をセットしてみたが、特に問題は無い。
System.AppDomain.CurrentDomain().SetData("hoge", Me)
Dim o As Object = System.AppDomain.CurrentDomain().GetData("hoge")
さて、ExecuteAssembly なるものが有ったので、これで現在のドメインから起動してみると…
System.AppDomain.CurrentDomain.ExecuteAssembly( _
"C:\...hoge.exe")
これは駄目、
'System.InvalidOperationException' のハンドルされていない例外が system.windows.forms.dll で発生しました。
追加情報 : 1 つのスレッド上で、2 つ目のメッセージ ループを開始できません。
Application.RunDialog または Form.ShowDialog を代わりに使用してください。
では新しくドメインを作成したらどうか？
これは起動は出来るが、終了時に問題を起こした。
System.AppDomain.CreateDomain("Hoge").ExecuteAssembly( _
"C:\...hoge.exe")
vb1.exe の 0x7c959af2 で初回の例外が発生しました : 0xC0000005: 場所 0x00000010 に書き込み中にアクセス違反が発生しました。
う～む、ウィンドウ メッセージ ループが駄目か…
VB.NET とは無縁の古典的な DLL の話。C それも VC 固有かも知れない。
昔、そんなテクニックが有ったのを思い出し、MSDN の説明を見て試す。
2007年に更新されたままだが、有効なようだ。
ソース中の共有データ
//#pragma comment(linker, "/SECTION:.hoge,RWS!K")
#pragma data_seg(".hoge")
char hogestr[64] = "hogeHOGE";
#pragma data_seg()
リンカの追加オプション
/SECTION:.hoge,RWS
追加のオプション枠に例のような文字列で指定する。
名前に、ドットで始めねばならない規則は無かったと思うが…
また、オブジェクト ファイルにリンカ オプションを記録する事になっている pragma comment もいけそう。複数箇所に現れうるので嫌がる人も居そうな反面、好む人も居る。
なお、単純サンプルだと期待通りに動作するが、複雑巨大システムだとうまくいかなかったりする。何か制限が有るのか、他の原因なのか判らない… その場合はメモリマップド ファイルの方が簡単だったりする。
さて、オプションが狙い通りにセットされたかどうか？
VS 付属の dumpbin で見てみる。
dumpbin xxx.dll /headers または
dumpbin xxx.dll /section:.hoge
Microsoft (R) COFF/PE Dumper Version 7.10.3077
Copyright (C) Microsoft Corporation. All rights reserved.
Dump of file xxx.dll
File Type: DLL
SECTION HEADER #6
.hoge name
14C virtual size
3A000 virtual address (1003A000 to 1003A14B)
1000 size of raw data
28000 file pointer to raw data (00028000 to 00028FFF)
0 file pointer to relocation table
0 file pointer to line numbers
0 number of relocations
0 number of line numbers
D0000040 flags
Initialized Data
Shared
Read Write
...
flags の処に Shared 属性が付いている。良さそうだ。
なお、K（Cacheable 属性）は「セクションをキャッシュ不可としてマークします。」と有るが、これは良く説明を読まねばならない。
/SECTION:.hoge,RWS!K のように否定でもって指定しないと意味が無い。
そうすれば Not Cached となる。尤も、どういう場合に効果有るのか判らない…
うまくゆかない。
とあるフォームを Paint イベントで（何か処理させた後）クローズする。
Public Class yyy : Inherits System.Windows.Forms.Form
Private Sub yyy_Paint(...
...
Me.Hide()
'Me.Visible = False
Me.Close()
End Sub
End Class
これをモードレス表示させる（モーダルでは起こらない）。
Public Class xxx : Inherits System.Windows.Forms.Form
Public f As yyy
...
Private Sub Button1_Click(...
f = New yyy
f.Show()
End Sub
End Class
するとクローズが終わる頃、次の例外が起こる。
'System.ObjectDisposedException' のハンドルされていない例外が system.windows.forms.dll で発生しました。 追加情報 : "yyy" という名前の、破棄されたオブジェクトにアクセスできません。
何故 モーダルで起こらないのか違いを見ると Me.Close() 後に Dispose が呼ばれないことが判る。
Close() でインスタンスまで破棄しようとするモードレスの振る舞いがいけない。（何て作りだ。生成時は New させて Show を強いるくせに…）
そう言う訳でモードレスの場合には Close() を呼ぶ時期を別にしないといけない。
Activated イベントで処理したり、API PostMessage 利用する手があるが、適切なタイミングが無ければ放置してガベージコレクタに任せるのが良いだろう。
それにしても Close() で Dispose を呼んでいるとは無茶苦茶な…
今時このような同じキーワードで異なる振る舞いを定義するのは如何なものか？ 何を考えているのか首を傾げる。
Dim の省略
Dim sum As Integer = 0
For i As Integer = 0 To 10
sum += i
Next
何処かに一覧が載っていた気がするが失念。