vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Fortgeschrittene Programmierung
Re: Problem! 
Autor: Ulli
Datum: 13.10.02 21:02

Begrüßungsbildschirm:
Option Explicit
Dim X As Integer
' zunächst die benötigten API-Deklarationen
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean

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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Private Sub Form_Load()
' Fenster-Attribute setzen
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, _
GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

Me.Show
DoEvents

lwa_FadeIn Me.hWnd, 5
Timer1.Enabled = True
X = 0
End Sub

Private Sub Timer1_Timer()
X = X + 1
Debug.Print X
If X = 2 Then
Me.Show
Timer1.Enabled = False
Unload Me
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
' FadeOut und beenden
lwa_FadeOut Me.hWnd, 5
End
End Sub

Hauptform:
Option Explicit
' zunächst die benötigten API-Deklarationen
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean

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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Private Sub Form_Load()
' Fenster-Attribute setzen
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, _
GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

Me.Show
DoEvents

lwa_FadeIn Me.hWnd, 5
End Sub

Modul1:
Option Explicit
' zunächst die benötigten API-Deklarationen
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean

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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2



Public Sub lwa_FadeIn(ByVal hWnd As Long, Optional ByVal iStep As Integer = 1)
' FadeIn
Dim bAlpha As Integer

bAlpha = 0
While bAlpha < 255
If bAlpha > 255 Then bAlpha = 255
SetLayeredWindowAttributes hWnd, 0, bAlpha, _
LWA_ALPHA
DoEvents

bAlpha = bAlpha + iStep
Wend
End Sub
Public Sub lwa_FadeOut(ByVal hWnd As Long, Optional ByVal iStep As Integer = 1)
' FadeOut
Dim bAlpha As Integer

bAlpha = 255
While bAlpha > 0
If bAlpha < 0 Then bAlpha = 0
SetLayeredWindowAttributes hWnd, 0, bAlpha, _
LWA_ALPHA
DoEvents

bAlpha = bAlpha - iStep
Wend
End Sub
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Problem!128Bastian13.10.02 17:49
Re: Problem!275unbekannt13.10.02 17:54
Re: Problem!88Ulli13.10.02 21:02
Ich ahnte es!267unbekannt13.10.02 21:19
Re: Ich ahnte es!78Bastian14.10.02 07:46

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel