ab.com コミュニティ

コード: 全て選択

	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

コード: 全て選択

#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

コード: 全て選択

#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