Index: /trunk/ab5.0/ablib/TestCase/SimpleTestCase/SimpleTestCase.ab =================================================================== --- /trunk/ab5.0/ablib/TestCase/SimpleTestCase/SimpleTestCase.ab (revision 544) +++ /trunk/ab5.0/ablib/TestCase/SimpleTestCase/SimpleTestCase.ab (revision 545) @@ -6,6 +6,6 @@ Function GetTempDirectory() As String - Return System.IO.Path.GetDirectoryName( System.Windows.Forms.Application.ExecutablePath ) + "\temp\" -' Return System.IO.Path.GetTempPath() +' Return System.IO.Path.GetDirectoryName( System.Windows.Forms.Application.ExecutablePath ) + "\temp\" + Return System.IO.Path.GetTempPath() End Function @@ -26,5 +26,5 @@ End Sub -Initialize() +'Initialize() Dim csbi As CONSOLE_SCREEN_BUFFER_INFO Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 545) @@ -0,0 +1,494 @@ +'Classes/ActiveBasic/Windows/UI/Control.ab + +#require + +Namespace ActiveBasic +Namespace Windows +Namespace UI + +'Namespace Detail +' TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL +'End Namespace + +Class Control +Public + Sub Control() + End Sub + + Virtual Sub ~Control() + End Sub + + Function Handle() As HWND + Handle = hwnd + End Function + + Static Function FromHWnd(hwnd As HWND) As Control + FromHWnd = Nothing + If IsWindow(hwnd) Then + FromHWnd = FromHWndCore(hwnd) + End If + End Function + +Private + Static Function FromHWndCore(hwnd As HWND) As Control + If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then + Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR + If gchValue <> 0 Then + Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue) + FromHWndCore = gch.Target As Control + Exit Function + End If + End If + End Function + +'-------------------------------- +' ウィンドウ作成 +/* + Function Create( + parent As HWND, + rect As RECT, + name As String, + style As DWord, + exStyle = 0 As DWord, + menu = 0 As HMENU) As HWND +*/ + +Public + Function Create() As Boolean + Dim cs As CREATESTRUCT + cs.hInstance = hInstance + cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR + GetCreateStruct(cs) + Create = createImpl(cs) + End Function + +Protected + Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT) + + Function createImpl(ByRef cs As CREATESTRUCT) As Boolean + Imports System.Runtime.InteropServices + + Dim gch = GCHandle.Alloc(This) + TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) + + StartWndProc() + + With cs + Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style, + .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) + createImpl = hwnd <> 0 + End With + End Function + +'-------------------------------- +' ウィンドウプロシージャ +'Protected +Public + Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Dim h = Nothing As MessageEventHandler + Dim b = messageMap.TryGetValue(Hex$(msg), h) + If b Then + If Not IsNothing(h) Then + Dim a = New MessageEventArgs(hwnd, msg, wp, lp) + h(This, a) + WndProc = a.LResult + Exit Function + End If + End If + WndProc = DefWndProc(msg, wp, lp) + End Function + + Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + DefWndProc = DefWindowProc(hwnd, msg, wp, lp) + End Function + +Private + Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys + Dim t As DWord + t = e.WParam And Keys.KeyCode + t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1 + t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2 + t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3 + makeKeysFormMsg = t As Keys + End Function + + Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs + Dim wp = e.WParam + Dim lp = e.LParam + makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0) + End Function + + /*! + @brief 最初にウィンドウプロシージャが呼ばれるときに実行される関数 + ここでは、主なメッセージハンドラの登録を行っている。 + @date 2008/07/11 + */ + Sub StartWndProc() + Dim t = This '#177対策 + AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground)) + Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase)) + AddMessageEvent(WM_LBUTTONDOWN, md) + AddMessageEvent(WM_RBUTTONDOWN, md) + AddMessageEvent(WM_MBUTTONDOWN, md) + AddMessageEvent(WM_XBUTTONDOWN, md) + Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase)) + AddMessageEvent(WM_LBUTTONUP, mu) + AddMessageEvent(WM_RBUTTONUP, mu) + AddMessageEvent(WM_MBUTTONUP, mu) + AddMessageEvent(WM_XBUTTONUP, mu) + Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase)) + AddMessageEvent(WM_LBUTTONDBLCLK, mu) + AddMessageEvent(WM_RBUTTONDBLCLK, mu) + AddMessageEvent(WM_MBUTTONDBLCLK, mu) + AddMessageEvent(WM_XBUTTONDBLCLK, mu) + + AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase)) + AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase)) + AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase)) +' AddMessageEvent(WM_CHAR, AddressOf(t.OnChar)) + AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase)) + End Sub + + Sub OnEraseBackground(sender As Object, e As MessageEventArgs) + Dim rc As RECT + Dim r = GetClientRect(hwnd, rc) + FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH) + e.LResult = TRUE + End Sub + + Sub OnMouseDownBase(sender As Object, e As MessageEventArgs) + OnMouseDown(makeMouseEventFromMsg(e)) + End Sub + + Sub OnMouseUpBase(sender As Object, e As MessageEventArgs) + Dim me = makeMouseEventFromMsg(e) + If doubleClickFired = False Then +' OnClick(System.EventArgs.Empty) + OnMouseClick(me) + doubleClickFired = False + End If + OnMouseUp(me) + End Sub + + Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs) + Dim me = makeMouseEventFromMsg(e) + doubleClickFired = True + OnMouseDown(me) +' OnDoubleClick(System.EventArgs.Empty) + OnMouseDoubleClick(me) + End Sub + + Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs) + Dim me = makeMouseEventFromMsg(e) + If mouseEntered Then + OnMouseMove(me) + Else + mouseEntered = True + OnMouseEnter(me) + End If + End Sub + + Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs) + Dim me = makeMouseEventFromMsg(e) + OnMouseLeave(me) + mouseEntered = False + End Sub + + Sub OnPaintBase(sender As Object, e As MessageEventArgs) + Dim ps As PAINTSTRUCT + BeginPaint(hwnd, ps) + Try + OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint)) + Finally + EndPaint(hwnd, ps) + End Try + End Sub + + Sub OnKeyDownBase(sender As Object, e As MessageEventArgs) + OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e))) + End Sub + + Sub OnKeyUpBase(sender As Object, e As MessageEventArgs) + OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e))) + End Sub + +' コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと +' Sub OnChar(sender As Object, e As MessageEventArgs) +' OnKeyPress(New KeyPressEventArgs(e.WParam As Char)) +' End Sub + + Sub OnCreateBase(sender As Object, e As MessageEventArgs) + OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT)) + End Sub + + messageMap As System.Collections.Generic.Dictionary + +Public + /*! + @biref メッセージイベントハンドラを登録する。 + @date 2007/12/04 + */ + Sub AddMessageEvent(message As DWord, h As MessageEventHandler) + If Not IsNothing(h) Then + If IsNothing(messageMap) Then + messageMap = New System.Collections.Generic.Dictionary + End If + Dim msg = Hex$(message) + Dim m = Nothing As MessageEventHandler + If messageMap.TryGetValue(msg, m) Then + messageMap.Item[msg] = m + h + Else + messageMap.Item[msg] = h + End If + End If + End Sub + + /*! + @biref メッセージイベントハンドラ登録を解除する。 + @date 2007/12/04 + */ + Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler) + If Not IsNothing(a) Then + If Not IsNothing(messageMap) Then + Dim msg = Hex$(message) + Dim m = messageMap.Item[msg] + If Not IsNothing(m) Then + messageMap.Item[msg] = m - a + End If + End If + End If + End Sub + +'-------------------------------- +' ウィンドウメッセージ処理 + + +'-------- +'イベント + +#include "ControlEvent.sbp" + +'-------------------------------- +' インスタンスメンバ変数 +Private + hwnd As HWND + /*! + @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ + 外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。 + */ + mouseEntered As Boolean + /*! + @brief ダブルクリックが起こったかどうかのフラグ + Click/MouseClickイベントのために用意している。 + @date 2008/07/12 + */ + doubleClickFired As Boolean + +'-------------------------------- +' 初期ウィンドウクラス +Private + Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Imports System.Runtime.InteropServices + + Dim rThis = Control.FromHWndCore(hwnd) + If IsNothing(rThis) Then + Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR + TlsSetValue(tlsIndex, 0) + If gchValue = 0 Then + Goto *InstanceIsNotFound + End If + Dim gch = GCHandle.FromIntPtr(gchValue) + rThis = gch.Target As Control + ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき + + If IsNothing(rThis) Then + Goto *InstanceIsNotFound + End If + rThis.hwnd = hwnd + SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE) + End If + WndProcFirst = rThis.WndProc(msg, wp, lp) + If msg = WM_NCDESTROY Then + Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR + If gchValue <> 0 Then + Dim gch = GCHandle.FromIntPtr(gchValue) + gch.Free() + End If + End If + + Exit Function + + *InstanceIsNotFound + OutputDebugString("ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.") + WndProcFirst = DefWindowProc(hwnd, msg, wp, lp) + End Function + +' Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord +' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord + +'-------------------------------- +' その他の補助関数 +Private +' Sub tracMouseEvent() +/* If pTrackMouseEvent <> 0 Then + Dim tme As TRACKMOUSEEVENT + With tme + .cbSize = Len(tme) + .dwFlags = TME_HOVER Or TME_LEAVE + .hwndTrack = wnd + .dwHoverTime = HOVER_DEFAULT + End With + pTrackMouseEvent(tme) + End If +*/ 'End Sub + +'-------------------------------- +' 初期化終了関連（特にウィンドウクラス） +Private + 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの + Static tlsIndex As DWord + + Static hInstance As HINSTANCE + Static atom As ATOM + Static hmodComctl As HMODULE +' Static pTrackMouseEvent As PTrackMouseEvent + + Static Const WindowClassName = "ActiveBasic.Windows.UI.Control" + Static Const PropertyInstance = 0 As ATOM +Public + Static Sub Initialize(hinst As HINSTANCE) + tlsIndex = TlsAlloc() + hInstance = hinst +' hmodComctl = LoadLibrary("comctl32.dll") +' pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) + + Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId()) + PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString)) + + Dim wcx As WNDCLASSEX + With wcx + .cbSize = Len (wcx) + .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS + .lpfnWndProc = AddressOf (WndProcFirst) + .cbClsExtra = 0 + .cbWndExtra = 0 + .hInstance = hinst + .hIcon = 0 + .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR + .hbrBackground = 0 + .lpszMenuName = 0 + .lpszClassName = ToTCStr(WindowClassName) + .hIconSm = 0 + End With + atom = RegisterClassEx(wcx) + If atom = 0 Then + Dim buf[1023] As TCHAR + wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError()) + OutputDebugString(buf) + Debug + ExitThread(0) + End If + End Sub + + Static Sub Uninitialize() + If atom <> 0 Then + UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance) + End If + If tlsIndex <> 0 And tlsIndex <> &hffffffff Then + TlsFree(tlsIndex) + End If +' If hmodComctl <> 0 Then +' FreeLibrary(hmodComctl) +' End If + If PropertyInstance <> 0 Then + GlobalDeleteAtom(PropertyInstance) + End If + End Sub + +End Class + +Class Form '仮 + Inherits Control +Protected + Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT) + With cs + .lpCreateParams = 0 + '.hInstance + .hMenu = 0 + .hwndParent = 0 + .cy = CW_USEDEFAULT + .cx = CW_USEDEFAULT + .y = CW_USEDEFAULT + .x = CW_USEDEFAULT + .style = WS_OVERLAPPEDWINDOW + .lpszName = "" + '.lpszClass + .dwExStyle = 0 + End With + End Sub +Public + + Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + WndProc = 0 + Select Case msg + Case Else + WndProc = Super.WndProc(msg, wp, lp) + End Select + End Function +End Class + +End Namespace 'UI +End Namespace 'Widnows +End Namespace 'ActiveBasic + +'---------- +'テスト実行用 + +Imports ActiveBasic.Windows.UI + +'OleInitialize() +Control.Initialize(GetModuleHandle(0)) + +Class MyForm + Inherits Form +Public + Sub MyForm() + Dim f = This + f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory)) + f.AddPaintDC(AddressOf (f.Paint)) + End Sub + + Sub Destory(sender As Object, e As EventArgs) + OutputDebugString(Ex"Destory\r\n") + PostQuitMessage(0) + End Sub + + Sub Paint(sender As Object, e As PaintDCEventArgs) + TextOut(e.Handle, 10, 10, "Hello world!", 12) + End Sub +End Class + +Dim f = New MyForm +f.Create() +ShowWindow(f.Handle, SW_SHOW) + +Dim m As MSG +Do + Dim ret = GetMessage(m, 0, 0, 0) + If ret = 0 Then + Exit Do + ElseIf ret = -1 Then + ExitProcess(-1) + End If + + TranslateMessage(m) + DispatchMessage(m) +Loop + +f = Nothing +System.GC.Collect() + +Control.Uninitialize() +'OleUninitialize() + +End Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp (revision 545) @@ -0,0 +1,264 @@ +Public + Sub AddPaintDC(h As PaintDCEventHandler) + If IsNothing(paintDC) Then + paintDC = h + Else + paintDC += h + End If + End Sub + Sub RemovePaintDC(h As PaintDCEventHandler) + If Not IsNothing(paintDC) Then + paintDC -= h + End If + End Sub +Private + Sub OnPaintDC(e As PaintDCEventArgs) + If Not IsNothing(paintDC) Then + paintDC(This, e) + End If + End Sub +Private + paintDC As PaintDCEventHandler + +Public + Sub AddMouseEnter(h As MouseEventHandler) + If IsNothing(mouseEnter) Then + mouseEnter = h + Else + mouseEnter += h + End If + End Sub + Sub RemoveMouseEnter(h As MouseEventHandler) + If Not IsNothing(mouseEnter) Then + mouseEnter -= h + End If + End Sub +Private + Sub OnMouseEnter(e As MouseEventArgs) + If Not IsNothing(mouseEnter) Then + mouseEnter(This, e) + End If + End Sub +Private + mouseEnter As MouseEventHandler + +Public + Sub AddMouseMove(h As MouseEventHandler) + If IsNothing(mouseMove) Then + mouseMove = h + Else + mouseMove += h + End If + End Sub + Sub RemoveMouseMove(h As MouseEventHandler) + If Not IsNothing(mouseMove) Then + mouseMove -= h + End If + End Sub +Private + Sub OnMouseMove(e As MouseEventArgs) + If Not IsNothing(mouseMove) Then + mouseMove(This, e) + End If + End Sub +Private + mouseMove As MouseEventHandler + +Public + Sub AddMouseHover(h As MouseEventHandler) + If IsNothing(mouseHover) Then + mouseHover = h + Else + mouseHover += h + End If + End Sub + Sub RemoveMouseHover(h As MouseEventHandler) + If Not IsNothing(mouseHover) Then + mouseHover -= h + End If + End Sub +Private + Sub OnMouseHover(e As MouseEventArgs) + If Not IsNothing(mouseHover) Then + mouseHover(This, e) + End If + End Sub +Private + mouseHover As MouseEventHandler + +Public + Sub AddMouseLeave(h As MouseEventHandler) + If IsNothing(mouseLeave) Then + mouseLeave = h + Else + mouseLeave += h + End If + End Sub + Sub RemoveMouseLeave(h As MouseEventHandler) + If Not IsNothing(mouseLeave) Then + mouseLeave -= h + End If + End Sub +Private + Sub OnMouseLeave(e As MouseEventArgs) + If Not IsNothing(mouseLeave) Then + mouseLeave(This, e) + End If + End Sub +Private + mouseLeave As MouseEventHandler + +Public + Sub AddMouseDown(h As MouseEventHandler) + If IsNothing(mouseDown) Then + mouseDown = h + Else + mouseDown += h + End If + End Sub + Sub RemoveMouseDown(h As MouseEventHandler) + If Not IsNothing(mouseDown) Then + mouseDown -= h + End If + End Sub +Private + Sub OnMouseDown(e As MouseEventArgs) + If Not IsNothing(mouseDown) Then + mouseDown(This, e) + End If + End Sub +Private + mouseDown As MouseEventHandler + +Public + Sub AddMouseClick(h As MouseEventHandler) + If IsNothing(mouseClick) Then + mouseClick = h + Else + mouseClick += h + End If + End Sub + Sub RemoveMouseClick(h As MouseEventHandler) + If Not IsNothing(mouseClick) Then + mouseClick -= h + End If + End Sub +Private + Sub OnMouseClick(e As MouseEventArgs) + If Not IsNothing(mouseClick) Then + mouseClick(This, e) + End If + End Sub +Private + mouseClick As MouseEventHandler + +Public + Sub AddMouseDoubleClick(h As MouseEventHandler) + If IsNothing(mouseDoubleClick) Then + mouseDoubleClick = h + Else + mouseDoubleClick += h + End If + End Sub + Sub RemoveMouseDoubleClick(h As MouseEventHandler) + If Not IsNothing(mouseDoubleClick) Then + mouseDoubleClick -= h + End If + End Sub +Private + Sub OnMouseDoubleClick(e As MouseEventArgs) + If Not IsNothing(mouseDoubleClick) Then + mouseDoubleClick(This, e) + End If + End Sub +Private + mouseDoubleClick As MouseEventHandler + +Public + Sub AddMouseUp(h As MouseEventHandler) + If IsNothing(mouseUp) Then + mouseUp = h + Else + mouseUp += h + End If + End Sub + Sub RemoveMouseUp(h As MouseEventHandler) + If Not IsNothing(mouseUp) Then + mouseUp -= h + End If + End Sub +Private + Sub OnMouseUp(e As MouseEventArgs) + If Not IsNothing(mouseUp) Then + mouseUp(This, e) + End If + End Sub +Private + mouseUp As MouseEventHandler + +Public + Sub AddKeyDown(h As KeyEventHandler) + If IsNothing(keyDown) Then + keyDown = h + Else + keyDown += h + End If + End Sub + Sub RemoveKeyDown(h As KeyEventHandler) + If Not IsNothing(keyDown) Then + keyDown -= h + End If + End Sub +Private + Sub OnKeyDown(e As KeyEventArgs) + If Not IsNothing(keyDown) Then + keyDown(This, e) + End If + End Sub +Private + keyDown As KeyEventHandler + +Public + Sub AddKeyUp(h As KeyEventHandler) + If IsNothing(keyUp) Then + keyUp = h + Else + keyUp += h + End If + End Sub + Sub RemoveKeyUp(h As KeyEventHandler) + If Not IsNothing(keyUp) Then + keyUp -= h + End If + End Sub +Private + Sub OnKeyUp(e As KeyEventArgs) + If Not IsNothing(keyUp) Then + keyUp(This, e) + End If + End Sub +Private + keyUp As KeyEventHandler + +Public + Sub AddCreate(h As CreateEventHandler) + If IsNothing(create) Then + create = h + Else + create += h + End If + End Sub + Sub RemoveCreate(h As CreateEventHandler) + If Not IsNothing(create) Then + create -= h + End If + End Sub +Private + Sub OnCreate(e As CreateEventArgs) + If Not IsNothing(create) Then + create(This, e) + End If + End Sub +Private + create As CreateEventHandler + Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEventList.txt =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEventList.txt (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEventList.txt (revision 545) @@ -0,0 +1,23 @@ +PaintDC PaintDCEvent ウィンドウの描画が必要なときに呼び出されます。 +'Click Event クリックされたときに呼び出されます。 +'DoubleClick Event ダブルクリックされたときに呼び出されます。 +'EnableChanged Event 有効状態が変化したときに呼び出されます。 +'Move Event ウィンドウが移動したときに呼び出されます。 +'Resize Event ウィンドウの大きさが変化したときに呼び出されます。 +'VisibleChanged Event ウィンドウの表示状態が変化したときに呼び出されます。 +'SetFocus Event フォーカスを得たときに呼び出されます。 +'KillFocus Event フォーカスを失ったときに呼び出されます。 +MouseEnter MouseEvent マウスカーソルがコントロールに入ってくると呼び出されます。 +MouseMove MouseEvent マウスカーソルがコントロール上で移動すると呼び出されます +MouseHover MouseEvent マウスカーソルがコントロール上で静止すると呼び出されます。 +MouseLeave MouseEvent マウスカーソルがコントロールから出て行くと呼び出されます。 +MouseDown MouseEvent マウスボタンが押されたときに呼び出されます。 +MouseClick MouseEvent マウスでクリックされたときに呼び出されます。 +MouseDoubleClick MouseEvent マウスでダブルクリックされたときに呼び出されます。 +MouseUp MouseEvent マウスボタンが離されたときに呼び出されます。 +'MouseWheel MouseEvent マウスホイールが回されたときに呼び出されます。 +KeyDown KeyEvent キーが押されたときに呼ばれます。 +KeyUp KeyEvent キーが離されたときに呼ばれます。 +'なぜかコンパイルエラーを起こすのでコメントアウト KeyPress KeyPressEvent キーが押されて文字が打たれたときに呼ばれます。 +Create CreateEvent ウィンドウが作成されたときに呼ばれます。 +'Destroy Event ウィンドウが破棄されるときに呼ばれます。 Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab (revision 545) @@ -0,0 +1,514 @@ +/** +@file Include/Classes/ActiveBasic/Windows/UI/EventArgs.ab +@brief イベントハンドラ関連 +*/ + +Namespace ActiveBasic +Namespace Windows +Namespace UI + +TypeDef EventArgs = System.EventArgs +TypeDef EventHandler = System.EventHandler + +Class MessageEventArgs + Inherits EventArgs +Public + Sub MessageEventArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) + msg = message +' hwnd = hwndSrc + wp = wParam + lp = lParam + lr = 0 + End Sub + + Function Msg() As DWord + Msg = msg + End Function + +' Function HWnd() As HWND +' HWnd = hwnd +' End Function + + Function WParam() As WPARAM + WParam = wp + End Function + + Function LParam() As LPARAM + LParam = lp + End Function + + Function LResult() As LRESULT + LResult = lr + End Function + + Sub LResult(lResult As LRESULT) + lr = lResult + End Sub +Private + msg As DWord +' hwnd As HWND + wp As WPARAM + lp As LPARAM + lr As LRESULT +End Class + +Delegate Sub MessageEventHandler(sender As Object, e As MessageEventArgs) + +Class PaintDCEventArgs + Inherits EventArgs +Public + Sub PaintDCEventArgs(hdcTarget As HDC, ByRef rect As RECT) + hdc = hdcTarget + rc = rect + End Sub + + Function Handle() As HDC + Handle = hdc + End Function + + Function ClipRect() As RECT + ClipRect = rc + End Function + +Private + hdc As HDC + rc As RECT +End Class + +Delegate Sub PaintDCEventHandler(sender As Object, e As PaintDCEventArgs) + +Class PaintDCHandledEventArgs + Inherits PaintDCEventArgs +Public + Sub PaintDCHandledEventArgs(hdcTarget As HDC, ByRef rect As RECT) + PaintDCEventArgs(hdcTarget, rect) + End Sub + + Function Handled() As Boolean + Handled = h + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + +Private + h As Boolean +End Class + +TypeDef PaintDCBackGroundEventArgs = PaintDCHandledEventArgs + +Enum MouseButtons + None = 0 + Left = MK_LBUTTON + Right = MK_RBUTTON + Middle = MK_MBUTTON + XButton1 = MK_XBUTTON1 + XButton2 = MK_XBUTTON2 + + Shift = MK_SHIFT + Control = MK_CONTROL +End Enum + +Class MouseEventArgs + Inherits EventArgs +Public + Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long) + This.button = button + This.clicks = clicks + This.pt = New System.Drawing.Point(x, y) + This.delta = delta + End Sub + + Const Function Button() As MouseButtons + Button = button + End Function + + Const Function Clicks() As Long + Clicks = clicks + End Function + + Const Function Delta() As Long + Delta = delta + End Function + + Const Function Locale() As System.Drawing.Point + Locale = New System.Drawing.Point(pt.X, pt.Y) + End Function + + Const Function X() As Long + X = pt.X + End Function + + Const Function Y() As Long + Y = pt.Y + End Function + +Private + pt As System.Drawing.Point + button As MouseButtons + clicks As Long + delta As Long +End Class + +Delegate Sub MouseEventHandler(sender As Object, e As MouseEventArgs) + +Class KeyPressEventArgs + Inherits EventArgs +Public + Sub KeyPressEventArgs(keyChar As Char) + key = keyChar + End Sub + + Sub KeyChar(keyChar As Char) + key = keyChar + End Sub + + Const Function KeyChar() As Char + KeyChar = key + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + + Const Function Handled() As Boolean + Handled = h + End Function +Private + key As Char + h As Boolean +End Class + +Delegate Sub KeyPressEventHandler(sender As Object, e As KeyPressEventArgs) + +Enum Keys + None = 0 + LButton = VK_LBUTTON + RButton = VK_RBUTTON + Cancel = VK_CANCEL + MButton = VK_MBUTTON + XButton1 = VK_XBUTTON1 + XButton2 = VK_XBUTTON2 + Back = VK_BACK + Tab = VK_TAB + LineFeed = &ha + Clear = VK_CLEAR + Enter = VK_RETURN + Return_ = VK_RETURN + ShiftKey = VK_SHIFT + ControlKey = VK_CONTROL + Menu = VK_MENU + Pause = VK_PAUSE + Capital = VK_CAPITAL + KanaMode = VK_KANA + HangulMode = VK_HANGUL + JunjaMode = VK_JUNJA + FinalMode = VK_FINAL + KanjiMode = VK_KANJI + HanjaMode = VK_HANJA + Escape = VK_ESCAPE + IMEConvert = VK_CONVERT + IMENonconvert = VK_NONCONVERT + IMEAccept = VK_ACCEPT + IMEModeChange = VK_MODECHANGE + Space = VK_SPACE + Prior = VK_PRIOR + PageUp = VK_PRIOR + PageDown = VK_NEXT + Next_ = VK_NEXT + End_ = VK_END + Home = VK_HOME + Left = VK_LEFT + Up = VK_UP + Right = VK_RIGHT + Down = VK_DOWN + Select_ = VK_SELECT + Print = VK_PRINT + Execute = VK_EXECUTE + Snapshot = VK_SNAPSHOT + Insert = VK_INSERT + Delete_ = VK_DELETE + Help = VK_HELP + D0 = &h30 + D1 = &h31 + D2 = &h32 + D3 = &h33 + D4 = &h34 + D5 = &h35 + D6 = &h36 + D7 = &h37 + D8 = &h38 + D9 = &h39 + A = &h41 + B = &h42 + C = &h43 + D = &h44 + E = &h45 + F = &h46 + G = &h47 + H = &h48 + I = &h49 + J = &h4a + K = &h4b + L = &h4c + M = &h4d + N = &h4e + O = &h4f + P = &h50 + Q = &h51 + R = &h52 + S = &h53 + T = &h54 + U = &h55 + V = &h56 + W = &h57 + X = &h58 + Y = &h59 + Z = &h5A + LWin = VK_LWIN + RWin = VK_RWIN + Apps = VK_APPS + Sleep = VK_SLEEP + NumPad0 = VK_NUMPAD0 + NumPad1 = VK_NUMPAD1 + NumPad2 = VK_NUMPAD2 + NumPad3 = VK_NUMPAD3 + NumPad4 = VK_NUMPAD4 + NumPad5 = VK_NUMPAD5 + NumPad6 = VK_NUMPAD6 + NumPad7 = VK_NUMPAD7 + NumPad8 = VK_NUMPAD8 + NumPad9 = VK_NUMPAD9 + Multiply = VK_MULTIPLY + Add = VK_ADD + Separator = VK_SEPARATOR + Substract = VK_SUBTRACT + Decimal = VK_DECIMAL + Divide = VK_DIVIDE + F1 = VK_F1 + F2 = VK_F2 + F3 = VK_F3 + F4 = VK_F4 + F5 = VK_F5 + F6 = VK_F6 + F7 = VK_F7 + F8 = VK_F8 + F9 = VK_F9 + F10 = VK_F10 + F11 = VK_F11 + F12 = VK_F12 + F13 = VK_F13 + F14 = VK_F14 + F15 = VK_F15 + F16 = VK_F16 + F17 = VK_F17 + F18 = VK_F18 + F19 = VK_F19 + F20 = VK_F20 + F21 = VK_F21 + F22 = VK_F22 + F23 = VK_F23 + F24 = VK_F24 + NumLock = VK_NUMLOCK + Scroll = VK_SCROLL + LShiftKey = VK_LSHIFT + RShiftKey = VK_RSHIFT + LControlKey = VK_LCONTROL + RControlKey = VK_RCONTROL + LMenu = VK_LMENU + RMenu = VK_RMENU + BrowserBack = VK_BROWSER_BACK + BrowserForward = VK_BROWSER_FORWARD + BrowserRefresh = VK_BROWSER_REFRESH + BrowserStop = VK_BROWSER_STOP + BrowserSearch = VK_BROWSER_SEARCH + BrowserFavorites = VK_BROWSER_FAVORITES + BrowserHome = VK_BROWSER_HOME + VolumeMute = VK_VOLUME_MUTE + VolumeDown = VK_VOLUME_DOWN + VolumeUp = VK_VOLUME_UP + MediaNextTrack = VK_MEDIA_NEXT_TRACK + MediaPreviousTrack = VK_MEDIA_PREV_TRACK + MediaStop = VK_MEDIA_STOP + MediaPlayPause = VK_MEDIA_PLAY_PAUSE + LaunchMail = VK_LAUNCH_MAIL + SelectMedia = VK_LAUNCH_MEDIA_SELECT + LaunchApplication1 = VK_LAUNCH_APP1 + LaunchApplication2 = VK_LAUNCH_APP2 + Oem1 = VK_OEM_1 + Oemplus = VK_OEM_PLUS + Oemcomma = VK_OEM_COMMA + OemMinus = VK_OEM_MINUS + OemPeriod = VK_OEM_PERIOD + Oem2 = VK_OEM_2 + OemQuestion = VK_OEM_2 + Oem3 = VK_OEM_3 + Oemtilde = VK_OEM_3 + Oem4 = VK_OEM_4 + OemOpenBrackets = VK_OEM_4 + Oem5 = VK_OEM_5 + OemPipe = VK_OEM_5 + Oem6 = VK_OEM_6 + OemCloseBrackets = VK_OEM_6 + Oem7 = VK_OEM_7 + OemQuotes = VK_OEM_7 + Oem8 = VK_OEM_8 + Oem102 = VK_OEM_102 + OemBackslash = VK_OEM_102 + ProcessKey = VK_PROCESSKEY + Packet = VK_PACKET + Attn = VK_ATTN + Crsel = VK_CRSEL + Exsel = VK_EXSEL + EraseEof = VK_EREOF + Play = VK_PLAY + NoName = VK_NONAME + Zoom = VK_ZOOM + Pa1 = VK_PA1 + OemClear = VK_OEM_CLEAR + + KeyCode = &hffff + + Shift = &h10000 + Control = &h20000 + Alt = &h40000 + + Modifiers = &hffff +End Enum + +Class KeyEventArgs + Inherits EventArgs +Public + Sub KeyEventArgs(keyData As Keys) + key = keyData + End Sub + + Function Alt() As Boolean + Alt = key And Keys.Menu + End Function + + Function Control() As Boolean + Control = key And Keys.Control + End Function + + Function Shift() As Boolean + Shift = key And Keys.Shift + End Function + + Function KeyCode() As Keys + Dim k = key As DWord + Dim mask = Keys.KeyCode As DWord + KeyCode = (k And mask) As Keys + End Function + + Function KeyData() As Keys + KeyData = key + End Function + + Function Modifiers() As Keys + Dim k = key As DWord + Dim mask = Keys.Modifiers As DWord + Modifiers = (k And mask) As Keys + End Function + + Function KeyValue() As Long + KeyValue = key As Long + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + + Function Handled() As Boolean + Handled = h + End Function + +Private + key As Keys + h As Boolean +End Class + +Delegate Sub KeyEventHandler(sender As Object, e As KeyEventArgs) + +Class CreateEventArgs + Inherits EventArgs +Public + Sub CreateEventArgs(pCreateStruct As *CREATESTRUCT) + pcs = pCreateStruct + End Sub + + Const Function HInstance() As HINSTANCE + HInstance = pcs->hInstance + End Function + + 'Menu: pcs->hMenu + + Const Function Parent() As Control + 'Parent = Control.FromHandle(pcs->hwndParent) + End Function + + Const Function Height() As Long + Height = pcs->cy + End Function + + Const Function Width() As Long + Width = pcs->cx + End Function + + Const Function Y() As Long + Y = pcs->cy + End Function + + Const Function X() As Long + X = pcs->cx + End Function + + Const Function Style() As DWord + Style = pcs->style As DWord + End Function + + Const Function Caption() As String + Caption = New String(pcs->lpszName) + End Function + + Const Function ClassName() As String + ClassName = New String(pcs->lpszClass) + End Function + + Const Function ExStyle() As DWord + ExStyle = pcs->dwExStyle + End Function + + Const Function CreateStruct() As *CREATESTRUCT + CreateStruct = pcs + End Function +Private + pcs As *CREATESTRUCT +End Class + +Delegate Sub CreateEventHandler(sender As Object, e As CreateEventArgs) + +Class FormClosingEventArgs + Inherits EventArgs +Public + Sub FormClosingEventArgs() + c = False + End Sub + + Function Cancel() As Boolean + Cancel = c + End Function + + Sub Cancel(cancel As Boolean) + c = cancel + End Sub +Private + c As Boolean +End Class + +Delegate Sub FormClosingEventHandler(sender As Object, e As FormClosingEventArgs) + +End Namespace 'UI +End Namespace 'Widnows +End Namespace 'ActiveBasic Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/FormEvent.sbp =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/FormEvent.sbp (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/FormEvent.sbp (revision 545) @@ -0,0 +1,22 @@ +Public + Sub AddQueryClose(h As FormClosingEventHandler) + If IsNothing(queryClose) Then + queryClose = h + Else + queryClose += h + End If + End Sub + Sub RemoveQueryClose(h As FormClosingEventHandler) + If Not IsNothing(queryClose) Then + queryClose -= h + End If + End Sub +Private + Sub OnQueryClose(e As FormClosingEventArgs) + If Not IsNothing(queryClose) Then + queryClose(This, e) + End If + End Sub +Private + queryClose As FormClosingEventHandler + Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/Control.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/Control.ab (revision 544) +++ (revision ) @@ -1,498 +1,0 @@ -'Classes/ActiveBasic/Windows/UI/Control.ab - -#require - -Namespace ActiveBasic -Namespace Windows -Namespace UI -Namespace Forms - -'Namespace Detail -' TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL -'End Namespace - -Class Control -Public - Sub Control() - End Sub - - Virtual Sub ~Control() - End Sub - - Function Handle() As HWND - Handle = hwnd - End Function - - Static Function FromHWnd(hwnd As HWND) As Control - FromHWnd = Nothing - If IsWindow(hwnd) Then - FromHWnd = FromHWndCore(hwnd) - End If - End Function - -Private - Static Function FromHWndCore(hwnd As HWND) As Control - If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then - Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR - If gchValue <> 0 Then - Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue) - FromHWndCore = gch.Target As Control - Exit Function - End If - End If - End Function - -'-------------------------------- -' ウィンドウ作成 -/* - Function Create( - parent As HWND, - rect As RECT, - name As String, - style As DWord, - exStyle = 0 As DWord, - menu = 0 As HMENU) As HWND -*/ - -Public - Function Create() As Boolean - Dim cs As CREATESTRUCT - cs.hInstance = hInstance - cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR - GetCreateStruct(cs) - Create = createImpl(cs) - End Function - -Protected - Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT) - - Function createImpl(ByRef cs As CREATESTRUCT) As Boolean - Imports System.Runtime.InteropServices - - Dim gch = GCHandle.Alloc(This) - TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) - - StartWndProc() - - With cs - Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style, - .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) - createImpl = hwnd <> 0 - End With - End Function - -'-------------------------------- -' ウィンドウプロシージャ -'Protected -Public - Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - Dim h = Nothing As MessageEventHandler - Dim b = messageMap.TryGetValue(Hex$(msg), h) - If b Then - If Not IsNothing(h) Then - Dim a = New MessageEventArgs(hwnd, msg, wp, lp) - h(This, a) - WndProc = a.LResult - Exit Function - End If - End If - WndProc = DefWndProc(msg, wp, lp) - End Function - - Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - DefWndProc = DefWindowProc(hwnd, msg, wp, lp) - End Function - -Private - Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys - Dim t As DWord - t = e.WParam And Keys.KeyCode - t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1 - t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2 - t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3 - makeKeysFormMsg = t As Keys - End Function - - Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs - Dim wp = e.WParam - Dim lp = e.LParam - makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0) - End Function - - /*! - @brief 最初にウィンドウプロシージャが呼ばれるときに実行される関数 - ここでは、主なメッセージハンドラの登録を行っている。 - @date 2008/07/11 - */ - Sub StartWndProc() - Dim t = This '#177対策 - AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground)) - Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase)) - AddMessageEvent(WM_LBUTTONDOWN, md) - AddMessageEvent(WM_RBUTTONDOWN, md) - AddMessageEvent(WM_MBUTTONDOWN, md) - AddMessageEvent(WM_XBUTTONDOWN, md) - Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase)) - AddMessageEvent(WM_LBUTTONUP, mu) - AddMessageEvent(WM_RBUTTONUP, mu) - AddMessageEvent(WM_MBUTTONUP, mu) - AddMessageEvent(WM_XBUTTONUP, mu) - Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase)) - AddMessageEvent(WM_LBUTTONDBLCLK, mu) - AddMessageEvent(WM_RBUTTONDBLCLK, mu) - AddMessageEvent(WM_MBUTTONDBLCLK, mu) - AddMessageEvent(WM_XBUTTONDBLCLK, mu) - - AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase)) - AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase)) - AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase)) -' AddMessageEvent(WM_CHAR, AddressOf(t.OnChar)) - AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase)) - End Sub - - Sub OnEraseBackground(sender As Object, e As MessageEventArgs) - Dim rc As RECT - Dim r = GetClientRect(hwnd, rc) - FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH) - e.LResult = TRUE - End Sub - - Sub OnMouseDownBase(sender As Object, e As MessageEventArgs) - OnMouseDown(makeMouseEventFromMsg(e)) - End Sub - - Sub OnMouseUpBase(sender As Object, e As MessageEventArgs) - Dim me = makeMouseEventFromMsg(e) - If doubleClickFired = False Then -' OnClick(System.EventArgs.Empty) - OnMouseClick(me) - doubleClickFired = False - End If - OnMouseUp(me) - End Sub - - Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs) - Dim me = makeMouseEventFromMsg(e) - doubleClickFired = True - OnMouseDown(me) -' OnDoubleClick(System.EventArgs.Empty) - OnMouseDoubleClick(me) - End Sub - - Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs) - Dim me = makeMouseEventFromMsg(e) - If mouseEntered Then - OnMouseMove(me) - Else - mouseEntered = True - OnMouseEnter(me) - End If - End Sub - - Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs) - Dim me = makeMouseEventFromMsg(e) - OnMouseLeave(me) - mouseEntered = False - End Sub - - Sub OnPaintBase(sender As Object, e As MessageEventArgs) - Dim ps As PAINTSTRUCT - BeginPaint(hwnd, ps) - Try - OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint)) - Finally - EndPaint(hwnd, ps) - End Try - End Sub - - Sub OnKeyDownBase(sender As Object, e As MessageEventArgs) - OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e))) - End Sub - - Sub OnKeyUpBase(sender As Object, e As MessageEventArgs) - OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e))) - End Sub - -' コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと -' Sub OnChar(sender As Object, e As MessageEventArgs) -' OnKeyPress(New KeyPressEventArgs(e.WParam As Char)) -' End Sub - - Sub OnCreateBase(sender As Object, e As MessageEventArgs) - OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT)) - End Sub - - messageMap As System.Collections.Generic.Dictionary - -Public - /*! - @biref メッセージイベントハンドラを登録する。 - @date 2007/12/04 - */ - Sub AddMessageEvent(message As DWord, h As MessageEventHandler) - If Not IsNothing(h) Then - If IsNothing(messageMap) Then - messageMap = New System.Collections.Generic.Dictionary - End If - Dim msg = Hex$(message) - Dim m = Nothing As MessageEventHandler - If messageMap.TryGetValue(msg, m) Then - messageMap.Item[msg] = m + h - Else - messageMap.Item[msg] = h - End If - End If - End Sub - - /*! - @biref メッセージイベントハンドラ登録を解除する。 - @date 2007/12/04 - */ - Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler) - If Not IsNothing(a) Then - If Not IsNothing(messageMap) Then - Dim msg = Nothing As Object : msg = New System.UInt32(message) - Dim m = messageMap.Item[msg] - If Not IsNothing(m) Then - messageMap.Item[msg] = m - a - End If - End If - End If - End Sub - -'-------------------------------- -' ウィンドウメッセージ処理 - - -'-------- -'イベント - -#include "ControlEvent.sbp" - -'-------------------------------- -' インスタンスメンバ変数 -Private - hwnd As HWND - /*! - @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ - 外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。 - */ - mouseEntered As Boolean - /*! - @brief ダブルクリックが起こったかどうかのフラグ - Click/MouseClickイベントのために用意している。 - @date 2008/07/12 - */ - doubleClickFired As Boolean - -'-------------------------------- -' 初期ウィンドウクラス -Private - Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - Imports System.Runtime.InteropServices - - Dim rThis = Control.FromHWndCore(hwnd) - If IsNothing(rThis) Then - Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR - TlsSetValue(tlsIndex, 0) - If gchValue = 0 Then - Goto *InstanceIsNotFound - End If - Dim gch = GCHandle.FromIntPtr(gchValue) - rThis = gch.Target As Control - ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき - - If IsNothing(rThis) Then - Goto *InstanceIsNotFound - End If - rThis.hwnd = hwnd - SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE) - End If - WndProcFirst = rThis.WndProc(msg, wp, lp) - If msg = WM_NCDESTROY Then - Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR - If gchValue <> 0 Then - Dim gch = GCHandle.FromIntPtr(gchValue) - gch.Free() - End If - End If - - Exit Function - - *InstanceIsNotFound - OutputDebugString("ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.") - WndProcFirst = DefWindowProc(hwnd, msg, wp, lp) - End Function - -' Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord -' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord - -'-------------------------------- -' その他の補助関数 -Private -' Sub tracMouseEvent() -/* If pTrackMouseEvent <> 0 Then - Dim tme As TRACKMOUSEEVENT - With tme - .cbSize = Len(tme) - .dwFlags = TME_HOVER Or TME_LEAVE - .hwndTrack = wnd - .dwHoverTime = HOVER_DEFAULT - End With - pTrackMouseEvent(tme) - End If -*/ 'End Sub - -'-------------------------------- -' 初期化終了関連（特にウィンドウクラス） -Private - 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの - Static tlsIndex As DWord - - Static hInstance As HINSTANCE - Static atom As ATOM - Static hmodComctl As HMODULE -' Static pTrackMouseEvent As PTrackMouseEvent - - Static Const WindowClassName = "ActiveBasic.Windows.UI.Control" - Static Const PropertyInstance = 0 As ATOM -Public - Static Sub Initialize(hinst As HINSTANCE) - tlsIndex = TlsAlloc() - hInstance = hinst -' hmodComctl = LoadLibrary("comctl32.dll") -' pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) - - Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId()) - PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString)) - - Dim wcx As WNDCLASSEX - With wcx - .cbSize = Len (wcx) - .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS - .lpfnWndProc = AddressOf (WndProcFirst) - .cbClsExtra = 0 - .cbWndExtra = 0 - .hInstance = hinst - .hIcon = 0 - .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR - .hbrBackground = 0 - .lpszMenuName = 0 - .lpszClassName = ToTCStr(WindowClassName) - .hIconSm = 0 - End With - atom = RegisterClassEx(wcx) - If atom = 0 Then - Dim buf[1023] As TCHAR - wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError()) - OutputDebugString(buf) - Debug - ExitThread(0) - End If - End Sub - - Static Sub Uninitialize() - If atom <> 0 Then - UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance) - End If - If tlsIndex <> 0 And tlsIndex <> &hffffffff Then - TlsFree(tlsIndex) - End If -' If hmodComctl <> 0 Then -' FreeLibrary(hmodComctl) -' End If - If PropertyInstance <> 0 Then - GlobalDeleteAtom(PropertyInstance) - End If - End Sub - -End Class - -Class Form '仮 - Inherits Control -Protected - Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT) - With cs - .lpCreateParams = 0 - '.hInstance - .hMenu = 0 - .hwndParent = 0 - .cy = CW_USEDEFAULT - .cx = CW_USEDEFAULT - .y = CW_USEDEFAULT - .x = CW_USEDEFAULT - .style = WS_OVERLAPPEDWINDOW - .lpszName = "" - '.lpszClass - .dwExStyle = 0 - End With - End Sub -Public - - Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - WndProc = 0 - Select Case msg - Case Else - WndProc = Super.WndProc(msg, wp, lp) - End Select - End Function -End Class - -End Namespace 'Forms -End Namespace 'UI -End Namespace 'Widnows -End Namespace 'ActiveBasic - - -'---------- -'テスト実行用 - -Imports ActiveBasic.Windows.UI.Forms - -'OleInitialize() -Control.Initialize(GetModuleHandle(0)) - -Class MyForm - Inherits Form -Public - Sub t() - Dim f = This - f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory)) - f.AddPaintDC(AddressOf (f.Paint)) - End Sub - - Sub Destory(sender As Object, e As EventArgs) - OutputDebugString(Ex"Destory\r\n") - PostQuitMessage(0) - End Sub - - Sub Paint(sender As Object, e As PaintDCEventArgs) - TextOut(e.Handle, 10, 10, "Hello world!", 12) - End Sub -End Class - -Dim f = New MyForm -f.t() -f.Create() -ShowWindow(f.Handle, SW_SHOW) - -Dim m As MSG -Do - Dim ret = GetMessage(m, 0, 0, 0) - If ret = 0 Then - Exit Do - ElseIf ret = -1 Then - ExitProcess(-1) - End If - - TranslateMessage(m) - DispatchMessage(m) -Loop - -f = Nothing -System.GC.Collect() - -Control.Uninitialize() -'OleUninitialize() - -End Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp (revision 544) +++ (revision ) @@ -1,264 +1,0 @@ -Public - Sub AddPaintDC(h As PaintDCEventHandler) - If IsNothing(paintDC) Then - paintDC = h - Else - paintDC += h - End If - End Sub - Sub RemovePaintDC(h As PaintDCEventHandler) - If Not IsNothing(paintDC) Then - paintDC -= h - End If - End Sub -Private - Sub OnPaintDC(e As PaintDCEventArgs) - If Not IsNothing(paintDC) Then - paintDC(This, e) - End If - End Sub -Private - paintDC As PaintDCEventHandler - -Public - Sub AddMouseEnter(h As MouseEventHandler) - If IsNothing(mouseEnter) Then - mouseEnter = h - Else - mouseEnter += h - End If - End Sub - Sub RemoveMouseEnter(h As MouseEventHandler) - If Not IsNothing(mouseEnter) Then - mouseEnter -= h - End If - End Sub -Private - Sub OnMouseEnter(e As MouseEventArgs) - If Not IsNothing(mouseEnter) Then - mouseEnter(This, e) - End If - End Sub -Private - mouseEnter As MouseEventHandler - -Public - Sub AddMouseMove(h As MouseEventHandler) - If IsNothing(mouseMove) Then - mouseMove = h - Else - mouseMove += h - End If - End Sub - Sub RemoveMouseMove(h As MouseEventHandler) - If Not IsNothing(mouseMove) Then - mouseMove -= h - End If - End Sub -Private - Sub OnMouseMove(e As MouseEventArgs) - If Not IsNothing(mouseMove) Then - mouseMove(This, e) - End If - End Sub -Private - mouseMove As MouseEventHandler - -Public - Sub AddMouseHover(h As MouseEventHandler) - If IsNothing(mouseHover) Then - mouseHover = h - Else - mouseHover += h - End If - End Sub - Sub RemoveMouseHover(h As MouseEventHandler) - If Not IsNothing(mouseHover) Then - mouseHover -= h - End If - End Sub -Private - Sub OnMouseHover(e As MouseEventArgs) - If Not IsNothing(mouseHover) Then - mouseHover(This, e) - End If - End Sub -Private - mouseHover As MouseEventHandler - -Public - Sub AddMouseLeave(h As MouseEventHandler) - If IsNothing(mouseLeave) Then - mouseLeave = h - Else - mouseLeave += h - End If - End Sub - Sub RemoveMouseLeave(h As MouseEventHandler) - If Not IsNothing(mouseLeave) Then - mouseLeave -= h - End If - End Sub -Private - Sub OnMouseLeave(e As MouseEventArgs) - If Not IsNothing(mouseLeave) Then - mouseLeave(This, e) - End If - End Sub -Private - mouseLeave As MouseEventHandler - -Public - Sub AddMouseDown(h As MouseEventHandler) - If IsNothing(mouseDown) Then - mouseDown = h - Else - mouseDown += h - End If - End Sub - Sub RemoveMouseDown(h As MouseEventHandler) - If Not IsNothing(mouseDown) Then - mouseDown -= h - End If - End Sub -Private - Sub OnMouseDown(e As MouseEventArgs) - If Not IsNothing(mouseDown) Then - mouseDown(This, e) - End If - End Sub -Private - mouseDown As MouseEventHandler - -Public - Sub AddMouseClick(h As MouseEventHandler) - If IsNothing(mouseClick) Then - mouseClick = h - Else - mouseClick += h - End If - End Sub - Sub RemoveMouseClick(h As MouseEventHandler) - If Not IsNothing(mouseClick) Then - mouseClick -= h - End If - End Sub -Private - Sub OnMouseClick(e As MouseEventArgs) - If Not IsNothing(mouseClick) Then - mouseClick(This, e) - End If - End Sub -Private - mouseClick As MouseEventHandler - -Public - Sub AddMouseDoubleClick(h As MouseEventHandler) - If IsNothing(mouseDoubleClick) Then - mouseDoubleClick = h - Else - mouseDoubleClick += h - End If - End Sub - Sub RemoveMouseDoubleClick(h As MouseEventHandler) - If Not IsNothing(mouseDoubleClick) Then - mouseDoubleClick -= h - End If - End Sub -Private - Sub OnMouseDoubleClick(e As MouseEventArgs) - If Not IsNothing(mouseDoubleClick) Then - mouseDoubleClick(This, e) - End If - End Sub -Private - mouseDoubleClick As MouseEventHandler - -Public - Sub AddMouseUp(h As MouseEventHandler) - If IsNothing(mouseUp) Then - mouseUp = h - Else - mouseUp += h - End If - End Sub - Sub RemoveMouseUp(h As MouseEventHandler) - If Not IsNothing(mouseUp) Then - mouseUp -= h - End If - End Sub -Private - Sub OnMouseUp(e As MouseEventArgs) - If Not IsNothing(mouseUp) Then - mouseUp(This, e) - End If - End Sub -Private - mouseUp As MouseEventHandler - -Public - Sub AddKeyDown(h As KeyEventHandler) - If IsNothing(keyDown) Then - keyDown = h - Else - keyDown += h - End If - End Sub - Sub RemoveKeyDown(h As KeyEventHandler) - If Not IsNothing(keyDown) Then - keyDown -= h - End If - End Sub -Private - Sub OnKeyDown(e As KeyEventArgs) - If Not IsNothing(keyDown) Then - keyDown(This, e) - End If - End Sub -Private - keyDown As KeyEventHandler - -Public - Sub AddKeyUp(h As KeyEventHandler) - If IsNothing(keyUp) Then - keyUp = h - Else - keyUp += h - End If - End Sub - Sub RemoveKeyUp(h As KeyEventHandler) - If Not IsNothing(keyUp) Then - keyUp -= h - End If - End Sub -Private - Sub OnKeyUp(e As KeyEventArgs) - If Not IsNothing(keyUp) Then - keyUp(This, e) - End If - End Sub -Private - keyUp As KeyEventHandler - -Public - Sub AddCreate(h As CreateEventHandler) - If IsNothing(create) Then - create = h - Else - create += h - End If - End Sub - Sub RemoveCreate(h As CreateEventHandler) - If Not IsNothing(create) Then - create -= h - End If - End Sub -Private - Sub OnCreate(e As CreateEventArgs) - If Not IsNothing(create) Then - create(This, e) - End If - End Sub -Private - create As CreateEventHandler - Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt (revision 544) +++ (revision ) @@ -1,23 +1,0 @@ -PaintDC PaintDCEvent ウィンドウの描画が必要なときに呼び出されます。 -'Click Event クリックされたときに呼び出されます。 -'DoubleClick Event ダブルクリックされたときに呼び出されます。 -'EnableChanged Event 有効状態が変化したときに呼び出されます。 -'Move Event ウィンドウが移動したときに呼び出されます。 -'Resize Event ウィンドウの大きさが変化したときに呼び出されます。 -'VisibleChanged Event ウィンドウの表示状態が変化したときに呼び出されます。 -'SetFocus Event フォーカスを得たときに呼び出されます。 -'KillFocus Event フォーカスを失ったときに呼び出されます。 -MouseEnter MouseEvent マウスカーソルがコントロールに入ってくると呼び出されます。 -MouseMove MouseEvent マウスカーソルがコントロール上で移動すると呼び出されます -MouseHover MouseEvent マウスカーソルがコントロール上で静止すると呼び出されます。 -MouseLeave MouseEvent マウスカーソルがコントロールから出て行くと呼び出されます。 -MouseDown MouseEvent マウスボタンが押されたときに呼び出されます。 -MouseClick MouseEvent マウスでクリックされたときに呼び出されます。 -MouseDoubleClick MouseEvent マウスでダブルクリックされたときに呼び出されます。 -MouseUp MouseEvent マウスボタンが離されたときに呼び出されます。 -'MouseWheel MouseEvent マウスホイールが回されたときに呼び出されます。 -KeyDown KeyEvent キーが押されたときに呼ばれます。 -KeyUp KeyEvent キーが離されたときに呼ばれます。 -'なぜかコンパイルエラーを起こすのでコメントアウト KeyPress KeyPressEvent キーが押されて文字が打たれたときに呼ばれます。 -Create CreateEvent ウィンドウが作成されたときに呼ばれます。 -'Destroy Event ウィンドウが破棄されるときに呼ばれます。 Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab (revision 544) +++ (revision ) @@ -1,516 +1,0 @@ -/** -@file Include/Classes/ActiveBasic/Windows/UI/EventArgs.ab -@brief イベントハンドラ関連 -*/ - -Namespace ActiveBasic -Namespace Windows -Namespace UI -Namespace Forms - -TypeDef EventArgs = System.EventArgs -TypeDef EventHandler = System.EventHandler - -Class MessageEventArgs - Inherits EventArgs -Public - Sub MessageEventArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) - msg = message -' hwnd = hwndSrc - wp = wParam - lp = lParam - lr = 0 - End Sub - - Function Msg() As DWord - Msg = msg - End Function - -' Function HWnd() As HWND -' HWnd = hwnd -' End Function - - Function WParam() As WPARAM - WParam = wp - End Function - - Function LParam() As LPARAM - LParam = lp - End Function - - Function LResult() As LRESULT - LResult = lr - End Function - - Sub LResult(lResult As LRESULT) - lr = lResult - End Sub -Private - msg As DWord -' hwnd As HWND - wp As WPARAM - lp As LPARAM - lr As LRESULT -End Class - -Delegate Sub MessageEventHandler(sender As Object, e As MessageEventArgs) - -Class PaintDCEventArgs - Inherits EventArgs -Public - Sub PaintDCEventArgs(hdcTarget As HDC, ByRef rect As RECT) - hdc = hdcTarget - rc = rect - End Sub - - Function Handle() As HDC - Handle = hdc - End Function - - Function ClipRect() As RECT - ClipRect = rc - End Function - -Private - hdc As HDC - rc As RECT -End Class - -Delegate Sub PaintDCEventHandler(sender As Object, e As PaintDCEventArgs) - -Class PaintDCHandledEventArgs - Inherits PaintDCEventArgs -Public - Sub PaintDCHandledEventArgs(hdcTarget As HDC, ByRef rect As RECT) - PaintDCEventArgs(hdcTarget, rect) - End Sub - - Function Handled() As Boolean - Handled = h - End Function - - Sub Handled(handled As Boolean) - h = handled - End Sub - -Private - h As Boolean -End Class - -TypeDef PaintDCBackGroundEventArgs = PaintDCHandledEventArgs - -Enum MouseButtons - None = 0 - Left = MK_LBUTTON - Right = MK_RBUTTON - Middle = MK_MBUTTON - XButton1 = MK_XBUTTON1 - XButton2 = MK_XBUTTON2 - - Shift = MK_SHIFT - Control = MK_CONTROL -End Enum - -Class MouseEventArgs - Inherits EventArgs -Public - Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long) - This.button = button - This.clicks = clicks - This.pt = New System.Drawing.Point(x, y) - This.delta = delta - End Sub - - Const Function Button() As MouseButtons - Button = button - End Function - - Const Function Clicks() As Long - Clicks = clicks - End Function - - Const Function Delta() As Long - Delta = delta - End Function - - Const Function Locale() As System.Drawing.Point - Locale = New System.Drawing.Point(pt.X, pt.Y) - End Function - - Const Function X() As Long - X = pt.X - End Function - - Const Function Y() As Long - Y = pt.Y - End Function - -Private - pt As System.Drawing.Point - button As MouseButtons - clicks As Long - delta As Long -End Class - -Delegate Sub MouseEventHandler(sender As Object, e As MouseEventArgs) - -Class KeyPressEventArgs - Inherits EventArgs -Public - Sub KeyPressEventArgs(keyChar As Char) - key = keyChar - End Sub - - Sub KeyChar(keyChar As Char) - key = keyChar - End Sub - - Const Function KeyChar() As Char - KeyChar = key - End Function - - Sub Handled(handled As Boolean) - h = handled - End Sub - - Const Function Handled() As Boolean - Handled = h - End Function -Private - key As Char - h As Boolean -End Class - -Delegate Sub KeyPressEventHandler(sender As Object, e As KeyPressEventArgs) - -Enum Keys - None = 0 - LButton = VK_LBUTTON - RButton = VK_RBUTTON - Cancel = VK_CANCEL - MButton = VK_MBUTTON - XButton1 = VK_XBUTTON1 - XButton2 = VK_XBUTTON2 - Back = VK_BACK - Tab = VK_TAB - LineFeed = &ha - Clear = VK_CLEAR - Enter = VK_RETURN - Return_ = VK_RETURN - ShiftKey = VK_SHIFT - ControlKey = VK_CONTROL - Menu = VK_MENU - Pause = VK_PAUSE - Capital = VK_CAPITAL - KanaMode = VK_KANA - HangulMode = VK_HANGUL - JunjaMode = VK_JUNJA - FinalMode = VK_FINAL - KanjiMode = VK_KANJI - HanjaMode = VK_HANJA - Escape = VK_ESCAPE - IMEConvert = VK_CONVERT - IMENonconvert = VK_NONCONVERT - IMEAccept = VK_ACCEPT - IMEModeChange = VK_MODECHANGE - Space = VK_SPACE - Prior = VK_PRIOR - PageUp = VK_PRIOR - PageDown = VK_NEXT - Next_ = VK_NEXT - End_ = VK_END - Home = VK_HOME - Left = VK_LEFT - Up = VK_UP - Right = VK_RIGHT - Down = VK_DOWN - Select_ = VK_SELECT - Print = VK_PRINT - Execute = VK_EXECUTE - Snapshot = VK_SNAPSHOT - Insert = VK_INSERT - Delete_ = VK_DELETE - Help = VK_HELP - D0 = &h30 - D1 = &h31 - D2 = &h32 - D3 = &h33 - D4 = &h34 - D5 = &h35 - D6 = &h36 - D7 = &h37 - D8 = &h38 - D9 = &h39 - A = &h41 - B = &h42 - C = &h43 - D = &h44 - E = &h45 - F = &h46 - G = &h47 - H = &h48 - I = &h49 - J = &h4a - K = &h4b - L = &h4c - M = &h4d - N = &h4e - O = &h4f - P = &h50 - Q = &h51 - R = &h52 - S = &h53 - T = &h54 - U = &h55 - V = &h56 - W = &h57 - X = &h58 - Y = &h59 - Z = &h5A - LWin = VK_LWIN - RWin = VK_RWIN - Apps = VK_APPS - Sleep = VK_SLEEP - NumPad0 = VK_NUMPAD0 - NumPad1 = VK_NUMPAD1 - NumPad2 = VK_NUMPAD2 - NumPad3 = VK_NUMPAD3 - NumPad4 = VK_NUMPAD4 - NumPad5 = VK_NUMPAD5 - NumPad6 = VK_NUMPAD6 - NumPad7 = VK_NUMPAD7 - NumPad8 = VK_NUMPAD8 - NumPad9 = VK_NUMPAD9 - Multiply = VK_MULTIPLY - Add = VK_ADD - Separator = VK_SEPARATOR - Substract = VK_SUBTRACT - Decimal = VK_DECIMAL - Divide = VK_DIVIDE - F1 = VK_F1 - F2 = VK_F2 - F3 = VK_F3 - F4 = VK_F4 - F5 = VK_F5 - F6 = VK_F6 - F7 = VK_F7 - F8 = VK_F8 - F9 = VK_F9 - F10 = VK_F10 - F11 = VK_F11 - F12 = VK_F12 - F13 = VK_F13 - F14 = VK_F14 - F15 = VK_F15 - F16 = VK_F16 - F17 = VK_F17 - F18 = VK_F18 - F19 = VK_F19 - F20 = VK_F20 - F21 = VK_F21 - F22 = VK_F22 - F23 = VK_F23 - F24 = VK_F24 - NumLock = VK_NUMLOCK - Scroll = VK_SCROLL - LShiftKey = VK_LSHIFT - RShiftKey = VK_RSHIFT - LControlKey = VK_LCONTROL - RControlKey = VK_RCONTROL - LMenu = VK_LMENU - RMenu = VK_RMENU - BrowserBack = VK_BROWSER_BACK - BrowserForward = VK_BROWSER_FORWARD - BrowserRefresh = VK_BROWSER_REFRESH - BrowserStop = VK_BROWSER_STOP - BrowserSearch = VK_BROWSER_SEARCH - BrowserFavorites = VK_BROWSER_FAVORITES - BrowserHome = VK_BROWSER_HOME - VolumeMute = VK_VOLUME_MUTE - VolumeDown = VK_VOLUME_DOWN - VolumeUp = VK_VOLUME_UP - MediaNextTrack = VK_MEDIA_NEXT_TRACK - MediaPreviousTrack = VK_MEDIA_PREV_TRACK - MediaStop = VK_MEDIA_STOP - MediaPlayPause = VK_MEDIA_PLAY_PAUSE - LaunchMail = VK_LAUNCH_MAIL - SelectMedia = VK_LAUNCH_MEDIA_SELECT - LaunchApplication1 = VK_LAUNCH_APP1 - LaunchApplication2 = VK_LAUNCH_APP2 - Oem1 = VK_OEM_1 - Oemplus = VK_OEM_PLUS - Oemcomma = VK_OEM_COMMA - OemMinus = VK_OEM_MINUS - OemPeriod = VK_OEM_PERIOD - Oem2 = VK_OEM_2 - OemQuestion = VK_OEM_2 - Oem3 = VK_OEM_3 - Oemtilde = VK_OEM_3 - Oem4 = VK_OEM_4 - OemOpenBrackets = VK_OEM_4 - Oem5 = VK_OEM_5 - OemPipe = VK_OEM_5 - Oem6 = VK_OEM_6 - OemCloseBrackets = VK_OEM_6 - Oem7 = VK_OEM_7 - OemQuotes = VK_OEM_7 - Oem8 = VK_OEM_8 - Oem102 = VK_OEM_102 - OemBackslash = VK_OEM_102 - ProcessKey = VK_PROCESSKEY - Packet = VK_PACKET - Attn = VK_ATTN - Crsel = VK_CRSEL - Exsel = VK_EXSEL - EraseEof = VK_EREOF - Play = VK_PLAY - NoName = VK_NONAME - Zoom = VK_ZOOM - Pa1 = VK_PA1 - OemClear = VK_OEM_CLEAR - - KeyCode = &hffff - - Shift = &h10000 - Control = &h20000 - Alt = &h40000 - - Modifiers = &hffff -End Enum - -Class KeyEventArgs - Inherits EventArgs -Public - Sub KeyEventArgs(keyData As Keys) - key = keyData - End Sub - - Function Alt() As Boolean - Alt = key And Keys.Menu - End Function - - Function Control() As Boolean - Control = key And Keys.Control - End Function - - Function Shift() As Boolean - Shift = key And Keys.Shift - End Function - - Function KeyCode() As Keys - Dim k = key As DWord - Dim mask = Keys.KeyCode As DWord - KeyCode = (k And mask) As Keys - End Function - - Function KeyData() As Keys - KeyData = key - End Function - - Function Modifiers() As Keys - Dim k = key As DWord - Dim mask = Keys.Modifiers As DWord - Modifiers = (k And mask) As Keys - End Function - - Function KeyValue() As Long - KeyValue = key As Long - End Function - - Sub Handled(handled As Boolean) - h = handled - End Sub - - Function Handled() As Boolean - Handled = h - End Function - -Private - key As Keys - h As Boolean -End Class - -Delegate Sub KeyEventHandler(sender As Object, e As KeyEventArgs) - -Class CreateEventArgs - Inherits EventArgs -Public - Sub CreateEventArgs(pCreateStruct As *CREATESTRUCT) - pcs = pCreateStruct - End Sub - - Const Function HInstance() As HINSTANCE - HInstance = pcs->hInstance - End Function - - 'Menu: pcs->hMenu - - Const Function Parent() As Control - 'Parent = Control.FromHandle(pcs->hwndParent) - End Function - - Const Function Height() As Long - Height = pcs->cy - End Function - - Const Function Width() As Long - Width = pcs->cx - End Function - - Const Function Y() As Long - Y = pcs->cy - End Function - - Const Function X() As Long - X = pcs->cx - End Function - - Const Function Style() As DWord - Style = pcs->style As DWord - End Function - - Const Function Caption() As String - Caption = New String(pcs->lpszName) - End Function - - Const Function ClassName() As String - ClassName = New String(pcs->lpszClass) - End Function - - Const Function ExStyle() As DWord - ExStyle = pcs->dwExStyle - End Function - - Const Function CreateStruct() As *CREATESTRUCT - CreateStruct = pcs - End Function -Private - pcs As *CREATESTRUCT -End Class - -Delegate Sub CreateEventHandler(sender As Object, e As CreateEventArgs) - -Class FormClosingEventArgs - Inherits EventArgs -Public - Sub FormClosingEventArgs() - c = False - End Sub - - Function Cancel() As Boolean - Cancel = c - End Function - - Sub Cancel(cancel As Boolean) - c = cancel - End Sub -Private - c As Boolean -End Class - -Delegate Sub FormClosingEventHandler(sender As Object, e As FormClosingEventArgs) - -End Namespace 'Forms -End Namespace 'UI -End Namespace 'Widnows -End Namespace 'ActiveBasic Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/MakeControlEventHandler.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/MakeControlEventHandler.ab (revision 544) +++ (revision ) @@ -1,80 +1,0 @@ -/* -注意：インクルードファイルではありません。 -イベント処理の実装コード生成プログラム。 -*/ - -Imports System -Imports System.IO -Imports System.Text -Imports ActiveBasic -Imports ActiveBasic.CType - -Function EventNameToMemberVariableName(eventName As String) As String - '先頭1字を小文字化 - Dim t = New StringBuilder(eventName) - t[0] = ToLower(t[0]) - Return t.ToString -End Function - -Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String) - Dim eventMember = EventNameToMemberVariableName(eventName) - Dim handlerType = argBase & "Handler" - Dim argsType = argBase & "Args" - out.WriteLine("Public") -' out.WriteLine(Ex"\t/*!") -' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する") -' out.WriteLine(Ex"\t*/") - out.WriteLine(Ex"\tSub Add" & eventName & "(h As " & handlerType & ")") - out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then") - out.WriteLine(Ex"\t\t\t" & eventMember & " = h") - out.WriteLine(Ex"\t\tElse") - out.WriteLine(Ex"\t\t\t" & eventMember & " += h") - out.WriteLine(Ex"\t\tEnd If") - out.WriteLine(Ex"\tEnd Sub") -' out.WriteLine(Ex"\t/*!") -' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する") -' out.WriteLine(Ex"\t*/") - out.WriteLine(Ex"\tSub Remove" & eventName & "(h As " & handlerType & ")") - out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") - out.WriteLine(Ex"\t\t\t" & eventMember & " -= h") - out.WriteLine(Ex"\t\tEnd If") - out.WriteLine(Ex"\tEnd Sub") - out.WriteLine("Private") -' out.WriteLine(Ex"\t/*!") -' out.WriteLine(Ex"\t@brief " & comment) -' out.WriteLine(Ex"\t*/") - out.WriteLine(Ex"\tSub On" & eventName & "(e As " & argsType & ")") - out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") - out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)") - out.WriteLine(Ex"\t\tEnd If") - out.WriteLine(Ex"\tEnd Sub") - out.WriteLine("Private") - out.WriteLine(Ex"\t" & eventMember & " As " & handlerType) - out.WriteLine() -End Sub - -'OutputEventHandlerCode("PaintDC", "PaintDCEventHandler", -' "ウィンドウの描画が必要なときに呼び出されます。") - -Sub MakeControlEvent(t As String) - Dim event As String, handler As String, comment As String - Dim n As DWord, i As DWord - /*Using*/ Dim in = New StreamReader(t + "EventList.txt") - /*Using*/ Dim out = New StreamWriter(t + "Event.sbp") - Do - Dim s = in.ReadLine - If IsNothing(s) Then - Exit Do - End If - If s[0] = Asc("'") Then Continue - Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab - If a.Count >= 3 Then - OutputEventHandlerCode(out, a[0], a[1], a[2]) - End If - Loop - in.Close() 'End Using - out.Close() 'End Using -End Sub - -MakeControlEvent("Control") -End Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/MakeControlEventHandler.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/MakeControlEventHandler.ab (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/MakeControlEventHandler.ab (revision 545) @@ -0,0 +1,81 @@ +/* +注意：インクルードファイルではありません。 +イベント処理の実装コード生成プログラム。 +*/ + +Imports System +Imports System.IO +Imports System.Text +Imports ActiveBasic +Imports ActiveBasic.CType + +Function EventNameToMemberVariableName(eventName As String) As String + '先頭1字を小文字化 + Dim t = New StringBuilder(eventName) + t[0] = ToLower(t[0]) + Return t.ToString +End Function + +Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String) + Dim eventMember = EventNameToMemberVariableName(eventName) + Dim handlerType = argBase & "Handler" + Dim argsType = argBase & "Args" + out.WriteLine("Public") +' out.WriteLine(Ex"\t/*!") +' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する") +' out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tSub Add" & eventName & "(h As " & handlerType & ")") + out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & " = h") + out.WriteLine(Ex"\t\tElse") + out.WriteLine(Ex"\t\t\t" & eventMember & " += h") + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\tEnd Sub") +' out.WriteLine(Ex"\t/*!") +' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する") +' out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tSub Remove" & eventName & "(h As " & handlerType & ")") + out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & " -= h") + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\tEnd Sub") + out.WriteLine("Private") +' out.WriteLine(Ex"\t/*!") +' out.WriteLine(Ex"\t@brief " & comment) +' out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tSub On" & eventName & "(e As " & argsType & ")") + out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)") + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\tEnd Sub") + out.WriteLine("Private") + out.WriteLine(Ex"\t" & eventMember & " As " & handlerType) + out.WriteLine() +End Sub + +'OutputEventHandlerCode("PaintDC", "PaintDCEventHandler", +' "ウィンドウの描画が必要なときに呼び出されます。") + +Sub MakeControlEvent(t As String) + Dim event As String, handler As String, comment As String + Dim n As DWord, i As DWord + /*Using*/ Dim in = New StreamReader(t + "EventList.txt") + /*Using*/ Dim out = New StreamWriter(t + "Event.sbp") + Do + Dim s = in.ReadLine + If IsNothing(s) Then + Exit Do + End If + If s[0] = Asc("'") Then Continue + Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab + If a.Count >= 3 Then + OutputEventHandlerCode(out, a[0], a[1], a[2]) + End If + Loop + in.Close() 'End Using + out.Close() 'End Using +End Sub + +MakeControlEvent("Control") +MakeControlEvent("Form") +End Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.sbp =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.sbp (revision 545) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.sbp (revision 545) @@ -0,0 +1,802 @@ +'Classes/ActiveBasic/Windows/UI/WindowHandle.sbp + +#ifdef _WIN64 +Declare Function _System_GetClassLongPtr Lib "user32" Alias _FuncName_GetClassLongPtr (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetClassLongPtr Lib "user32" Alias _FuncName_SetClassLongPtr (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +Declare Function _System_GetWindowLongPtr Lib "user32" Alias _FuncName_GetWindowLongPtr (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetWindowLongPtr Lib "user32" Alias _FuncName_SetWindowLongPtr (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +#else +Declare Function _System_GetClassLongPtr Lib "user32" Alias _FuncName_GetClassLong (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetClassLongPtr Lib "user32" Alias _FuncName_SetClassLong (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +Declare Function _System_GetWindowLongPtr Lib "user32" Alias _FuncName_GetWindowLong (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetWindowLongPtr Lib "user32" Alias _FuncName_SetWindowLong (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +#endif +Declare Function _System_GetParent Lib "user32" Alias "GetParent" (hWnd As HWND) As HWND +Declare Function _System_SetParent Lib "user32" Alias "SetParent" (hWnd As HWND, hwndParent As HWND) As HWND +Declare Function _System_GetMenu Lib "user32" Alias "GetMenu" (hWnd As HWND) As HMENU +Declare Function _System_SetMenu Lib "user32" Alias "SetMenu" (hWnd As HWND, hmenu As HMENU) As HMENU +Declare Function _System_InvalidateRect Lib "user32" Alias "InvalidateRect" (hWnd As HWND, ByRef Rect As RECT, bErase As BOOL) As BOOL +Declare Function _System_InvalidateRgn Lib "user32" Alias "InvalidateRgn" (hWnd As HWND, hRgn As HRGN, bErase As BOOL) As BOOL +Declare Function _System_ValidateRect Lib "user32" Alias "ValidateRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL +Declare Function _System_ValidateRgn Lib "user32" Alias "ValidateRgn" (hWnd As HWND, hRgn As HRGN) As BOOL +Declare Function _System_BeginPaint Lib "user32" Alias "BeginPaint" (hWnd As HWND, ByRef ps As PAINTSTRUCT) As HDC +Declare Function _System_EndPaint Lib "user32" Alias "EndPaint" (hWnd As HWND, ByRef ps As PAINTSTRUCT) As HDC +Declare Function _System_ClientToScreen Lib "user32" Alias "ClientToScreen" (hWnd As HWND, ByRef Point As POINTAPI) As BOOL +Declare Function _System_ScreenToClient Lib "user32" Alias "ScreenToClient" (hWnd As HWND, ByRef Point As POINTAPI) As BOOL +Declare Function _System_CreateCaret Lib "user32" Alias "CreateCaret" (hWnd As HWND, hBitmap As HBITMAP, nWidth As Long, nHeight As Long) As BOOL +Declare Function _System_HideCaret Lib "user32" Alias "HideCaret" (hWnd As HWND) As BOOL +Declare Function _System_ShowCaret Lib "user32" Alias "ShowCaret" (hWnd As HWND) As BOOL +Declare Function _System_DrawMenuBar Lib "user32" Alias "DrawMenuBar" (hwnd As HWND) As BOOL +Declare Function _System_GetWindowRect Lib "user32" Alias "DrawMenuBar" (hWnd As HWND, ByRef Rect As RECT) As BOOL +Declare Function _System_IsWindow Lib "user32" Alias "IsWindow" (hWnd As HWND) As BOOL +Declare Function _System_IsIconic Lib "user32" Alias "IsIconic" (hWnd As HWND) As BOOL +Declare Function _System_GetClientRect Lib "user32" Alias "GetClientRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL +Declare Function _System_GetProp Lib "user32" Alias _FuncName_GetProp (hWnd As HWND, pString As PCTSTR) As HANDLE +Declare Function _System_SetProp Lib "user32" Alias _FuncName_SetProp (hWnd As HWND, pString As PCTSTR, hData As HANDLE) As BOOL +Declare Function _System_GetClassName Lib "user32" Alias _FuncName_GetClassName (hWnd As HWND, lpClassName As PTSTR, nMaxCount As Long) As Long +Declare Function _System_GetScrollInfo Lib "user32" Alias "GetScrollInfo" (hWnd As HWND, fnBar As Long, ByRef lpsi As SCROLLINFO) As BOOL +Declare Function _System_SetScrollInfo Lib "user32" Alias "SetScrollInfo" (hWnd As HWND, fnBar As Long, ByRef lpsi As SCROLLINFO, bRedraw As Long) As BOOL +Declare Function _System_GetSystemMenu Lib "user32" Alias "GetSystemMenu" (hWnd As HWND, bRevert As BOOL) As HMENU +Declare Function _System_GetDC Lib "user32" Alias "GetDC" (hwnd As HWND) As HDC +Declare Function _System_GetDCEx Lib "user32" Alias "GetDCEx" (hwnd As HWND, hrgnClip As HRGN, flags As DWord) As HDC +Declare Function _System_GetWindowDC Lib "user32" Alias "GetWindowDC" (hwnd As HWND) As HDC +Declare Function _System_ReleaseDC Lib "user32" Alias "ReleaseDC" (hwnd As HWND, hdc As HDC) As BOOL +Declare Function _System_SendMessage Lib "user32" Alias _FuncName_SendMessage (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT +Declare Function _System_PostMessage Lib "user32" Alias _FuncName_PostMessage (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT +Declare Function _System_SendDlgItemMessage Lib "user32" Alias _FuncName_SendDlgItemMessage (hwnd As HWND, id As DWord, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT +Declare Function _System_GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (hwnd As HWND, pdwProcessId As *DWord) As DWord + +Namespace ActiveBasic +Namespace Windows +Namespace UI + +Class WindowHandle + hwnd As HWND +Public + Sub WindowHandle() + hwnd = 0 + End Sub + + Sub WindowHandle(hwndNew As HWND) + hwnd = hwndNew + End Sub + + Const Function HWnd() As HWND + Return hwnd + End Function + + Const Function Operator() As HWND + Return hwnd + End Function + + Function BringToTop() As Boolean + Return BringWindowToTop(hwnd) As Boolean + End Function + + Function BeginPaint(ByRef ps As PAINTSTRUCT) As HDC + Return _System_BeginPaint(hwnd, ps) + End Function +/* + Const Function ChildFromPoint(x As Long, y As Long) As WindowHandle + Return New WindowHandle(ChildWindowFromPoint(hwnd, x, y)) + End Function + + Const Function ChildFromPointEx(x As Long, y As Long, flags As DWord) As WindowHandle + Return New WindowHandle(ChildWindowFromPointEx(hwnd, x, y, flags)) + End Function +*/ + Const Function ClientToScreen(ByRef pt As POINTAPI) As Boolean + Return _System_ClientToScreen(hwnd, pt) As Boolean + End Function + + Const Function ClientToScreen(ByRef rc As RECT) As Boolean + Dim ppt = VarPtr(rc) As *POINTAPI + Return (_System_ClientToScreen(hwnd, ppt[0]) <> FALSE And _System_ClientToScreen(hwnd, ppt[1]) <> FALSE) As Boolean + End Function + + Function Close() As Boolean + Return CloseWindow(hwnd) As Boolean + End Function + + Function CreateCaret(hbmp As HBITMAP, width As Long, height As Long) As Boolean + Return _System_CreateCaret(hwnd, hbmp, width, height) As Boolean + End Function + + Function Destroy() As Boolean + Return DestroyWindow(hwnd) As Boolean + End Function + + Function DrawMenuBar() As Boolean + Return _System_DrawMenuBar(hwnd) As Boolean + End Function +/* + Function EnableScrollBar(SBFlags As DWord, arrows As DWord) As Boolean + Return EnableScrollBar(hwnd, SBFlags, arrows) As Boolean + End Function +*/ + Function Enable(enable As Boolean) As Boolean + Return EnableWindow(hwnd, enable) As Boolean + End Function + + Function EndPaint(ByRef ps As PAINTSTRUCT) As Boolean + Return _System_EndPaint(hwnd, ps) As Boolean + End Function + + Const Function EnumChilds(enumFunc As WNDENUMPROC, lp As LPARAM) As Boolean + Return EnumChildWindows(hwnd, enumFunc, lp) As Boolean + End Function + + Function Flash(invert As Boolean) As Boolean + Return FlashWindow(hwnd, invert) As Boolean + End Function + + Const Function GetClassLongPtr(index As Long) As LONG_PTR + Return _System_GetClassLongPtr(hwnd, index) + End Function + + Const Function GetClassName(className As PTSTR, maxCount As Long) As Long + Return _System_GetClassName(hwnd, className, maxCount) + End Function + + Const Function GetClientRect(ByRef rc As RECT) As Boolean + Return _System_GetClientRect(hwnd, rc) As Boolean + End Function +/* + Const Function GetContextHelpId() As DWord + Return GetWindowContextHelpId(hwnd) + End Function +*/ + Function GetDC() As HDC + Return _System_GetDC(hwnd) + End Function + + Function GetDCEx(hrgnClip As HRGN, flags As DWord) As HDC + Return _System_GetDCEx(hwnd, hrgnClip, flags) + End Function +/* + Const Function GetDlgCtrlID() As Long + Return GetDlgCtrlID(hwnd) + End Function + + Const Function GetDlgItem(idDlgItem As Long) As WindowHandle + Return GetDlgItem(hwnd, idDlgItem) + End Function + + Const Function GetDlgItemText(idDlgItem As Long, ps As PTSTR, maxCount As Long) As Long + Return GetDlgItemText(hwnd, idDlgItem, ps, maxCount) + End Function +*/ + Const Function GetMenu() As HMENU + Return _System_GetMenu(hwnd) + End Function +/* + Const Function GetParent() As WindowHandle + Return New WindowHandle(_System_GetParent(hwnd)) + End Function +*/ + Const Function GetProp(str As String) As HANDLE + Return _System_GetProp(hwnd, ToTCStr(str)) + End Function + + Const Function GetProp(psz As PCTSTR) As HANDLE + Return _System_GetProp(hwnd, psz) + End Function + + Const Function GetProp(atom As ATOM) As HANDLE + Return _System_GetProp(hwnd, atom As ULONG_PTR As PCTSTR) + End Function + + Const Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean + Return _System_GetScrollInfo(hwnd, fnBar, si) As Boolean + End Function +/* + Const Function GetSystemMenu(revert As Boolean) As HMENU + Return GetSystemMenu(hwnd, revert) + End Function + + Const Function GetUpdateRect(ByRef rc As RECT, erase As Boolean) As Boolean + Return GetUpdateRact(hwnd, rc, erase) As Boolean + End Function + + Const Function GetUpdateRgn(hrgn As HRGN, erase As Boolean) As Boolean + Return GetUpdateRgn(hwnd, hrgn, erase) As Boolean + End Function + + Const Function GetWindow(cmd As DWord) As WindowHandle + Return GetWindow(hwnd, cmd) + End Function +*/ + Function GetWindowDC() As HDC + Return _System_GetWindowDC(hwnd) + End Function + + Const Function GetWindowLongPtr(index As Long) As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, index) + End Function +/* + Const Function GetWindowPlasement(ByRef wndpl As WINDOWPLACEMENT) As Boolean + Return GetWindowPlasement(hwnd, wndpl) As Boolean + End Function +*/ + Const Function GetWindowRect(ByRef rc As RECT) As Boolean + Return _System_GetWindowRect(hwnd, rc) As Boolean + End Function + + Const Function GetText(ps As PTSTR, maxCount As Long) As Boolean + Return GetWindowText(hwnd, ps, maxCount) As Boolean + End Function + + Const Function GetTextLength() As Long + Return GetWindowTextLength(hwnd) + End Function + + Const Function GetWindowThreadId() As DWord + Return _System_GetWindowThreadProcessId(hwnd, 0) + End Function + + Const Function GetWindowThreadProcessId(ByRef processId As DWord) As DWord + Return _System_GetWindowThreadProcessId(hwnd, VarPtr(processId)) + End Function + + Function HideCaret() As Boolean + Return _System_HideCaret(hwnd) As Boolean + End Function + + Function InvalidateRect(ByRef rc As RECT, erace As Boolean) As Boolean + Return _System_InvalidateRect(hwnd, rc, erace) As Boolean + End Function + + Function InvalidateRect(ByRef rc As RECT) As Boolean + Return _System_InvalidateRect(hwnd, rc, TRUE) As Boolean + End Function + + Function InvalidateRgn(hrgn As HRGN, erace As Boolean) As Boolean + Return _System_InvalidateRgn(hwnd, hrgn, erace) As Boolean + End Function + + Function InvalidateRgn(hrgn As HRGN) As Boolean + Return _System_InvalidateRgn(hwnd, hrgn, TRUE) As Boolean + End Function + + Function Invalidate(erace As Boolean) As Boolean + Return _System_InvalidateRect(hwnd, ByVal 0, erace) As Boolean + End Function + + Function Invalidate() As Boolean + Return _System_InvalidateRect(hwnd, ByVal 0, TRUE) As Boolean + End Function +/* + Const Function IsChild(hwnd As HWND) As Boolean + Return IsChild(This.hwnd, hwnd) As Boolean + End Function + + Const Function IsDialogMessage(ByRef msg As MSG) As Boolean + Return IsDialogMessage(hwnd, msg) As Boolean + End Function +*/ + Const Function IsIconic() As Boolean + Return _System_IsIconic(hwnd) As Boolean + End Function + + Const Function IsWindow() As Boolean + Return _System_IsWindow(hwnd) As Boolean + End Function + + Const Function IsEnabled() As Boolean + Return IsWindowEnabled(hwnd) As Boolean + End Function + + Const Function IsUnicode() As Boolean + Return IsWindowUnicode(hwnd) As Boolean + End Function + + Const Function IsVisible() As Boolean + Return IsWindowVisible(hwnd) As Boolean + End Function +/* + Const Function IsZoomed() As Boolean + Return IsZoomed(hwnd) As Boolean + End Function + + Function KillTimer(idEvent As ULONG_PTR) As Boolean + Return KillTimer(idEvent) As Boolean + End Function +*/ + Function LockUpdate() As Boolean + Return LockWindowUpdate(hwnd) As Boolean + End Function +/* + Function MapPoints(hwndTo As HWND, pPoints As *POINTAPI, cPoints As DWord) As Long + Return MapWindowPoints(hwnd, hwndTo, pPoints, cPoints) + End Function + + Function MapPoints(hwndTo As HWND, ByRef rc As RECT) As Long + Return MapWindowPoints(hwnd, hwndTo, VarPtr(rc) As *POINTAPI, 2) + End Function + + Const Function MessageBox(text As PCTSTR, caption As PCTSTR, uType As DWord) As Long + Return MessageBox(hwnd, text, caption, uType) + End Function + + Const Function MessageBox(text As PCTSTR, caption As PCTSTR) As Long + Return MessageBox(hwnd, text, caption, MB_OK) + End Function + + Const Function MessageBox(text As PCTSTR) As Long + Return MessageBox(hwnd, text, 0, MB_OK) + End Function +*/ + Function Move(x As Long, y As Long, width As Long, height As Long, repaint As Boolean) As Boolean + Return MoveWindow(hwnd, x, y, width, height, repaint) As Boolean + End Function + + Function Move(x As Long, y As Long, width As Long, height As Long) As Boolean + Return MoveWindow(hwnd, x, y, width, height, TRUE) As Boolean + End Function + + Function Move(ByRef rc As RECT, repaint As Boolean) As Boolean + With rc + Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, repaint) As Boolean + End With + End Function + + Function Move(ByRef rc As RECT) As Boolean + With rc + Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, TRUE) As Boolean + End With + End Function +/* + Function OpenClipboard() As Boolean + Return OpenClipboard(hwnd) As Boolean + End Function + + Function OpenIcon() As Boolean + Return OpenIcon(hwnd) As Boolean + End Function +*/ + Function PostMessage(msg As DWord, wp As WPARAM, lp As LPARAM) As Boolean + Return _System_PostMessage(hwnd, msg, wp, lp) As Boolean + End Function + + Function PostMessage(msg As DWord) As Boolean + Return _System_PostMessage(hwnd, msg, 0, 0) As Boolean + End Function +/* + Function RedrawWindow(ByRef rcUpdate As RECT, hrgnUpdate As HRGN, flags As DWord) As Boolean + Return RedrawWindow(hwnd, rcUpdatre, hrgnUpdate, flags) As Boolean + End Function +*/ + Function ReleaseDC(hdc As HDC) As Boolean + Return _System_ReleaseDC(hwnd, hdc) As Boolean + End Function +/* + Function RemoveProp(str As String) As HANDLE + Return RemoveProp(hwnd, ToTCStr(str)) + End Function + + Function RemoveProp(psz As PCTSTR) As HANDLE + Return RemoveProp(hwnd, psz) + End Function + + Function RemoveProp(atom As ATOM) As HANDLE + Return RemoveProp(hwnd, atom As ULONG_PTR As PCTSTR) + End Function +*/ + Const Function ScreenToClient(ByRef pt As POINTAPI) As Boolean + Return _System_ScreenToClient(hwnd, pt) As Boolean + End Function + + Const Function ScreenToClient(ByRef rc As RECT) As Boolean + Dim ppt = VarPtr(rc) As *POINTAPI + Return (_System_ScreenToClient(hwnd, ppt[0]) <> FALSE And _System_ScreenToClient(hwnd, ppt[1]) <> FALSE) As Boolean + End Function + + Function Scroll(dx As Long, dy As Long, ByRef rcScroll As RECT, ByRef rcClip As RECT, hrgnUpdate As HRGN, ByRef rcUpdate As RECT, flags As DWord) As Boolean + Return ScrollWindowEx(hwnd, dx, dy, rcScroll, rcClip, hrgnUpdate, rcUpdate, flags) As Boolean + End Function + + Function SendDlgItemMessage(idDlgItem As Long, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Return _System_SendDlgItemMessage(hwnd, idDlgItem, msg, wp, lp) + End Function + + Function SendDlgItemMessage(idDlgItem As Long, msg As DWord) As LRESULT + Return _System_SendDlgItemMessage(hwnd, idDlgItem, msg, 0, 0) + End Function + + Function SendMessage(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Return _System_SendMessage(hwnd, msg, wp, lp) + End Function + + Function SendMessage(msg As DWord) As LRESULT + Return _System_SendMessage(hwnd, msg, 0, 0) + End Function +/* + Function SetActiveWindow() As WindowHandle + Return New WindowHandle(SetActiveWindow(hwnd)) + End Function + + Function SetDlgItemText(idDlgItem As Long, psz As PCTSTR) As Boolean + Return SetDlgItemText(hwnd, idDlgItem, psz) As Boolean + End Function + + Function SetCapture() As WindowHandle + Return New WindowHandle(SetCapture(hwnd)) + End Function +*/ + Function SetClassLongPtr(index As Long, newLong As LONG_PTR) As LONG_PTR + Return _System_SetClassLongPtr(hwnd, index, newLong) + End Function +/* + Function SetFocus() As WindowHandle + Return New WindowHandle(SetFocus(hwnd)) + End Function +*/ + Function SetForeground() As Boolean + Return SetForegroundWindow(hwnd) As Boolean + End Function + + Function SetMenu(hmenu As HMENU) As Boolean + Return _System_SetMenu(hwnd, hmenu) As Boolean + End Function + + Function SetParent(hwndNewParent As HWND) As WindowHandle + Return New WindowHandle(_System_SetParent(hwnd, hwndNewParent)) + End Function + + Function SetProp(str As String, hData As HANDLE) As Boolean + Return _System_SetProp(hwnd, ToTCStr(str), hData) As Boolean + End Function + + Function SetProp(psz As PCTSTR, hData As HANDLE) As Boolean + Return _System_SetProp(hwnd, psz, hData) As Boolean + End Function + + Function SetProp(atom As ATOM, hData As HANDLE) As Boolean + Return This.SetProp((atom As ULONG_PTR) As PCTSTR, hData) As Boolean + End Function + + Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO, redraw As Boolean) As Boolean + Return _System_SetScrollInfo(hwnd, fnBar, si, redraw) As Boolean + End Function + + Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean + Return _System_SetScrollInfo(hwnd, fnBar, si, TRUE) As Boolean + End Function +/* + Function SetTimer(idEvent As ULONG_PTR, elapse As DWord, timerFunc As TIMERPROC) As ULONG_PTR + Return SetTmer(hwnd, idEvent, elapse, timerFunc) + End Function + + Function SetTimer(idEvent As ULONG_PTR, elapse As DWord) As ULONG_PTR + Return This.SetTmer(hwnd, idEvent, elapse, 0) + End Function + + Function SetContextHelpId(contextHelpId As DWord) As Boolean + Return SetContextHelpId(hwnd, contextHelpId) As Boolean + End Function +*/ + Function SetWindowLongPtr(index As Long, newLong As LONG_PTR) As LONG_PTR + Return _System_SetWindowLongPtr(hwnd, index, newLong) + End Function +/* + Function SetWindowPlacement(ByRef wndpl As WINDOWPLACEMENT) As Boolean + Return SetWindowPlacement(hwnd, wndpl) As Boolean + End Function +*/ + Function SetPos(hwndInsertAfter As HWND, x As Long, y As Long, cx As Long, cy As Long, flags As DWord) As Boolean + Return SetWindowPos(hwnd, hwndInsertAfter, x, y, cx, cy, flags) As Boolean + End Function + + Function SetPos(hwndInsertAfter As HWND, ByRef rc As RECT, flags As DWord) As Boolean + With rc + Return SetWindowPos(hwnd, hwndInsertAfter, .left, .top, .right - .left, .bottom - .top, flags) As Boolean + End With + End Function + + Function SetRgn(hrgn As HRGN, redraw As Boolean) As Boolean + Return SetWindowRgn(hwnd, hrgn, redraw) As Boolean + End Function + + Function SetRgn(hrgn As HRGN) As Boolean + Return SetWindowRgn(hwnd, hrgn, TRUE) As Boolean + End Function + + Function SetText(psz As PCTSTR) As Boolean + Return SetWindowText(hwnd, psz) As Boolean + End Function + + Function SetText(str As String) As Boolean + Return SetWindowText(hwnd, ToTCStr(str)) As Boolean + End Function + + Function ShowCaret() As Boolean + Return _System_ShowCaret(hwnd) As Boolean + End Function +/* + Function ShowScrollBar(bar As DWord, show As Boolean) As Boolean + Return ShowScrollBar(hwnd, bar, show) As Boolean + End Function + + Function ShowScrollBar(bar As DWord) As Boolean + Return ShowScrollBar(hwnd, bar, TRUE) As Boolean + End Function +*/ + Function Show(cmdShow As DWord) As Boolean + Return ShowWindow(hwnd, cmdShow) As Boolean + End Function + + Function ShowAsync(cmdShow As DWord) As Boolean + Return ShowWindowAsync(hwnd, cmdShow) As Boolean + End Function + + Function Update() As Boolean + Return UpdateWindow(hwnd) As Boolean + End Function + + Function ValidateRect(ByRef rc As RECT) As Boolean + Return _System_ValidateRect(hwnd, rc) As Boolean + End Function + + Function ValidateRgn(hrgn As HRGN) As Boolean + Return _System_ValidateRgn(hwnd, hrgn) As Boolean + End Function + + Function Validate() As Boolean + Return _System_ValidateRect(hwnd, ByVal 0) As Boolean + End Function + + ' Get/SetWindowLongPtr Wrappers + + Const Function GetExStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord + End Function + + Const Function GetStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord + End Function +#ifdef _UNDEF + Const Function GetWndProc() As WNDPROC + Return _System_GetWindowLongPtr(hwnd, GWLP_WNDPROC) As WNDPROC + End Function +#endif + Const Function GetInstance() As HINSTANCE + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE + End Function + + Const Function GetUserData() As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) + End Function + + Function SetExStyle(style As DWord) As DWord + Return _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, style) As DWord + End Function + + Function SetStyle(style As DWord) As DWord + Return _System_SetWindowLongPtr(hwnd, GWL_STYLE, style) As DWord + End Function +#ifdef _UNDEF + Function SetWndProc(wndProc As WNDPROC) As WNDPROC + Return _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, wndProc As WNDPROC) As WNDPROC + End Function +#endif + Function SetUserData(value As LONG_PTR) As LONG_PTR + Return _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, value As LONG_PTR) + End Function + + ' Propaties + + Const Function ClientRect() As RECT + _System_GetClientRect(hwnd, ClientRect) + End Function +#ifdef _UNDEF + Sub ClientRect(ByRef rc As RECT) + Dim hasMenu As BOOL + If IsChild() = False And GetMenu() <> 0 Then + hasMenu = TRUE + Else + hasMenu = FALSE + End If + AdjustWindowRectEx(rc, GetStyle(), hasMenu, GetExStyle()) + This.Move(rc) ' WindowRect = rc + End Sub +#endif + Const Function WindowRect() As RECT + _System_GetWindowRect(hwnd, WindowRect) + End Function + + Sub WindowRect(ByRef rc As RECT) + This.Move(rc) + End Sub +#ifdef _UNDEF + Const Function ContextHelpID() As DWord + Return GetContextHelpId(hwnd) + End Function + + Sub ContextHelpID(newID As DWord) + _System_SetContextHelpId(hwnd, newId) + End Sub + + Const Function DlgCtrlID() As Long + Return GetDlgCtrlID(hwnd) + End Function + + Sub DlgCtrlId(newId As Long) + _System_SetWindowLongPtr(hwnd, GWLP_ID, newId) + End Sub + + Function DlgItem(idDlgItem As Long) As WindowHandle + Dim w As WindowHandle(GetDlgItem(hwnd, idDlgItem)) + Return w + End Function +#endif + Const Function ExStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord + End Function + + Sub ExStyle(newExStyle As DWord) + _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, newExStyle) + End Sub + + Const Function Style() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord + End Function + + Sub Style(newStyle As DWord) + _System_SetWindowLongPtr(hwnd, GWL_STYLE, newStyle) + End Sub + + Const Function Enabled() As Boolean + Return IsWindowEnabled(hwnd) As Boolean + End Function + + Sub Enabled(enable As Boolean) + EnableWindow(hwnd, enable) + End Sub + + Const Function Font() As HFONT + Return _System_SendMessage(hwnd, WM_GETFONT, 0, 0) As HFONT + End Function + + Sub Font(hfntNew As HFONT) + _System_SendMessage(hwnd, WM_SETFONT, hfntNew As WPARAM, TRUE) + End Sub + + Const Function Maximized() As Boolean + Return IsIconic() As Boolean + End Function + + Sub Maximized(maximized As Boolean) + If maximized <> False Then + ShowWindow(hwnd, SW_SHOWMAXIMIZED) + Else + ShowWindow(hwnd, SW_RESTORE) + End If + End Sub + + Const Function Minimized() As Boolean + Return _System_IsIconic(hwnd) As Boolean + End Function + + Sub Minimized(minimized As Boolean) + If minimized <> False Then + CloseWindow(hwnd) + Else + OpenIcon(hwnd) + End If + End Sub + + Const Function Instance() As HINSTANCE + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE + End Function + + ' IsWindow, IsUnicodeはメソッドと同じ。 + + Const Function Parent() As WindowHandle + Return New WindowHandle(_System_GetParent(hwnd)) + End Function + + Sub Parent(hwndNewParent As HWND) + _System_SetParent(hwnd, hwndNewParent) + End Sub + + Const Function ProcessId() As DWord + GetWindowThreadProcessId(ProcessId) + End Function + + Const Function ThreadId() As DWord + Return GetWindowThreadProcessId(ByVal 0) + End Function + + Const Function Menu() As HMENU + Return _System_GetMenu(hwnd) + End Function + + Sub Menu(hmenuNew As HMENU) + _System_SetMenu(hwnd, hmenuNew) + End Sub + + Const Function Prop(str As String) As HANDLE + Return GetProp(str) + End Function + + Const Function Prop(psz As PCTSTR) As HANDLE + Return GetProp(psz) + End Function + + Const Function Prop(atom As ATOM) As HANDLE + Return GetProp(atom) + End Function + + Sub Prop(str As PCTSTR, h As HANDLE) + SetProp(str, h) + End Sub + + Sub Prop(atom As ATOM, h As HANDLE) + SetProp(atom, h) + End Sub + + Const Function Text() As String + Dim size = GetWindowTextLength(hwnd) + 1 + Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR + Dim length = GetWindowText(hwnd, p, size) + Text = New String(p, length As Long) + End Function + + Sub Text(newText As String) + SetWindowText(hwnd, ToTCStr(newText)) + End Sub + + Sub Text(newText As PCTSTR) + SetWindowText(hwnd, newText) + End Sub + + Const Function TextLength() As Long + Return GetWindowTextLength(hwnd) + End Function +#ifdef _UNDEF + Const Function UserData() As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) + End Function + + Sub UserData(newValue As LONG_PTR) + _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, newValue) + End Sub +#endif + Const Function Visible() As Boolean + Return IsWindowVisible(hwnd) As Boolean + End Function + + Sub Visible(visible As Boolean) + If visible <> False Then + ShowWindow(hwnd, SW_SHOW) + Else + ShowWindow(hwnd, SW_HIDE) + EndIf + End Sub +#ifdef _UNDEF + Const Function WindowPlacement() As WINDOWPLACEMENT + WindowPlacement.length = Len(WindowPlacement) + GetWindowPlacement(hwnd, WindowPlacement) + End Function + + Sub WindowPlacement(ByRef wndpl As WINDOWPLACEMENT) + SetWindowPlacement(wndpl) + End Sub + + Const Function WndProc() As WNDPROC + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC + End Function + + Sub WndProc(newWndProc As WNDPROC) + _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, newWndProc As LONG_PTR) + End Sub +#endif +Protected + Sub SetHWnd(hwndNew As HWND) + hwnd = hwndNew + End Sub +End Class + +End Namespace 'UI +End Namespace 'Widnows +End Namespace 'ActiveBasic Index: unk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/WindowHandle.sbp =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/WindowHandle.sbp (revision 544) +++ (revision ) @@ -1,800 +1,0 @@ -'Classes/ActiveBasic/Windows/WindowHandle.sbp - -#ifdef _WIN64 -Declare Function _System_GetClassLongPtr Lib "user32" Alias _FuncName_GetClassLongPtr (hWnd As HWND, nIndex As Long) As LONG_PTR -Declare Function _System_SetClassLongPtr Lib "user32" Alias _FuncName_SetClassLongPtr (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR -Declare Function _System_GetWindowLongPtr Lib "user32" Alias _FuncName_GetWindowLongPtr (hWnd As HWND, nIndex As Long) As LONG_PTR -Declare Function _System_SetWindowLongPtr Lib "user32" Alias _FuncName_SetWindowLongPtr (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR -#else -Declare Function _System_GetClassLongPtr Lib "user32" Alias _FuncName_GetClassLong (hWnd As HWND, nIndex As Long) As LONG_PTR -Declare Function _System_SetClassLongPtr Lib "user32" Alias _FuncName_SetClassLong (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR -Declare Function _System_GetWindowLongPtr Lib "user32" Alias _FuncName_GetWindowLong (hWnd As HWND, nIndex As Long) As LONG_PTR -Declare Function _System_SetWindowLongPtr Lib "user32" Alias _FuncName_SetWindowLong (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR -#endif -Declare Function _System_GetParent Lib "user32" Alias "GetParent" (hWnd As HWND) As HWND -Declare Function _System_SetParent Lib "user32" Alias "SetParent" (hWnd As HWND, hwndParent As HWND) As HWND -Declare Function _System_GetMenu Lib "user32" Alias "GetMenu" (hWnd As HWND) As HMENU -Declare Function _System_SetMenu Lib "user32" Alias "SetMenu" (hWnd As HWND, hmenu As HMENU) As HMENU -Declare Function _System_InvalidateRect Lib "user32" Alias "InvalidateRect" (hWnd As HWND, ByRef Rect As RECT, bErase As BOOL) As BOOL -Declare Function _System_InvalidateRgn Lib "user32" Alias "InvalidateRgn" (hWnd As HWND, hRgn As HRGN, bErase As BOOL) As BOOL -Declare Function _System_ValidateRect Lib "user32" Alias "ValidateRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL -Declare Function _System_ValidateRgn Lib "user32" Alias "ValidateRgn" (hWnd As HWND, hRgn As HRGN) As BOOL -Declare Function _System_BeginPaint Lib "user32" Alias "BeginPaint" (hWnd As HWND, ByRef ps As PAINTSTRUCT) As HDC -Declare Function _System_EndPaint Lib "user32" Alias "EndPaint" (hWnd As HWND, ByRef ps As PAINTSTRUCT) As HDC -Declare Function _System_ClientToScreen Lib "user32" Alias "ClientToScreen" (hWnd As HWND, ByRef Point As POINTAPI) As BOOL -Declare Function _System_ScreenToClient Lib "user32" Alias "ScreenToClient" (hWnd As HWND, ByRef Point As POINTAPI) As BOOL -Declare Function _System_CreateCaret Lib "user32" Alias "CreateCaret" (hWnd As HWND, hBitmap As HBITMAP, nWidth As Long, nHeight As Long) As BOOL -Declare Function _System_HideCaret Lib "user32" Alias "HideCaret" (hWnd As HWND) As BOOL -Declare Function _System_ShowCaret Lib "user32" Alias "ShowCaret" (hWnd As HWND) As BOOL -Declare Function _System_DrawMenuBar Lib "user32" Alias "DrawMenuBar" (hwnd As HWND) As BOOL -Declare Function _System_GetWindowRect Lib "user32" Alias "DrawMenuBar" (hWnd As HWND, ByRef Rect As RECT) As BOOL -Declare Function _System_IsWindow Lib "user32" Alias "IsWindow" (hWnd As HWND) As BOOL -Declare Function _System_IsIconic Lib "user32" Alias "IsIconic" (hWnd As HWND) As BOOL -Declare Function _System_GetClientRect Lib "user32" Alias "GetClientRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL -Declare Function _System_GetProp Lib "user32" Alias _FuncName_GetProp (hWnd As HWND, pString As PCTSTR) As HANDLE -Declare Function _System_SetProp Lib "user32" Alias _FuncName_SetProp (hWnd As HWND, pString As PCTSTR, hData As HANDLE) As BOOL -Declare Function _System_GetClassName Lib "user32" Alias _FuncName_GetClassName (hWnd As HWND, lpClassName As PTSTR, nMaxCount As Long) As Long -Declare Function _System_GetScrollInfo Lib "user32" Alias "GetScrollInfo" (hWnd As HWND, fnBar As Long, ByRef lpsi As SCROLLINFO) As BOOL -Declare Function _System_SetScrollInfo Lib "user32" Alias "SetScrollInfo" (hWnd As HWND, fnBar As Long, ByRef lpsi As SCROLLINFO, bRedraw As Long) As BOOL -Declare Function _System_GetSystemMenu Lib "user32" Alias "GetSystemMenu" (hWnd As HWND, bRevert As BOOL) As HMENU -Declare Function _System_GetDC Lib "user32" Alias "GetDC" (hwnd As HWND) As HDC -Declare Function _System_GetDCEx Lib "user32" Alias "GetDCEx" (hwnd As HWND, hrgnClip As HRGN, flags As DWord) As HDC -Declare Function _System_GetWindowDC Lib "user32" Alias "GetWindowDC" (hwnd As HWND) As HDC -Declare Function _System_ReleaseDC Lib "user32" Alias "ReleaseDC" (hwnd As HWND, hdc As HDC) As BOOL -Declare Function _System_SendMessage Lib "user32" Alias _FuncName_SendMessage (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT -Declare Function _System_PostMessage Lib "user32" Alias _FuncName_PostMessage (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT -Declare Function _System_SendDlgItemMessage Lib "user32" Alias _FuncName_SendDlgItemMessage (hwnd As HWND, id As DWord, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT -Declare Function _System_GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (hwnd As HWND, pdwProcessId As *DWord) As DWord - -Namespace ActiveBasic -Namespace Windows - -Class WindowHandle - hwnd As HWND -Public - Sub WindowHandle() - hwnd = 0 - End Sub - - Sub WindowHandle(hwndNew As HWND) - hwnd = hwndNew - End Sub - - Const Function HWnd() As HWND - Return hwnd - End Function - - Const Function Operator() As HWND - Return hwnd - End Function - - Function BringToTop() As Boolean - Return BringWindowToTop(hwnd) As Boolean - End Function - - Function BeginPaint(ByRef ps As PAINTSTRUCT) As HDC - Return _System_BeginPaint(hwnd, ps) - End Function -/* - Const Function ChildFromPoint(x As Long, y As Long) As WindowHandle - Return New WindowHandle(ChildWindowFromPoint(hwnd, x, y)) - End Function - - Const Function ChildFromPointEx(x As Long, y As Long, flags As DWord) As WindowHandle - Return New WindowHandle(ChildWindowFromPointEx(hwnd, x, y, flags)) - End Function -*/ - Const Function ClientToScreen(ByRef pt As POINTAPI) As Boolean - Return _System_ClientToScreen(hwnd, pt) As Boolean - End Function - - Const Function ClientToScreen(ByRef rc As RECT) As Boolean - Dim ppt = VarPtr(rc) As *POINTAPI - Return (_System_ClientToScreen(hwnd, ppt[0]) <> FALSE And _System_ClientToScreen(hwnd, ppt[1]) <> FALSE) As Boolean - End Function - - Function Close() As Boolean - Return CloseWindow(hwnd) As Boolean - End Function - - Function CreateCaret(hbmp As HBITMAP, width As Long, height As Long) As Boolean - Return _System_CreateCaret(hwnd, hbmp, width, height) As Boolean - End Function - - Function Destroy() As Boolean - Return DestroyWindow(hwnd) As Boolean - End Function - - Function DrawMenuBar() As Boolean - Return _System_DrawMenuBar(hwnd) As Boolean - End Function -/* - Function EnableScrollBar(SBFlags As DWord, arrows As DWord) As Boolean - Return EnableScrollBar(hwnd, SBFlags, arrows) As Boolean - End Function -*/ - Function Enable(enable As Boolean) As Boolean - Return EnableWindow(hwnd, enable) As Boolean - End Function - - Function EndPaint(ByRef ps As PAINTSTRUCT) As Boolean - Return _System_EndPaint(hwnd, ps) As Boolean - End Function - - Const Function EnumChilds(enumFunc As WNDENUMPROC, lp As LPARAM) As Boolean - Return EnumChildWindows(hwnd, enumFunc, lp) As Boolean - End Function - - Function Flash(invert As Boolean) As Boolean - Return FlashWindow(hwnd, invert) As Boolean - End Function - - Const Function GetClassLongPtr(index As Long) As LONG_PTR - Return _System_GetClassLongPtr(hwnd, index) - End Function - - Const Function GetClassName(className As PTSTR, maxCount As Long) As Long - Return _System_GetClassName(hwnd, className, maxCount) - End Function - - Const Function GetClientRect(ByRef rc As RECT) As Boolean - Return _System_GetClientRect(hwnd, rc) As Boolean - End Function -/* - Const Function GetContextHelpId() As DWord - Return GetWindowContextHelpId(hwnd) - End Function -*/ - Function GetDC() As HDC - Return _System_GetDC(hwnd) - End Function - - Function GetDCEx(hrgnClip As HRGN, flags As DWord) As HDC - Return _System_GetDCEx(hwnd, hrgnClip, flags) - End Function -/* - Const Function GetDlgCtrlID() As Long - Return GetDlgCtrlID(hwnd) - End Function - - Const Function GetDlgItem(idDlgItem As Long) As WindowHandle - Return GetDlgItem(hwnd, idDlgItem) - End Function - - Const Function GetDlgItemText(idDlgItem As Long, ps As PTSTR, maxCount As Long) As Long - Return GetDlgItemText(hwnd, idDlgItem, ps, maxCount) - End Function -*/ - Const Function GetMenu() As HMENU - Return _System_GetMenu(hwnd) - End Function -/* - Const Function GetParent() As WindowHandle - Return New WindowHandle(_System_GetParent(hwnd)) - End Function -*/ - Const Function GetProp(str As String) As HANDLE - Return _System_GetProp(hwnd, ToTCStr(str)) - End Function - - Const Function GetProp(psz As PCTSTR) As HANDLE - Return _System_GetProp(hwnd, psz) - End Function - - Const Function GetProp(atom As ATOM) As HANDLE - Return _System_GetProp(hwnd, atom As ULONG_PTR As PCTSTR) - End Function - - Const Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean - Return _System_GetScrollInfo(hwnd, fnBar, si) As Boolean - End Function -/* - Const Function GetSystemMenu(revert As Boolean) As HMENU - Return GetSystemMenu(hwnd, revert) - End Function - - Const Function GetUpdateRect(ByRef rc As RECT, erase As Boolean) As Boolean - Return GetUpdateRact(hwnd, rc, erase) As Boolean - End Function - - Const Function GetUpdateRgn(hrgn As HRGN, erase As Boolean) As Boolean - Return GetUpdateRgn(hwnd, hrgn, erase) As Boolean - End Function - - Const Function GetWindow(cmd As DWord) As WindowHandle - Return GetWindow(hwnd, cmd) - End Function -*/ - Function GetWindowDC() As HDC - Return _System_GetWindowDC(hwnd) - End Function - - Const Function GetWindowLongPtr(index As Long) As LONG_PTR - Return _System_GetWindowLongPtr(hwnd, index) - End Function -/* - Const Function GetWindowPlasement(ByRef wndpl As WINDOWPLACEMENT) As Boolean - Return GetWindowPlasement(hwnd, wndpl) As Boolean - End Function -*/ - Const Function GetWindowRect(ByRef rc As RECT) As Boolean - Return _System_GetWindowRect(hwnd, rc) As Boolean - End Function - - Const Function GetText(ps As PTSTR, maxCount As Long) As Boolean - Return GetWindowText(hwnd, ps, maxCount) As Boolean - End Function - - Const Function GetTextLength() As Long - Return GetWindowTextLength(hwnd) - End Function - - Const Function GetWindowThreadId() As DWord - Return _System_GetWindowThreadProcessId(hwnd, 0) - End Function - - Const Function GetWindowThreadProcessId(ByRef processId As DWord) As DWord - Return _System_GetWindowThreadProcessId(hwnd, VarPtr(processId)) - End Function - - Function HideCaret() As Boolean - Return _System_HideCaret(hwnd) As Boolean - End Function - - Function InvalidateRect(ByRef rc As RECT, erace As Boolean) As Boolean - Return _System_InvalidateRect(hwnd, rc, erace) As Boolean - End Function - - Function InvalidateRect(ByRef rc As RECT) As Boolean - Return _System_InvalidateRect(hwnd, rc, TRUE) As Boolean - End Function - - Function InvalidateRgn(hrgn As HRGN, erace As Boolean) As Boolean - Return _System_InvalidateRgn(hwnd, hrgn, erace) As Boolean - End Function - - Function InvalidateRgn(hrgn As HRGN) As Boolean - Return _System_InvalidateRgn(hwnd, hrgn, TRUE) As Boolean - End Function - - Function Invalidate(erace As Boolean) As Boolean - Return _System_InvalidateRect(hwnd, ByVal 0, erace) As Boolean - End Function - - Function Invalidate() As Boolean - Return _System_InvalidateRect(hwnd, ByVal 0, TRUE) As Boolean - End Function -/* - Const Function IsChild(hwnd As HWND) As Boolean - Return IsChild(This.hwnd, hwnd) As Boolean - End Function - - Const Function IsDialogMessage(ByRef msg As MSG) As Boolean - Return IsDialogMessage(hwnd, msg) As Boolean - End Function -*/ - Const Function IsIconic() As Boolean - Return _System_IsIconic(hwnd) As Boolean - End Function - - Const Function IsWindow() As Boolean - Return _System_IsWindow(hwnd) As Boolean - End Function - - Const Function IsEnabled() As Boolean - Return IsWindowEnabled(hwnd) As Boolean - End Function - - Const Function IsUnicode() As Boolean - Return IsWindowUnicode(hwnd) As Boolean - End Function - - Const Function IsVisible() As Boolean - Return IsWindowVisible(hwnd) As Boolean - End Function -/* - Const Function IsZoomed() As Boolean - Return IsZoomed(hwnd) As Boolean - End Function - - Function KillTimer(idEvent As ULONG_PTR) As Boolean - Return KillTimer(idEvent) As Boolean - End Function -*/ - Function LockUpdate() As Boolean - Return LockWindowUpdate(hwnd) As Boolean - End Function -/* - Function MapPoints(hwndTo As HWND, pPoints As *POINTAPI, cPoints As DWord) As Long - Return MapWindowPoints(hwnd, hwndTo, pPoints, cPoints) - End Function - - Function MapPoints(hwndTo As HWND, ByRef rc As RECT) As Long - Return MapWindowPoints(hwnd, hwndTo, VarPtr(rc) As *POINTAPI, 2) - End Function - - Const Function MessageBox(text As PCTSTR, caption As PCTSTR, uType As DWord) As Long - Return MessageBox(hwnd, text, caption, uType) - End Function - - Const Function MessageBox(text As PCTSTR, caption As PCTSTR) As Long - Return MessageBox(hwnd, text, caption, MB_OK) - End Function - - Const Function MessageBox(text As PCTSTR) As Long - Return MessageBox(hwnd, text, 0, MB_OK) - End Function -*/ - Function Move(x As Long, y As Long, width As Long, height As Long, repaint As Boolean) As Boolean - Return MoveWindow(hwnd, x, y, width, height, repaint) As Boolean - End Function - - Function Move(x As Long, y As Long, width As Long, height As Long) As Boolean - Return MoveWindow(hwnd, x, y, width, height, TRUE) As Boolean - End Function - - Function Move(ByRef rc As RECT, repaint As Boolean) As Boolean - With rc - Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, repaint) As Boolean - End With - End Function - - Function Move(ByRef rc As RECT) As Boolean - With rc - Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, TRUE) As Boolean - End With - End Function -/* - Function OpenClipboard() As Boolean - Return OpenClipboard(hwnd) As Boolean - End Function - - Function OpenIcon() As Boolean - Return OpenIcon(hwnd) As Boolean - End Function -*/ - Function PostMessage(msg As DWord, wp As WPARAM, lp As LPARAM) As Boolean - Return _System_PostMessage(hwnd, msg, wp, lp) As Boolean - End Function - - Function PostMessage(msg As DWord) As Boolean - Return _System_PostMessage(hwnd, msg, 0, 0) As Boolean - End Function -/* - Function RedrawWindow(ByRef rcUpdate As RECT, hrgnUpdate As HRGN, flags As DWord) As Boolean - Return RedrawWindow(hwnd, rcUpdatre, hrgnUpdate, flags) As Boolean - End Function -*/ - Function ReleaseDC(hdc As HDC) As Boolean - Return _System_ReleaseDC(hwnd, hdc) As Boolean - End Function -/* - Function RemoveProp(str As String) As HANDLE - Return RemoveProp(hwnd, ToTCStr(str)) - End Function - - Function RemoveProp(psz As PCTSTR) As HANDLE - Return RemoveProp(hwnd, psz) - End Function - - Function RemoveProp(atom As ATOM) As HANDLE - Return RemoveProp(hwnd, atom As ULONG_PTR As PCTSTR) - End Function -*/ - Const Function ScreenToClient(ByRef pt As POINTAPI) As Boolean - Return _System_ScreenToClient(hwnd, pt) As Boolean - End Function - - Const Function ScreenToClient(ByRef rc As RECT) As Boolean - Dim ppt = VarPtr(rc) As *POINTAPI - Return (_System_ScreenToClient(hwnd, ppt[0]) <> FALSE And _System_ScreenToClient(hwnd, ppt[1]) <> FALSE) As Boolean - End Function - - Function Scroll(dx As Long, dy As Long, ByRef rcScroll As RECT, ByRef rcClip As RECT, hrgnUpdate As HRGN, ByRef rcUpdate As RECT, flags As DWord) As Boolean - Return ScrollWindowEx(hwnd, dx, dy, rcScroll, rcClip, hrgnUpdate, rcUpdate, flags) As Boolean - End Function - - Function SendDlgItemMessage(idDlgItem As Long, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - Return _System_SendDlgItemMessage(hwnd, idDlgItem, msg, wp, lp) - End Function - - Function SendDlgItemMessage(idDlgItem As Long, msg As DWord) As LRESULT - Return _System_SendDlgItemMessage(hwnd, idDlgItem, msg, 0, 0) - End Function - - Function SendMessage(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - Return _System_SendMessage(hwnd, msg, wp, lp) - End Function - - Function SendMessage(msg As DWord) As LRESULT - Return _System_SendMessage(hwnd, msg, 0, 0) - End Function -/* - Function SetActiveWindow() As WindowHandle - Return New WindowHandle(SetActiveWindow(hwnd)) - End Function - - Function SetDlgItemText(idDlgItem As Long, psz As PCTSTR) As Boolean - Return SetDlgItemText(hwnd, idDlgItem, psz) As Boolean - End Function - - Function SetCapture() As WindowHandle - Return New WindowHandle(SetCapture(hwnd)) - End Function -*/ - Function SetClassLongPtr(index As Long, newLong As LONG_PTR) As LONG_PTR - Return _System_SetClassLongPtr(hwnd, index, newLong) - End Function -/* - Function SetFocus() As WindowHandle - Return New WindowHandle(SetFocus(hwnd)) - End Function -*/ - Function SetForeground() As Boolean - Return SetForegroundWindow(hwnd) As Boolean - End Function - - Function SetMenu(hmenu As HMENU) As Boolean - Return _System_SetMenu(hwnd, hmenu) As Boolean - End Function - - Function SetParent(hwndNewParent As HWND) As WindowHandle - Return New WindowHandle(_System_SetParent(hwnd, hwndNewParent)) - End Function - - Function SetProp(str As String, hData As HANDLE) As Boolean - Return _System_SetProp(hwnd, ToTCStr(str), hData) As Boolean - End Function - - Function SetProp(psz As PCTSTR, hData As HANDLE) As Boolean - Return _System_SetProp(hwnd, psz, hData) As Boolean - End Function - - Function SetProp(atom As ATOM, hData As HANDLE) As Boolean - Return This.SetProp((atom As ULONG_PTR) As PCTSTR, hData) As Boolean - End Function - - Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO, redraw As Boolean) As Boolean - Return _System_SetScrollInfo(hwnd, fnBar, si, redraw) As Boolean - End Function - - Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean - Return _System_SetScrollInfo(hwnd, fnBar, si, TRUE) As Boolean - End Function -/* - Function SetTimer(idEvent As ULONG_PTR, elapse As DWord, timerFunc As TIMERPROC) As ULONG_PTR - Return SetTmer(hwnd, idEvent, elapse, timerFunc) - End Function - - Function SetTimer(idEvent As ULONG_PTR, elapse As DWord) As ULONG_PTR - Return This.SetTmer(hwnd, idEvent, elapse, 0) - End Function - - Function SetContextHelpId(contextHelpId As DWord) As Boolean - Return SetContextHelpId(hwnd, contextHelpId) As Boolean - End Function -*/ - Function SetWindowLongPtr(index As Long, newLong As LONG_PTR) As LONG_PTR - Return _System_SetWindowLongPtr(hwnd, index, newLong) - End Function -/* - Function SetWindowPlacement(ByRef wndpl As WINDOWPLACEMENT) As Boolean - Return SetWindowPlacement(hwnd, wndpl) As Boolean - End Function -*/ - Function SetPos(hwndInsertAfter As HWND, x As Long, y As Long, cx As Long, cy As Long, flags As DWord) As Boolean - Return SetWindowPos(hwnd, hwndInsertAfter, x, y, cx, cy, flags) As Boolean - End Function - - Function SetPos(hwndInsertAfter As HWND, ByRef rc As RECT, flags As DWord) As Boolean - With rc - Return SetWindowPos(hwnd, hwndInsertAfter, .left, .top, .right - .left, .bottom - .top, flags) As Boolean - End With - End Function - - Function SetRgn(hrgn As HRGN, redraw As Boolean) As Boolean - Return SetWindowRgn(hwnd, hrgn, redraw) As Boolean - End Function - - Function SetRgn(hrgn As HRGN) As Boolean - Return SetWindowRgn(hwnd, hrgn, TRUE) As Boolean - End Function - - Function SetText(psz As PCTSTR) As Boolean - Return SetWindowText(hwnd, psz) As Boolean - End Function - - Function SetText(str As String) As Boolean - Return SetWindowText(hwnd, ToTCStr(str)) As Boolean - End Function - - Function ShowCaret() As Boolean - Return _System_ShowCaret(hwnd) As Boolean - End Function -/* - Function ShowScrollBar(bar As DWord, show As Boolean) As Boolean - Return ShowScrollBar(hwnd, bar, show) As Boolean - End Function - - Function ShowScrollBar(bar As DWord) As Boolean - Return ShowScrollBar(hwnd, bar, TRUE) As Boolean - End Function -*/ - Function Show(cmdShow As DWord) As Boolean - Return ShowWindow(hwnd, cmdShow) As Boolean - End Function - - Function ShowAsync(cmdShow As DWord) As Boolean - Return ShowWindowAsync(hwnd, cmdShow) As Boolean - End Function - - Function Update() As Boolean - Return UpdateWindow(hwnd) As Boolean - End Function - - Function ValidateRect(ByRef rc As RECT) As Boolean - Return _System_ValidateRect(hwnd, rc) As Boolean - End Function - - Function ValidateRgn(hrgn As HRGN) As Boolean - Return _System_ValidateRgn(hwnd, hrgn) As Boolean - End Function - - Function Validate() As Boolean - Return _System_ValidateRect(hwnd, ByVal 0) As Boolean - End Function - - ' Get/SetWindowLongPtr Wrappers - - Const Function GetExStyle() As DWord - Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord - End Function - - Const Function GetStyle() As DWord - Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord - End Function -#ifdef _UNDEF - Const Function GetWndProc() As WNDPROC - Return _System_GetWindowLongPtr(hwnd, GWLP_WNDPROC) As WNDPROC - End Function -#endif - Const Function GetInstance() As HINSTANCE - Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE - End Function - - Const Function GetUserData() As LONG_PTR - Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) - End Function - - Function SetExStyle(style As DWord) As DWord - Return _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, style) As DWord - End Function - - Function SetStyle(style As DWord) As DWord - Return _System_SetWindowLongPtr(hwnd, GWL_STYLE, style) As DWord - End Function -#ifdef _UNDEF - Function SetWndProc(wndProc As WNDPROC) As WNDPROC - Return _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, wndProc As WNDPROC) As WNDPROC - End Function -#endif - Function SetUserData(value As LONG_PTR) As LONG_PTR - Return _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, value As LONG_PTR) - End Function - - ' Propaties - - Const Function ClientRect() As RECT - _System_GetClientRect(hwnd, ClientRect) - End Function -#ifdef _UNDEF - Sub ClientRect(ByRef rc As RECT) - Dim hasMenu As BOOL - If IsChild() = False And GetMenu() <> 0 Then - hasMenu = TRUE - Else - hasMenu = FALSE - End If - AdjustWindowRectEx(rc, GetStyle(), hasMenu, GetExStyle()) - This.Move(rc) ' WindowRect = rc - End Sub -#endif - Const Function WindowRect() As RECT - _System_GetWindowRect(hwnd, WindowRect) - End Function - - Sub WindowRect(ByRef rc As RECT) - This.Move(rc) - End Sub -#ifdef _UNDEF - Const Function ContextHelpID() As DWord - Return GetContextHelpId(hwnd) - End Function - - Sub ContextHelpID(newID As DWord) - _System_SetContextHelpId(hwnd, newId) - End Sub - - Const Function DlgCtrlID() As Long - Return GetDlgCtrlID(hwnd) - End Function - - Sub DlgCtrlId(newId As Long) - _System_SetWindowLongPtr(hwnd, GWLP_ID, newId) - End Sub - - Function DlgItem(idDlgItem As Long) As WindowHandle - Dim w As WindowHandle(GetDlgItem(hwnd, idDlgItem)) - Return w - End Function -#endif - Const Function ExStyle() As DWord - Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord - End Function - - Sub ExStyle(newExStyle As DWord) - _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, newExStyle) - End Sub - - Const Function Style() As DWord - Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord - End Function - - Sub Style(newStyle As DWord) - _System_SetWindowLongPtr(hwnd, GWL_STYLE, newStyle) - End Sub - - Const Function Enabled() As Boolean - Return IsWindowEnabled(hwnd) As Boolean - End Function - - Sub Enabled(enable As Boolean) - EnableWindow(hwnd, enable) - End Sub - - Const Function Font() As HFONT - Return _System_SendMessage(hwnd, WM_GETFONT, 0, 0) As HFONT - End Function - - Sub Font(hfntNew As HFONT) - _System_SendMessage(hwnd, WM_SETFONT, hfntNew As WPARAM, TRUE) - End Sub - - Const Function Maximized() As Boolean - Return IsIconic() As Boolean - End Function - - Sub Maximized(maximized As Boolean) - If maximized <> False Then - ShowWindow(hwnd, SW_SHOWMAXIMIZED) - Else - ShowWindow(hwnd, SW_RESTORE) - End If - End Sub - - Const Function Minimized() As Boolean - Return _System_IsIconic(hwnd) As Boolean - End Function - - Sub Minimized(minimized As Boolean) - If minimized <> False Then - CloseWindow(hwnd) - Else - OpenIcon(hwnd) - End If - End Sub - - Const Function Instance() As HINSTANCE - Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE - End Function - - ' IsWindow, IsUnicodeはメソッドと同じ。 - - Const Function Parent() As WindowHandle - Return New WindowHandle(_System_GetParent(hwnd)) - End Function - - Sub Parent(hwndNewParent As HWND) - _System_SetParent(hwnd, hwndNewParent) - End Sub - - Const Function ProcessId() As DWord - GetWindowThreadProcessId(ProcessId) - End Function - - Const Function ThreadId() As DWord - Return GetWindowThreadProcessId(ByVal 0) - End Function - - Const Function Menu() As HMENU - Return _System_GetMenu(hwnd) - End Function - - Sub Menu(hmenuNew As HMENU) - _System_SetMenu(hwnd, hmenuNew) - End Sub - - Const Function Prop(str As String) As HANDLE - Return GetProp(str) - End Function - - Const Function Prop(psz As PCTSTR) As HANDLE - Return GetProp(psz) - End Function - - Const Function Prop(atom As ATOM) As HANDLE - Return GetProp(atom) - End Function - - Sub Prop(str As PCTSTR, h As HANDLE) - SetProp(str, h) - End Sub - - Sub Prop(atom As ATOM, h As HANDLE) - SetProp(atom, h) - End Sub - - Const Function Text() As String - Dim size = GetWindowTextLength(hwnd) + 1 - Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR - Dim length = GetWindowText(hwnd, p, size) - Text = New String(p, length As Long) - End Function - - Sub Text(newText As String) - SetWindowText(hwnd, ToTCStr(newText)) - End Sub - - Sub Text(newText As PCTSTR) - SetWindowText(hwnd, newText) - End Sub - - Const Function TextLength() As Long - Return GetWindowTextLength(hwnd) - End Function -#ifdef _UNDEF - Const Function UserData() As LONG_PTR - Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) - End Function - - Sub UserData(newValue As LONG_PTR) - _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, newValue) - End Sub -#endif - Const Function Visible() As Boolean - Return IsWindowVisible(hwnd) As Boolean - End Function - - Sub Visible(visible As Boolean) - If visible <> False Then - ShowWindow(hwnd, SW_SHOW) - Else - ShowWindow(hwnd, SW_HIDE) - EndIf - End Sub -#ifdef _UNDEF - Const Function WindowPlacement() As WINDOWPLACEMENT - WindowPlacement.length = Len(WindowPlacement) - GetWindowPlacement(hwnd, WindowPlacement) - End Function - - Sub WindowPlacement(ByRef wndpl As WINDOWPLACEMENT) - SetWindowPlacement(wndpl) - End Sub - - Const Function WndProc() As WNDPROC - Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC - End Function - - Sub WndProc(newWndProc As WNDPROC) - _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, newWndProc As LONG_PTR) - End Sub -#endif -Protected - Sub SetHWnd(hwndNew As HWND) - hwnd = hwndNew - End Sub -End Class - -End Namespace 'Widnows -End Namespace 'ActiveBasic Index: /trunk/ab5.0/ablib/src/Classes/index.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/index.ab (revision 544) +++ /trunk/ab5.0/ablib/src/Classes/index.ab (revision 545) @@ -7,6 +7,6 @@ #require "./ActiveBasic/Strings/Strings.ab" #require "./ActiveBasic/Windows/CriticalSection.ab" -#require "./ActiveBasic/Windows/WindowHandle.sbp" #require "./ActiveBasic/Windows/Windows.ab" +#require "./ActiveBasic/Windows/UI/WindowHandle.sbp" #require "./ActiveBasic/Xml/Parser.ab" #require "./System/Blittable.ab" @@ -91,16 +91,4 @@ #require "./System/Threading/Timeout.ab" #require "./System/Threading/WaitHandle.ab" -#require "./System/Windows/Forms/Application.ab" -#require "./System/Windows/Forms/ContainerControl.ab" -#require "./System/Windows/Forms/Control.ab" -#require "./System/Windows/Forms/CreateParams.ab" -#require "./System/Windows/Forms/Form.ab" -#require "./System/Windows/Forms/Message.ab" -#require "./System/Windows/Forms/MessageBox.ab" -#require "./System/Windows/Forms/misc.ab" -#require "./System/Windows/Forms/PaintEventArgs.ab" -#require "./System/Windows/Forms/ScrollableControl.ab" -#require "./System/Windows/Forms/WebBrowser.ab" -#require "./System/Windows/Forms/WebBrowserBase.ab" #require "./System/Xml/XmlAttribute.ab" #require "./System/Xml/XmlCharacterData.ab"