ab.com コミュニティ https://www.activebasic.com/forum/ |
|
AB4の方でもVirtualとOverrideが使えれば… https://www.activebasic.com/forum/viewtopic.php?t=2039 |
ページ 1 / 1 |
作成者: | ゲスト [ 2007年9月02日(日) 18:47 ] |
記事の件名: | AB4の方でもVirtualとOverrideが使えれば… |
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 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |