vbAccelerator - Contents of code file: frmAbout.frm

This file is part of the download VB6 CD Ripper, which is described in the article CD Ripping in VB Part 1.

VERSION 5.00
Begin VB.Form frmAbout 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "%Title%"
   ClientHeight    =   4320
   ClientLeft      =   4815
   ClientTop       =   3105
   ClientWidth     =   6285
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmAbout.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   288
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   419
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Timer tmr 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   300
      Top             =   3720
   End
   Begin VB.PictureBox picLogo 
      BackColor       =   &H80000010&
      BorderStyle     =   0  'None
      Height          =   1035
      Left            =   1365
      MouseIcon       =   "frmAbout.frx":000C
      MousePointer    =   99  'Custom
      Picture         =   "frmAbout.frx":015E
      ScaleHeight     =   1035
      ScaleWidth      =   4800
      TabIndex        =   7
      Tag             =   "/index.html"
      ToolTipText     =   "Click to visit vbAccelerator.com - Advanced VB, C#
       and VB.NET source code."
      Top             =   75
      Width           =   4800
   End
   Begin VB.TextBox txtAcknowledgements 
      ForeColor       =   &H80000015&
      Height          =   1215
      Left            =   1380
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   2280
      Width           =   4815
   End
   Begin VB.PictureBox picNothing 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000010&
      BorderStyle     =   0  'None
      Height          =   1065
      Left            =   60
      ScaleHeight     =   71
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   408
      TabIndex        =   3
      Top             =   60
      Width           =   6120
      Begin VB.Label lblLinkTo 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Height          =   255
         Left            =   1320
         TabIndex        =   8
         Top             =   810
         Width           =   4815
      End
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   435
      Left            =   4860
      TabIndex        =   0
      Top             =   3660
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   1215
      Left            =   60
      ScaleHeight     =   1215
      ScaleWidth      =   6120
      TabIndex        =   5
      Top             =   60
      Width           =   6120
   End
   Begin VB.Label lblVersion 
      BackStyle       =   0  'Transparent
      Caption         =   "%Version%"
      Height          =   255
      Left            =   1380
      TabIndex        =   6
      Top             =   1980
      Width           =   4755
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      X1              =   4
      X2              =   412
      Y1              =   240
      Y2              =   240
   End
   Begin VB.Label lblAppName 
      BackStyle       =   0  'Transparent
      Caption         =   "%AppName%"
      Height          =   255
      Left            =   1380
      TabIndex        =   2
      Top             =   1320
      Width           =   4815
   End
   Begin VB.Label lblCopyright 
      BackStyle       =   0  'Transparent
      Caption         =   "%Copyright%"
      Height          =   495
      Left            =   1380
      TabIndex        =   1
      Top             =   3720
      Width           =   3435
   End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type
Private Type TRIVERTEX
   x As Long
   y As Long
   Red As Integer
   Green As Integer
   Blue As Integer
   Alpha As Integer
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type
Private Type GRADIENT_TRIANGLE
    Vertex1 As Long
    Vertex2 As Long
    Vertex3 As Long
End Type
Private Declare Function GradientFill Lib "msimg32" ( _
   ByVal hDC As Long, _
   pVertex As TRIVERTEX, _
   ByVal dwNumVertex As Long, _
   pMesh As GRADIENT_RECT, _
   ByVal dwNumMesh As Long, _
   ByVal dwMode As Long) As Long
Private Declare Function GradientFillTriangle Lib "msimg32" Alias
 "GradientFill" ( _
   ByVal hDC As Long, _
   pVertex As TRIVERTEX, _
   ByVal dwNumVertex As Long, _
   pMesh As GRADIENT_TRIANGLE, _
   ByVal dwNumMesh As Long, _
   ByVal dwMode As Long) As Long

Private Const GRADIENT_FILL_RECT_H As Long = 0
Private Const GRADIENT_FILL_RECT_V As Long = 1
Private Const GRADIENT_FILL_TRIANGLE As Long = &H2

Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR
 As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
 (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
 ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As
 Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal
 nIndex As Long) As Long
Private Const BITSPIXEL = 12         '  Number of bits per pixel

