ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 20:49

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 1 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2007年9月02日(日) 18:47 
[hide=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
[/hide]
[hide=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
[/hide]
[hide=Main.abp]
コード:
#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
[/hide]
良いのになぁなんて妄想して関数ポインタ使用しm


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 1 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke