Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0462: Fenster transparent(durchscheinend) machen

 von 

Beschreibung 

Seit Windows 2000 ist es auch möglich, Fenster mit SetLayeredWindowAttributes transparent zu machen. Mit Hilfe dieses kleinen Codes ist dies ohne Weiteres auch bei Ihren Programmen möglich.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetWindowLongA (GetWindowLong), SetLayeredWindowAttributes, SetWindowLongA (SetWindowLong)

Download:

Download des Beispielprojektes [2,71 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Sub Command1_Click()
    Call Mache_Transparent(Me.hWnd, 128)
End Sub

Private Sub Command2_Click()
    Call Mache_Transparent(Me.hWnd, 255)
End Sub

Private Sub Form_Load()

End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Declare Function GetWindowLong Lib "user32.dll" _
                 Alias "GetWindowLongA" ( _
                 ByVal hWnd As Long, _
                 ByVal nIndex As Long) As Long
                 
Declare Function SetWindowLong Lib "user32.dll" _
                 Alias "SetWindowLongA" ( _
                 ByVal hWnd As Long, _
                 ByVal nIndex As Long, _
                 ByVal dwNewLong As Long) As Long
                 
Declare Function SetLayeredWindowAttributes Lib "user32.dll" ( _
                 ByVal hWnd As Long, _
                 ByVal crKey As Long, _
                 ByVal bAlpha As Byte, _
                 ByVal dwFlags As Long) As Long

Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000

'Macht nur eine Farbe transparent
'Public Const LWA_COLORKEY = &H1

'Macht das ganze Fenster transparent
Public Const LWA_ALPHA = &H2

Public Sub Mache_Transparent(hWnd As Long, Rate As Byte)
    '### funktioniert nur unter Windows 2000 oder XP!!!
    '### macht das Fenster, dessen hWnd übergeben wurde, transparent
    '### Rate: 254 = normal 0 = ganz transparent (also unsichtbar)
    '### 190 ist z.B. ein guter Wert
    
    Dim WinInfo As Long
    
    WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
    
    If Rate < 255 Then
        WinInfo = WinInfo Or WS_EX_LAYERED
        SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
        SetLayeredWindowAttributes hWnd, 0, Rate, LWA_ALPHA
    Else
        'Wenn als Rate 255 angegeben wird,
        'so wird der Ausgangszustand wiederhergestellt
        WinInfo = WinInfo Xor WS_EX_LAYERED
        SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
    End If
End Sub

'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 26 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Gustav am 23.04.2010 um 16:01

Mit der Funkion hex(Zahl) kann man jede beliebige Zahl in Hexadezimalzahlen umwandeln lassen. Dadurch lassen sich auch Farbstufen transparent gestalten.

Kommentar von asdfi8 am 01.04.2008 um 19:55

Gib einfach &HFFFFFF ein

Kommentar von CHRTEK-Network CNT am 07.04.2006 um 17:09

Um nur eine Farbe transparent zu machen, muss LWA_ALPHA den wert &H1 bekommen.

In der Zeile

SetLayeredWindowAttributes hwnd, 0, Rate, LWA_ALPHA

ist die 0 interessant.
Hier muss die Farbe als Dezimalzahl übergeben werden.
Um dies zu errechnen öffnet man den Windows Taschenrechner.
Man stellt ihn auf wissenschaftlich ein und wählt Heximal.
Nun fügt man den Hex Wert eines Bildbearbeitungsprogramms, einer gewählten Farbe (z.B. FFFFFF ist weiß) in den Rechner ein.
Nun wählt man Dezimal Zahlen.
Man erhält z.B. bei dem Wert FFFFFF (weiß) die dezimalzahl
16777215, diese nutzt man anstatt der 0 und schon funktioniert es ;)

Ich hoffe ich habe es nicht zu umständlich erklärt ;)
Also Hex nach Dez umwandeln und es wird laufen ;)

ciao

Kommentar von Tobias Fischer am 30.08.2005 um 20:47

Die Option, nur eine Farbe transparent zu machen, funktioniert bei mir zwar ganz gut, aber leider nur mit Schwarz.
Wie muss ich den Code ändern, damit anstelle von Schwarz eine andere Farbe durchsichtig wird, die nicht (z.B. in Labeltexten) vorkommt (wie z.B. der klassische Magenta-Ton)?

Vielen Dank im Vorraus,
Tobias Fischer