Private Type OSVERSIONINFO
   dwVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion(0 To 127) As Byte
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA"
 (lpVersionInfo As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As
 Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC
 As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal
 hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
 Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal
 hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC 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 CreateDIBSection Lib "gdi32" _
    (ByVal hDC As Long, _
    pBitmapInfo As BITMAPINFO, _
    ByVal un As Long, _
    lplpVoid As Long, _
    ByVal handle As Long, _
    ByVal dw As Long) As Long

Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "OLEPRO32.DLL" ( _
      lpPictDesc As PictDesc, _
      riid As GUID, _
      ByVal fPictureOwnsHandle As Long, _
      ipic As IPicture _
    ) As Long
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr()
 As Any) As Long

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
    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 BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  SourceConstantAlpha As Byte
  AlphaFormat As Byte
End Type
' BlendOp:
Private Const AC_SRC_OVER = &H0
' AlphaFormat:
Private Const AC_SRC_ALPHA = &H1

Private Declare Function AlphaBlend Lib "msimg32.dll" ( _
  ByVal hdcDest As Long, _
  ByVal nXOriginDest As Long, _
  ByVal nYOriginDest As Long, _
  ByVal nWidthDest As Long, _
  ByVal nHeightDest As Long, _
  ByVal hDcSrc As Long, _
  ByVal nXOriginSrc As Long, _
  ByVal nYOriginSrc As Long, _
  ByVal nWidthSrc As Long, _
  ByVal nHeightSrc As Long, _
  ByVal lBlendFunction As Long _
) As Long

Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal
 crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal
 nBkMode As Long) As Long
    Private Const OPAQUE = 2
    Private Const TRANSPARENT = 1
