プロシージャの動きをクラス独自の物にしたいのですが
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)
プロシージャの動きをクラス独自の物にしたいのですが 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]
|