[VB6] Transparente Form

[n00kie]

Hallo. Ich wollte fragen ob jemand einen Source dafür hat um eine Form Durchsichtig bzw. Tranperent zu machen.

[Mentos05]

durchsichtig kannst in vb unter den eigenschaften machen "visible" auf false setzen. oder halt im source
form1.visible = false
durchsichtig weiß ich nicht genau grad

mfg

[-=Player=-]

durchsichtig kannst in vb unter den eigenschaften machen "visible" auf false setzen. oder halt im source
form1.visible = false
durchsichtig weiß ich nicht genau grad

mfg

das ist merkwürdig was du geschrieben hast.
Erstmal sagst du ihn wie man eineForm durchsichtig macht und im letzten satz schreibst du, du weißt nicht wie man die durchsichtig macht.
hmm... komisch aber naja, hier ein link:

http://www.activevb.de/tipps/vb6tipps/tipp0462.html

[Mentos05]

ah sry meine natürlich ich weiß nicht wie man eine form transparent macht^^
nur durchsichtig

[Nemo.A]

Unter Delphi kannst du sowas direkt im Objekt-Inspektor einstellen. Musst erstmal etwas auf "true" setzen, und dann halt die Transparenz einstellen (0-255 oder so). Die Einträge stehen ganz oben (wenn die Form markiert ist), wie die Eigenschaften heißen, weiß ich nicht mehr.

[Bi0sh0k]

Hier hab ich was echt geniales für dich.
Du musst wenn du eine Glass Form haben willst nur den BORDER STYLE auf KEIN stellen und das in die Form setzen die Durchsichtig werden soll:

Kommt in die Form:

Option Explicit

Private WithEvents fEvents As Form
Private bNoResize As Boolean, bNoActivate As Boolean

' Loading / Unloading
'-----------------------------
Private Sub Form_Load()
    Set fEvents = frmBlank
    
    ' ShowInTaskBar
    SetWindowLong Me.hWnd, GWL_STYLE, GetWindowLong(Me.hWnd, GWL_STYLE) Or WS_SYSMENU Or WS_MINIMIZEBOX
    
    ' Set Transparency
    Me.BackColor = vbCyan
    
    SetTrans Me, , Me.BackColor
    SetTrans fEvents, 1
    
    'Center
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    
    Me.Show
    fEvents.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload fEvents
    Set fEvents = Nothing
End Sub

' Handling MouseEvents
'-----------------------------
Private Sub fEvents_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If IsOverCtl(Me, x \ Screen.TwipsPerPixelX, y \ Screen.TwipsPerPixelY) Then Me.SetFocus
End Sub

' Keep forms relative zOrder:
' only needed if there are other forms in your app
'-----------------------------
Private Sub fEvents_Activate()
    If Not GetNextWindow(fEvents.hWnd) = Me.hWnd Then Me.ZOrder
End Sub

Private Sub Form_Activate()
    If Not GetNextWindow(Me.hWnd) = fEvents.hWnd Then fEvents.ZOrder
    
End Sub

' Keep forms same size:
'-----------------------------
Private Sub fEvents_Resize()
    If bNoResize Then Exit Sub
    bNoResize = True
    With fEvents
        Me.Move .Left, .Top, .Width, .Height
    End With
    bNoResize = False
End Sub

Private Sub Form_Resize()
    If bNoResize Then Exit Sub
    bNoResize = True
    With Me
        fEvents.Move .Left, .Top, .Width, .Height
    End With
    bNoResize = False
End Sub

Jetzt musst du noch ein modul mit dem Namen modMain.bas erstellen und da kommt dann folgendes rein:

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
                ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long

Public 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 GetWindowRect Lib "user32" ( _
                ByVal hwnd As Long, _
                lpRect As RECT) As Long

Private Declare Function ClientToScreen Lib "user32" ( _
                ByVal hwnd As Long, _
                lpPoint As POINTAPI) As Long

Private Declare Function GetWindow Lib "user32" ( _
                ByVal hwnd As Long, _
                ByVal wCmd As Long) As Long
                
Public Const GWL_STYLE = (-16)
Public Const WS_SYSMENU = &H80000
Public Const WS_MINIMIZEBOX = &H20000
    
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
    
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Private Const GW_HWNDNEXT = 2

Public Sub SetTrans(oForm As Form, Optional bytAlpha As Byte = 255, Optional lColor As Long = 0)
    Dim lStyle As Long
    lStyle = GetWindowLong(oForm.hwnd, GWL_EXSTYLE)
    If Not (lStyle And WS_EX_LAYERED) = WS_EX_LAYERED Then _
        SetWindowLong oForm.hwnd, GWL_EXSTYLE, lStyle Or WS_EX_LAYERED
    SetLayeredWindowAttributes oForm.hwnd, lColor, bytAlpha, LWA_COLORKEY Or LWA_ALPHA
End Sub

Public Function IsOverCtl(oForm As Form, ByVal X As Long, ByVal Y As Long) As Boolean
    Dim ctl As Control, lhWnd As Long, r As RECT, pt As POINTAPI
    
    pt.X = X: pt.Y = Y
    ClientToScreen oForm.hwnd, pt
    
    For Each ctl In oForm.Controls
        On Error GoTo ErrHandler
        lhWnd = ctl.hwnd
        On Error GoTo 0
        If lhWnd Then
            GetWindowRect ctl.hwnd, r
            IsOverCtl = (pt.X >= r.Left And pt.X <= r.Right And pt.Y >= r.Top And pt.Y <= r.Bottom)
            If IsOverCtl Then Exit Function
        End If
    Next ctl
    Exit Function
ErrHandler:
    lhWnd = 0
    Resume Next
End Function

Public Function GetNextWindow(ByVal lhWnd As Long) As Long
    GetNextWindow = GetWindow(lhWnd, GW_HWNDNEXT)
End Function

Jetzt sieht man alles außer den Hintergrund der Form und dem Rahmen inklusive der minimieren-, maximieren- und schließentaste.
Alles andere ist sichtbar.
Das hab ich bei google nur einmal gefunden und das nach 2 stunden.
War schwer das richtige zu finden.
Viel Spaß!

[n00kie]

Danke, aber das Problem wurde schon letztes Jahr gelöst.