ウィンドウプロシージャについては、SfcMini.MachineCodeオブジェクトを利用して対応可能です。サンプルコードとして、この機能を用いてCreateWindowEx, ShowWindow, UpdateWindow, DispatchMessage関数を作成し、これらを使ってWindowsプログラムを構築する例を挙げてあります。
 また、ウインドウプロシージャを簡単に使用するためのクラス『WindowProcedure』がライブラリにあります。

サンプルコード

 ウインドウプロシージャを、マシン語で記述する例です。フォームの『閉じる』ボタンを押した時にアプリケーションを終了する機能だけをサポートした簡単な物です。ライブラリのWindowProcedureクラスを利用した例としては、こちらを参照してください。
option explicit
Dim i

Sub Declare(obj,dll,proc)
  set obj=CreateObject("SfcMini.DynaCall")
  obj.Declare dll,proc
End Sub

Dim PostQuitMessage, RegisterClassEx, UnregisterClass, LoadCursor
Dim GetMessage, TranslateMessage, GetStockObject,DefWindowProc
Dim MessageBox

Declare PostQuitMessage,"user32" ,"PostQuitMessage"
Declare RegisterClassEx,"user32" ,"RegisterClassExA"
Declare UnregisterClass,"user32" ,"UnregisterClassA"
Declare GetMessage,"user32" ,"GetMessageA"
Declare TranslateMessage,"user32" ,"TranslateMessage"
Declare LoadCursor,"user32" ,"LoadCursorA"
Declare GetStockObject,"gdi32" ,"GetStockObject"
Declare DefWindowProc,"User32.dll" ,"DefWindowProcA"
Declare MessageBox,"user32","MessageBoxA"

Dim API
set API=CreateObject("SfcMini.DynaCall")
API.LoadLibrariesA "user32"

Dim WP,WPbuff,CheckWP,label1,label2
set WP=CreateObject("SfcMini.MachineCode")
set WPbuff=CreateObject("SfcMini.MachineCode")
set CheckWP=CreateObject("SfcMini.MachineCode")
WPbuff.Reset(1028)
WPbuff.AddInt32(0) 'First 4 bytes contain number of que.

with WP
for i=1 to 2
  .Reset
  .AddCode "8b442408"                   'mov       eax,[esp+08]
  .AddCode "3d":.AddInt32 WM_DESTROY    'cmp       eax,WM_DESTROY
  .AddCode "0f84":.AddInt32 label1,true 'je        label1
  .AddCode "8b442404"                   'mov       eax,[esp+04]//hwnd
  .AddCode "8b5c2408"                   'mov       ebx,[esp+08]//message
  .AddCode "8b4c240c"                   'mov       ecx,[esp+0c]//wparam
  .AddCode "8b542410"                   'mov       edx,[esp+10]//lparam
  .AddCode "52"                         'push      edx
  .AddCode "51"                         'push      ecx
  .AddCode "53"                         'push      ebx
  .AddCode "50"                         'push      eax
  .AddCode "b8"
  .AddInt32 DefWindowProc.Address       'mov       eax,DefWindowProc.Address
  .AddCode "ffd0"                       'call      eax
  .AddCode "c21000"                     'ret       0010

                                        '//store four parameters
  label1= _
  .AddCode("bb")
  .AddInt32 WPbuff.BufferAddress              'mov       ebx,WPbuff.BufferAddress
  .AddCode "ff03"                       'inc       dword ptr [ebx]
  .AddCode "8b03"                       'mov       eax,[ebx]
  .AddCode "c1e004"                     'shl       eax,04
  .AddCode "03d8"                       'add       ebx,eax
  .AddCode "8b442404"                   'mov       eax,[esp+04]
  .AddCode "894304"                     'mov       [ebx+04],eax
  .AddCode "8b442408"                   'mov       eax,[esp+08]
  .AddCode "894308"                     'mov       [ebx+08],eax
  .AddCode "8b44240c"                   'mov       eax,[esp+0c]
  .AddCode "89430c"                     'mov       [ebx+0c],eax
  .AddCode "8b442410"                   'mov       eax,[esp+10]
  .AddCode "894310"                     'mov       [ebx+10],eax
  .AddCode "33c0"                       'xor       eax,eax      //return 0;
  .AddCode "c21000"                     'ret       0010
