ab.com コミュニティ

コード: 全て選択

'CApplication

	class CApplication
	Public
		sub CAppliation()
			m_hInst=GetModuleHandle(0)
		End Sub
		sub ~CApplication()
			RemoveProp(pWindow->m_hWnd,"pThis")
		End Sub
		sub Run(pObject As *CWindowThunk)
			pWindow=pObject
			pWindow->m_hInst=m_hInst
			Register()
			CreateMainWnd()
			Initialize()
			Uninitialize()
			_Loop()
		End Sub
		function GlobalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
			Dim pThis As *CWindowThunk
			pThis=GetProp(hwnd,"pThis")
			select case msg
				Case WM_DESTROY
					pThis->LocalProc(hwnd,msg,wParam,lParam)
					PostQuitMessage(0)
				Case else
					pThis->LocalProc(hwnd,msg,wParam,lParam)
					GlobalProc=DefWindowProc(hwnd,msg,wParam,lParam)
			End Select
		End Function
	Protected
		sub Register()
			Dim wcx As WNDCLASSEX
			with wcx
				.cbSize=SizeOf(WNDCLASSEX)
				.cbClsExtra=0
				.cbWndExtra=0
				.hbrBackground=COLOR_3DFACE+1
				.hCursor=LoadCursor(NULL,IDC_ARROW)
				.hIcon=LoadIcon(NULL,IDI_APPLICATION)
				.hIconSm=NULL
				.hInstance=m_hInst
				.lpfnWndProc=AddressOf(GlobalProc)
				.lpszClassName="MainWindow"
				.lpszMenuName=NULL
				.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
			End With
			if RegisterClassEx(wcx) then else end
		End Sub
		sub CreateMainWnd()
			Dim hwnd As HWND
			hwnd=pWindow->Create()
			SetProp(hwnd,"pThis",VarPtr(this))
		End Sub
		sub Initialize()
		End Sub
		sub Uninitialize()
		End Sub
		sub _Loop()
			Dim msg As MSG
			Do
				TranslateMessage(msg)
				DispatchMessage(msg)
			Loop while GetMessage(msg,NULL,0,0)
		End Sub
	Protected
		m_hInst As HINSTANCE
		pWindow As *CWindowThunk
	End Class

'CWindow

	class CWindow
	Public
		sub CWindow()
		End Sub
		sub ~CWindow()
		End Sub
	Public
		function Create() As HWND
			m_hWnd=CreateWindowEx(
				0,
				"MainWindow",NULL,
				WS_OVERLAPPEDWINDOW or WS_VISIBLE,
				100,0,
				640,480,
				NULL,NULL,
				m_hInst,
				NULL
			)
		End Function
		function LocalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
			Select Case msg
				Case WM_KEYDOWN
					OutputDebugString("WM_KEYDOWN")
			End Select
		End Function
	Public
		m_hWnd As HWND
		m_hInst As HINSTANCE
	End Class

	class CWindowTest : inherits CWindow
	Public
		function LocalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
			Select Case msg
				Case WM_KEYDOWN
					OutputDebugString("キーダウン")
			End Select
		End Function
	End Class

	class CWindowThunk : inherits CWindowTest'CWindow
	Public
		sub CWindowThunk()
		End Sub
		sub ~CWindowThunk()
		End Sub
	Public
	End Class
	
	Dim App As CApplication
	
	App.Run(new CWindow)