[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
'背景色を設定
Dim h3DFaceBrush As HBRUSH
h3DFaceBrush=CreateSolidBrush(GetSysColor(COLOR_3DFACE))
'ウインドウのハンドル名を決定、フォントを確定
Dim hMain As HWND
Dim hFont_Main As HFONT
hFont_Main=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"MS Pゴシック")
'ウィンドウクラスの元になる変数を宣言
Dim WinClass As WNDCLASSEX
'初期値設定処理
FillMemory(VarPtr(WinClass),Len(WinClass),0)
'クラスのサイズを設定
WinClass.cbSize=Len(WinClass)
'インスタンスハンドルを標準に設定
WinClass.hInstance=GetModuleHandle(0)
'幅や高さの変更時に再絵画、クリック通知
WinClass.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
'クラス名設定
WinClass.lpszClassName="NORMAL0"
'メインループの位置を設定
WinClass.lpfnWndProc=AddressOf(MainProc)
'背景色を設定
WinClass.hbrBackground=h3DFaceBrush
'ウインドウクラス生成
RegisterClassEx(WinClass)
'ウインドウ生成
CreateWindowEx(&H00000000,"NORMAL0","Test",&H10cf0000,-2147483648,-2147483648,200,100,0,0,GetModuleHandle(0),0)
'アイコンを入れる場合はあらかじめ宣言しておく
'#resource "resource.rc"
'Const IDI_ICON1=101
'ボタンの識別名を設定・識別数値を決定
Const CommandButton1=10001
Const CommandButton2=10002
'メインループ
Function MainProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainProc=EventCall_Main(hWnd,dwMsg,wParam,lParam)
End Function
Function EventCall_Main(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case message
Case WM_DESTROY
Main_Destroy()
Case WM_CREATE
hMain=hWnd
'アイコンを入れる場合
'SendMessage(hMain,WM_SETICON,ICON_SMALL,LoadIcon(GetModuleHandle(0),IDI_ICON1))
'この中にボタンやメニューなどを作らせる関数を置く。
'例。
CreateWindowEx(&H00000000,"BUTTON","1",&H50000000,0,0,88,21,hWnd,CommandButton1 As HMENU,GetModuleHandle(0),0)
SendMessage(GetDlgItem(hWnd,CommandButton1),WM_SETFONT,hFont_Main As WPARAM,0)
CreateWindowEx(&H00000000,"BUTTON","2",&H50000000,88,0,88,21,hWnd,CommandButton2 As HMENU,GetModuleHandle(0),0)
SendMessage(GetDlgItem(hWnd,CommandButton2),WM_SETFONT,hFont_Main As WPARAM,0)
'ここまで
Main_Create()
Case WM_CLOSE
Dim cancel=0 As Integer
If cancel=0 Then DestroyWindow(hWnd)
Case WM_COMMAND
'この中にボタンがクリックされたときなどに呼び出す関数を置く。
'例。
Select Case LOWORD(wParam)
Case CommandButton1
Select Case HIWORD(wParam)
Case BN_CLICKED
Main_CommandButton1_Click()
End Select
Case CommandButton2
Select Case HIWORD(wParam)
Case BN_CLICKED
Main_CommandButton2_Click()
End Select
End Select
'ここまで
Case Else
EventCall_Main=DefWindowProc(hWnd,message,wParam,lParam)
Exit Function
End Select
EventCall_Main=0
End Function
Sub Main_Create()
'ウインドウが作られたときの動作(ボタン作成等はEventCall_Main関数内で書いておく。ここでは変数の上下など。
End Sub
Sub Main_CommandButton1_Click()
'ボタン1がクリックされたときの動作
End Sub
Sub Main_CommandButton2_Click()
'ボタン2がクリックされたときの動作
End Sub
Sub Main_Destroy()
'ウインドウが消えるときにする動作
DeleteObject(hFont_Main)
DeleteObject(h3DFaceBrush)
PostQuitMessage(0)
End Sub
Dim msgMain As MSG, iResult As Long
Do
iResult=GetMessage(msgMain,0,0,0)
If iResult=0 or iResult=-1 Then Exit Do
TranslateMessage(msgMain)
DispatchMessage(msgMain)
Loop
ExitProcess(0)
約100行です。即効で作ったのですがコンパイルは通ります。一応動きます。
うまくいきました?
[hide][code] '背景色を設定 Dim h3DFaceBrush As HBRUSH h3DFaceBrush=CreateSolidBrush(GetSysColor(COLOR_3DFACE))
'ウインドウのハンドル名を決定、フォントを確定 Dim hMain As HWND Dim hFont_Main As HFONT hFont_Main=CreateFont(-12,0,0,0,400,0,0,0,128,3,2,1,32,"MS Pゴシック")
'ウィンドウクラスの元になる変数を宣言 Dim WinClass As WNDCLASSEX '初期値設定処理 FillMemory(VarPtr(WinClass),Len(WinClass),0) 'クラスのサイズを設定 WinClass.cbSize=Len(WinClass) 'インスタンスハンドルを標準に設定 WinClass.hInstance=GetModuleHandle(0) '幅や高さの変更時に再絵画、クリック通知 WinClass.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS 'クラス名設定 WinClass.lpszClassName="NORMAL0" 'メインループの位置を設定 WinClass.lpfnWndProc=AddressOf(MainProc) '背景色を設定 WinClass.hbrBackground=h3DFaceBrush 'ウインドウクラス生成 RegisterClassEx(WinClass) 'ウインドウ生成 CreateWindowEx(&H00000000,"NORMAL0","Test",&H10cf0000,-2147483648,-2147483648,200,100,0,0,GetModuleHandle(0),0)
'アイコンを入れる場合はあらかじめ宣言しておく '#resource "resource.rc" 'Const IDI_ICON1=101
'ボタンの識別名を設定・識別数値を決定 Const CommandButton1=10001 Const CommandButton2=10002 'メインループ Function MainProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord ' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。 MainProc=EventCall_Main(hWnd,dwMsg,wParam,lParam) End Function
Function EventCall_Main(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT Select Case message Case WM_DESTROY Main_Destroy() Case WM_CREATE hMain=hWnd 'アイコンを入れる場合 'SendMessage(hMain,WM_SETICON,ICON_SMALL,LoadIcon(GetModuleHandle(0),IDI_ICON1)) 'この中にボタンやメニューなどを作らせる関数を置く。 '例。 CreateWindowEx(&H00000000,"BUTTON","1",&H50000000,0,0,88,21,hWnd,CommandButton1 As HMENU,GetModuleHandle(0),0) SendMessage(GetDlgItem(hWnd,CommandButton1),WM_SETFONT,hFont_Main As WPARAM,0) CreateWindowEx(&H00000000,"BUTTON","2",&H50000000,88,0,88,21,hWnd,CommandButton2 As HMENU,GetModuleHandle(0),0) SendMessage(GetDlgItem(hWnd,CommandButton2),WM_SETFONT,hFont_Main As WPARAM,0) 'ここまで Main_Create() Case WM_CLOSE Dim cancel=0 As Integer If cancel=0 Then DestroyWindow(hWnd) Case WM_COMMAND 'この中にボタンがクリックされたときなどに呼び出す関数を置く。 '例。 Select Case LOWORD(wParam) Case CommandButton1 Select Case HIWORD(wParam) Case BN_CLICKED Main_CommandButton1_Click() End Select Case CommandButton2 Select Case HIWORD(wParam) Case BN_CLICKED Main_CommandButton2_Click() End Select End Select 'ここまで Case Else EventCall_Main=DefWindowProc(hWnd,message,wParam,lParam) Exit Function End Select EventCall_Main=0 End Function
Sub Main_Create() 'ウインドウが作られたときの動作(ボタン作成等はEventCall_Main関数内で書いておく。ここでは変数の上下など。
End Sub
Sub Main_CommandButton1_Click() 'ボタン1がクリックされたときの動作 End Sub
Sub Main_CommandButton2_Click() 'ボタン2がクリックされたときの動作 End Sub
Sub Main_Destroy() 'ウインドウが消えるときにする動作 DeleteObject(hFont_Main) DeleteObject(h3DFaceBrush) PostQuitMessage(0) End Sub
Dim msgMain As MSG, iResult As Long Do iResult=GetMessage(msgMain,0,0,0) If iResult=0 or iResult=-1 Then Exit Do TranslateMessage(msgMain) DispatchMessage(msgMain) Loop ExitProcess(0)[/code] [/hide] 約100行です。即効で作ったのですがコンパイルは通ります。一応動きます。 うまくいきました?
|