Results 1 to 9 of 9

Thread: Slowly Appearing Preloader

Threaded View

  1. #4
    INXSIVE Bruce Fox's Avatar
    Join Date
    Sep 2001
    Location
    Melbourne, Australia
    Posts
    7,429
    This may do the trick (if you have Win 2K or above). Place a timer on the Form.
    (Modified original code posted by RobDog888)

    VB Code:
    1. Option Explicit
    2.  
    3. 'Note: Win 2K +
    4.  
    5. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
    6. (ByVal lpLibFileName As String) As Long
    7.  
    8. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
    9. ByVal lpProcName As String) As Long
    10.  
    11. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    12.  
    13. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    14. (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    15.  
    16. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, _
    17. ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    18.  
    19. Private Const GWL_EXSTYLE = (-20)
    20. Private Const WS_EX_LAYERED = &H80000
    21. Private Const LWA_ALPHA = &H2
    22.  
    23. Private mlHwnd As Long
    24.  
    25. Private Sub Form_Load()
    26.  
    27.     Timer1.Interval = 100
    28.     Timer1.Enabled = True
    29.     AlphaBlendForm Me.hwnd, 0 'MAX VALUE = OPAIC/ MIN VALUE = 0 CANT SEE
    30.  
    31. End Sub
    32. Private Sub AlphaBlendForm(ByVal lHwnd As Long, ByVal intTranslucenceLevel As Integer)
    33.     If APIExists("SetLayeredWindowAttributes", "User32") Then
    34.         SetWindowLong lHwnd, GWL_EXSTYLE, WS_EX_LAYERED
    35.         SetLayeredWindowAttributes lHwnd, 0, intTranslucenceLevel, LWA_ALPHA
    36.     Else
    37.         MsgBox "Your OS does not support Alpha Blending.", vbExclamation, "Alpha Blend"
    38.     End If
    39. End Sub
    40.  
    41. Private Function APIExists(ByVal pstrFunctionName As String, ByVal pstrDllName As String) As Boolean
    42.     Dim lngHandle   As Long
    43.     Dim lngAddr     As Long
    44.     lngHandle = LoadLibrary(pstrDllName)
    45.     If Not (lngHandle = 0) Then
    46.         lngAddr = GetProcAddress(lngHandle, pstrFunctionName)
    47.         FreeLibrary lngHandle
    48.     End If
    49.     APIExists = Not (lngAddr = 0)
    50. End Function
    51.  
    52. Private Sub Timer1_Timer()
    53. Static intIdx As Integer
    54.  
    55.     AlphaBlendForm Me.hwnd, intIdx
    56.    
    57.     'Increment the Index counter
    58.     If intIdx >= 255 Then
    59.         Timer1.Enabled = False
    60.     Else
    61.         intIdx = intIdx + 5
    62.     End If
    63.  
    64. End Sub




    Bruce.
    Last edited by Bruce Fox; Nov 3rd, 2004 at 09:30 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width