ウィンドウクラス。

メッセージ

7 · #1 投稿記事 by 7 » 2006年3月11日(土) 20:04

自分の知識と計画性の無さで以前の愚行を重ねるだけかもしれませんが、愚行を晴らすべく気持ちでおります...。

'------------------------------------------------------------
' Ver.1.1 2006/06/11
' ウィンドウを操作するクラスのベース
'------------------------------------------------------------
#ifndef _SVN_CLASS_WINDOWBASE
#define _SVN_CLASS_WINDOWBASE

	Class CWindowBase
	Protected
		c_hWnd As HWND
		c_isWindow As BOOL
	Public
		'------------------------------------------------------------
		' Initialization Methods
		'------------------------------------------------------------
		Sub CWindowBase()
			c_hWnd=NULL
			c_isWindow=FALSE
		End Sub
		Sub CWindowBase(ByVal hWnd As HWND)
			connect(hWnd)
		End Sub

		Sub ~CWindowBase()
			disconnect()
		End Sub

		'指定されたウィンドウハンドルと関連付ける
		Sub connect(ByVal hWnd As HWND)
			disconnect()
			If IsWindow(hWnd) Then
				c_hWnd=hWnd
				c_isWindow=TRUE
			End If
		End Sub

		'関連付けられているウィンドウハンドルを破棄
		Function disconnect() As HWND
			disconnect=c_hWnd
			c_hWnd=NULL
			c_isWindow=FALSE
		End Function

		'------------------------------------------------------------
		' Window State Methods
		'------------------------------------------------------------
		'関連付けられているウィンドウハンドルを取得
		Function getHandle() As HWND
			getHandle=c_hWnd
		End Function

		'関連付けられているウィンドウが存在しているか取得
		Function isWindow() As BOOL
			isWindow=c_isWindow
		End Function
	End Class

#endif

Sample [ここをクリックすると内容が表示されます]

CWindowBaseEx,CWindow,...,と続けて行こうと思います。暖かく見守ってやって下さい...かしこ。

Ver.1.1
丁度3ヶ月経っての更新(修正)ですね。
問題ないんですけど、FALSEを代入するべき所をNULLを代入してたので直しました。

7 · #2 投稿記事 by 7 » 2006年3月12日(日) 14:54

CWindowBaseEx.sbp Ver.0.5 [ここをクリックすると内容が表示されます]

コード: 全て選択