Private Declare Function DrawTextA Lib "user32" (ByVal hDC As Long, ByVal lpStr
 As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function DrawTextW Lib "user32" (ByVal hDC As Long, ByVal lpStr
 As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Const DT_LEFT = &H0&
    Private Const DT_TOP = &H0&
    Private Const DT_CENTER = &H1&
    Private Const DT_RIGHT = &H2&
    Private Const DT_VCENTER = &H4&
    Private Const DT_BOTTOM = &H8&
    Private Const DT_WORDBREAK = &H10&
    Private Const DT_SINGLELINE = &H20&
    Private Const DT_EXPANDTABS = &H40&
    Private Const DT_TABSTOP = &H80&
    Private Const DT_NOCLIP = &H100&
    Private Const DT_EXTERNALLEADING = &H200&
    Private Const DT_CALCRECT = &H400&
    Private Const DT_NOPREFIX = &H800
    Private Const DT_INTERNAL = &H1000&
    Private Const DT_WORD_ELLIPSIS = &H40000


Private m_hDib(0 To 1) As Long
Private m_hBmpOld(0 To 1) As Long
Private m_hDC(0 To 1) As Long
Private m_lPtr(0 To 1) As Long
Private m_tBI(0 To 1) As BITMAPINFO
Private m_lAlpha As Single

Private m_sAppName As String
Private m_sVersion As String
Private m_sCopyright As String
Private m_sCopyrightUrl As String
Private m_sTitle As String
Private m_sAcknowledgements As String
Private m_bShowing As Boolean

Private m_xDir() As Long
Private m_yDir() As Long

Private m_tOSV As OSVERSIONINFO


Private Sub SetAsUrl(ctl As Control, ByVal sUrl As String)
   If (Len(sUrl) > 0) Then
      ctl.Tag = sUrl
      ctl.ForeColor = &H800000
      ctl.FontUnderline = True
      ctl.MouseIcon = picLogo.MouseIcon
      ctl.MousePointer = 99
      If (Len(ctl.ToolTipText) = 0) Then
         ctl.ToolTipText = "Go to " & sUrl
      End If
   Else
      If Len(ctl.Tag) > 0 Then
         If (ctl.ToolTipText = "Go to " & ctl.Tag) Then
            ctl.ToolTipText = ""
         End If
         ctl.Tag = ""
      End If
      ctl.ForeColor = vbWindowText
      ctl.FontUnderline = False
      ctl.MousePointer = vbDefault
   End If
End Sub

Private Sub UrlClick(ctl As Control)
   If Len(ctl.Tag) > 0 Then
      ShellExecute Me.hWnd, "open", ctl.Tag, "", "", SW_SHOWNORMAL
   End If
End Sub

Public Property Get Acknowledgements() As String
   Acknowledgements = m_sAcknowledgements
End Property
Public Property Let Acknowledgements(ByVal sAcknowledgements As String)
   m_sAcknowledgements = sAcknowledgements
   If (m_bShowing) Then
      txtAcknowledgements = m_sAcknowledgements
   End If
End Property
Public Property Get Title() As String
   Title = m_sTitle
End Property
Public Property Let Title(ByVal sTitle As String)
   m_sTitle = sTitle
   If (m_bShowing) Then
      Me.Caption = m_sTitle
   End If
End Property
Public Property Get Copyright() As String
   Copyright = m_sCopyright
End Property
Public Property Let Copyright(ByVal sCopyright As String)
   m_sCopyright = sCopyright
   If (m_bShowing) Then
      lblCopyright.Caption = m_sCopyright
   End If
End Property
Public Property Get CopyrightUrl() As String
   CopyrightUrl = m_sCopyrightUrl
End Property
Public Property Let CopyrightUrl(ByVal sCopyrightUrl As String)
   m_sCopyrightUrl = sCopyrightUrl
   If (m_bShowing) Then
      SetAsUrl lblCopyright, m_sCopyrightUrl
   End If
End Property

Public Property Get Version() As String
   Version = m_sVersion
End Property
Public Property Let Version(ByVal sVersion As String)
   m_sVersion = sVersion
   If (m_bShowing) Then
      lblVersion.Caption = sVersion
   End If
End Property
Public Property Get AppName() As String
   AppName = m_sAppName
End Property
Public Property Let AppName(ByVal sAppName As String)
   m_sAppName = sAppName
   If (m_bShowing) Then
      lblAppName.Caption = m_sAppName
   End If
End Property


Private Sub cmdOK_Click()
   Unload Me
End Sub

Private Sub Form_Load()
   
   m_tOSV.dwVersionInfoSize = Len(m_tOSV)
   GetVersionEx m_tOSV
   
   ' Defaults:
   If Len(m_sAppName) = 0 Then
      m_sAppName = App.FileDescription
   End If
   If Len(m_sTitle) = 0 Then
      m_sTitle = App.Title
   End If
   If Len(m_sCopyright) = 0 Then
      m_sCopyright = App.LegalCopyright
   End If
   If Len(m_sVersion) = 0 Then
      m_sVersion = "Version: " & App.Major & "." & App.Minor & "." &
       App.Revision
   End If
   If Len(m_sAcknowledgements) = 0 Then
      m_sAcknowledgements = App.Comments
   End If
   
   Me.Caption = m_sTitle
   lblAppName.Caption = m_sAppName
   lblCopyright.Caption = m_sCopyright
   SetAsUrl lblCopyright, m_sCopyrightUrl
   lblVersion.Caption = m_sVersion
   txtAcknowledgements.Text = m_sAcknowledgements
   
   If Me.Icon.handle = 0 Then
      Dim frm As Form
      For Each frm In Forms
         If (frm.BorderStyle = 2) Then
            Me.Icon = frm.Icon
            Exit For
         End If
      Next
   End If
   
   m_bShowing = True
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   ClearUp 1
   ClearUp 0
End Sub

Private Sub Form_Resize()
   If (m_tOSV.dwMajorVersion > 4) Or _
      (m_tOSV.dwMajorVersion = 4) And (m_tOSV.dwMinorVersion >= 10) Then
      If (GetDeviceCaps(Me.hDC, BITSPIXEL) > 8) Then
         Me.Cls
         Dim tR As RECT
         tR.left = 0
         tR.top = 0
         tR.right = Me.ScaleWidth
         tR.bottom = Me.ScaleHeight
         GradientFillTri Me.hDC, tR, _
            BlendColor(vb3DHighlight, vbButtonFace), vbButtonFace, _
            vbButtonFace, BlendColor(vbButtonFace, vbButtonShadow, 224)
         Me.Refresh
      End If
   End If
End Sub

Private Sub lblCopyright_Click()
   UrlClick lblCopyright
End Sub

Private Sub lblLinkTo_Click()
   UrlClick lblLinkTo
End Sub

Private Sub picLogo_Click()
   UrlClick picLogo
End Sub

Private Sub GradientFillTri( _
      ByVal lHDC As Long, _
      tR As RECT, _
      ByVal topLeftColor As OLE_COLOR, _
      ByVal topRightColor As OLE_COLOR, _
      ByVal bottomLeftColor As OLE_COLOR, _
      ByVal bottomRightColor As OLE_COLOR _
   )
Dim hBrush As Long
Dim lTopLeftColor As Long
Dim lTopRightColor As Long
Dim lBottomLeftColor As Long
Dim lBottomRightColor As Long
Dim lR As Long
   
   ' Use GradientFill:
   OleTranslateColor topLeftColor, 0, lTopLeftColor
   OleTranslateColor topRightColor, 0, lTopRightColor
   OleTranslateColor bottomLeftColor, 0, lBottomLeftColor
   OleTranslateColor bottomRightColor, 0, lBottomRightColor

   Dim tTV(0 To 3) As TRIVERTEX
   Dim tGR(0 To 1)  As GRADIENT_TRIANGLE
   
   setTriVertexColor tTV(0), lTopLeftColor
   tTV(0).x = tR.left
   tTV(0).y = tR.top
   
   setTriVertexColor tTV(1), lTopRightColor
   tTV(1).x = tR.right
   tTV(1).y = tR.top
   
   setTriVertexColor tTV(2), lBottomRightColor
   tTV(2).x = tR.right
   tTV(2).y = tR.bottom
   
   setTriVertexColor tTV(3), lBottomLeftColor
   tTV(3).x = tR.left
   tTV(3).y = tR.bottom
   
   tGR(0).Vertex1 = 0
   tGR(0).Vertex2 = 1
   tGR(0).Vertex3 = 2
    
   tGR(1).Vertex1 = 0
   tGR(1).Vertex2 = 2
   tGR(1).Vertex3 = 3
   
   GradientFillTriangle lHDC, tTV(0), 4, tGR(0), 2, GRADIENT_FILL_TRIANGLE
   
End Sub

Private Sub setTriVertexColor(tTV As TRIVERTEX, lColor As Long)
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long
   lRed = (lColor And &HFF&) * &H100&
   lGreen = (lColor And &HFF00&)
   lBlue = (lColor And &HFF0000) \ &H100&
   setTriVertexColorComponent tTV.Red, lRed
   setTriVertexColorComponent tTV.Green, lGreen
   setTriVertexColorComponent tTV.Blue, lBlue
End Sub
Private Sub setTriVertexColorComponent(ByRef iColor As Integer, ByVal
 lComponent As Long)
   If (lComponent And &H8000&) = &H8000& Then
      iColor = (lComponent And &H7F00&)
      iColor = iColor Or &H8000
   Else
      iColor = lComponent
   End If
End Sub


Private Sub picNothing_Click()
   If (GetDeviceCaps(Me.hDC, BITSPIXEL) > 8) Then
      If Not (tmr.Enabled) Then
         CreateFromHBitmap 0, picLogo.Picture.handle
         Create 1, m_tBI(0).bmiHeader.biWidth, m_tBI(0).bmiHeader.biHeight
         LoadPictureBlt 1, m_hDC(0)
         picLogo.Visible = False
         m_lAlpha = 255
         tmr_Timer
         tmr.Enabled = True
      Else
         picLogo.Visible = True
         tmr.Enabled = False
      End If
   End If
End Sub

Private Sub tmr_Timer()
Dim tSAIn As SAFEARRAY2D
Dim bDibIn() As Byte
Dim tSAOut As SAFEARRAY2D
Dim bDibOut() As Byte
Static lIndexFrom As Long
Static lIndexTo As Long

Dim xEnd As Long, yEnd As Long
Dim x As Long, y As Long, y2 As Long, x2 As Long

   lIndexFrom = lIndexTo
   If (lIndexFrom = 1) Then
      lIndexTo = 0
   Else
      lIndexTo = 1
   End If
   '
   ' Get the bits in the from DIB section:
   With tSAIn
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = m_tBI(lIndexFrom).bmiHeader.biHeight
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = 4 * m_tBI(lIndexFrom).bmiHeader.biWidth
       .pvData = m_lPtr(lIndexFrom)
   End With
   CopyMemory ByVal VarPtrArray(bDibIn()), VarPtr(tSAIn), 4

   With tSAOut
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = m_tBI(lIndexTo).bmiHeader.biHeight
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = 4 * m_tBI(lIndexTo).bmiHeader.biWidth
       .pvData = m_lPtr(lIndexTo)
   End With
   CopyMemory ByVal VarPtrArray(bDibOut()), VarPtr(tSAOut), 4

   xEnd = tSAIn.Bounds(1).cElements - 4
   yEnd = tSAIn.Bounds(0).cElements - 1
   For y = yEnd To 0 Step -1
      For x = 0 To xEnd Step 4
         
         y2 = y + (Rnd * 4) - 2
         If (y2 < 0) Then
            y2 = yEnd + y2
         End If
         If (y2 > yEnd) Then
            y2 = y2 - yEnd - 1
         End If
         
         x2 = x + Int(Rnd * 4) * 4 - 64
         If (x2 < 0) Then
            x2 = xEnd + x2
         End If
         If (x2 > xEnd) Then
            x2 = x2 - xEnd - 4
         End If
         
         bDibOut(x, y) = (14& * bDibIn(x, y)) \ 16& + (1& * bDibIn(x2, y2) \
          16&) + 16&
         bDibOut(x + 1, y) = (14& * bDibIn(x + 1, y)) \ 16& + (1& * bDibIn(x2 +
          1, y2) \ 16&) + 16&
         bDibOut(x + 2, y) = (14& * bDibIn(x + 2, y)) \ 16& + (1& * bDibIn(x2 +
          2, y2) \ 16&) + 16&
         
      Next x
   Next y
   
   ' Clear the temporary array descriptor
   CopyMemory ByVal VarPtrArray(bDibIn), 0&, 4
   CopyMemory ByVal VarPtrArray(bDibOut), 0&, 4
   
   picNothing.Cls
   Dim lTextAlpha As Long
   Dim tR As RECT
   tR.left = 87
   tR.right = 87 + m_tBI(0).bmiHeader.biWidth
   tR.top = 1
   tR.bottom = 1 + m_tBI(0).bmiHeader.biHeight
   lTextAlpha = m_lAlpha + 128
   If (lTextAlpha <= 255) Then
      SetBkMode picNothing.hDC, TRANSPARENT
      SetTextColor picNothing.hDC, BlendColor(vbButtonShadow, vb3DHighlight,
       lTextAlpha)
      DrawText picNothing.hDC, "vbAccelerator is a site providing advanced,
       free source code for VB, C# and VB.NET programmers.  Specialities are
       controls, user interface and imaging.  Everything is free and comes
       complete with full source code.", tR, DT_CENTER Or DT_VCENTER Or
       DT_WORDBREAK
      If (lTextAlpha < 64) And (lblLinkTo.Tag = "") Then
         lblLinkTo.Caption = "/index.html"
         SetAsUrl lblLinkTo, "/index.html"
         lblLinkTo.ForeColor = BlendColor(vbButtonShadow, vb3DHighlight,
          lTextAlpha)
      End If
   End If
   If (m_lAlpha > 0) Then
   
      Dim lBlend As Long
      Dim bf As BLENDFUNCTION
      bf.BlendOp = AC_SRC_OVER
      bf.BlendFlags = 0
      bf.SourceConstantAlpha = m_lAlpha
      bf.AlphaFormat = 0
      CopyMemory lBlend, bf, 4
      AlphaBlend picNothing.hDC, _
         87, 1, m_tBI(0).bmiHeader.biWidth, m_tBI(0).bmiHeader.biHeight, _
         m_hDC(lIndexTo), _
         0, 0, m_tBI(0).bmiHeader.biWidth, m_tBI(0).bmiHeader.biHeight, _
         lBlend
   End If
   
   m_lAlpha = m_lAlpha - 4
   If (m_lAlpha < -128) Then
      tmr.Enabled = False
   End If
   picNothing.Refresh
   '
End Sub

Private Function CreateFromHBitmap( _
      ByVal lIndex As Long, _
      ByVal hBmp As Long _
   )
Dim lHDC As Long
Dim lhWnd As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBmp As BITMAP
   GetObjectAPI hBmp, Len(tBmp), tBmp
   If (Create(lIndex, tBmp.bmWidth, tBmp.bmHeight)) Then
      lhWnd = GetDesktopWindow()
      lhDCDesktop = GetDC(lhWnd)
      If (lhDCDesktop <> 0) Then
         lHDC = CreateCompatibleDC(lhDCDesktop)
         ReleaseDC lhWnd, lhDCDesktop ' 2003-07-05: Corrected for GDI leak in
          Win98
         If (lHDC <> 0) Then
            lhBmpOld = SelectObject(lHDC, hBmp)
            LoadPictureBlt lIndex, lHDC
            SelectObject lHDC, lhBmpOld
            DeleteDC lHDC
         End If
      End If
   End If
   
End Function

Private Function Create( _
        ByVal lIndex As Long, _
        ByVal lWidth As Long, _
        ByVal lHeight As Long _
    ) As Boolean
   ClearUp lIndex
   m_hDC(lIndex) = CreateCompatibleDC(Me.hDC)
   If (m_hDC(lIndex) <> 0) Then
       If (CreateDIB(lIndex, m_hDC(lIndex), lWidth, lHeight, m_hDib(lIndex)))
        Then
           m_hBmpOld(lIndex) = SelectObject(m_hDC(lIndex), m_hDib(lIndex))
           Create = True
       Else
           DeleteDC m_hDC(lIndex)
           m_hDC(lIndex) = 0
       End If
   End If
End Function

Private Sub LoadPictureBlt( _
        ByVal lIndex As Long, _
        ByVal lHDC As Long, _
        Optional ByVal lSrcLeft As Long = 0, _
        Optional ByVal lSrcTop As Long = 0, _
        Optional ByVal lSrcWidth As Long = -1, _
        Optional ByVal lSrcHeight As Long = -1, _
        Optional ByVal eRop As RasterOpConstants = vbSrcCopy _
    )
    If lSrcWidth < 0 Then lSrcWidth = m_tBI(lIndex).bmiHeader.biWidth
    If lSrcHeight < 0 Then lSrcHeight = m_tBI(lIndex).bmiHeader.biHeight
    BitBlt m_hDC(lIndex), 0, 0, lSrcWidth, lSrcHeight, lHDC, lSrcLeft, lSrcTop,
     eRop
End Sub

Private Sub ClearUp(ByVal lIndex As Long)
   If (m_hDC(lIndex) <> 0) Then
      If (m_hDib(lIndex) <> 0) Then
         SelectObject m_hDC(lIndex), m_hBmpOld(lIndex)
         DeleteObject m_hDib(lIndex)
      End If
      DeleteObject m_hDC(lIndex)
   End If
   m_hDC(lIndex) = 0: m_hDib(lIndex) = 0: m_hBmpOld(lIndex) = 0: m_lPtr(lIndex)
    = 0
End Sub

Private Function CreateDIB( _
      ByVal lIndex As Long, _
      ByVal lHDC As Long, _
      ByVal lWidth As Long, _
      ByVal lHeight As Long, _
      ByRef hDib As Long _
   ) As Boolean
   With m_tBI(lIndex).bmiHeader
      .biSize = Len(m_tBI(lIndex).bmiHeader)
      .biWidth = lWidth
      .biHeight = lHeight
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = BI_RGB
      .biSizeImage = lWidth * 4 * lHeight
   End With
   hDib = CreateDIBSection( _
         lHDC, _
         m_tBI(lIndex), _
         DIB_RGB_COLORS, _
         m_lPtr(lIndex), _
         0, 0)
   CreateDIB = (hDib <> 0)
End Function

Private Property Get BlendColor( _
      ByVal oColorFrom As OLE_COLOR, _
      ByVal oColorTo As OLE_COLOR, _
      Optional ByVal Alpha As Long = 128 _
   ) As Long
Dim lCFrom As Long
Dim lCTo As Long
   OleTranslateColor oColorFrom, 0, lCFrom
   OleTranslateColor oColorTo, 0, lCTo
Dim lSrcR As Long
Dim lSrcG As Long
Dim lSrcB As Long
Dim lDstR As Long
Dim lDstG As Long
Dim lDstB As Long
   lSrcR = lCFrom And &HFF
   lSrcG = (lCFrom And &HFF00&) \ &H100&
   lSrcB = (lCFrom And &HFF0000) \ &H10000
   lDstR = lCTo And &HFF
   lDstG = (lCTo And &HFF00&) \ &H100&
   lDstB = (lCTo And &HFF0000) \ &H10000
     
   
   BlendColor = RGB( _
      ((lSrcR * Alpha) / 255) + ((lDstR * (255 - Alpha)) / 255), _
      ((lSrcG * Alpha) / 255) + ((lDstG * (255 - Alpha)) / 255), _
      ((lSrcB * Alpha) / 255) + ((lDstB * (255 - Alpha)) / 255) _
      )
      
End Property

Private Function DrawText(ByVal hDC As Long, ByVal sText As String, rc As RECT,
 ByVal lFlags As Long)
Dim lPtr As Long
   If (m_tOSV.dwPlatformId = VER_PLATFORM_WIN32_NT) Then
      lPtr = StrPtr(sText)
      If Not (lPtr = 0) Then
         DrawTextW hDC, ByVal lPtr, -1, rc, lFlags
      End If
   Else
      DrawTextA hDC, sText, -1, rc, lFlags
   End If

End Function