2023/09/05(Tue) 19:59:32 編集(投稿者)
2023/09/05(Tue) 19:59:28 編集(投稿者)

■No35510に返信(本体は眼鏡さんの記事)

親の子コントロールの処理がまずかったので修正しています。

いつか作ろうと思って作ってなかったんですが、いい機会なのでカスタムコントロールを作ってみました。
(1) 背景に親コントロールを描画
親コントロールは子コントロールを除いて描画する（でないと自分が描画されてしまい、ループする）
描画は WM_PRINTCLIENT メッセージを送ることで行っています。

(2) 親の子コントロールを描画
親の子コントロールは、その子も描画するので DrawToBitmap で良い

Option Strict On
Imports System.Runtime.InteropServices

Public Class TransparentPictureBox
    Inherits PictureBox

    Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
        MyBase.OnPaintBackground(pevent)
        If Parent IsNot Nothing Then
            DrawParent(pevent.Graphics, Parent)
            Dim ctls = Parent.Controls
            Dim i = ctls.Count - 1
            While i >= 0
                Dim ctrl As Control = ctls(i)
                If ctrl Is Me Then Exit While
                If ctrl.Visible Then
                    DrawSameHierarchy(pevent.Graphics, ctrl)
                End If
                i -= 1
            End While
        End If
    End Sub

    Private Sub DrawParent(g As Graphics, ctrl As Control)
        Dim mapRect = MapRectangle(Me, Me.ClientRectangle, ctrl)
        Dim rect = Rectangle.Intersect(ctrl.ClientRectangle, mapRect)
        If rect.Width > 0 AndAlso rect.Height > 0 Then
            Using bmp As New Bitmap(ctrl.Width, ctrl.Height,
                                    Imaging.PixelFormat.Format32bppRgb)
                Using bmpG = Graphics.FromImage(bmp)
                    Dim hdc = bmpG.GetHdc()
                    Dim printParam = PRF_CLIENT Or PRF_ERASEBKGND
                    SendMessage(ctrl.Handle, WM_PRINTCLIENT,
                                hdc, New IntPtr(printParam))
                    bmpG.ReleaseHdc()
                End Using
                Dim drawRect = MapRectangle(ctrl, rect, Me)
                g.DrawImage(bmp, drawRect, rect, GraphicsUnit.Pixel)
            End Using
        End If
    End Sub

    Private Sub DrawSameHierarchy(g As Graphics, ctrl As Control)
        Dim mapRect = MapRectangle(Me, Me.ClientRectangle, Parent)
        Dim rect = Rectangle.Intersect(ctrl.Bounds, mapRect)
        If rect.Width > 0 AndAlso rect.Height > 0 Then
            Using bmp As New Bitmap(ctrl.Width, ctrl.Height,
                                    Imaging.PixelFormat.Format32bppRgb)
                ctrl.DrawToBitmap(bmp, New Rectangle(Point.Empty, ctrl.Size))
                Dim drawRect = MapRectangle(Parent, rect, Me)
                Dim clipRect = New Rectangle(
                                rect.Location - CType(ctrl.Location, Size), rect.Size)
                g.DrawImage(bmp, drawRect, clipRect, GraphicsUnit.Pixel)
            End Using
        End If
    End Sub

    Private Function MapRectangle(fromCtrl As Control,
                                  fromRect As Rectangle,
                                  toCtrl As Control) As Rectangle
        Dim rect As New RECT(fromRect)
        MapWindowPoints(fromCtrl.Handle, toCtrl.Handle, rect, 2)
        Return rect.ToRectangle()
    End Function

    Private Const WM_PRINTCLIENT = &H318
    Private Const PRF_CHECKVISIBLE = &H1,
                  PRF_NONCLIENT = &H2,
                  PRF_CLIENT = &H4,
                  PRF_ERASEBKGND = &H8,
                  PRF_CHILDREN = &H10

    <StructLayout(LayoutKind.Sequential)>
    Private Structure RECT
        Public Left, Top, Right, Bottom As Integer
        Public Sub New(r As Rectangle)
            Left = r.Left
            Top = r.Top
            Bottom = r.Bottom
            Right = r.Right
        End Sub
        Public Function ToRectangle() As Rectangle
            Return Rectangle.FromLTRB(Left, Top, Right, Bottom)
        End Function
    End Structure

    <DllImport("user32")>
    Private Shared Function MapWindowPoints(
                        hwndFrom As IntPtr, hwndTo As IntPtr,
                        ByRef RECT As RECT, cPoints As Integer) As Integer
    End Function

    <DllImport("user32", CharSet:=CharSet.Auto)>
    Private Shared Function SendMessage(
                        hwnd As IntPtr, msg As Integer,
                        wparam As IntPtr, lparam As IntPtr) As IntPtr
    End Function

End Class