✔ Transparent

Sinac · 16. Oktober 2002

Hallo!
Kann ich irgendwie das Programmfenster durchsichtig machen?
so in etwa mit Form1.BackColor = transparent
oder so? wenn ichs so mach wird schwarz, weil der compiler
mit der eigenschaft wohl nix anfangen kann oda so!

Dario Linsky · 16. Oktober 2002

ganz so einfach wie mit der zuweisung der hintergrundfarbe ist das auch nicht. das läuft in vb (wie immer) über ein paar api-funktionen.
ein paar tutorials und beispielcode dazu gibt es hier:
http://www.juicystudio.com/tutorial/vb/transparentform.html
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=816&lngWId=-1
http://www.visualbasicforum.com/t38522.html
http://www.vbcode.com/asp/showsn.asp?theID=128

Daniel Toplak · 23. Oktober 2002

Also so weit ich weiß geht das mit den Transparenten Fomularen nur unter Windows ME und Windows2000, da diese beiden Alpha-Blending von Fenstern unterstützen. Bei anderen Betriebssystemen würde das sicherlich auch gehen, aber das erfordert einiges mehr als nur ein Formular anzuzeigen, dann da müsste man das Fenster von "Hand" zeichnen.
Und dazu ist VB nicht sonderlich gut geeignet.

Ich leg mal ein Test-Beispiel bei, das ich vor einiger Zeit mal mit VB6 erstellt habe. Wenn man den Mauszeiger aus dem Fenster bewegt, dann wird es Transparent.

Gruss Homer

daniel009frog · 11. September 2007

Hallo, bin frisch-backener Azubi und muss mich in das Progr. reinwurschteln.

API ist warscheinlich schon zu hart für den Anfang, aber diese Funktion brauch ich aus diesem Bereich für ein Programm an dem ich rumprobiere.

Was muss ich entfernen/verändern, damit die Form zwar den Blend-Effekt ausführt aber keine ovale Form erhält?
DOWNLOAD von Daniel Toplak (s.O.)

Ein bisschen verändert.

Objects:
Form1
Timer1

Code:

Option Explicit
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    left As Integer
    right As Integer
    top As Integer
    bottom As Integer
End Type

Dim alphablend As Boolean
Dim xt As Integer
Dim yt As Integer
Private Sub Form_Load()
    xt = Screen.TwipsPerPixelX
    yt = Screen.TwipsPerPixelY
    
    
    alphablend = False
    Dim Rgn As Long
    Rgn = CreateEllipticRgn(0, 0, Me.Width / xt, Me.Height / xt)
    SetWindowRgn Me.hWnd, Rgn, True
 
End Sub

Private Sub Timer1_Timer()
    Dim point As POINTAPI
    Dim rechteck2 As RECT
    
    GetCursorPos point

    
    rechteck2.left = Me.left / xt
    rechteck2.right = (Me.Width / xt) + rechteck2.left
    rechteck2.top = Me.top / yt
    rechteck2.bottom = (Me.Height / yt) + rechteck2.top

    
    
    If point.X > rechteck2.left And point.X < rechteck2.right _
    And point.Y > rechteck2.top And point.Y < rechteck2.bottom Then
        If alphablend = True Then blend 0
    Else
        If alphablend = False Then blend 1
    End If

End Sub

Private Function blend(flag As Integer)
    Dim Ret As Long
    Dim i As Integer
    'Set the window style to 'Layered'
    Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    
    SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
    'Set the opacity of the layered window to 128
    Select Case flag
        Case 1
            For i = 255 To 128 Step -2
                DoEvents
                SetLayeredWindowAttributes Me.hWnd, 0, i, LWA_ALPHA
                alphablend = True
            Next i
        Case 0
            For i = 128 To 255 Step 2
                DoEvents
                SetLayeredWindowAttributes Me.hWnd, 0, i, LWA_ALPHA
                alphablend = False
            Next i
    End Select
    
