vbAccelerator - Contents of code file: frmAbout.frm

VERSION 5.00
Begin VB.Form frmAbout 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "About Theme Explorer"
   ClientHeight    =   3090
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4680
   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     =   3090
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Timer tmrFadeOut 
      Enabled         =   0   'False
      Interval        =   20
      Left            =   960
      Top             =   2460
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   435
      Left            =   3180
      TabIndex        =   0
      Top             =   2580
      Width           =   1335
   End
   Begin VB.Label lblInfo 
      BackStyle       =   0  'Transparent
      Caption         =   "This sample enables you to try drawing with the
       various theme parts and states exposed by UxTheme.DLL on Windows XP and
       above."
      Height          =   1935
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   4395
   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 Const ETDT_DISABLE = &H1
Private Const ETDT_ENABLE = &H2
Private Const ETDT_USETABTEXTURE = &H4
Private Const ETDT_ENABLETAB = (ETDT_ENABLE Or ETDT_USETABTEXTURE)
Private Declare Function EnableThemeDialogTexture Lib "uxtheme.dll" ( _
   ByVal hWnd As Long, ByVal dwFlags As Long) As Long
Private Declare Function IsThemeDialogTextureEnabled Lib "uxtheme.dll" ( _
   ByVal hWnd As Long) As Long

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 Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
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 Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000

Private m_cUxTheme As cUxTheme
Private m_cSysIml As cVBALSysImageList
Private m_lAlpha As Long

Private Sub cmdOK_Click()
   frmXPThemeExplorer.Enabled = True
   frmXPThemeExplorer.SetFocus
   tmrFadeOut.Enabled = True
End Sub

Private Sub Form_Load()
   ' sets dialog texturing on.  Depends on installed theme
   ' whether anything happens...
   EnableThemeDialogTexture Me.hWnd, ETDT_ENABLE
   
   Set m_cSysIml = New cVBALSysImageList
   m_cSysIml.IconSizeX = 32
   m_cSysIml.IconSizeY = 32
   m_cSysIml.Create
   Set m_cUxTheme = New cUxTheme
   m_cUxTheme.hWnd = Me.hWnd
   m_cUxTheme.hIml = m_cSysIml.hIml
   m_lAlpha = 255
End Sub


Private Sub Form_Paint()
   
   With m_cUxTheme
      .Class = "Tab"
      .Text = ""
      .IconIndex = 0
      .Part = TABP_BODY
      .State = 1
      .hdc = Me.hdc
      .Width = Me.ScaleWidth \ Screen.TwipsPerPixelX
      .Height = Me.ScaleHeight \ Screen.TwipsPerPixelY
      .Draw
   
      .Text = "vbAccelerator.com Theme Explorer"
      .TextAlign = DT_LEFT Or DT_VCENTER Or DT_SINGLELINE
      .Class = "ExplorerBar"
      .Part = EBP_HEADERBACKGROUND
      .State = 1
      .left = 2
      .tOp = 2
      .Width = .Width - 4
      .Height = 32
      .IconIndex = m_cSysIml.ItemIndex(App.Path & "\" & App.EXEName & ".exe")
      .Draw
   End With
   
End Sub

Private Sub tmrFadeOut_Timer()
   If (m_lAlpha = 255) Then
      Dim lStyle As Long
      lStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
      lStyle = lStyle Or WS_EX_LAYERED
      SetWindowLong Me.hWnd, GWL_EXSTYLE, lStyle
   End If
   Dim lAlpha
   m_lAlpha = m_lAlpha - 25
   lAlpha = m_lAlpha
   If (lAlpha < 0) Then
      lAlpha = 0
   End If
   SetLayeredWindowAttributes Me.hWnd, 0, lAlpha, LWA_ALPHA
   If (m_lAlpha < 0) Then
      Unload Me
   End If
End Sub