Kommentar von Topcam am 20.02.2005 um 16:13

Hier gibt es das "CoolXP"

http://www.vbmaster.gbadmin.de

da erledigen sich lange Declare.

Die click in den Eigenschaften und die Picturebox
ist transparent.

im Packet sind : *.ocx

xpButton xpFrame xpOption xpCheck

xpProgress xpText xpList xpCombo

xpDir xpFile xpUpDown xpPicture

xpDrive xpMenu xpPanel xpSlider

xpScrollBars xpPropertyList

xpForm xpListView xpMsgInput

xpTaskBar xpStartMenu xpMonthView

xpImageList xpOutBar xpRollUpContainer

xpSideMenu xpTabStrip

alles Kostenlos für groß und klein .
Aufwendige Anleitung und diverse VB Scripte.

Kommentar von Gr.C.S.-Software am 08.05.2004 um 23:49

Hier der richtige Link
GRCS.DE
oder Hier


Kommentar von Gr.C.S. Software am 05.04.2004 um 22:45

<a href="www.grcs.de">WWW.GRCS.de</a> Wir sind für Sie da, haben Sie fragen klicken Sie drauf. Ihr Softwarehersteller

Kommentar von GrCS Software am 07.10.2003 um 01:04

ich habe mir erlaubt einen besserren zeu entwickeln:
der heir läuft unter win 95 , 98 , nt 4.0 ,2000, xp

ausserdem kann man auch eine Picture box transparent machen !

kopiert den gesamten kode in eine Bas oder direckt in eine form !

code :