next
end with
with CheckWP
for i=1 to 2
  .Reset
  .AddCode "bb":.AddInt32 WPbuff.BufferAddress'mov       ebx,WPbuff.BufferAddress
  .AddCode "8b442404"                   'mov       eax,[esp+04]
  .AddCode "3d":.AddInt32 0             'cmp       eax,0
  .AddCode "0f85":.AddInt32 label2,true 'jne       label2
  
                                        '//Check-if mode (Que shifts)
  .AddCode "8b0b"                       'mov       ecx,[ebx]
  .AddCode "c1e104"                     'shl       ecx,04  //ecx=ecx*16;
  .AddCode "83f900"                     'cmp       ecx,00000000
  .AddCode "0f85":.AddInt32 label1,true 'jne       label1
  .AddCode "33c0"                       'xor       eax,eax //If nothing remains (ecx=0),
  .AddCode "c20400"                     'ret       0004    //return 0;//(do nothing)
  label1= _
  .AddCode("8b4314")                    'mov       eax,[ebx+14]
  .AddCode "894304"                     'mov       [ebx+04],eax
  .AddCode "83c304"                     'add       ebx,00000004
  .AddCode "e2":.AddByte label1,true    'loop      label1
  .AddCode "bb":.AddInt32 WPbuff.BufferAddress'mov       ebx,WPbuff.BufferAddress
  .AddCode "8b03"                       'mov       eax,[ebx]
  .AddCode "ff0b"                       'dec       dword ptr [ebx]
  .AddCode "c20400"                     'ret       0004

                                        '//Get-data mode
  label2= _
  .AddCode("c1e002")                    'shl       eax,02   //eax=eax*4;
  .AddCode "03d8"                       'add       ebx,eax
  .AddCode "8b03"                       'mov       eax,[ebx]
  .AddCode "c20400"                     'ret       0004
next
end with

Function CreateWindowEx(dwExStyle,lpClassName,lpWindowName, _
    dwStyle,X,Y,nWidth,nHeight,hwndParent,hMenu, _
    hInstance,lpParam)
  CreateWindowEx=API.CreateWindowExA(dwExStyle,lpClassName,lpWindowName, _
    dwStyle,X,Y,nWidth,nHeight,hwndParent,hMenu, _
    hInstance,lpParam)
  do until CheckWP(0)=0
    call WndProc(CheckWP(1),CheckWP(2),CheckWP(3),CheckWP(4))
  loop
End Function

Function DispatchMessage(lpMsg)
  DispatchMessage=API.DispatchMessageA(lpMsg)
  do until CheckWP(0)=0
    call WndProc(CheckWP(1),CheckWP(2),CheckWP(3),CheckWP(4))
  loop
End Function
Function ShowWindow(hWnd,nCmdShow)
  ShowWindow=API.ShowWindow(hWnd,nCmdShow)
  do until CheckWP(0)=0
    call WndProc(CheckWP(1),CheckWP(2),CheckWP(3),CheckWP(4))
  loop
End Function
Function UpdateWindow(hWnd)
  UpdateWindow=API.UpdateWindow(hWnd)
  do until CheckWP(0)=0
    call WndProc(CheckWP(1),CheckWP(2),CheckWP(3),CheckWP(4))
  loop
End Function

'Window Class
Dim WNDCLASSEX:set WNDCLASSEX=CreateObject("SfcMini.Structure")
WNDCLASSEX _
  "cbSize","Long", _
  "style","Long", _
  "lpfnWndProc","Long", _
  "cbClsExtra","Long", _
  "cbWndExtra","Long", _
  "hInstance","Long", _
  "hIcon","Long", _
  "hCursor","Long", _
  "hbrBackground","Long", _
  "lpszMenuName","String", _
  "lpszClassName","String", _
  "hIconSm","Long"

'MSG structure
Dim MSG:set MSG=CreateObject("SfcMini.Structure")
MSG _
  "message", "Long", _
  "wParam", "Long", _
  "lParam", "Long", _
  "time", "Long", _
  "pt_x", "Long", _
  "pt_y", "Long"

Const WM_DESTROY = &H2
Const SW_SHOW = 5
Const LTGRAY_BRUSH = 1
Const WS_OVERLAPPEDWINDOW = &HCF0000
Const CW_USEDEFAULT = &H80000000
Const IDC_ARROW = 32512

'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 (GetMessage(MSG, 0, 0, 0))
        Call TranslateMessage(MSG)
        Call DispatchMessage(MSG)
      Loop

    End If

    Call UnregisterClass(g_chClassName, p_hInstance)
  End If
  WinMain=0
End Function

'Register Window Class
Function InitApplication(p_hInstance, AddressOfWndProc )
    Call UnregisterClass(g_chClassName, p_hInstance)
    with WNDCLASSEX
     .cbSize = 48
     .style = 0
     .lpfnWndProc = AddressOfWndProc
     .cbClsExtra = 0
     .cbWndExtra = 0
     .hInstance = p_hInstance
     .hIcon = 0
     .hCursor = LoadCursor(0,IDC_ARROW)
     .hbrBackground = GetStockObject(LTGRAY_BRUSH)
     .lpszMenuName = 0
     .lpszClassName = g_chClassName
     .hIconSm = 0
    end with

    If 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 = 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 ShowWindow(hWnd, p_nCmdShow)
    Call UpdateWindow(hWnd)
    InitInstance = True
End Function

'Window Procedure
Function WndProc(hwnd,message,wparam,lparam)
  select case message
  case WM_DESTROY
    Call PostQuitMessage(0)
    WndProc=0
  case else
    WndProc=DefWindowProc(hwnd,message,wparam,lparam)
  end select
End Function


























































































































































































































































実行結果
Window Procedure