AB4だとオーバーライドできず・・・こんな感じにしてます。
もっとスマートな方法はないもんですかねぇ・・・
inherits CWindowTestをCWindowにすると動きが変わる
[ここをクリックすると内容が表示されます]
コード: 全て選択
'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)