source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.ab@ 646

'Classes/ActiveBasic/Windows/UI/WindowHandle.sbp

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 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_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_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_SendMessage Lib "user32" Alias "SendMessageA" (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
Declare Function _System_PostMessage Lib "user32" Alias "PostMessageA" (hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
Declare Function _System_SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (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
Private
    Sub ThrowIfFailedNT(ret As BOOL, msg As String)
        If ret = FALSE Then
            ThrowWithLastErrorNT(msg)
        End If
    End Sub
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
/*
    Static Function FromHWnd(hwnd As HWND) As WindowHandle
        FromHWnd = Control.FromHWnd(hwnd)
        If IsNothing(FromHWnd) Then
            FromHWnd = New WindowHandle(hwnd)
        End If
    End Function
*/
    Sub BringToTop()
        ThrowIfFailedNT(BringWindowToTop(hwnd), "WindowHandle.BringToTop")
    End Sub

'座標関係
    Const Function ClientToScreen(ByRef pt As POINTAPI) As POINTAPI
        ClientToScreen = pt
        ThrowIfFailedNT(_System_ClientToScreen(hwnd, ClientToScreen), "WindowHandle.ClientToScreen")
    End Function

    Const Function ClientToScreen(ByRef rc As RECT) As RECT
        ClientToScreen = rc
        Dim ppt = VarPtr(ClientToScreen) As *POINTAPI
        ThrowIfFailedNT(_System_ClientToScreen(hwnd, ppt[0]), "WindowHandle.ClientToScreen")
        ThrowIfFailedNT(_System_ClientToScreen(hwnd, ppt[1]), "WindowHandle.ClientToScreen")
    End Function

    Const Function ScreenToClient(ByRef pt As POINTAPI) As POINTAPI
        ScreenToClient = pt
        ThrowIfFailedNT(_System_ScreenToClient(hwnd, ScreenToClient), "WindowHandle.ScreenToClient")
    End Function

    Const Function ScreenToClient(ByRef rc As RECT) As RECT
        ScreenToClient = rc
        Dim ppt = VarPtr(ScreenToClient) As *POINTAPI
        ThrowIfFailedNT(_System_ScreenToClient(hwnd, ppt[0]), "WindowHandle.ClientToScreen")
        ThrowIfFailedNT(_System_ScreenToClient(hwnd, ppt[1]), "WindowHandle.ClientToScreen")
    End Function

    Sub Move(x As Long, y As Long, width As Long, height As Long, repaint = True As Boolean)
        ThrowIfFailedNT(MoveWindow(hwnd, x, y, width, height, repaint), "WindowHandle.Move")
    End Sub

    Sub Move(ByRef rc As RECT, repaint = True As Boolean)
        With rc
            Move(.left, .top, .right - .left, .bottom - .top, repaint)
        End With
    End Sub

    Sub SetPos(hwndInsertAfter As HWND, x As Long, y As Long, cx As Long, cy As Long, flags As DWord)
        ThrowIfFailedNT(SetWindowPos(hwnd, hwndInsertAfter, x, y, cx, cy, flags), "WindowHandle.SetPos")
    End Sub

    Sub SetPos(hwndInsertAfter As HWND, ByRef rc As RECT, flags As DWord)
        With rc
            SetPos(hwndInsertAfter, .left, .top, .right - .left, .bottom - .top, flags)
        End With
    End Sub

    Const Function ClientRect() As RECT
        ThrowIfFailedNT(GetClientRect(hwnd, ClientRect), "WindowHandle.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
        GetWindowRect(hwnd, WindowRect)
    End Function

    Sub WindowRect(ByRef rc As RECT)
        This.Move(rc)
    End Sub

    Const Function WindowPlacement() As WINDOWPLACEMENT
        WindowPlacement.length = Len(WindowPlacement)
        ThrowIfFailedNT(GetWindowPlacement(hwnd, WindowPlacement), "WindowHandle.WindowPlacement (get)")
    End Function

    Sub WindowPlacement(ByRef wndpl As WINDOWPLACEMENT)
        ThrowIfFailedNT(SetWindowPlacement(hwnd, wndpl), "WindowHandle.WindowPlacement (set)")
    End Sub

'キャレット
    Sub CreateCaret(hbmp As HBITMAP, width As Long, height As Long)
        ThrowIfFailedNT(_System_CreateCaret(hwnd, hbmp, width, height), "WindowHandle.CreateCaret")
    End Sub

    Sub HideCaret()
        ThrowIfFailedNT(_System_HideCaret(hwnd), "WindowHandle.HideCaret")
    End Sub

    Sub ShowCaret()
        ThrowIfFailedNT(_System_ShowCaret(hwnd), "WindowHandle.ShowCaret")
    End Sub
'全般
    Sub Destroy()
        DestroyWindow(hwnd)
    End Sub


    Const Function ProcessId() As DWord
        GetWindowThreadProcessId(ProcessId)
    End Function

    Const Function ThreadId() As DWord
        Return GetWindowThreadProcessId(ByVal 0)
    End Function

    Const Function Prop(str As String) As HANDLE
        Return GetProp(hwnd, ToTCStr(str))
    End Function

    Const Function Prop(psz As PCTSTR) As HANDLE
        Return GetProp(hwnd, psz)
    End Function

    Const Function Prop(atom As ATOM) As HANDLE
        Return GetProp(hwnd, atom As ULONG_PTR As PCTSTR)
    End Function

    Sub Prop(str As String, hData As HANDLE)
        SetProp(hwnd, ToTCStr(str), hData)
    End Sub

    Sub Prop(str As PCTSTR, h As HANDLE)
        SetProp(hwnd, str, h)
    End Sub

    Sub Prop(atom As ATOM, h As HANDLE)
        SetProp(hwnd, atom As ULONG_PTR As PCTSTR, h)
    End Sub

    Const Function Text() As String
        Dim size = GetWindowTextLength(hwnd) + 1
        Dim sb = New System.Text.StringBuilder(size)
        sb.Length = size
        Dim length = GetWindowText(hwnd, StrPtr(sb), size)
        sb.Length(length)
        Text = sb.ToString
    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

    Function Flash(invert As Boolean) As Boolean
        Return FlashWindow(hwnd, invert) As Boolean
    End Function
/*
    Const Function GetWindow(cmd As DWord) As WindowHandle
        Return GetWindow(hwnd, cmd)
    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 IsValid() As Boolean
        Return IsWindow(hwnd) As Boolean
    End Function

    Const Function IsUnicode() As Boolean
        Return IsWindowUnicode(hwnd) As Boolean
    End Function
/*
    Function KillTimer(idEvent As ULONG_PTR) As Boolean
        Return KillTimer(idEvent) 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 SetActiveWindow() As WindowHandle
        Return New WindowHandle(SetActiveWindow(hwnd))
    End Function

    Function SetCapture() As WindowHandle
        Return New WindowHandle(SetCapture(hwnd))
    End Function
 
    Function SetFocus() As WindowHandle
        Return New WindowHandle(SetFocus(hwnd))
    End Function
*/
    Function SetForeground() As Boolean
        Return SetForegroundWindow(hwnd) As Boolean
    End Function

    Const Function ContextHelpID() As DWord
        Return GetWindowContextHelpId(hwnd)
    End Function

    Sub ContextHelpID(newId As DWord)
        ThrowIfFailedNT(SetWindowContextHelpId(hwnd, newId), "WindowHandle.ContextHelpID")
    End Sub
'表示関係
    '呼出前に可視状態だったらTrue、そうでなければFalseが返る。
    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

    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

    Const Function Maximized() As Boolean
        Return IsZoomed(hwnd) As Boolean
    End Function

    Sub Maximized(maximized As Boolean)
        If maximized <> False Then
            Show(SW_SHOWMAXIMIZED)
        Else
            Show(SW_RESTORE)
        End If
    End Sub

    Const Function Minimized() As Boolean
        Return 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 Enable() As Boolean
        Return IsWindowEnabled(hwnd) As Boolean
    End Function

    Sub Enable(enable As Boolean)
        EnableWindow(hwnd, enable)
    End Sub

'メニュー
/*
    Sub DrawMenuBar()
        ThrowIfFailedNT(_System_DrawMenuBar(hwnd), "WindowHandle.DrawMenuBar")
    End Sub
    Const Function GetMenu() As HMENU
        Return _System_GetMenu(hwnd)
    End Function

    Sub SetMenu(hmenu As HMENU)
        ThrowIfFailedNT(_System_SetMenu(hwnd, hmenu), "WindowHandle.SetMenu")
    End Sub
*/
    Const Function GetWindowThreadProcessId(ByRef processId As DWord) As DWord
        Return _System_GetWindowThreadProcessId(hwnd, VarPtr(processId))
    End Function

'スクロールバー
/*
    Function EnableScrollBar(SBFlags As DWord, arrows As DWord) As Boolean
        Return EnableScrollBar(hwnd, SBFlags, arrows) As Boolean
    End Function

    Const Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean
        Return _System_GetScrollInfo(hwnd, fnBar, si) 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 Long
        Return ScrollWindowEx(hwnd, dx, dy, rcScroll, rcClip, hrgnUpdate, rcUpdate, flags)
    End Function

    Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO, redraw = True As Boolean) As Long
        Return _System_SetScrollInfo(hwnd, fnBar, si, redraw)
    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
*/
'子ウィンドウ
    Const Sub EnumChilds(enumFunc As WNDENUMPROC, lp As LPARAM)
        EnumChildWindows(hwnd, enumFunc, lp)
    End Sub
/*
    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
*/
'描画
    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

    Function GetWindowDC() As HDC
        Return _System_GetWindowDC(hwnd)
    End Function

    Sub Invalidate(ByRef rc As RECT, erace As Boolean)
        ThrowIfFailedNT(InvalidateRect(hwnd, rc, erace), "WindowHandle.Invalidate")
    End Sub

    Sub Invalidate(ByRef rc As RECT)
        ThrowIfFailedNT(InvalidateRect(hwnd, rc, TRUE), "WindowHandle.Invalidate")
    End Sub

    Sub Invalidate(hrgn As HRGN, erace As Boolean)
        'InvalidateRgnは常に非0を返すというMSDNライブラリの記述を信じる
        InvalidateRgn(hwnd, hrgn, erace)
    End Sub

    Sub Invalidate(hrgn As HRGN)
        InvalidateRgn(hwnd, hrgn, TRUE)
    End Sub

    Sub Invalidate(erace As Boolean)
        ThrowIfFailedNT(InvalidateRect(hwnd, ByVal 0, erace), "WindowHandle.Invalidate")
    End Sub

    Sub Invalidate()
        ThrowIfFailedNT(InvalidateRect(hwnd, ByVal 0, TRUE), "WindowHandle.Invalidate")
    End Sub

    Sub Validate(ByRef rc As RECT)
        ThrowIfFailedNT(ValidateRect(hwnd, rc), "WindowHandle.Validate")
    End Sub

    Sub Validate(hrgn As HRGN)
        ThrowIfFailedNT(ValidateRgn(hwnd, hrgn), "WindowHandle.Validate")
    End Sub

    Sub Validate()
        ThrowIfFailedNT(ValidateRect(hwnd, ByVal 0), "WindowHandle.Validate")
    End Sub

    Sub Update()
        ThrowIfFailedNT(UpdateWindow(hwnd), "WindowHandle.Update")
    End Sub

    Sub Redraw(ByRef rcUpdate As RECT, hrgnUpdate As HRGN, flags As DWord)
        ThrowIfFailedNT(RedrawWindow(hwnd, rcUpdate, hrgnUpdate, flags), "WindowHandle.Update")
    End Sub

    Sub ReleaseDC(hdc As HDC)
        ThrowIfFailedNT(_System_ReleaseDC(hwnd, hdc), "WindowHandle.ReleaseDC")
    End Sub

    Sub SetRgn(hrgn As HRGN, redraw = True As Boolean)
        ThrowIfFailedNT(SetWindowRgn(hwnd, hrgn, redraw), "WindowHandle.SetRgn")
    End Sub
'メッセージ
    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 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

'その他
    Const Function Id() As Long
        Return GetDlgCtrlID(hwnd)
    End Function

    Sub Id(newId As Long)
        SetWindowLongPtr(hwnd, GWLP_ID, newId)
    End Sub
/*
    Function DlgItem(idDlgItem As Long) As WindowHandle
        DlgItem = New WindowHandle(GetDlgItem(hwnd, idDlgItem))
    End Function
*/
    Const Function ExStyle() As DWord
        Return GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord
    End Function

    Sub ExStyle(newExStyle As DWord)
        SetWindowLongPtr(hwnd, GWL_EXSTYLE, newExStyle As LONG_PTR)
    End Sub

    Const Function Style() As DWord
        Return GetWindowLongPtr(hwnd, GWL_STYLE) As DWord
    End Function

    Sub Style(newStyle As DWord)
        SetWindowLongPtr(hwnd, GWL_STYLE, newStyle)
    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 Instance() As HINSTANCE
        Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE
    End Function

    Const Function Parent() As WindowHandle
        Return New WindowHandle(GetParent(hwnd))
    End Function

    Sub Parent(hwndNewParent As HWND)
        SetParent(hwnd, hwndNewParent)
    End Sub

    Const Function UserData() As LONG_PTR
        Return GetWindowLongPtr(hwnd, GWLP_USERDATA)
    End Function

    Sub UserData(newValue As LONG_PTR)
        SetWindowLongPtr(hwnd, GWLP_USERDATA, newValue)
    End Sub

#ifdef _UNDEF
    Const Function WndProc() As WNDPROC
        Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC
    End Function

    Sub WndProc(newWndProc As WNDPROC)
        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