Attribute VB_Name = "hlp_VBTransparentControls"
Option Explicit
Option Base 0

Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetClassLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public hClassHookCheck_Orig As Long
Public hClassHookOption_Orig As Long
Public DefButtonProc As Long
Public DefStaticProc As Long

Public Enum VBTransparentControlsEnum
  VBTC_Check = &H1&
  VBTC_Option = &H2&
  VBTC_PictureBox = &H10& ' NonDC currently only, just releasing the Brush?
  End Enum

Public Sub VBTransparentControls_FixThem(ByVal WhatToFix As VBTransparentControlsEnum, ByVal StartupForm As Form)
  Dim xChk1 As CheckBox
  Dim xOpt1 As OptionButton
  Dim xPic1 As PictureBox
  
  DefButtonProc = GetDefaultProc("BUTTON")
  If Not DefButtonProc = 0& Then
    If Not (CLng(WhatToFix) And VBTC_Check) = 0& Then
      Set xChk1 = StartupForm.Controls.Add("VB.CheckBox", "VBTransparentControls_RuntimeCheckBox", StartupForm)
      Call SetClassLongA(xChk1.hWnd, -24&, DefButtonProc)
      'hClassHookCheck_Orig = HookVBControl("ThunderCheckBox", DefButtonProc) 'AddressOf hClassHookCheck)
      StartupForm.Controls.Remove xChk1
      End If
    If Not (CLng(WhatToFix) And VBTC_Option) = 0& Then
      Set xOpt1 = StartupForm.Controls.Add("VB.OptionButton", "VBTransparentControls_RuntimeOptionButton", StartupForm)
      Call SetClassLongA(xOpt1.hWnd, -24&, DefButtonProc)
      StartupForm.Controls.Remove xOpt1
      End If
    End If
  
  DefStaticProc = GetDefaultProc("STATIC")
  If Not DefStaticProc = 0& Then
    If Not (CLng(WhatToFix) And VBTC_PictureBox) = 0& Then
      Set xPic1 = StartupForm.Controls.Add("VB.PictureBox", "VBTransparentControls_PictureBox", StartupForm)
      'Debug.Print xPic1.HasDC
      'Call SetClassLongA(xPic1.hWnd, -10&, 0&)
      Call SetClassLongA(xPic1.hWnd, -24&, DefStaticProc)
      StartupForm.Controls.Remove xPic1
      End If
    End If
  End Sub

Public Function GetDefaultProc(ByVal xChar1 As String) As Long
  Dim xLong1 As Long

  xLong1 = CreateWindowExA(0&, xChar1, "", 0&, 0&, 0&, 0&, 0&, 0&, 0&, CLng(App.hInstance), 0&)
  If Not xLong1 = 0& Then
    GetDefaultProc = GetClassLongA(xLong1, -24&)
    Call DestroyWindow(xLong1)
    End If
  End Function

Private Function IsVB6IDE() As Boolean
  On Error GoTo Er1
  Debug.Print 1 / 0
Rs1:
  On Error GoTo 0
  Exit Function

Er1:
  IsVB6IDE = True
  Resume Rs1
  End Function
