Keskustelu: Ohjelmointikysymykset: VB6: Kuinka muuttaa _frame_ läpinäkyväksi?

Option Explicit

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) _
      As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject _
      As Long) As Long

Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 _
      As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 _
      As Long) As Long

Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn _
      As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
      ByVal nCombineMode As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
      ByVal x As Long, ByVal y As Long) As Long

Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd _
      As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public CtrlDc As Long

Public Function FrameTranz(Ctrl As Object) As Long
  Dim lHoch As Long
  Dim lBreit As Long
  Dim lTemp As Long
  Dim lSkin As Long
  Dim lStart As Long
  Dim lZeile As Long
  Dim lSpalte As Long
  Dim lBackColor As Long

lSkin = CreateRectRgn(0, 0, 0, 0)

  With Ctrl
'   bei Form.ScaleMode = vbTwips
    lHoch = .Height / Screen.TwipsPerPixelY
    lBreit = .Width / Screen.TwipsPerPixelX

'   bei Form.ScaleMode = vbPixels
'   lHoch = .Height
'   lBreit = .Width

    CtrlDc = GetDC(.hwnd)
    lBackColor = Ctrl.BackColor

    For lZeile = 0 To lHoch - 1
      lSpalte = 0
      Do While lSpalte < lBreit
        Do While lSpalte < lBreit And GetPixel(CtrlDc, lSpalte, lZeile) = lBackColor
          lSpalte = lSpalte + 1
        Loop

        If lSpalte < lBreit Then
          lStart = lSpalte
          Do While lSpalte < lBreit And GetPixel(CtrlDc, lSpalte, lZeile) <> lBackColor
            lSpalte = lSpalte + 1
          Loop

          If lSpalte > lBreit Then lSpalte = lBreit
          lTemp = CreateRectRgn(lStart, lZeile, lSpalte, lZeile + 1)
          Call CombineRgn(lSkin, lSkin, lTemp, 2)
          Call DeleteObject(lTemp)
        End If
      Loop
    Next lZeile
  End With

FrameTranz = lSkin
End Function

Public Sub FrameTransparent(Ctrl As Object)
Dim lSkin As Long
    'Ctrl.Visible = True
    lSkin = FrameTranz(Ctrl)
    Call SetWindowRgn(Ctrl.hwnd, lSkin, True)
End Sub

Private Sub Form_Load()
Frame1.BackColor = &HFF&
End Sub

Private Sub NaytaValikko_Click(Index As Integer)
If Index = 1 Then

Frame1.Visible = True
transparent_timer.Enabled = True

ElseIf Index = 2 Then


End If
End Sub
'Timer (AUTTAKAA TÄSSÄ)
'Eli en saanut toimimaan tätä niin, että kun painaa nappia,
'se laittaa visible = true ja pistää transparentiksi.
'Sen takia laitoin timerin, jonka interval = 1

Private Sub transparent_timer_Timer()
FrameTransparent Frame1
transparent_timer.Enabled = False
End Sub