tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板) [ツリー表示へ]   [Home]
一括表示(VB.NET VB2005)
タイトルGetWindowRectの値がおかしい
記事No11837
投稿日: 2017/05/17(Wed) 23:52
投稿者jikoryuu
GetWindowRectで親ウィンドウを取得するとフォームより大きめのサイズが返されてきます
コントロールではぴったりのサイズが返ってくるのですが親フォームだとフェード表現や影の領域まで
含めて返されるようです
Alt+PrtScでのキャプチャーではフォームの大きさピッタリに取得できているようです
解決策があればご教授下さい

このプログラム仕様はピクチャーボックスからドラッグすると他のアプリケーションのウィンドウハンドルを
取得しそのウィンドウ領域を取得してビットマップに描画しクリップボードにコピーするというものです

少し長いですがプログラムコードも載せておきます

環境はVB2015,Windows10です

Public Class frmControlCapture
    Private Declare Function SendMessage Lib "User32.dll" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Long
    Private Declare Sub ReleaseCapture Lib "User32.dll" ()
    Private Declare Function GetDesktopWindow Lib "user32.dll" () As IntPtr
    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2
    Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr
    Private Declare Function BitBlt Lib "gdi32.dll" (
     ByVal hDestDC As IntPtr,
     ByVal x As Int32,
     ByVal y As Int32,
     ByVal nWidth As Int32,
     ByVal nHeight As Int32,
     ByVal hSrcDC As IntPtr,
     ByVal xSrc As Int32,
     ByVal ySrc As Int32,
     ByVal dwRop As Int32) As Long
    Const SRCCOPY As Int32 = &HCC0020
    Private Declare Function ReleaseDC Lib "user32.dll" (
     ByVal hwnd As IntPtr,
     ByVal hdc As IntPtr) As IntPtr
    Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr
    Private hDesktopWnd As IntPtr
    Private hDesktopDC As IntPtr
    Private Structure POINTAPI
        Public x As Int32
        Public y As Int32
    End Structure
    Private Structure LOGPEN
        Public lopnStyle As Long
        Public lopnWidth As POINTAPI
        Public lopnColor As Long
    End Structure
    Private Structure RECT
        Public Left As Int32
        Public Top As Int32
        Public Right As Int32
        Public Bottom As Int32
    End Structure
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
    Private Declare Function LineTo Lib "gdi32.dll" (
     ByVal hdc As IntPtr,
     ByVal x As Int32,
     ByVal y As Int32) As Int32
    Private Declare Function MoveToEx Lib "gdi32.dll" (
     ByVal hdc As IntPtr,
     ByVal x As Int32,
     ByVal y As Int32,
     ByRef lpPoint As POINTAPI) As Int32
    Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function WindowFromPoint Lib "user32.dll" (
     ByVal xPoint As Int32,
     ByVal yPoint As Int32) As IntPtr
    Private pCursor As POINTAPI
    Private Declare Function InvertRect Lib "user32.dll" (
     ByVal hdc As IntPtr,
     ByRef lpRect As RECT) As Boolean
    Private hOldControl As IntPtr
    Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (
     ByVal lpDriverName As String,
     ByVal lpDeviceName As String,
     ByVal lpOutput As String,
     ByVal lpInitData As Int32) As IntPtr
    'ByRef lpInitData As DEVMODE) As IntPtr
    'Private Structure DEVMODE
    '    Public dmDeviceName As String '* CCHDEVICENAME
    '    Public dmSpecVersion As Int16
    '    Public dmDriverVersion As Int16
    '    Public dmSize As Int16
    '    Public dmDriverExtra As Int16
    '    Public dmFields As Int32
    '    Public dmOrientation As Int16
    '    Public dmPaperSize As Int16
    '    Public dmPaperLength As Int16
    '    Public dmPaperWidth As Int16
    '    Public dmScale As Int16
    '    Public dmCopies As Int16
    '    Public dmDefaultSource As Int16
    '    Public dmPrintQuality As Int16
    '    Public dmColor As Int16
    '    Public dmDuplex As Int16
    '    Public dmYResolution As Int16
    '    Public dmTTOption As Int16
    '    Public dmCollate As Int16
    '    Public dmFormName As String '* CCHFORMNAME
    '    Public dmUnusedPadding As Int16
    '    Public dmBitsPerPel As Int16
    '    Public dmPelsWidth As Int32
    '    Public dmPelsHeight As Int32
    '    Public dmDisplayFlags As Int32
    '    Public dmDisplayFrequency As Int32
    'End Structure
    Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As IntPtr
    Private Declare Function SelectObject Lib "gdi32.dll" (
     ByVal hdc As IntPtr,
     ByVal hObject As IntPtr) As IntPtr
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As IntPtr) As Boolean
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Boolean
    Private Declare Function SetClipboardData Lib "user32.dll" (
     ByVal wFormat As Int32,
     ByVal hMem As IntPtr) As IntPtr
    Private Declare Function CloseClipboard Lib "user32.dll" () As Boolean
    Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (
     ByVal hdc As IntPtr,
     ByVal nWidth As Int32,
     ByVal nHeight As Int32) As Int32
    Private Const CF_BITMAP As Long = 2
    Private Declare Function DeleteDC Lib "gdi32.dll" (
     ByVal hdc As IntPtr) As Boolean

    Private Sub frmControlCapture_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        If e.Button = MouseButtons.Left Then
            Call ReleaseCapture()
            Call SendMessage(Me.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
        End If
    End Sub

    Private Sub picControlCapture_MouseMove(sender As Object, e As MouseEventArgs) Handles picControlCapture.MouseMove
        Dim rDesktop As RECT
        Dim rDesktop2 As RECT
        Dim pAPI As POINTAPI
        Dim hControl As IntPtr
        If e.Button = MouseButtons.Left Then
            Call GetCursorPos(pAPI)
            hControl = WindowFromPoint(pAPI.x, pAPI.y)
            If (hOldControl <> hControl) Then
                If hOldControl <> 0 Then
                    GetWindowRect(hOldControl, rDesktop)
                    hDesktopWnd = GetDesktopWindow()
                    hDesktopDC = GetWindowDC(hDesktopWnd)
                    InvertRect(hDesktopDC, rDesktop)
                    rDesktop2.Top = rDesktop.Top + 5
                    rDesktop2.Left = rDesktop.Left + 5
                    rDesktop2.Bottom = rDesktop.Bottom - 5
                    rDesktop2.Right = rDesktop.Right - 5
                    InvertRect(hDesktopDC, rDesktop2)
                    Call ReleaseDC(hDesktopWnd, hDesktopDC)
                End If
                hOldControl = hControl
                GetWindowRect(hControl, rDesktop)
                hDesktopWnd = GetDesktopWindow()
                hDesktopDC = GetWindowDC(hDesktopWnd)
                InvertRect(hDesktopDC, rDesktop)
                rDesktop2.Top = rDesktop.Top + 5
                rDesktop2.Left = rDesktop.Left + 5
                rDesktop2.Bottom = rDesktop.Bottom - 5
                rDesktop2.Right = rDesktop.Right - 5
                InvertRect(hDesktopDC, rDesktop2)
                Call ReleaseDC(hDesktopWnd, hDesktopDC)
            End If
        End If
    End Sub

    Private Sub picControlCapture_MouseUp(sender As Object, e As MouseEventArgs) Handles picControlCapture.MouseUp
        Dim rDesktop As RECT
        Dim rDesktop2 As RECT
        Dim pAPI As POINTAPI
        Dim hControl As IntPtr
        Dim hControlDC As IntPtr
        hOldControl = 0
        If e.Button = MouseButtons.Left Then
            Call GetCursorPos(pAPI)
            hControl = WindowFromPoint(pAPI.x, pAPI.y)
            GetWindowRect(hControl, rDesktop)
            hDesktopWnd = GetDesktopWindow()
            hDesktopDC = GetWindowDC(hDesktopWnd)
            'hControlDC = GetDC(picGetControl.Handle)
            InvertRect(hDesktopDC, rDesktop)
            rDesktop2.Top = rDesktop.Top + 5
            rDesktop2.Left = rDesktop.Left + 5
            rDesktop2.Bottom = rDesktop.Bottom - 5
            rDesktop2.Right = rDesktop.Right - 5
            InvertRect(hDesktopDC, rDesktop2)

            Dim hdcScreen As IntPtr
            Dim hdc_mem_screen As IntPtr
            Dim hBitmap As IntPtr
            'Dim oDev As DEVMODE
            'On Error Resume Next
            hdcScreen = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
            hdc_mem_screen = CreateCompatibleDC(hdcScreen)
            hBitmap = CreateCompatibleBitmap(hdcScreen, rDesktop.Right - rDesktop.Left, rDesktop.Bottom - rDesktop.Top)
            Call SelectObject(hdc_mem_screen, hBitmap)
            Call BitBlt(hdc_mem_screen, 0&, 0&, rDesktop.Right - rDesktop.Left, rDesktop.Bottom - rDesktop.Top, hDesktopDC, rDesktop.Left, rDesktop.Top, SRCCOPY)
            If OpenClipboard(hDesktopWnd) = True Then
                Call EmptyClipboard()
                Call SetClipboardData(CF_BITMAP, hBitmap)
                Call CloseClipboard()
            End If
            Call DeleteDC(hdc_mem_screen)
            Call ReleaseDC(hDesktopWnd, hDesktopDC)
        End If

    End Sub

End Class

[ツリー表示へ]
タイトルRe: GetWindowRectの値がおかしい
記事No11838
投稿日: 2017/05/18(Thu) 23:03
投稿者Hongliang
hhttps://social.msdn.microsoft.com/Forums/vstudio/ja-JP/24a29e45-afde-448a-9958-d2fb2dfd4183/
DWMが有効になってると色々とあるようですね。
DWMが有効な場合はDwmGetWindowAttributeを使うと良いようです。

[ツリー表示へ]
タイトルRe^2: GetWindowRectの値がおかしい
記事No11839
投稿日: 2017/05/18(Thu) 23:29
投稿者jikoryuu
回答ありがとうございます

しかしこれどうやってVBに実装したらいいんですかね…

[ツリー表示へ]
タイトルRe^3: GetWindowRectの値がおかしい
記事No11840
投稿日: 2017/05/19(Fri) 00:31
投稿者jikoryuu
http://www.tek-tips.com/viewthread.cfm?qid=1518877

参考となるURL見つけました
これを実装してみたいと思います

[ツリー表示へ]
タイトルRe^4: GetWindowRectの値がおかしい
記事No11841
投稿日: 2017/05/19(Fri) 01:19
投稿者jikoryuu
    Private Enum DWMWINDOWATTRIBUTE
        DWMWA_NCRENDERING_ENABLED = 1
        DWMWA_NCRENDERING_POLICY
        DWMWA_TRANSITIONS_FORCEDISABLED
        DWMWA_ALLOW_NCPAINT
        DWMWA_CAPTION_BUTTON_BOUNDS
        DWMWA_NONCLIENT_RTL_LAYOUT
        DWMWA_FORCE_ICONIC_REPRESENTATION
        DWMWA_FLIP3D_POLICY
        DWMWA_EXTENDED_FRAME_BOUNDS
        DWMWA_LAST
    End Enum
    Private Declare Function DwmGetWindowAttribute Lib "dwmapi.dll" (
     ByVal hwnd As IntPtr,
     ByVal dwAttribute As DWMWINDOWATTRIBUTE,
     ByRef pvAttribute As RECT,
     ByVal cbAttribute As Int32) As Boolean

上記のように宣言して
下記のようにGetWindowRectの行を修正することで正しい値を得ることができました
(hControl,hOldControlの変更に注意)

    If DwmGetWindowAttribute(hControl, DWMWINDOWATTRIBUTE.DWMWA_EXTENDED_FRAME_BOUNDS,
         rDesktop, System.Runtime.InteropServices.Marshal.SizeOf(rDesktop)) = True Then
            GetWindowRect(hControl, rDesktop)
    End If

ただもう一つ問題が発生しました
自身のウィンドウのタイトルバーにドラッグすると反転表示がおかしくなってしまいます
これはまた時間を見て修正して行こうと思います

これで一応解決とさせて頂きます
Hongliangさん、ありがとうございました

[ツリー表示へ]