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)

プロシージャの動きをクラス独自の物にしたいのですが
AB4だとオーバーライドできず・・・こんな感じにしてます。
もっとスマートな方法はないもんですかねぇ・・・

inherits CWindowTestをCWindowにすると動きが変わる
[hide][code]'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)[/code][/hide]