End Function

daniel009frog · 11. September 2007

Der Original-Code unverändert:

Objects:
Form1
Timer1
Text1

Code:

Option Explicit
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    left As Integer
    right As Integer
    top As Integer
    bottom As Integer
End Type

Dim alphablend As Boolean
Dim xt As Integer
Dim yt As Integer
Private Sub Form_Load()
    xt = Screen.TwipsPerPixelX
    yt = Screen.TwipsPerPixelY
    
    
    alphablend = False
    Dim Rgn As Long
    Rgn = CreateEllipticRgn(0, 0, Me.Width / xt, Me.Height / xt)
    SetWindowRgn Me.hWnd, Rgn, True
 
End Sub

Private Sub Timer1_Timer()
    Dim point As POINTAPI
    Dim rechteck2 As RECT
    
    GetCursorPos point
    Me.Caption = "x:" & point.X & " y:" & point.Y
    
    rechteck2.left = Me.left / xt
    rechteck2.right = (Me.Width / xt) + rechteck2.left
    rechteck2.top = Me.top / yt
    rechteck2.bottom = (Me.Height / yt) + rechteck2.top
    
    Text1.Text = "links:" & rechteck2.left & vbCrLf _
               & "rechts:" & rechteck2.right & vbCrLf _
               & "oben:" & rechteck2.top & vbCrLf _
               & "unten:" & rechteck2.bottom
    
    
    If point.X > rechteck2.left And point.X < rechteck2.right _
    And point.Y > rechteck2.top And point.Y < rechteck2.bottom Then
        If alphablend = True Then blend 0
    Else
        If alphablend = False Then blend 1
    End If

End Sub

Private Function blend(flag As Integer)
    Dim Ret As Long
    Dim i As Integer
    'Set the window style to 'Layered'
    Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    
    SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
    'Set the opacity of the layered window to 128
    Select Case flag
        Case 1
            For i = 255 To 128 Step -2
                DoEvents
                SetLayeredWindowAttributes Me.hWnd, 0, i, LWA_ALPHA
                alphablend = True
            Next i
        Case 0
            For i = 128 To 255 Step 2
                DoEvents
                SetLayeredWindowAttributes Me.hWnd, 0, i, LWA_ALPHA
                alphablend = False
            Next i
    End Select
    
End Function

odCaplan · 11. September 2007

An daniel009frog :

Einfach 3 Zeilen ausblenden :

Private Sub Form_Load()
xt = Screen.TwipsPerPixelX
yt = Screen.TwipsPerPixelY

alphablend = False

' deaktivieren
' Dim Rgn As Long
' Rgn = CreateEllipticRgn(0, 0, Me.Width / xt, Me.Height / xt)
' SetWindowRgn Me.hWnd, Rgn, True

End Sub

An Daniel Toplak: danke für's Beispiel. Ist wirklich gut

daniel009frog · 12. September 2007

Vielen Dank Caplan!

Es läuft alles so wie es sollte.

MfG Daniel

odCaplan · 13. September 2007

Hallo Daniel,

Gern geschehen.

Bitte vergiss nicht den Eintrag als erledigt zu markieren. Du bist der Einzige, der dafür die Rechte hat.

daniel009frog · 14. September 2007

Ne, tut mir leid,
ich kriege bei dem Versuch das Thema als erledigt abzustempeln eine Fehlermeldung, dass ich nicht die benötigten Rechte dazu besitze.

✔ Transparent

Sinac

Erfahrenes Mitglied

Dario Linsky

Erfahrenes Mitglied

Daniel Toplak

Erfahrenes Mitglied

Anhänge

daniel009frog

Grünschnabel

daniel009frog

Grünschnabel

odCaplan

Grünschnabel

daniel009frog

Grünschnabel

odCaplan

Grünschnabel

daniel009frog

Grünschnabel

Neue Beiträge