Option Explicit
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function CreateRectRgn Lib "GDI32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CombineRgn Lib "GDI32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "GDI32" (ByVal hObject 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 Const RGN_OR = 2
Private Declare Sub OleTranslateColor Lib "oleaut32.dll" ( _
ByVal clr As Long, _
ByVal hpal As Long, _
ByRef lpcolorref As Long)

Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long

End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte

End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD

End Type
Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "GDI32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "GDI32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Const LWA_COLORKEY = &H1
Private Const GWL_EXSTYLE = (-20)
Private 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

Public Function MakeFormTransparent(frm As Object)
Dim hRegion As Long
Dim WinStyle As Long
Dim lngTransColor As Long

'Systemfarben ggf. in RGB-Werte übersetzen
hRegion = RegionFromBitmap(frm)
SetWindowRgn frm.hwnd, hRegion, True
DeleteObject hRegion

End Function

Private Function RegionFromBitmap(picSource As Object) As Long
Dim lngRetr As Long, lngHeight As Long, lngWidth As Long
Dim lngRgnFinal As Long, lngRgnTmp As Long
Dim lngStart As Long, lngTransColor As Long
Dim X As Long, Y As Long
Dim hDC As Long, LngTrasSet As Long

Dim bi24BitInfo As BITMAPINFO
Dim iBitmap As Long
Dim BWidth As Long
Dim BHeight As Long
Dim iDC As Long
Dim PicBits() As Byte
Dim Col As Long
Dim OldScaleMode As ScaleModeConstants

OldScaleMode = picSource.ScaleMode
picSource.ScaleMode = vbPixels
lngTransColor = GetPixel(picSource.hDC, 0, 0)
hDC = picSource.hDC
lngWidth = picSource.ScaleWidth '- 1
lngHeight = picSource.ScaleHeight - 1

BWidth = (picSource.ScaleWidth \ 4) * 4 + 4
BHeight = picSource.ScaleHeight

'Bitmap-Header
With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = BWidth
.biHeight = BHeight + 1
End With
'ByteArrays in der erforderlichen Größe anlegen
ReDim PicBits(0 To bi24BitInfo.bmiHeader.biWidth * 3 - 1, 0 To bi24BitInfo.bmiHeader.biHeight - 1)

iDC = CreateCompatibleDC(hDC)
'Gerätekontextunabhängige Bitmap (DIB) erzeugen
iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
'iBitmap in den neuen DIB-DC wählen
Call SelectObject(iDC, iBitmap)
'hDC des Quell-Fensters in den hDC der DIB kopieren
Call BitBlt(iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, hDC, 0, 0, vbSrcCopy)
'Gerätekontextunabhängige Bitmap in ByteArrays kopieren
Call GetDIBits(hDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, PicBits(0, 0), bi24BitInfo, DIB_RGB_COLORS)

'Wir brauchen nur den Array, also können wir die Bitmap direkt wieder löschen.

'DIB-DC
Call DeleteDC(iDC)
'Bitmap
Call DeleteObject(iBitmap)

lngRgnFinal = CreateRectRgn(0, 0, 0, 0)

For Y = 0 To lngHeight
For X = 0 To lngWidth

LngTrasSet = RGB(PicBits(X * 3 + 2, _
lngHeight - Y + 1), PicBits(X * 3 + 1, _
lngHeight - Y + 1), PicBits(X * 3, _
lngHeight - Y + 1))
If LngTrasSet <> lngTransColor And lngStart = 0 Then
lngStart = X
End If
If (LngTrasSet = lngTransColor And lngStart > 0) Or (X = lngWidth And lngStart > 0) Then
lngRgnTmp = CreateRectRgn(lngStart, Y, X, Y + 1)
lngRetr = CombineRgn(lngRgnFinal, lngRgnFinal, lngRgnTmp, RGN_OR)
DeleteObject lngRgnTmp
lngStart = 0
End If
Next X
Next Y
DoEvents
picSource.ScaleMode = OldScaleMode
RegionFromBitmap = lngRgnFinal
End Function

Kommentar von Grcs Software am 06.10.2003 um 22:48

das liegt daran das windows die Farbe ausradiert !
besser währe es wenn du die form selbst transbarent machst !
eine bessere Lösung ist Mack transparent !
dann kannst du selbst eine Picturebox Transparent
machen

Kommentar von InKUbuS GhUL am 06.10.2003 um 04:23

Hallo Leutz...

...also der Tipp ist wirklich super, denn er funktioniert im Gegensatz zu vielen anderen Tips in dieser Richtung! Ich habe jetzt nur eine Frage:

Ich habe eine Form, auf der Form ist eine PictureBox. Ichmöchte die Form gerne transparent bzw. fast unsichtbar haben...soweit funktioniert das ja auch, aber ich will nicht, dass das Bild in der PictureBox ebenfalls transparent wird!
Ist ja toll, dass die PictureBox auch transparent wird, aber nicht, dass man das Bild nicht mehr erkennen kann. Ich habe auch schon versucht nur die Farbe Grau transparent zu machen, jedoch mit dem Erfolg, dass entweder wieder das Bild mit transparent war oder das die Form gar nicht mehr zu sehen ist!
Ich hoffe es weiß jemand Rat!!!

Schon mal besten Dank
InKUbuS GhUL

Kommentar von Volker Racho am 02.09.2003 um 21:57

Ich habe ein kleines Problem mit diesem Tip. Immer wenn ich die Form per Titelleiste verschiebe, wird sie wieder undurchsichtig. Weiß jamand abhlife (ausser Form_Paint())
Danke im voraus.

Kommentar von Marc am 01.09.2003 um 14:40

Wie kann ich das auch mit Benutzersteuerelementen machen? Ich habe es so gemacht:

<code>
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000

'Macht nur eine Farbe transparent
Const LWA_COLORKEY = &H1

'Macht das ganze Fenster transparent
Const LWA_ALPHA = &H2
Event Click()
Event MouseMove(X As Single, Y As Single)

Private Sub UserControl_Click()
Call Mache_Transparent(hWnd, 0)
End Sub


Sub Mache_Transparent(hWnd As Long, Rate As Long)
'### funktioniert nur unter Windows 2000 oder XP!!!
'### macht das Fenster, dessen hWnd übergeben
'### wurde, transparent.
'### Rate: 254 = normal 0 = ganz transparent
'### 190 ist z.B. ein guter Wert

Dim WinInfo As Long

WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)

If Rate < 255 Then
WinInfo = WinInfo Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
SetLayeredWindowAttributes hWnd, 0, Rate, LWA_ALPHA
Else
'Wenn als Rate 255 angegeben wird,
'so wird der Ausgangszustand wiederhergestellt
WinInfo = WinInfo Xor WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
End If
End Sub
</code>

Kommentar von JoWi am 16.08.2003 um 09:14

Hallo MGalpa,

Der hier vorgstellte Code läuft definintiv NUR unter Windows 2k und XP. Den anderen Betreibssystemen fehlt die Möglichkeit dazu. Allerdings gibt es Workarrounds! Goggle mal ein wenig!

Gruß,
Jochen

Admin @ActiveVB

Kommentar von MGalpa am 16.08.2003 um 01:59

