ab.com コミュニティ

メニューからフォントダイアログを表示させその設定をエディットボックス１
に出力するソースを教えてください。


易しく、丁寧に、教えてくれるかた、大歓迎。

ヒント：SendMessage( hWnd ,WM_SETFONT, hFont ,0)
hWnd:エディットボックスのハンドル
hFont:フォントのハンドル

少しは考えてみましょう。

　こちらの続きですよね。新たにトピックを作る必要はなかったと思います。

　みどるべあさんの書いたとおり，エディットボックスへWM_SETFONTを送る(SendMessage)のです。
ただ，今回は親のウィンドウハンドル(hMainWnd)と子のID(EditBox1など)がわかっているはずなのでSendDlgItemMessageのほうが便利でしょう。
WM_SETFONTを送るタイミングは前回のコードでCreateFontIndirectを行った直後が適切です。

　また，フォントハンドルはエディットコントロールが使うので，前回のようにすぐに削除するわけにはいきません。
削除するのはエディットコントロールがフォントを使い終わった後にする必要があります。
具体的には，エディットコントロールがなくなったときと別のフォントが指定されたときになるでしょう。

　コントロールが削除されると言うのは通常親が削除されるときだと思えばよいです。
つまりMainWndのDestroyイベントが打ってつけです。
別のフォントが指定されたときと言うのはもちろんMainWnd_IDM_FONT_MenuClick（2度目以降）ですね。

　となるとMainWnd_IDM_FONT_MenuClickを越えてフォントハンドルを持ち続けなければなりません。
それには今のところグローバル変数にするのがABでは一般的です。次の例ではhfntEditという名前にしています。
0で初期化していますが，0なら有効なフォントハンドルではないとしてDeleteFontしないよう弾いています。
（MainWnd_CommandButton1_Clickが最初に呼ばれたときや，1回も呼ばれずにMainWndが終了したときなど）

　ここまでの話をコードにするとこうなります。

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hfntEdit = 0 As HFONT

/* 中略 */

Sub MainWnd_Destroy()
	プロジェクト名_DestroyObjects()
	If hfntEdit <> 0 Then
		DeleteObject(hfntEdit)
	End If
	PostQuitMessage(0)
End Sub

Sub MainWnd_CommandButton1_Click()
	' ここは前回と同じなので省略
	If ChooseFont(cf) <> FALSE Then
		Dim hfnt As HFONT
		hfnt = CreateFontIndirect(lf)
		SendDlgItemMessage(hMainWnd, EditBox1, WM_SETFONT, hfnt As WPARAM, TRUE)
		If hfntEdit <> 0 Then
			DeleteObject(hfntEdit)
		End If
		hfntEdit = hfnt
	End If
End Sub