'----------Ver.0.5 2006/03/12----------
'----------ウィンドウを操作するクラスのベース(拡張)----------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
	Public
		'----------Window Initialize Method----------
		Sub CWindowBaseEx()
			CWindowBase()
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
		End Sub

		'----------Window Message Method----------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function getMessage(ByVal bWnd As Long,ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			If bWnd=NULL Then
				getMessage=GetMessage(lpMsg,NULL,wMsgFilterMin,wMsgFilterMax)
			Else
				getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
			End If
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function peekMessage(ByVal bWnd As Long,ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			If bWnd=NULL Then
				peekMessage=PeekMessage(lpMsg,NULL,wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
			Else
				peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
			End If
		End Function

		'----------Window Text Method----------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As BytePtr)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As BytePtr
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'----------Window State Method----------
		'ウィンドウを無効、または有効にする
		Sub setEnabled(ByVal bEnable As BOOL)
			EnableWindow(c_hWnd,bEnable)
		End Sub

		'ウィンドウが有効であるか、無効であるかを取得
		Function isEnabled() As BOOL
			isEnabled=IsWindowEnabled(getHandle())
		End Function

		'ウィンドウにキーボードフォーカスを設定
		Function setFocusable() As HWND
			setFocusable=SetFocus(c_hWnd)
		End Function

		'ウィンドウがキーボードフォーカスを持っているかを取得
		Function isFocusable() As BOOL
			isFocusable=FALSE
			If GetFocus()=getHandle() Then
				isFocusable=TRUE
			End If
		End Function

		'ウィンドウの表示状態を設定
		Sub setVisible(ByVal nCmdShow As Long)
			ShowWindow(getHandle(),nCmdShow)
		End Sub

		'ウィンドウが表示されているか、非表示かを取得
		Function isVisible() As BOOL
			isVisible=IsWindowVisible(getHandle())
		End Function

		'ウィンドウを表示する
		Sub show()
			setVisible(SW_SHOW)
		End Sub
		'ウィンドウを非表示にする
		Sub hide()
			setVisible(SW_HIDE)
		End Sub

		'ウィンドウの描画を無効、または有効にする
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(c_hWnd)
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウにマウスをキャプチャーする
		Function setCapture() As HWND
			setCapture=SetCapture(getHandle())
		End Function

		'ウィンドウからマウスのキャプチャーを解除
		Sub releaseCapture()
			ReleaseCapture()
		End Sub

		'ウィンドウがマウスをキャプチャーしているかを取得
		Function isCapture() As BOOL
			isCapture=FALSE
			If getHandle()=GetCapture() Then
				isCapture=TRUE
			End If
		End Function
	End Class

#endif

CWindowBaseEx.sbp Ver.0.6 [ここをクリックすると内容が表示されます]

コード: 全て選択

'----------Ver.0.6 2006/03/13----------
'----------ウィンドウを操作するクラスのベース(拡張)----------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
	Public
		'----------Window Initialize Method----------
		Sub CWindowBaseEx()
			CWindowBase()
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
		End Sub

		'----------Window Message Method----------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function getMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function peekMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
		End Function

		'----------Window Text Method----------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As BytePtr)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As BytePtr
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'----------Window Rectangle Method----------
		'ウィンドウの左上隅、右下隅の座標をスクリーン座標で取得
		Sub getRect(ByRef lpRect As RECT)
			GetWindowRect(getHandle(),lpRect)
		End Sub

		'ウィンドウのクライアント領域の、左上隅と右下隅の座標を取得
		Sub getClientRect(ByRef lpRect As RECT)
			GetClientRect(getHandle(),lpRect)
		End Sub

		'ウィンドウの更新領域をすべて含む、最小の長方形の座標を取得
		Function getUpdateRect(ByRef lpRect As RECT,ByVal bErase As BOOL) As BOOL
			getUpdateRect=GetUpdateRect(getHandle(),lpRect,bErase)
		End Function

		'ウィンドウの長方形領域の再描画を要求
		Sub invalidateRect(ByRef lpRect As RECT,ByVal bErase As BOOL)
			InvalidateRect(getHandle(),lpRect,bErase)
		End Sub

		'ウィンドウの更新領域から指定した長方形領域を除外
		Sub validateRect(ByRef lpRect As RECT)
			ValidateRect(getHandle(),lpRect)
		End Sub

		'----------Window State Method----------
		'ウィンドウを無効、または有効にする
		Sub setEnabled(ByVal bEnable As BOOL)
			EnableWindow(c_hWnd,bEnable)
		End Sub

		'ウィンドウが有効であるか、無効であるかを取得
		Function isEnabled() As BOOL
			isEnabled=IsWindowEnabled(getHandle())
		End Function

		'ウィンドウにキーボードフォーカスを設定
		Function setFocusable() As HWND
			setFocusable=SetFocus(c_hWnd)
		End Function

		'ウィンドウがキーボードフォーカスを持っているかを取得
		Function isFocusable() As BOOL
			isFocusable=FALSE
			If GetFocus()=getHandle() Then
				isFocusable=TRUE
			End If
		End Function

		'ウィンドウの表示状態を設定
		Sub setVisible(ByVal nCmdShow As Long)
			ShowWindow(getHandle(),nCmdShow)
		End Sub

		'ウィンドウが表示されているか、非表示かを取得
		Function isVisible() As BOOL
			isVisible=IsWindowVisible(getHandle())
		End Function

		'ウィンドウの描画を無効、または有効にする
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(c_hWnd)
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウにマウスをキャプチャーする
		Function setCapture() As HWND
			setCapture=SetCapture(getHandle())
		End Function

		'ウィンドウからマウスのキャプチャーを解除
		Sub releaseCapture()
			ReleaseCapture()
		End Sub

		'ウィンドウがマウスをキャプチャーしているかを取得
		Function isCapture() As BOOL
			isCapture=FALSE
			If getHandle()=GetCapture() Then
				isCapture=TRUE
			End If
		End Function
	End Class

#endif

CWindowBaseEx.sbp Ver.0.7 [ここをクリックすると内容が表示されます]

コード: 全て選択

'----------Ver.0.7 2006/03/14----------
'----------ウィンドウを操作するクラスのベース(拡張)----------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
	Public
		'----------Window Initialize Method----------
		Sub CWindowBaseEx()
			CWindowBase()
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
		End Sub

		'----------Window Message Method----------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function getMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function peekMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
		End Function

		'----------Window Information Method----------
		'ウィンドウに関する情報を設定
		Function setLong(ByVal nIndex As Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setLong=SetWindowLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関する情報を取得
		Function getLong(ByVal nIndex As Long) As LONG_PTR
			getLong=GetWindowLong(getHandle(),nIndex)
		End Function

		'ウィンドウのスタイルを設定
		Function setStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setStyle=setLong(GWL_STYLE,NewStyle)
		End Function

		'ウィンドウのスタイルを取得
		Function getStyle() As LONG_PTR
			getStyle=getLong(GWL_STYLE)
		End Function

		'ウィンドウの拡張スタイルを設定
		Function setExStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setExStyle=setLong(GWL_EXSTYLE,NewStyle)
		End Function

		'ウィンドウの拡張スタイルを取得
		Function getExStyle() As LONG_PTR
			getExStyle=getLong(GWL_EXSTYLE)
		End Function

		'----------Window Text Method----------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As BytePtr)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As BytePtr
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'----------Window Rectangle Method----------
		'ウィンドウの左上隅、右下隅の座標をスクリーン座標で取得
		Sub getRect(ByRef left As Long,ByRef top As Long,ByRef right As Long,ByRef bottom As Long)
		Dim _rc As RECT
			GetWindowRect(getHandle(),_rc)
			left=_rc.left
			top=_rc.top
			right=_rc.right
			bottom=_rc.bottom
		End Sub
		Sub getRect(ByRef lpRect As RECT)
			GetWindowRect(getHandle(),lpRect)
		End Sub
		Function getRect() *RECT
			getRect=calloc(SizeOf(RECT))
			GetWindowRect(getHandle(),ByVal getRect)
		End Function

		'ウィンドウのクライアント領域の、左上隅と右下隅の座標を取得
		Sub getClientRect(ByRef lpRect As RECT)
			GetClientRect(getHandle(),lpRect)
		End Sub

		'ウィンドウの更新領域をすべて含む、最小の長方形の座標を取得
		Function getUpdateRect(ByRef lpRect As RECT,ByVal bErase As BOOL) As BOOL
			getUpdateRect=GetUpdateRect(getHandle(),lpRect,bErase)
		End Function

		'ウィンドウの長方形領域の再描画を要求
		Sub invalidateRect(ByRef lpRect As RECT,ByVal bErase As BOOL)
			InvalidateRect(getHandle(),lpRect,bErase)
		End Sub

		'ウィンドウの更新領域から指定した長方形領域を除外
		Sub validateRect(ByRef lpRect As RECT)
			ValidateRect(getHandle(),lpRect)
		End Sub

		'----------Window Position Method----------
		'ウィンドウの位置とサイズを設定
		Sub move(ByVal x As Long,ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal bRepain As BOOL)
			MoveWindow(getHandle(),x,y,nWidth,nHeight,bRepain)
		End Sub

		'ウィンドウの位置とサイズ、および表示状態を設定
		Sub setPos(ByVal hWndInsertAfter As HWND,ByVal x As Long,ByVal y As Long,ByVal cx As Long,ByVal cy As Long,ByVal uFlags As DWord)
			SetWindowPos(getHandle(),hWndInsertAfter,x,y,cx,cy,uFlags)
		End Sub

		'ウィンドウの位置を設定
		Sub setLocation(ByVal x As Long,ByVal y As Long)
			setPos(NULL,x,y,NULL,NULL,SWP_NOSIZE or SWP_NOZORDER)
		End Sub
		Sub setLocation(ByRef lpPoint As POINTAPI)
			setLocation(lpPoint.x,lpPoint.y)
		End Sub
		Sub setLocation(ByVal lpPoint As *POINTAPI)
			setLocation(lpPoint->x,lpPoint->y)
		End Sub

		'ウィンドウの位置を取得
		Sub getLocation(ByRef x As Long,ByRef y As Long)
		Dim _rc As RECT
			getRect(_rc)
			x=_rc.left
			y=_rc.top
		End Sub
		Sub getLocation(ByRef lpPoint As POINTAPI)
		Dim _rc As RECT
			getRect(_rc)
			memcpy(VarPtr(lpPoint),VarPtr(_rc),SizeOf(LONG)*2)
		End Sub
		Function getLocation() As *POINTAPI
		Dim _rc As RECT
			getLocation=calloc(SizeOf(POINTAPI))
			getRect(_rc)
			memcpy(getLocation,VarPtr(_rc),SizeOf(LONG)*2)
		End Function

		'----------Window Size Method----------
		Sub setSize(ByVal width As Long,ByVal height As Long)
		Dim rc As RECT
			getRect(rc)
			width=rc.right-rc.left
			height=rc.bottom-rc.top
		End Sub

		Sub getSize(ByVal width As Long,ByVal height As Long)
		Dim rc As RECT
			getRect(rc)
			width=rc.right-rc.left
			height=rc.bottom-rc.top
		End Sub
		Sub getSize(ByRef lpSize As SIZE)
		Dim rc As RECT
			getRect(rc)
			lpSize.cx=rc.right-rc.left
			lpSize.cy=rc.bottom-rc.top
		End Sub

		'----------Window State Method----------
		'ウィンドウを無効、または有効にする
		Sub setEnabled(ByVal bEnable As BOOL)
			EnableWindow(c_hWnd,bEnable)
		End Sub

		'ウィンドウが有効であるか、無効であるかを取得
		Function isEnabled() As BOOL
			isEnabled=IsWindowEnabled(getHandle())
		End Function

		'ウィンドウにキーボードフォーカスを設定
		Function setFocusable() As HWND
			setFocusable=SetFocus(c_hWnd)
		End Function

		'ウィンドウがキーボードフォーカスを持っているかを取得
		Function isFocusable() As BOOL
			isFocusable=FALSE
			If GetFocus()=getHandle() Then
				isFocusable=TRUE
			End If
		End Function

		'ウィンドウの表示状態を設定
		Sub setVisible(ByVal nCmdShow As Long)
			ShowWindow(getHandle(),nCmdShow)
		End Sub

		'ウィンドウが表示されているか、非表示かを取得
		Function isVisible() As BOOL
			isVisible=IsWindowVisible(getHandle())
		End Function

		'ウィンドウの描画を無効、または有効にする
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(c_hWnd)
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウにマウスをキャプチャーする
		Function setCapture() As HWND
			setCapture=SetCapture(getHandle())
		End Function

		'ウィンドウからマウスのキャプチャーを解除
		Sub releaseCapture()
			ReleaseCapture()
		End Sub

		'ウィンドウがマウスをキャプチャーしているかを取得
		Function isCapture() As BOOL
			isCapture=FALSE
			If getHandle()=GetCapture() Then
				isCapture=TRUE
			End If
		End Function
	End Class

#endif

CWindowBaseEx.sbp Ver.0.8 [ここをクリックすると内容が表示されます]

コード: 全て選択

'----------Ver.0.8 2006/03/21----------
'----------ウィンドウを操作するクラスのベース(拡張)----------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
'	Protected
'		c_lpRect As *RECT
'		c_lpPoint As *POINTAPI
	Public
		'----------Window Initialize Method----------
		Sub CWindowBaseEx()
			CWindowBase()
'			c_lpRect=calloc(SizeOf(RECT))
'			c_lpPoint=calloc(SizeOf(POINTAPI))
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
'			c_lpRect=calloc(SizeOf(RECT))
'			c_lpPoint=calloc(SizeOf(POINTAPI))
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
'			free(c_lpRect)
'			free(c_lpPoint)
		End Sub

		'----------Window Message Method----------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function getMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
		End Function

		'呼び出し側スレッドのメッセージ キューからメッセージを取得
		Function peekMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
		End Function

		'----------Window Information Method----------
		'ウィンドウに関する情報を設定
		Function setLong(ByVal nIndex As Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setLong=SetWindowLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関する情報を取得
		Function getLong(ByVal nIndex As Long) As LONG_PTR
			getLong=GetWindowLong(getHandle(),nIndex)
		End Function

		'ウィンドウのスタイルを設定
		Function setStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setStyle=setLong(GWL_STYLE,NewStyle)
		End Function

		'ウィンドウのスタイルを取得
		Function getStyle() As LONG_PTR
			getStyle=getLong(GWL_STYLE)
		End Function

		'ウィンドウの拡張スタイルを設定
		Function setExStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setExStyle=setLong(GWL_EXSTYLE,NewStyle)
		End Function

		'ウィンドウの拡張スタイルを取得
		Function getExStyle() As LONG_PTR
			getExStyle=getLong(GWL_EXSTYLE)
		End Function

		'----------Window Text Method----------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As BytePtr)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As BytePtr
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'----------Window Rectangle Method----------
		'ウィンドウの左上隅、右下隅の座標をスクリーン座標で取得
		Sub getRect(ByRef lpRect As RECT)
			GetWindowRect(getHandle(),lpRect)
		End Sub

		'ウィンドウのクライアント領域の、左上隅と右下隅の座標を取得
		Sub getClientRect(ByRef lpRect As RECT)
			GetClientRect(getHandle(),lpRect)
		End Sub

		'ウィンドウの更新領域をすべて含む、最小の長方形の座標を取得
		Function getUpdateRect(ByRef lpRect As RECT,ByVal bErase As BOOL) As BOOL
			getUpdateRect=GetUpdateRect(getHandle(),lpRect,bErase)
		End Function

		'ウィンドウの長方形領域の再描画を要求
		Sub invalidateRect(ByRef lpRect As RECT,ByVal bErase As BOOL)
			InvalidateRect(getHandle(),lpRect,bErase)
		End Sub

		'ウィンドウの更新領域から指定した長方形領域を除外
		Sub validateRect(ByRef lpRect As RECT)
			ValidateRect(getHandle(),lpRect)
		End Sub

		'----------Window Position Method----------
		'ウィンドウの位置とサイズを設定
		Sub move(ByVal x As Long,ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal bRepain As BOOL)
			MoveWindow(getHandle(),x,y,nWidth,nHeight,bRepain)
		End Sub

		'ウィンドウの位置とサイズ、および表示状態を設定
		Sub setPos(ByVal hWndInsertAfter As HWND,ByVal x As Long,ByVal y As Long,ByVal cx As Long,ByVal cy As Long,ByVal uFlags As DWord)
			SetWindowPos(getHandle(),hWndInsertAfter,x,y,cx,cy,uFlags)
		End Sub

		'ウィンドウの位置を設定
		Sub setLocation(ByVal x As Long,ByVal y As Long)
			setPos(NULL,x,y,NULL,NULL,SWP_NOSIZE or SWP_NOZORDER)
		End Sub
		Sub setLocation(ByRef lpPoint As POINTAPI)
			setLocation(lpPoint.x,lpPoint.y)
		End Sub

		'ウィンドウの位置を取得
		Sub getLocation(ByRef x As Long,ByRef y As Long)
		Dim _rc As RECT
			getRect(_rc)
			x=_rc.left
			y=_rc.top
		End Sub
		Sub getLocation(ByRef lpPoint As POINTAPI)
			getLocation(lpPoint.x,lpPoint.y)
		End Sub

		'ウィンドウのX座標を設定
		Sub setX(ByVal x As Long) As Long
			setLocation(x,getY())
		End Sub

		'ウィンドウのX座標を取得
		Function getX() As Long
		Dim _rc As RECT
			getRect(_rc)
			getX=_rc.left
		End Function

		'ウィンドウのY座標を設定
		Sub setY(ByVal y As Long) As Long
			setLocation(getX(),y)
		End Sub

		'ウィンドウのY座標を取得
		Function getY() As Long
		Dim _rc As RECT
			getRect(_rc)
			getY=_rc.top
		End Function

		'----------Window Size Method----------
		'ウィンドウのサイズを設定
		Sub setSize(ByVal width As Long,ByVal height As Long)
			setPos(NULL,NULL,NULL,width,height,SWP_NOMOVE or SWP_NOZORDER)
		End Sub
		Sub setSize(ByRef lpSize As SIZE)
			setSize(lpSize.cx,lpSize.cy)
		End Sub

		'ウィンドウのサイズを取得
		Sub getSize(ByRef width As Long,ByRef height As Long)
		Dim rc As RECT
			getRect(rc)
			width=rc.right-rc.left
			height=rc.bottom-rc.top
		End Sub
		Sub getSize(ByRef lpSize As SIZE)
			getSize(lpSize.cx,lpSize.cy)
		End Sub

		'ウィンドウの横幅を設定
		Sub setWidth(ByVal width As Long)
			setSize(width,getHeight())
		End Sub

		'ウィンドウの横幅を取得
		Function getWidth() As Long
		Dim rc As RECT
			getRect(rc)
			getWidth=rc.right-rc.left
		End Function

		'ウィンドウの高さを設定
		Sub setHeight(ByVal height As Long)
			setSize(getWidth(),height)
		End Sub

		'ウィンドウの高さを取得
		Function getHeight() As Long
		Dim rc As RECT
			getRect(rc)
			getHeight=rc.bottom-rc.top
		End Function

		'----------Window State Method----------
		'ウィンドウを無効、または有効にする
		Sub setEnabled(ByVal bEnable As BOOL)
			EnableWindow(c_hWnd,bEnable)
		End Sub

		'ウィンドウが有効であるか、無効であるかを取得
		Function isEnabled() As BOOL
			isEnabled=IsWindowEnabled(getHandle())
		End Function

		'ウィンドウにキーボードフォーカスを設定
		Function setFocusable() As HWND
			setFocusable=SetFocus(c_hWnd)
		End Function

		'ウィンドウがキーボードフォーカスを持っているかを取得
		Function isFocusable() As BOOL
			isFocusable=FALSE
			If GetFocus()=getHandle() Then
				isFocusable=TRUE
			End If
		End Function

		'ウィンドウの表示状態を設定
		Sub setVisible(ByVal nCmdShow As Long)
			ShowWindow(getHandle(),nCmdShow)
		End Sub

		'ウィンドウが表示されているか、非表示かを取得
		Function isVisible() As BOOL
			isVisible=IsWindowVisible(getHandle())
		End Function

		'ウィンドウの描画を無効、または有効にする
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(c_hWnd)
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウにマウスをキャプチャーする
		Function setCapture() As HWND
			setCapture=SetCapture(getHandle())
		End Function

		'ウィンドウからマウスのキャプチャーを解除
		Sub releaseCapture()
			ReleaseCapture()
		End Sub

		'ウィンドウがマウスをキャプチャーしているかを取得
		Function isCapture() As BOOL
			isCapture=FALSE
			If getHandle()=GetCapture() Then
				isCapture=TRUE
			End If
		End Function
	End Class

#endif

CWindowBaseEx.sbp Ver.0.9 [ここをクリックすると内容が表示されます]

コード: 全て選択

'------------------------------------------------------------
' ウィンドウを操作するクラスのベース(拡張)
' Ver.0.9 2006/06/11
'------------------------------------------------------------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
	Public
		'------------------------------------------------------------
		' Initialization Methods
		'------------------------------------------------------------
		Sub CWindowBaseEx()
			CWindowBase()
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
		End Sub

		'------------------------------------------------------------
		' Message Methods
		'------------------------------------------------------------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウのメッセージ キューからメッセージを取得
		Function getMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
		End Function

		'ウィンドウのメッセージ キューからメッセージを取得
		Function peekMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
		End Function

		'------------------------------------------------------------
		' Attribute Methods
		'------------------------------------------------------------
		'ウィンドウに関する情報を設定
		Function setLong(ByVal nIndex As Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setLong=SetWindowLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関する情報を取得
		Function getLong(ByVal nIndex As Long) As LONG_PTR
			getLong=GetWindowLong(getHandle(),nIndex)
		End Function

		'ウィンドウのスタイルを設定
		Function setStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setStyle=setLong(GWL_STYLE,NewStyle)
		End Function

		'ウィンドウのスタイルを取得
		Function getStyle() As LONG_PTR
			getStyle=getLong(GWL_STYLE)
		End Function

		' 指定されたウィンドウスタイルを持つか判断
		Function isStyle(ByVal Style As LONG_PTR) As BOOL
			isStyle=((getStyle() And Style)<>FALSE) And TRUE
		End Function

		'ウィンドウの拡張スタイルを設定
		Function setExStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setExStyle=setLong(GWL_EXSTYLE,NewStyle)
		End Function

		'ウィンドウの拡張スタイルを取得
		Function getExStyle() As LONG_PTR
			getExStyle=getLong(GWL_EXSTYLE)
		End Function

		' 指定された拡張スタイルを持つか判断
		Function isExStyle(ByVal Style As LONG_PTR) As BOOL
			isExStyle=((getExStyle() And Style)<>FALSE) And TRUE
		End Function

		'ウィンドウプロシージャのアドレス、またはハンドルを取得
		Function setWndProcedure(ByVal NewProc As LONG_PTR) As LONG_PTR
			setWndProcedure=setLong(GWL_WNDPROC,NewProc)
		End Function

		'ウィンドウプロシージャのアドレス、またはハンドルを取得
		Function getWndProcedure() As LONG_PTR
			getWndProcedure=getLong(GWL_WNDPROC)
		End Function

		'アプリケーションのインスタンスハンドルを設定
		Function setInstance(ByVal NewInstance As LONG_PTR) As LONG_PTR
			setInstance=setLong(GWL_HINSTANCE,NewInstance)
		End Function

		'アプリケーションのインスタンスハンドルを取得
		Function getInstance() As LONG_PTR
			getInstance=getLong(GWL_HINSTANCE)
		End Function

		'ウィンドウに関連付けられたWNDCLASSEX構造体の情報を設定
		Function setClassLong(ByVal nIndex as Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setClassLong=SetClassLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関連付けられたWNDCLASSEX構造体から情報を取得
		Function getClassLong(ByVal nIndex As Long) As LONG_PTR
			getClassLong=GetClassLong(getHandle(),nIndex)
		End Function

		'WNDCLASSEX構造体に関連付けられているカーソルのハンドルを設定
		Function setCursor(ByVal NewCursor As HCURSOR) As HCURSOR
			setCursor=setClassLong(GCL_HCURSOR,NewCursor As LONG_PTR) As HCURSOR
		End Function

		'WNDCLASSEX構造体に関連付けられているカーソルのハンドルを取得
		Function getCursor() As HCURSOR
			getCursor=getClassLong(GCL_HCURSOR) As HCURSOR
		End Function

		'------------------------------------------------------------
		' Window Text Method
		'------------------------------------------------------------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As LPCSTR)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As LPSTR
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'------------------------------------------------------------
		' Update and Painting Methods
		'------------------------------------------------------------
		'ウィンドウの再描画を許可(TRUE)、または禁止(FALSE)
		Sub setRedraw(ByVal bRedraw As BOOL)
			sendMessage(WM_SETREDRAW,bRedraw,NULL)
		End Sub

		'ウィンドウの描画を無効(TRUE)、または有効(FALSE)
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(getHandle())
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウの更新領域が空でない場合、WM_PAINTを送って更新
		Sub update()
			UpdateWindow(getHandle())
		End Sub

		'ウィンドウの再描画要求時に呼び出す
		Function beginPaint(ByRef lpPaint As PAINTSTRUCT) As HDC
			beginPaint=BeginPaint(getHandle(),lpPaint)
		End Function

		'BeginPaint関数によって行われる描画を終了
		Sub endPaint(ByRef lpPaint As PAINTSTRUCT)
			EndPaint(getHandle(),lpPaint)
		End Sub

		'ウィンドウの更新領域をすべて含む、最小の長方形の座標を取得
		Function getUpdateRect(ByRef lpRect As RECT,ByVal bErase As BOOL) As BOOL
			getUpdateRect=GetUpdateRect(getHandle(),lpRect,bErase)
		End Function

		'ウィンドウの更新領域を、指定したリージョンにコピー
		Function getUpdateRgn(ByVal hRgn As HRGN,ByVal bErase As BOOL) As Long
			getUpdateRgn=GetUpdateRgn(getHandle(),hRgn,bErase)
		End Function

		'ウィンドウのクライアント領域全体の再描画を要求
		Sub invalidate(ByVal bErase As BOOL)
			invalidateRect(ByVal NULL,bErase)
		End Sub

		'ウィンドウの長方形領域の再描画を要求
		Sub invalidateRect(ByRef lpRect As RECT,ByVal bErase As BOOL)
			InvalidateRect(getHandle(),lpRect,bErase)
		End Sub

		'ウィンドウ内の指定したリージョンの再描画を要求
		Sub invalidateRgn(ByVal hRgn As HRGN,ByVal bErase As BOOL)
			InvalidateRgn(getHandle(),hRgn,bErase)
		End Sub

		'ウィンドウの更新領域からクライアント領域全体を除外
		Sub validate()
			validateRect(ByVal NULL)
		End Sub

		'ウィンドウの更新領域から指定した長方形領域を除外
		Sub validateRect(ByRef lpRect As RECT)
			ValidateRect(getHandle(),lpRect)
		End Sub

		'ウィンドウの更新領域から指定したリージョンが示す領域を除外
		Sub validateRgn(ByVal hRgn As HRGN)
			ValidateRgn(getHandle(),hRgn)
		End Sub

		'------------------------------------------------------------
		' Window Rectangle Method
		'------------------------------------------------------------
		'ウィンドウの左上隅、右下隅の座標をスクリーン座標で取得
		Sub getRect(ByRef lpRect As RECT)
			GetWindowRect(getHandle(),lpRect)
		End Sub
		Function getRect() As *RECT
		Dim _rc As RECT
			getRect=calloc(SizeOf(RECT))
			getRect(_rc)
			memcpy(getRect,VarPtr(_rc),SizeOf(RECT))
		End Function

		'ウィンドウのクライアント領域の、左上隅と右下隅の座標を取得
		Sub getClientRect(ByRef lpRect As RECT)
			GetClientRect(getHandle(),lpRect)
		End Sub
		Function getClientRect() As *RECT
		Dim _rc As RECT
			getClientRect=calloc(SizeOf(RECT))
			getClientRect(_rc)
			memcpy(getClientRect,VarPtr(_rc),SizeOf(RECT))
		End Function

		'------------------------------------------------------------
		' Window Position Method
		'------------------------------------------------------------
		'ウィンドウの位置とサイズを設定
		Sub move(ByVal x As Long,ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal bRepain As BOOL)
			MoveWindow(getHandle(),x,y,nWidth,nHeight,bRepain)
		End Sub

		'ウィンドウの位置とサイズ、および表示状態を設定
		Sub setPos(ByVal hWndInsertAfter As HWND,ByVal x As Long,ByVal y As Long,ByVal cx As Long,ByVal cy As Long,ByVal uFlags As DWord)
			SetWindowPos(getHandle(),hWndInsertAfter,x,y,cx,cy,uFlags)
		End Sub

		'ウィンドウの位置を設定
		Sub setLocation(ByVal x As Long,ByVal y As Long)
			setPos(NULL,x,y,NULL,NULL,SWP_NOSIZE or SWP_NOZORDER)
		End Sub
		Sub setLocation(ByRef lpPoint As POINTAPI)
			setLocation(lpPoint.x,lpPoint.y)
		End Sub
		Sub setLocation(ByVal lpPoint As *POINTAPI)
			setLocation(lpPoint->x,lpPoint->y)
		End Sub

		'ウィンドウの位置を取得
		Sub getLocation(ByRef x As Long,ByRef y As Long)
		Dim _rc As RECT
			getRect(_rc)
			x=_rc.left
			y=_rc.top
		End Sub
		Sub getLocation(ByRef lpPoint As POINTAPI)
			getLocation(lpPoint.x,lpPoint.y)
		End Sub
		Function getLocation() As *POINTAPI
		Dim _pt As POINTAPI
			getLocation=calloc(SizeOf(POINTAPI))
			getLocation(_pt)
			memcpy(getLocation,VarPtr(_pt),SizeOf(POINTAPI))
		End Function

		'ウィンドウのX座標を設定
		Sub setX(ByVal x As Long) As Long
			setLocation(x,getY())
		End Sub

		'ウィンドウのX座標を取得
		Function getX() As Long
		Dim _rc As RECT
			getRect(_rc)
			getX=_rc.left
		End Function

		'ウィンドウのY座標を設定
		Sub setY(ByVal y As Long) As Long
			setLocation(getX(),y)
		End Sub

		'ウィンドウのY座標を取得
		Function getY() As Long
		Dim _rc As RECT
			getRect(_rc)
			getY=_rc.top
		End Function

		'------------------------------------------------------------
		' Window Size Method
		'------------------------------------------------------------
		'ウィンドウのサイズを設定
		Sub setSize(ByVal width As Long,ByVal height As Long)
			setPos(NULL,NULL,NULL,width,height,SWP_NOMOVE or SWP_NOZORDER)
		End Sub
		Sub setSize(ByRef lpSize As SIZE)
			setSize(lpSize.cx,lpSize.cy)
		End Sub
		Sub setSize(ByVal lpSize As *SIZE)
			setSize(lpSize->cx,lpSize->cy)
		End Sub

		'ウィンドウのサイズを取得
		Sub getSize(ByRef width As Long,ByRef height As Long)
		Dim rc As RECT
			getRect(rc)
			width=rc.right-rc.left
			height=rc.bottom-rc.top
		End Sub
		Sub getSize(ByRef lpSize As SIZE)
			getSize(lpSize.cx,lpSize.cy)
		End Sub
		Function getSize() As *SIZE
		Dim _sz As SIZE
			getSize=calloc(SizeOf(SIZE))
			getSize(_sz)
			memcpy(getSize,VarPtr(_sz),SizeOf(SIZE))
		End Function

		'ウィンドウの横幅を設定
		Sub setWidth(ByVal width As Long)
			setSize(width,getHeight())
		End Sub

		'ウィンドウの横幅を取得
		Function getWidth() As Long
		Dim rc As RECT
			getRect(rc)
			getWidth=rc.right-rc.left
		End Function

		'ウィンドウの高さを設定
		Sub setHeight(ByVal height As Long)
			setSize(getWidth(),height)
		End Sub

		'ウィンドウの高さを取得
		Function getHeight() As Long
		Dim rc As RECT
			getRect(rc)
			getHeight=rc.bottom-rc.top
		End Function

		'------------------------------------------------------------
		' Caret Methods
		'------------------------------------------------------------
		'ウィンドウのキャレットを表示
		Sub showCaret()
			ShowCaret(getHandle())
		End Sub

		'ウィンドウのキャレットを非表示
		Sub hideCaret()
			HideCaret(getHandle())
		End Sub

		'ウィンドウにキャレットを作成
		Sub createCaret(ByVal hBitmap As HBITMAP,ByVal nWidth As Long,ByVal nHeight As Long)
			CreateCaret(getHandle(),hBitmap,nWidth,nHeight)
		End Sub

		'ウィンドウに黒くて四角いキャレットを作成
		Sub createSolidCaret(ByVal nWidth As Long,ByVal nHeight As Long)
			createCaret(NULL As HBITMAP,nWidth,nHeight)
		End Sub

		'ウィンドウに灰色の四角いキャレットを作成
		Sub createGrayCaret(ByVal nWidth As Long,ByVal nHeight As Long)
			createCaret(1 As HBITMAP,nWidth,nHeight)
		End Sub

		'ウィンドウのキャレットを消去
		Sub destroyCaret()
			DestroyCaret()
		End Sub

		'キャレットの表示位置を設定
		Sub setCaretPos(ByVal x As Long,ByVal y As Long)
			SetCaretPos(x,y)
		End Sub
		Sub setCaretPos(ByRef lpPoint As POINTAPI)
			setCaretPos(lpPoint.x,lpPoint.y)
		End Sub
		Sub setCaretPos(ByVal lpPoint As *POINTAPI)
			setCaretPos(lpPoint->x,lpPoint->y)
		End Sub

		'キャレットの位置を取得
		Sub getCaretPos(ByRef lpPoint As POINTAPI)
			GetCaretPos(lpPoint)
		End Sub
		Function getCaretPos() As *POINTAPI
		Dim _pt As POINTAPI
			getCaretPos=calloc(SizeOf(POINTAPI))
			getCaretPos(_pt)
			memcpy(getCaretPos,VarPtr(_pt),SizeOf(POINTAPI))
		End Function

		'キャレットの位置を移動
		Sub moveCaretPos(ByVal x As Long,ByVal y As Long)
		Dim _pa As POINTAPI
			getCaretPos(_pa)
			setCaretPos(_pa.x+x,_pa.y+y)
		End Sub

		'------------------------------------------------------------
		' Window Capture Methods
		'------------------------------------------------------------
		'ウィンドウにマウスをキャプチャーする
		Function setCapture() As HWND
			setCapture=SetCapture(getHandle())
		End Function

		'ウィンドウからマウスのキャプチャーを解除
		Sub releaseCapture()
			ReleaseCapture()
		End Sub

		'ウィンドウがマウスをキャプチャーしているかを取得
		Function isCapture() As BOOL
			isCapture=FALSE
			If getHandle()=GetCapture() Then
				isCapture=TRUE
			End If
		End Function

		'------------------------------------------------------------
		' Window Timer Method
		'------------------------------------------------------------
		'ウィンドウにタイマーを設定
		Function setTimer(ByVal nIDEvent As DWord,ByVal nElapse As DWord,ByVal lpTimerFunc As DWord) As DWord
			setTimer=SetTimer(getHandle(),nIDEvnet,nElapse,lpTimerFunc)
		End Function

		'ウィンドウのタイマーを破棄
		Sub killTimer(ByVal nIDEvent As DWord)
			KillTimer(getHandle(),nIDEvent)
		End Sub

		'------------------------------------------------------------
		' Window State Method
		'------------------------------------------------------------
		'ウィンドウを無効、または有効にする
		Sub setEnabled(ByVal bEnable As BOOL)
			EnableWindow(getHandle(),bEnable)
		End Sub

		'ウィンドウが有効であるか、無効であるかを取得
		Function isEnabled() As BOOL
			isEnabled=IsWindowEnabled(getHandle())
		End Function

		'ウィンドウにキーボードフォーカスを設定
		Function setFocusable() As HWND
			setFocusable=SetFocus(getHandle())
		End Function

		'ウィンドウがキーボードフォーカスを持っているかを取得
		Function isFocusable() As BOOL
			isFocusable=FALSE
			If GetFocus()=getHandle() Then
				isFocusable=TRUE
			End If
		End Function

		'ウィンドウの表示状態を設定
		Sub setVisible(ByVal nCmdShow As Long)
			ShowWindow(getHandle(),nCmdShow)
		End Sub

		'ウィンドウが表示されているか、非表示かを取得
		Function isVisible() As BOOL
			isVisible=IsWindowVisible(getHandle())
		End Function
	End Class

#endif

CWindowBaseEx.sbp Ver.1.1 [ここをクリックすると内容が表示されます]

コード: 全て選択

'------------------------------------------------------------
' ウィンドウを操作するクラスのベース(拡張)
' Ver.1.1 2006/06/13
'------------------------------------------------------------
#ifndef _SVN_CLASS_WINDOWBASEEX
#define _SVN_CLASS_WINDOWBASEEX

#include "CWindowBase.sbp"

	Class CWindowBaseEx
		Inherits CWindowBase
	Public
		'------------------------------------------------------------
		' Initialization Methods
		'------------------------------------------------------------
		Sub CWindowBaseEx()
			CWindowBase()
		End Sub
		Sub CWindowBaseEx(ByVal hWnd As HWND)
			CWindowBase(hWnd)
		End Sub

		Sub ~CWindowBaseEx()
			disconnect()
		End Sub

		'------------------------------------------------------------
		' Message Methods
		'------------------------------------------------------------
		'ウィンドウにメッセージを送る
		Function sendMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			sendMessage=SendMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウが属するスレッドにメッセージをポストする
		Function postMessage(ByVal wMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
			postMessage=PostMessage(getHandle(),wMsg,wParam,lParam)
		End Function

		'ウィンドウのメッセージ キューからメッセージを取得
		Function getMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord) As Long
			getMessage=GetMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax)
		End Function

		'ウィンドウのメッセージ キューからメッセージを取得
		Function peekMessage(ByRef lpMsg As MSG,ByVal wMsgFilterMin As DWord,ByVal wMsgFilterMax As DWord,ByVal wRemoveMsg As DWord) As Long
			peekMessage=PeekMessage(lpMsg,getHandle(),wMsgFilterMin,wMsgFilterMax,wRemoveMsg)
		End Function

		'------------------------------------------------------------
		' Attribute Methods
		'------------------------------------------------------------
		'ウィンドウに関する情報を設定
		Function setLong(ByVal nIndex As Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setLong=SetWindowLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関する情報を取得
		Function getLong(ByVal nIndex As Long) As LONG_PTR
			getLong=GetWindowLong(getHandle(),nIndex)
		End Function

		'ウィンドウのスタイルを設定
		Function setStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setStyle=setLong(GWL_STYLE,NewStyle)
		End Function

		'ウィンドウのスタイルを取得
		Function getStyle() As LONG_PTR
			getStyle=getLong(GWL_STYLE)
		End Function

		' 指定されたウィンドウスタイルを持つか判断
		Function isStyle(ByVal Style As LONG_PTR) As BOOL
			isStyle=((getStyle() And Style)<>FALSE) And TRUE
		End Function

		'ウィンドウの拡張スタイルを設定
		Function setExStyle(ByVal NewStyle As LONG_PTR) As LONG_PTR
			setExStyle=setLong(GWL_EXSTYLE,NewStyle)
		End Function

		'ウィンドウの拡張スタイルを取得
		Function getExStyle() As LONG_PTR
			getExStyle=getLong(GWL_EXSTYLE)
		End Function

		' 指定された拡張スタイルを持つか判断
		Function isExStyle(ByVal Style As LONG_PTR) As BOOL
			isExStyle=((getExStyle() And Style)<>FALSE) And TRUE
		End Function

		'ウィンドウプロシージャのアドレス、またはハンドルを取得
		Function setWndProcedure(ByVal NewProc As LONG_PTR) As LONG_PTR
			setWndProcedure=setLong(GWL_WNDPROC,NewProc)
		End Function

		'ウィンドウプロシージャのアドレス、またはハンドルを取得
		Function getWndProcedure() As LONG_PTR
			getWndProcedure=getLong(GWL_WNDPROC)
		End Function

		'アプリケーションのインスタンスハンドルを設定
		Function setInstance(ByVal NewInstance As LONG_PTR) As LONG_PTR
			setInstance=setLong(GWL_HINSTANCE,NewInstance)
		End Function

		'アプリケーションのインスタンスハンドルを取得
		Function getInstance() As LONG_PTR
			getInstance=getLong(GWL_HINSTANCE)
		End Function

		'ウィンドウに関連付けられたWNDCLASSEX構造体の情報を設定
		Function setClassLong(ByVal nIndex as Long,ByVal NewLong As LONG_PTR) As LONG_PTR
			setClassLong=SetClassLong(getHandle(),nIndex,NewLong)
		End Function

		'ウィンドウに関連付けられたWNDCLASSEX構造体から情報を取得
		Function getClassLong(ByVal nIndex As Long) As LONG_PTR
			getClassLong=GetClassLong(getHandle(),nIndex)
		End Function

		'WNDCLASSEX構造体に関連付けられているカーソルのハンドルを設定
		Function setCursor(ByVal NewCursor As HCURSOR) As HCURSOR
			setCursor=setClassLong(GCL_HCURSOR,NewCursor As LONG_PTR) As HCURSOR
		End Function

		'WNDCLASSEX構造体に関連付けられているカーソルのハンドルを取得
		Function getCursor() As HCURSOR
			getCursor=getClassLong(GCL_HCURSOR) As HCURSOR
		End Function

		' 親ウィンドウのハンドルを設定
		Function setParent(ByVal hWndNewParent As HWND) As HWND
			setParent=SetParent(getHandle(),hWndNewParent)
		End Function

		' 親ウィンドウのハンドルを取得
		Function getParent() As HWND
			getParent=GetParent(getHandle())
		End Function

		'------------------------------------------------------------
		' Window Text Method
		'------------------------------------------------------------
		'ウィンドウの文字列をクリア
		Sub clear()
			setText(0)
		End Sub

		'ウィンドウに文字列を設定
		Sub setText(ByVal lpString As LPCSTR)
			SetWindowText(getHandle(),lpString)
		End Sub

		'ウィンドウの文字列を取得
		Function getText() As LPSTR
		Dim length As Long
			length=length()+1
			getText=malloc(length)
			GetWindowText(getHandle(),getText,length)
		End Function

		'ウィンドウの文字列の長さを取得
		Function length() As Long
			length=GetWindowTextLength(getHandle())
		End Function

		'------------------------------------------------------------
		' Update and Painting Methods
		'------------------------------------------------------------
		' クライアント領域に対するデバイスコンテキストを取得
		Function getDC() As HDC
			getDC=GetDC(getHandle())
		End Function

		' クライアント領域に対するデバイスコンテキストを取得
		Function getDCEx(ByVal hrgnClip As HRGN,ByVal dwFlags As DWord) As HDC
			getDCEx=GetDCEx(getHandle(),hrgnClip,dwFlags)
		End Function

		'ウィンドウの再描画を許可(TRUE)、または禁止(FALSE)
		Sub setRedraw(ByVal bRedraw As BOOL)
			sendMessage(WM_SETREDRAW,bRedraw,NULL)
		End Sub

		'ウィンドウの描画を無効(TRUE)、または有効(FALSE)
		Sub lockUpdate(ByVal bLock As BOOL)
			If bLock Then
				LockWindowUpdate(getHandle())
			Else
				LockWindowUpdate(NULL)
			End If
		End Sub

		'ウィンドウの更新領域が空でない場合、WM_PAINTを送って更新
		Sub update()
			UpdateWindow(getHandle())
		End Sub

		'ウィンドウの再描画要求時に呼び出す
		Function beginPaint(ByRef lpPaint As PAINTSTRUCT) As HDC
			beginPaint=BeginPaint(getHandle(),lpPaint)
		End Function

		'BeginPaint関数によって行われる描画を終了
		Sub endPaint(ByRef lpPaint As PAINTSTRUCT)
			EndPaint(getHandle(),lpPaint)
		End Sub

		'ウィンドウの更新領域をすべて含む、最小の長方形の座標を取得
		Function getUpdateRect(ByRef lpRect As RECT,ByVal bErase As BOOL) As BOOL
			getUpdateRect=GetUpdateRect(getHandle(),lpRect,bErase)
		End Function

		'ウィンドウの更新領域を、指定したリージョンにコピー
		Function getUpdateRgn(ByVal hRgn As HRGN,ByVal bErase As BOOL) As Long
			getUpdateRgn=GetUpdateRgn(getHandle(),hRgn,bErase)
		End Function

		'ウィンドウのクライアント領域全体の再描画を要求
		Sub invalidate(ByVal bErase As BOOL)
			invalidateRect(ByVal NULL,bErase)
		End Sub

		'ウィンドウの長方形領域の再描画を要求
		Sub invalidateRect(ByRef lpRect As RECT,ByVal bErase As BOOL)
			InvalidateRect(getHandle(),lpRect,bErase)
		End Sub

		'ウィンドウ内の指定したリージョンの再描画を要求
		Sub invalidateRgn(ByVal hRgn As HRGN,ByVal bErase As BOOL)
			InvalidateRgn(getHandle(),hRgn,bErase)
		End Sub

		'ウィンドウの更新領域からクライアント領域全体を除外
		Sub validate()
			validateRect(ByVal NULL)
		End Sub

		'ウィンドウの更新領域から指定した長方形領域を除外
		Sub validateRect(ByRef lpRect As RECT)
			ValidateRect(getHandle(),lpRect)
		End Sub

		'ウィンドウの更新領域から指定したリージョンが示す領域を除外
		Sub validateRgn(ByVal hRgn As HRGN)
			ValidateRgn(getHandle(),hRgn)
		End Sub

		'------------------------------------------------------------
		' Window Rectangle Method
		'------------------------------------------------------------
		'ウィンドウの左上隅、右下隅の座標をスクリーン座標で取得
		Sub getRect(ByRef lpRect As RECT)
			GetWindowRect(getHandle(),lpRect)
		End Sub
		Function getRect() As *RECT
		Dim _rc As RECT
			getRect=calloc(SizeOf(RECT))
			getRect(_rc)
			memcpy(getRect,VarPtr(_rc),SizeOf(RECT))
		End Function

		'ウィンドウのクライアント領域の、左上隅と右下隅の座標を取得
		Sub getClientRect(ByRef lpRect As RECT)
			GetClientRect(getHandle(),lpRect)
		End Sub
		Function getClientRect() As *RECT
		Dim _rc As RECT
			getClientRect=calloc(SizeOf(RECT))
			getClientRect(_rc)
			memcpy(getClientRect,VarPtr(_rc),SizeOf(RECT))
		End Function

		'------------------------------------------------------------
		' Window Position Method
		'------------------------------------------------------------
		'ウィンドウの位置とサイズを設定
		Sub move(ByVal x As Long,ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal bRepain As BOOL)
			MoveWindow(getHandle(),x,y,nWidth,nHeight,bRepain)
		End Sub

		'ウィンドウの位置とサイズ、および表示状態を設定
		Sub setPos(ByVal hWndInsertAfter As HWND,ByVal x As Long,ByVal y As Long,ByVal cx As Long,ByVal cy As Long,ByVal uFlags As DWord)
			SetWindowPos(getHandle(),hWndInsertAfter,x,y,cx,cy,uFlags)
		End Sub

		'ウィンドウの位置を設定
		Sub setLocation(ByVal x As Long,ByVal y As Long)
			setPos(NULL,x,y,NULL,NULL,SWP_NOSIZE or SWP_NOZORDER)
		End Sub
		Sub setLocation(ByRef lpPoint As POINTAPI)
			setLocation(lpPoint.x,lpPoint.y)
		End Sub
		Sub setLocation(ByVal lpPoint As *POINTAPI)
			setLocation(lpPoint->x,lpPoint->y)
		End Sub

		'ウィンドウの位置を取得
		Sub getLocation(ByRef x As Long,ByRef y As Long)
		Dim _rc As RECT
			getRect(_rc)
			x=_rc.left
			y=_rc.top
		End Sub
		Sub getLocation(ByRef lpPoint As POINTAPI)
			getLocation(lpPoint.x,lpPoint.y)
		End Sub
		Function getLocation() As *POINTAPI
		Dim _pt As POINTAPI
			getLocation=calloc(SizeOf(POINTAPI))
			getLocation(_pt)
			memcpy(getLocation,VarPtr(_pt),SizeOf(POINTAPI))
		End Function

		'ウィンドウのX座標を設定
		Sub setX(ByVal x As Long) As Long
			setLocation(x,getY())
		End Sub

		'ウィンドウのX座標を取得
		Function getX() As Long
		Dim _rc As RECT
			getRect(_rc)
			getX=_rc.left
		End Function

		'ウィンドウのY座標を設定
		Sub setY(ByVal y As Long) As Long
			setLocation(getX(),y)
		End Sub

		'ウィンドウのY座標を取得
		Function getY() As Long
		Dim _rc As RECT
			getRect(_rc)
			getY=_rc.top
		End Function

		'------------------------------------------------------------
		' Window Size Method
		'------------------------------------------------------------
		'ウィンドウのサイズを設定
		Sub setSize(ByVal width As Long,ByVal height As Long)
			setPos(NULL,NULL,NULL,width,height,SWP_NOMOVE or SWP_NOZORDER)
		End Sub
		Sub setSize(ByRef lpSize As SIZE)
			setSize(lpSize.cx,lpSize.cy)
		End Sub
		Sub setSize(ByVal lpSize As *SIZE)
			setSize(lpSize->cx,lpSize->cy)
		End Sub

		'ウィンドウのサイズを取得
		Sub getSize(ByRef width As Long,ByRef height As Long)
		Dim rc As RECT
			getRect(rc)
			width=rc.right-rc.left
			height=rc.bottom-rc.top
		End Sub
		Sub getSize(ByRef lpSize As SIZE)
			getSize(lpSize.cx,lpSize.cy)
		End Sub
		Function getSize() As *SIZE
		Dim _sz As SIZE
			getSize=calloc(SizeOf(SIZE))
			getSize(_sz)
			memcpy(getSize,VarPtr(_sz),SizeOf(SIZE))
		End Function

		'ウィンドウの横幅を設定
		Sub setWidth(ByVal width As Long)
			setSize(width,getHeight())
		End Sub

		'ウィンドウの横幅を取得
		Function getWidth() As Long
		Dim rc As RECT
			getRect(rc)
			getWidth=rc.right-rc.left
		End Function

		'ウィンドウの高さを設定
		Sub setHeight(ByVal height As Long)
			setSize(getWidth(),height)
		End Sub

		'ウィンドウの高さを取得
		Function getHeight() As Long
		Dim rc As RECT
			getRect(rc)
			getHeight=rc.bottom-rc.top
		End Function

		'------------------------------------------------------------
		' Caret Methods
		'------------------------------------------------------------
		'ウィンドウのキャレットを表示
		Sub showCaret()
			ShowCaret(getHandle())
		End Sub

		'ウィンドウのキャレットを非表示
		Sub hideCaret()
			HideCaret(getHandle())
		End Sub

		'ウィンドウにキャレットを作成
		Sub createCaret(ByVal hBitmap As HBITMAP,ByVal nWidth As Long,ByVal nHeight As Long)
			CreateCaret(getHandle(),hBitmap,nWidth,nHeight)
		End Sub

		'ウィンドウに黒くて四角いキャレットを作成
		Sub createSolidCaret(ByVal nWidth As Long,ByVal nHeight As Long)
			createCare

7 · #3 投稿記事 by 7 » 2006年3月28日(火) 19:32

上の投稿の追記です。書き込める文字数の上限を超えてしまったようで反映されません。

Sample (手抜き) [ここをクリックすると内容が表示されます]

コード: 全て選択

Dim hWnd As CWindowBaseEx
Dim str As BytePtr
Dim pt As *POINTAPI
Dim sz As *SIZE

	hWnd.connect(hMainWnd)

	If hWnd.isWindow() Then
		str=hWnd.getText()
		hWnd.clear()
		MessageBox(hMainWnd,"ウィンドウの文字列を取得した後消去","MESSAGE",MB_OK)

		'setRedraw()関数の方がいいのかも
		hWnd.lockUpdate(TRUE)
		hWnd.setText(str)
		hWnd.lockUpdate(FALSE)
		free(str)
		MessageBox(hMainWnd,"ウィンドウの描写を無効にしてから文字列を設定し描写を有効","MESSAGE",MB_OK)
/*
		hWnd.setRedraw(FALSE)
		hWnd.setText(str)
		hWnd.setRedraw(TRUE)
		free(str)
		MessageBox(hMainWnd,"ウィンドウの描写を無効にしてから文字列を設定し描写を有効","MESSAGE",MB_OK)
*/

		hWnd.setEnabled(FALSE)
		Sleep(1000)
		hWnd.setEnabled(TRUE)
		MessageBox(hMainWnd,"ウィンドウを無効にして有効","MESSAGE",MB_OK)

		pt=hWnd.getLocation()
		free(pt)
		MessageBox(hMainWnd,"ウィンドウのX座標、Y座標を取得","MESSAGE",MB_OK)

		hWnd.setLocation(100,100)
		MessageBox(hMainWnd,"ウィンドウのX座標、Y座標を設定","MESSAGE",MB_OK)

		sz=hWnd.getSize()
		free(sz)
		MessageBox(hMainWnd,"ウィンドウの横幅、高さを取得","MESSAGE",MB_OK)

		hWnd.setSize(360,360)
		MessageBox(hMainWnd,"ウィンドウの横幅、高さを設定","MESSAGE",MB_OK)
	End If

Ver.0.6
show(),hide()を廃止、CWindowで定義することにしました。
getMessage(),postMessage()も変更しました。正しい判断か分かりませんが...。

Ver.0.7
ストリクト関連(?)で問題があって、戻り値が*RECTだとDoubleだと認識されちゃうんですよね。*POINTAPIは大丈夫なんですが...。
ウィンドウのサイズに関するメソッドが思いっきり間違ってたので0.8で直しました。

Ver.0.8
ポインタ型構造体を弄くるのをひとまず辞めました...。

Ver.0.9
戻り値を*RECTにしてもDoubleだと認識されないのでポインタ型構造体を弄くるようにしました。
2006/06/11に追記。
setIcon, getIcon関数を廃止。CWindowで定義します。
moveCaretPos関数を追加。
isStyle, isExStyle関数を追加。

Ver.1.0
setActive, isActive関数を追加。
setForeground, isForeground関数を追加。

Ver.1.1
setParent, getParentを追加。
getDC, getDCExを追加。
結構忘れてたな...。

ということで次はCWindowです。

CWindow.sbp Ver.0.01 [ここをクリックすると内容が表示されます]

コード: 全て選択

'----------Ver.0.01 2006/03/28----------
'----------ウィンドウを操作するクラス----------
#ifndef _SVN_CLASS_WINDOW
#define _SVN_CLASS_WINDOW

#include "CWindowBaseEx.sbp"

	Class CWindow
		Inherits CWindowBaseEx
	Public
		'----------Window Initialize Method----------
		Sub CWindow()
			CWindowBaseEx()
		End Sub
		Sub CWindow(ByVal hWnd As HWND)
			CWindowBaseEx(hWnd)
		End Sub

		Sub ~CWindow()
			disconnect()
		End Sub

		'----------Window State Method----------
		'ウィンドウを表示
		Sub show()
			setVisible(SW_SHOW)
		End Sub

		'ウィンドウを非表示
		Sub hide()
			setVisible(SW_HIDE)
		End Sub
	End Class

#endif

超暫定的存在として無駄に公開です。