CWindowBase.sbp [ここをクリックすると内容が表示されます]
コード: 全て選択
Class CWindowBase
Public
Sub CWindowBase()
Width=GetSystemMetrics(SM_CXSCREEN)
Height=GetSystemMetrics(SM_CYSCREEN)
Background=GetStockObject(WHITE_BRUSH)
ClassName="MainWindow"
WindowName="MainWindow For ObjectPrograming"
Style=WS_OVERLAPPEDWINDOW
cx=640
cy=480
x=Width\2-cx\2
y=Height\2-cy\2
End Sub
Sub ~CWindowBase()
RemoveProp(hwnd,"pThis")
End Sub
Sub Register()
If pRegister Then
pRegister(VarPtr(this))
Else
Dim wcx As WNDCLASSEX
With wcx
.cbSize =SizeOf(WNDCLASSEX)
.cbClsExtra =0
.cbWndExtra =0
.hbrBackground =Background
.hCursor =LoadCursor(NULL,IDC_ARROW)
.hIcon =LoadIcon(NULL,IDI_APPLICATION)
.hIconSm =NULL
.hInstance =hInstance
.lpfnWndProc =AddressOf(GlobalProc)
.lpszClassName =ClassName
.lpszMenuName =NULL
.style =CS_VREDRAW or CS_HREDRAW
End With
If RegisterClassEx(wcx) Then Else End
End If
End Sub
Sub Create()
If pCreate Then
pCreate(VarPtr(this))
Else
hwnd=CreateWindowEx(0,ClassName,WindowName,Style,x,y,cx,cy,NULL,NULL,hInstance,NULL)
SetProp(hwnd,"pThis",VarPtr(this))
End If
End Sub
Function LocalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
Select Case msg
Case WM_DESTROY
PostQuitMessage(0)
Case Else
If pLocalProc Then
LocalProc=pLocalProc(hwnd,msg,wParam,lParam)
Else
LocalProc=DefWindowProc(hwnd,msg,wParam,lParam)
End If
End Select
End Function
Sub _Loop()
If pLoop Then
pLoop(VarPtr(this))
Else
Dim msg As MSG
Do
TranslateMessage(msg)
DispatchMessage(msg)
Loop while GetMessage(msg,NULL,0,0)
End If
End Sub
Sub Initalize()
If pInitalize Then pInitalize(VarPtr(this))
End Sub
Sub Uninitalize()
If pUninitalize Then pUninitalize(VarPtr(this))
End Sub
Public
pRegister As *Sub(pThis As *CWindowBase)
pCreate As *Sub(pThis As *CWindowBase)
pLoop As *Sub(pThis As *CWindowBase)
pLocalProc As *Function(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
pInitalize As *Sub(pThis As *CWindowBase)
pUninitalize As *Sub(pThis As *CWindowBase)
Protected
Background As DWord
ClassName As *Byte
WindowName As *Byte
Style As DWord
x As Long
y As Long
cx As Long
cy As Long
WndProc As DWord
Public
hwnd As HWND
hInstance As HINSTANCE
Width As Long
Height As Long
End Class
Function GlobalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
Dim pThis As *CWindowBase
pThis=GetProp(hwnd,"pThis")
If pThis Then
GlobalProc=pThis->LocalProc(hwnd,msg,wParam,lParam)
Else
GlobalProc=DefWindowProc(hwnd,msg,wParam,lParam)
End If
End Function
CApplicationBase.sbp [ここをクリックすると内容が表示されます]
コード: 全て選択
#include "CWindowBase.sbp"
Class CApplicationBase
Public
Sub CApplicationBase()
End Sub
Sub ~CApplicationBase()
End
End Sub
Sub Run(pWindow As *CWindowBase)
pWindow->hInstance=GetModuleHandle(0)
pWindow->Register()
pWindow->Create()
pWindow->Initalize()
ShowWindow(pWindow->hwnd,SW_SHOW)
pWindow->_Loop()
pWindow->Uninitalize()
Delete pWindow
Delete VarPtr(this)
End Sub
End Class
Dim Application As *CApplicationBase
Application=New CApplicationBase
Main.abp [ここをクリックすると内容が表示されます]
良いのになぁなんて妄想して関数ポインタ使用しmコード: 全て選択
#include "CApplicationBase.sbp"
Application->Run(New CWindow)
Class CWindow
Inherits CWindowBase
Public
Sub CWindow()
pLocalProc=AddressOf(LocalProc) ' Override Function/Sub
pInitalize=AddressOf(Initalize)
Background=COLOR_3DFACE+1
End Sub
Sub ~CWindow()
End Sub
Sub Initalize(pThis As *CWindowBase)
Dim hdc As HDC
hdc=GetDC(pThis->hwnd)
ReleaseDC(pThis->hwnd,hdc)
End Sub
Function LocalProc(hwnd As HWND,msg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
Select Case msg
Case Else
LocalProc=DefWindowProc(hwnd,msg,wParam,lParam)
End Select
End Function
End Class