ab.com コミュニティ

'このファイルはウィンドウ定義ファイル（*.wnd）をもとに生成されています

Const Static1=1000

Dim hModal As HWND
Dim hFont_Modal As HFONT
hFont_Modal=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック")
Dim h3DFaceBrush As HBRUSH
h3DFaceBrush=CreateSolidBrush(GetSysColor(COLOR_3DFACE))


Sub D_DestroyObjects()
	DeleteObject(hFont_Modal)
	DeleteObject(h3DFaceBrush)
End Sub

Function EventCall_Modal(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
	Select Case message
		Case WM_INITDIALOG
			hModal=hWnd
			CreateWindowEx(&H00000000,"STATIC","Text1",&H50000000,151,142,50,12,hWnd,Static1 As HMENU,GetModuleHandle(0),0)
			SendMessage(GetDlgItem(hWnd,Static1),WM_SETFONT,hFont_Modal As WPARAM,0)
		Case WM_DESTROY
		Case WM_CLOSE
			Dim cancel=0 As Integer
			If cancel=0 Then EndDialog(hWnd,0)
		Case Else
			EventCall_Modal=DefWindowProc(hWnd,message,wParam,lParam)
			Exit Function
	End Select
	EventCall_Modal=0
End Function

Function DefaultCallProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
	DefaultCallProc=DefWindowProc(hWnd,message,wParam,lParam)
End Function

Dim _RadSys_dlgwcl As WNDCLASSEX
FillMemory(VarPtr(_RadSys_dlgwcl),Len(_RadSys_dlgwcl),0)
_RadSys_dlgwcl.cbSize=Len(_RadSys_dlgwcl)
_RadSys_dlgwcl.hInstance=GetModuleHandle(0)
_RadSys_dlgwcl.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
_RadSys_dlgwcl.hIcon=LoadIcon(NULL,MAKEINTRESOURCE(IDI_APPLICATION))
_RadSys_dlgwcl.hIconSm=LoadIcon(NULL,MAKEINTRESOURCE(IDI_WINLOGO))
_RadSys_dlgwcl.hCursor=LoadCursor(NULL,MAKEINTRESOURCE(IDC_ARROW))
_RadSys_dlgwcl.lpszClassName="NORMALDLG"
_RadSys_dlgwcl.hbrBackground=h3DFaceBrush
_RadSys_dlgwcl.lpfnWndProc=AddressOf(DefaultCallProc)
RegisterClassEx(_RadSys_dlgwcl)

Function DialogBox(hOwnerWnd As HWND, TemplateName As LPSTR) As LONG_PTR
	Dim hDlg As HWND
	If lstrcmp(TemplateName,"Modal")=0 Then
		hModal=CreateWindowEx(&H00000000,"NORMALDLG","Modal",&H00c80000,-1,-1,480,360,hOwnerWnd,0 As HMENU,GetModuleHandle(0),0)
		hDlg=hModal
		SetWindowLong(hModal,GWL_WNDPROC,AddressOf(ModalProc) As LONG_PTR)
		SendMessage(hModal,WM_INITDIALOG,0,0)
		ShowWindow(hModal,SW_SHOW)
	Else
		Exit Function
	End If
	EnableWindow(hOwnerWnd,0)

	Dim msg As MSG, iResult As Long
	Do
		iResult=GetMessage(msg,0,0,0)
		If iResult=0 or iResult=-1 Then Exit Do
		If IsDialogMessage(hDlg,msg) Then Continue
		TranslateMessage(msg)
		DispatchMessage(msg)
	Loop
	DialogBox=msg.wParam
End Function
Sub EndDialog(hWnd As HWND, lResult As Long)
	EnableWindow(GetWindow(hWnd,GW_OWNER),1)
	DestroyWindow(hWnd)
	PostMessage(0,WM_QUIT,lResult,0)
End Sub

Function CreateDialog(hOwnerWnd As HWND, TemplateName As LPSTR) As HWND
End Function

Dim hFont_Modal As HFONT
hFont_Modal=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック")

SendMessage(hModal,WM_INITDIALOG,0,0)

Case WM_INITDIALOG
	hModal=hWnd
	CreateWindowEx(&H00000000,"STATIC","Text1",&H50000000,151,142,50,12,hWnd,Static1 As HMENU,GetModuleHandle(0),0)
	SendMessage(GetDlgItem(hWnd,Static1),WM_SETFONT,hFont_Modal As WPARAM,0)

FONT      = -12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック"

確認したところ、DLLのCallback.wbpには
[hide][code]'このファイルはウィンドウ定義ファイル（*.wnd）をもとに生成されています

Const Static1=1000

Dim hModal As HWND
Dim hFont_Modal As HFONT
hFont_Modal=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック")
Dim h3DFaceBrush As HBRUSH
h3DFaceBrush=CreateSolidBrush(GetSysColor(COLOR_3DFACE))


Sub D_DestroyObjects()
DeleteObject(hFont_Modal)
DeleteObject(h3DFaceBrush)
End Sub

Function EventCall_Modal(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case message
Case WM_INITDIALOG
hModal=hWnd
CreateWindowEx(&H00000000,"STATIC","Text1",&H50000000,151,142,50,12,hWnd,Static1 As HMENU,GetModuleHandle(0),0)
SendMessage(GetDlgItem(hWnd,Static1),WM_SETFONT,hFont_Modal As WPARAM,0)
Case WM_DESTROY
Case WM_CLOSE
Dim cancel=0 As Integer
If cancel=0 Then EndDialog(hWnd,0)
Case Else
EventCall_Modal=DefWindowProc(hWnd,message,wParam,lParam)
Exit Function
End Select
EventCall_Modal=0
End Function

Function DefaultCallProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
DefaultCallProc=DefWindowProc(hWnd,message,wParam,lParam)
End Function

Dim _RadSys_dlgwcl As WNDCLASSEX
FillMemory(VarPtr(_RadSys_dlgwcl),Len(_RadSys_dlgwcl),0)
_RadSys_dlgwcl.cbSize=Len(_RadSys_dlgwcl)
_RadSys_dlgwcl.hInstance=GetModuleHandle(0)
_RadSys_dlgwcl.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
_RadSys_dlgwcl.hIcon=LoadIcon(NULL,MAKEINTRESOURCE(IDI_APPLICATION))
_RadSys_dlgwcl.hIconSm=LoadIcon(NULL,MAKEINTRESOURCE(IDI_WINLOGO))
_RadSys_dlgwcl.hCursor=LoadCursor(NULL,MAKEINTRESOURCE(IDC_ARROW))
_RadSys_dlgwcl.lpszClassName="NORMALDLG"
_RadSys_dlgwcl.hbrBackground=h3DFaceBrush
_RadSys_dlgwcl.lpfnWndProc=AddressOf(DefaultCallProc)
RegisterClassEx(_RadSys_dlgwcl)

Function DialogBox(hOwnerWnd As HWND, TemplateName As LPSTR) As LONG_PTR
Dim hDlg As HWND
If lstrcmp(TemplateName,"Modal")=0 Then
hModal=CreateWindowEx(&H00000000,"NORMALDLG","Modal",&H00c80000,-1,-1,480,360,hOwnerWnd,0 As HMENU,GetModuleHandle(0),0)
hDlg=hModal
SetWindowLong(hModal,GWL_WNDPROC,AddressOf(ModalProc) As LONG_PTR)
SendMessage(hModal,WM_INITDIALOG,0,0)
ShowWindow(hModal,SW_SHOW)
Else
Exit Function
End If
EnableWindow(hOwnerWnd,0)

Dim msg As MSG, iResult As Long
Do
iResult=GetMessage(msg,0,0,0)
If iResult=0 or iResult=-1 Then Exit Do
If IsDialogMessage(hDlg,msg) Then Continue
TranslateMessage(msg)
DispatchMessage(msg)
Loop
DialogBox=msg.wParam
End Function
Sub EndDialog(hWnd As HWND, lResult As Long)
EnableWindow(GetWindow(hWnd,GW_OWNER),1)
DestroyWindow(hWnd)
PostMessage(0,WM_QUIT,lResult,0)
End Sub

Function CreateDialog(hOwnerWnd As HWND, TemplateName As LPSTR) As HWND
End Function
[/code][/hide]とありました。

フォントの作成は
[code]Dim hFont_Modal As HFONT
hFont_Modal=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック")
[/code]とプログラム側と同じになっているので正常に作られていると思います。

フォントの参照ですが、DialogBox関数内で
[code]SendMessage(hModal,WM_INITDIALOG,0,0)
[/code]とWM_INITDIALOGが送られ、EventCall_Modal関数内で
[code]Case WM_INITDIALOG
hModal=hWnd
CreateWindowEx(&H00000000,"STATIC","Text1",&H50000000,151,142,50,12,hWnd,Static1 As HMENU,GetModuleHandle(0),0)
SendMessage(GetDlgItem(hWnd,Static1),WM_SETFONT,hFont_Modal As WPARAM,0)
[/code]となっているので、WM_SETFONTでフォントが参照されていると思うのですが・・・。

ちなみにプログラム側ではMainWndしかないのでDialogBox関数を覗いても
変数(hDlg As HWND)が１個定義されているだけでした。

またCallback.wbpの元となる*.wndファイルには
[code]FONT = -12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック"
[/code]となっていました。(プログラム側、DLL側の両方とも)

プログラム側のCallback.wbpを見てもらえれば解ると思うのですが、
hFont_MainWnd=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"ＭＳ Ｐゴシック")
等とフォントを作っています。

ダイアログウィンドウを作るときも通常これが参照されるのでフォントについてうまく行くのですが、DLL側から作る場合うまく参照されないのではないでしょうか？
Callback.wbpにDialogBox関数が定義されていると思うので、眺めてみてください。

Sub Export OpenDialog(hWnd As HWND)
	DialogBox(hWnd, "Modal")
End Sub

Sub MainWnd_CommandButton1_Click()

    Dim hInst As HINSTANCE 'DLLのインスタンスハンドル
    Dim DllFunc As *Sub(hWnd As HWND) '関数ポインタ

    'DLLをロード(DLL_PATHはDLLのフルパスを格納したBytePtr)
    hInst=LoadLibrary(DLL_PATH) 

    '関数ポインタを取得
    DllFunc=GetProcAddress(hInst, "OpenDialog") As *Sub

    '関数を実行
    DllFunc(hMainWnd)

    'DLLを解放
    FreeLibrary(hInst)

End Sub

初めまして、のぶあやと申します。

RADでダイアログウィンドウを作り、表示させる関数をDLLに入れて、
プログラムからDLLをロード、関数を実行するとダイアログは表示できるのですが、
ダイアログに貼り付けたコントロールのフォントのサイズが大きくなってしまいます。

DLL側
[hide]
新規作成＞プロジェクト＞ＤＬＬ プロシージャライブラリを選択
RADツールで「Modal」というダイアログ テンプレート(モーダル)を作成して
Staticウィンドウなどのコントロールを適当に配置し、
[code]
Sub Export OpenDialog(hWnd As HWND)
DialogBox(hWnd, "Modal")
End Sub
[/code]
をソースに加える
[/hide]
プログラム側
[hide]
新規作成＞プロジェクト＞EXE ノーマルウィンドウベースを選択
MainWndにボタン(CommandButton1)を配置し、
[code]
Sub MainWnd_CommandButton1_Click()

Dim hInst As HINSTANCE 'DLLのインスタンスハンドル
Dim DllFunc As *Sub(hWnd As HWND) '関数ポインタ

'DLLをロード(DLL_PATHはDLLのフルパスを格納したBytePtr)
hInst=LoadLibrary(DLL_PATH)

'関数ポインタを取得
DllFunc=GetProcAddress(hInst, "OpenDialog") As *Sub

'関数を実行
DllFunc(hMainWnd)

'DLLを解放
FreeLibrary(hInst)

End Sub
[/code]
をソースに加える
[/hide]
タグが上手くいってればいいのですが・・・

それぞれコンパイルして、実行するとフォントのサイズが変わってしまいます。
DLLの明示的読み込み以外は変なことをしていないのでバグだと思い、投稿しました。
なお、暗黙的読み込みにしても同様の現象が発生しました。

ちなみに環境は
AB4.21、AB4.24、AB5CP3＋XP Pro
AB4.24+XP Home
です。

できればAB4もこれの修正版を公開してほしいのですが、
すでにAB5がリリースされているので無理でしょうか？