Also ich muß ja sagen wer sich dieses Update ausgedacht hat muß echt Dämlichsein !

^
das was vorher war fande ich echt besser nach einigen Korekturen konnte ich so gar andere fnster ändern und das bei allen Systemen einschließlich win95

Kommentar von Johannes Roth am 13.08.2003 um 15:52

@Askin:
du benötigst Visual Basic 5 oder besser 6. Je nach Version kostet das richtig deftig, wobei, eigentlich kann's sogar sein das man das nicht mehr kaufen kann weil es den Nachfolger gibt...
keine Chance mit deinen Grafiktools!

Kommentar von Christoph von Wittich am 30.07.2003 um 00:42

Es ist nicht möglich diesen Tipp auf Child Windows anzuwenden (vgl. MSDN).

Kommentar von Askin am 22.07.2003 um 19:41

Hi Ich bin Neu hier und habe keine Ahnung vom Programmmieren (leider)Wie und WO muss ich denn das da oben alles eintippen ???
Eine kleine hilfe bitte....
Das mit dem Transparent machen hab ich mit StyleBuilder und PaintShopPro7 probiert aber hat nicht geklappt.Bitte um hilfe Danke..

Mfg

Kommentar von Katrin R. am 15.07.2003 um 14:46

Klasse Code :-).
Aber da ist übrigens ein Tippfehler in der Beschreibung :-).
(jaja, ich Besserwisser und Hobby-Haarspalter, ich weiß)

Kommentar von Michael am 25.06.2003 um 00:04

Wie kann ich diesen Tipp (Effekt) bei MDI-Childs umsetzen???

so funktioniert es leider nicht.

Kommentar von Fabian am 03.06.2003 um 14:25

Ich hab versucht ein fremdes Fenster Transparent zu machen, was leider nicht geklappt hat. Weis jemand wie sowas möglich ist ?

MFG Fabian

Kommentar von Jens Schweizer am 08.11.2002 um 23:24

Hallo Zusammen.
Nicht schlecht anzusehen. Allerdings konnt ich folgendes Phenomän beobachten: Ein TreeCD aus VB6, der normalerweise einen überlangen Node als Tooltip anzeigt, hat Probleme, diesen richtig anzuzeigen. So scheint der Tooltip zu blinken, lesen kann man da nix.
Weiss jemand, wie man das abstellen kann? Wenn ja, bitte mailen.

Viele Grüße
Jens Schweizer

Kommentar von BenniVB am 23.08.2002 um 14:41

Hi Tom. Die Umwandlung des Desktops in Graustufen, die vom "Abmelden-Programm" vorgenommen wird ist keine magische neue Funktion von XP. In Wirklichkeit ist nämlich alles, was hinter dem Abmelden-Dialog liegt nur eine Grafik, die einen Screenshoot des Bildschirms enthält, wie er aussah, bevor der Abmelden-Dialog angezeigt wurde. Und wie man Grafiken in ihre Graustufen umwandelt, das steht glaub ich sogar hier in den Tips. Du mußt halt mit Hilfe eines Timers die Farbpixel der Grafik langsam in ihren vollen Grauton umwandeln lassen, also etwas von ihrem Helligkeitswert abziehen. Eigentlich ganz einfach. Gruß BenniVB

Kommentar von Tom am 09.08.2002 um 16:52

unter xp müsste noch eine funktion verfügbar sein, um den desktop in graustufen unzuwandeln (z.b. bein abmelden-dialog)!!
hat jemand ahnung, welche funktion dafür zuständig ist und wie sie zu bedienen ist?

Kommentar von Uwe Rieger am 10.06.2002 um 13:29

Hi cashc0der.
Ich hab nicht alt zuviel Erfahrung mit MDI, aber ich weis das du das MDI-Form transpaerent machen kannst und dabei auch alle MDI-Childs Transparent werden.
Ich denke mal das Windows dies eFunktion nur für richtige Fenster bereit stellt.

Kommentar von crashc0der am 27.04.2002 um 00:13

Wenn die Form die transparent gemacht werden soll ein MDI-Child ist geht das nicht. Bin leider kein VB-Profi und kenne den Grund nicht, weiss da jemand weiter?

Kommentar von Daniel Pramel am 25.02.2002 um 07:45

Hey cool, das ist ja mein Code! Hatte ganz vergessen, das ich euch den mal geschickt habe*g*