Прозрачность меняется от 0 до 255
Даже если таймер или sleep поставить на 1 миллисекунду, Autoredraw формы - False (меняю прозрачность с шагом 4) все равно долго получается, а хотелось бы с шагом 1, чтобы плавнее, но тогда совсем долго будет. Хотелось бы, чтобы от нуля до 255 за 0,5 секунды где-то.
Можно ли как-то ускорить процесс.
Код примерно такой:
Это в модуле:
- Код: Выделить всё
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
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _
ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Sub SetTransparent(hWnd As Long, ByVal Layered As Byte)
Dim Ret As Long
Ret = GetWindowLong(hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes hWnd, 0, Layered, LWA_ALPHA
End Sub
А это в форме (изначально visible формы false):
- Код: Выделить всё
Private Sub Form_Load()
On Error Resume Next
SetTransparent Me.hWnd, 0
Timer1.Enabled = True
Me.Visible = True
End Sub
Private Sub Timer1_Timer()
Static par As Integer
If par > 254 Then Timer1.Enabled = False: Exit Sub
SetTransparent Me.hWnd, par
par = par + 4
End Sub
, но думаю, что так.