Folge dem Video um zu sehen, wie unsere Website als Web-App auf dem Startbildschirm installiert werden kann.
Anmerkung: Diese Funktion ist in einigen Browsern möglicherweise nicht verfügbar.
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
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