Tipp 0111 Transparente Objekte
Autor/Einsender:
Datum:
  Ronald Janowski
14.08.2001
Entwicklungsumgebung:   VB 6
Mit den Funktionen in diesem Beispiel ist es möglich die Steuerelemente CommandButton und PictureBox transparent zu machen. Klickbar bleibt nur das Bild bzw. der Text in dem jeweiligen Control. Die Möglichkeiten, die sich hiermit bieten, liegen klar auf der Hand: Endlich echte CommandButton mit freigestaltbarer Form, da die Form nur durch das Bild (z.B. Bild mit Dreieck = dreieckiger Button) bestimmt wird.
Code im Codebereich des Moduls
 
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 cmdDc As Long

Public Function picTranz(cPic As PictureBox) 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 cPic
    lHoch = .Height / Screen.TwipsPerPixelY
    lBreit = .Width / Screen.TwipsPerPixelX

    lBackColor = GetPixel(.hDC, 0, 0)

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

        If lSpalte < lBreit Then
          lStart = lSpalte
          Do While lSpalte < lBreit And _
                GetPixel(.hDC, 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

  picTranz = lSkin
End Function

Public Sub picTransparent(cPic As PictureBox)
  Dim lSkin As Long

  With cPic
    .Visible = True
    .Left = 0
    .Top = 0
    .BorderStyle = 0
    .AutoRedraw = True
    .AutoSize = True
    lSkin = picTranz(cPic)
    Call SetWindowRgn(cPic.hwnd, lSkin, True)
  End With
End Sub

Public Function cmdTranz(cBttn As CommandButton) 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 cBttn
    lHoch = .Height / Screen.TwipsPerPixelY
    lBreit = .Width / Screen.TwipsPerPixelX

    cmdDc = GetDC(.hwnd)
    lBackColor = cBttn.BackColor

    For lZeile = 2 To lHoch - 3
      lSpalte = 2
      Do While lSpalte < (lBreit - 3)
        Do While lSpalte < (lBreit - 3) And _
              GetPixel(cmdDc, lSpalte, lZeile) = lBackColor
          lSpalte = lSpalte + 1
        Loop

        If lSpalte < (lBreit - 3) Then
          lStart = lSpalte
          Do While lSpalte < (lBreit - 3) And _
                GetPixel(cmdDc, 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

  cmdTranz = lSkin
End Function

Public Sub cmdTransparent(cBttn As CommandButton)
  Dim lSkin As Long

  With cBttn
    .Visible = True
    .Left = cBttn.Left
    .Top = cBttn.Top
    lSkin = cmdTranz(cBttn)
    Call SetWindowRgn(cBttn.hwnd, lSkin, True)
  End With
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Sub cmdTranz_Click(Index As Integer)
  Select Case Index
    Case 0: picTransparent pic1
    Case 1: cmdTransparent cmd1: cmdTransparent _
            cmd2: cmdTransparent cmd3: cmdTransparent _
            cmd4: cmdTranz(1).Enabled = False
  End Select
End Sub
 
Weitere Links zum Thema
Skin-Effekt
Transparenz
Transparenz mit TransparentBlt

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (9,9 kB) Downloads bisher: [ 4696 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 9. September 2011