<ライブラリ>
WindowProcedure.vbs
ウィンドウプロシージャを扱うためのクラス『WindowProcedure』を提供します。
WindowProcedureクラスには以下のパブリックメソッドがあります。
Address
引数はありません。
ウインドウプロシージャのアドレスを示すポインタを返します。
SetWndProc(funcName)
funcNameに、ウィンドウプロシージャを記述する関数名を文字列で指定します。
戻り値はありません。
TrackMsg(uMsg, rCode)
ウィンドウプロシージャに、uMsgで示されたメッセージを、rCodeで示された戻り値で処理するように指令します。
CreateWindowEx
ShowWindow
UpdateWindow
DispatchMessage
VBScriptで記述するウィンドウプロシージャに対応させるためにはこれらのパブリック関数をAPIとして用いてください。
PostQuitMessage
RegisterClassEx
UnregisterClass
LoadCursor
GetMessage
TranslateMessage
GetStockObject
DefWindowProc
上記の4つの関数以外に、これらの関数もAPI呼び出しに使用可能です。
サンプルコード
実行結果

Dim SFC
Set SFC=CreateObject("SfcMini.tools")
Execute SFC.Include("<WindowProcedure.vbs>")
Set SFC=CreateObject("SfcMini.tools")
Execute SFC.Include("<WindowProcedure.vbs>")
WindowProcedureクラスには以下のパブリックメソッドがあります。
Address
引数はありません。
ウインドウプロシージャのアドレスを示すポインタを返します。
SetWndProc(funcName)
funcNameに、ウィンドウプロシージャを記述する関数名を文字列で指定します。
戻り値はありません。
TrackMsg(uMsg, rCode)
ウィンドウプロシージャに、uMsgで示されたメッセージを、rCodeで示された戻り値で処理するように指令します。
CreateWindowEx
ShowWindow
UpdateWindow
DispatchMessage
VBScriptで記述するウィンドウプロシージャに対応させるためにはこれらのパブリック関数をAPIとして用いてください。
PostQuitMessage
RegisterClassEx
UnregisterClass
LoadCursor
GetMessage
TranslateMessage
GetStockObject
DefWindowProc
上記の4つの関数以外に、これらの関数もAPI呼び出しに使用可能です。
サンプルコード
option explicit
Dim SFC,WP
set SFC=CreateObject("SfcMini.tools")
Execute SFC.Include("<WindowProcedure.vbs>")
Set WP=new WindowProcedure
WP.SetWndProc "WndProc"
'Window Class
Execute SFC.Include("<Structures\WNDCLASSEX.vbs>")
'MSG structure
Execute SFC.Include("<Structures\MSG.vbs>")
Const LTGRAY_BRUSH = 1
'Just call WinMain()
Const g_chAppName = "TestApplication" 'Application name
Const g_chClassName = "TestWndClass" 'Window class name
Wscript.quit(WinMain(0,0,"",SW_SHOW))
Function WinMain(p_hInstance, p_hPreInst, p_pchCmdLine, p_iCmdShow)
'Register Window Class
If InitApplication(p_hInstance,WP.Address) = True Then
'Show Window
If InitInstance(p_hInstance, p_iCmdShow) = True Then
'Message Loop
Do While (WP.GetMessage(MSG, 0, 0, 0))
Call WP.TranslateMessage(MSG)
Call WP.DispatchMessage(MSG)
Loop
End If
Call WP.UnregisterClass(g_chClassName, p_hInstance)
End If
WinMain=MSG.wParam
End Function
'Register Window Class
Function InitApplication(p_hInstance, AddressOfWndProc )
Call WP.UnregisterClass(g_chClassName, p_hInstance)
with WNDCLASSEX
.cbSize = 48
.style = 0
.lpfnWndProc = AddressOfWndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = p_hInstance
.hIcon = 0
.hCursor = WP.LoadCursor(0,IDC_ARROW)
.hbrBackground = WP.GetStockObject(LTGRAY_BRUSH)
.lpszMenuName = 0
.lpszClassName = g_chClassName
.hIconSm = 0
end with
If WP.RegisterClassEx(WNDCLASSEX) Then
InitApplication=True
Else
InitApplication=False
End If
End Function
'Show Window
Function InitInstance(p_hInstance, p_nCmdShow)
Dim hWnd
'Create Window
hWnd = WP.CreateWindowEx(0, g_chClassName, g_chAppName, _
WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
0, 0, p_hInstance, 0)
If hWnd = 0 Then
InitInstance = False
Exit Function
End If
'Show Window
Call WP.ShowWindow(hWnd, p_nCmdShow)
Call WP.UpdateWindow(hWnd)
InitInstance = True
End Function
'Window Procedure
Function WndProc(hwnd,message,wparam,lparam)
select case message
case WM_DESTROY
Call WP.PostQuitMessage(0)
WndProc=0
case else
WndProc=WP.DefWindowProc(hwnd,message,wparam,lparam)
end select
End Function
Dim SFC,WP
set SFC=CreateObject("SfcMini.tools")
Execute SFC.Include("<WindowProcedure.vbs>")
Set WP=new WindowProcedure
WP.SetWndProc "WndProc"
'Window Class
Execute SFC.Include("<Structures\WNDCLASSEX.vbs>")
'MSG structure
Execute SFC.Include("<Structures\MSG.vbs>")
Const LTGRAY_BRUSH = 1
'Just call WinMain()
Const g_chAppName = "TestApplication" 'Application name
Const g_chClassName = "TestWndClass" 'Window class name
Wscript.quit(WinMain(0,0,"",SW_SHOW))
Function WinMain(p_hInstance, p_hPreInst, p_pchCmdLine, p_iCmdShow)
'Register Window Class
If InitApplication(p_hInstance,WP.Address) = True Then
'Show Window
If InitInstance(p_hInstance, p_iCmdShow) = True Then
'Message Loop
Do While (WP.GetMessage(MSG, 0, 0, 0))
Call WP.TranslateMessage(MSG)
Call WP.DispatchMessage(MSG)
Loop
End If
Call WP.UnregisterClass(g_chClassName, p_hInstance)
End If
WinMain=MSG.wParam
End Function
'Register Window Class
Function InitApplication(p_hInstance, AddressOfWndProc )
Call WP.UnregisterClass(g_chClassName, p_hInstance)
with WNDCLASSEX
.cbSize = 48
.style = 0
.lpfnWndProc = AddressOfWndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = p_hInstance
.hIcon = 0
.hCursor = WP.LoadCursor(0,IDC_ARROW)
.hbrBackground = WP.GetStockObject(LTGRAY_BRUSH)
.lpszMenuName = 0
.lpszClassName = g_chClassName
.hIconSm = 0
end with
If WP.RegisterClassEx(WNDCLASSEX) Then
InitApplication=True
Else
InitApplication=False
End If
End Function
'Show Window
Function InitInstance(p_hInstance, p_nCmdShow)
Dim hWnd
'Create Window
hWnd = WP.CreateWindowEx(0, g_chClassName, g_chAppName, _
WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
0, 0, p_hInstance, 0)
If hWnd = 0 Then
InitInstance = False
Exit Function
End If
'Show Window
Call WP.ShowWindow(hWnd, p_nCmdShow)
Call WP.UpdateWindow(hWnd)
InitInstance = True
End Function
'Window Procedure
Function WndProc(hwnd,message,wparam,lparam)
select case message
case WM_DESTROY
Call WP.PostQuitMessage(0)
WndProc=0
case else
WndProc=WP.DefWindowProc(hwnd,message,wparam,lparam)
end select
End Function
実行結果
