登録日時: 2005年5月31日(火) 18:51 記事: 473
お住まい: 新潟県
|
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 [ 2006年6月13日(火) 18:11 ], 累計 8 回
|
|