ab.com コミュニティ

コード: 全て選択

Dim hMainWnd As HWND
Dim hChildWnd As HWND

Function WndProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
  Select Case message
    Case WM_CREATE
      Dim pCS As *CREATESTRUCT

      pCS = lParam As *CREATESTRUCT
      hChildWnd = CreateWindowEx(0,
                                "CHILD",
                                "CHILD",
                                WS_OVERLAPPEDWINDOW or WS_VISIBLE,
                                CW_USEDEFAULT,
                                CW_USEDEFAULT,
                                320,
                                240,
                                hWnd,
                                0,
                                pCS->hInstance,
                                NULL)

    Case WM_DESTROY
      PostQuitMessage(0)      'ここでアクセス違反
      MsgBox 0, "WM_DESTROY"
      WndProc = 0
    Case Else
      WndProc = DefWindowProc(hWnd, message, wParam, lParam)
  End Select
End Function

Function ChildProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
  '子ウィンドウでもアクセス違反
  ChildProc = DefWindowProc(hWnd, message, wParam, lParam)
End Function

Dim wc As WNDCLASSEX
FillMemory(VarPtr(wc), Len(wc), 0)
With wc
  .cbSize        = SizeOf(WNDCLASSEX)
  .hInstance     = GetModuleHandle(0)
  .style         = CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
  .hCursor       = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
  .hIcon         = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
  .hIconSm       = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
  .lpszClassName = "PARENT"
  .lpfnWndProc   = AddressOf(WndProc)
  .hbrBackground = (COLOR_3DFACE+1)
End With
RegisterClassEx(wc)

wc.lpszClassName = "CHILD"
wc.lpfnWndProc   = AddressOf(ChildProc)
RegisterClassEx(wc)

RegisterClassEx(wc)
hMainWnd = CreateWindowEx(0,
                          "PARENT",
                          "PARENT",
                          WS_OVERLAPPEDWINDOW or WS_VISIBLE,
                          CW_USEDEFAULT,
                          CW_USEDEFAULT,
                          640,
                          480,
                          0,
                          0,
                          GetModuleHandle(0),
                          0)

Dim msgMain As MSG, iResult As Long
Do
  iResult=GetMessage(msgMain, 0, 0, 0)
  If iResult = 0 or iResult = -1 Then
    MsgBox 0, "test" 'ここには来ない
    Exit Do
  End if
  TranslateMessage(msgMain)
  DispatchMessage(msgMain)
Loop
End