home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / ComboBoxEX2066925222007.psc / ComboBoxEx32 / clsXPStyle.cls next >
Text File  |  2007-03-13  |  3KB  |  97 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsXPStyle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Declare Sub InitCommonControls Lib "comctl32" ()
  17. Private Declare Function ActivateWindowTheme Lib "uxtheme" Alias "SetWindowTheme" (ByVal hwnd As Long, Optional ByVal pszSubAppName As Long = 0, Optional ByVal pszSubIdList As Long = 0) As Long
  18. Private Declare Function DeactivateWindowTheme Lib "uxtheme" Alias "SetWindowTheme" (ByVal hwnd As Long, Optional ByRef pszSubAppName As String = " ", Optional ByRef pszSubIdList As String = " ") As Long
  19.  
  20. Sub UpdateManiFest()
  21. Dim ManiFest As String
  22.     ManiFest = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & _
  23.     Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & _
  24.     "?><assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & _
  25.     Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & _
  26.     "><assemblyIdentity version=" & Chr(34) & "1.0.0.0" & Chr(34) & _
  27.     " processorArchitecture=" & Chr(34) & "X86" & Chr(34) & " name=" & Chr(34) & _
  28.     "Template.WindowsXP.Theme" & Chr(34) & " type=" & Chr(34) & "win32" & _
  29.     Chr(34) & " /> <description>For use with VB6.</description> <dependency>" & _
  30.     " <dependentAssembly> <assemblyIdentity type=" & Chr(34) & "win32" & _
  31.     Chr(34) & " name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & _
  32.     Chr(34) & " version=" & Chr(34) & "6.0.0.0" & Chr(34) & _
  33.     " processorArchitecture=" & Chr(34) & "X86" & Chr(34) & _
  34.     " publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34) & _
  35.     " language=" & Chr(34) & "*" & Chr(34) & " /> </dependentAssembly>" & _
  36.     " </dependency> </assembly>"
  37. Dim sPath As String, Pid As Long
  38.     sPath = App.Path
  39.         If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  40.     sPath = sPath & App.EXEName & ".exe.manifest"
  41.         If IsFile(sPath) = False Then
  42.             Open sPath For Output As 1
  43.                 Print #1, ManiFest
  44.             Close 1
  45.                 SetAttr sPath, vbSystem + vbHidden
  46.         End If
  47. ManiFest = ""
  48. End Sub
  49. Public Function IsDir(d) As Boolean
  50. On Error GoTo E
  51.         IsDir = False
  52.     RmDir d
  53.         MkDir d
  54.         IsDir = True
  55. Exit Function
  56. E:
  57. '    Debug.Print Err.Description
  58.     If Err.Description = "Path not found" Then
  59.         IsDir = False
  60.     Else
  61.         IsDir = True
  62.     End If
  63. End Function
  64. Public Function IsFile(F) As Boolean
  65. On Error GoTo E
  66.     IsFile = False
  67.         If InStr(F, ":") = 0 Then
  68.             Exit Function
  69.         End If
  70.         If InStr(F, "\") = 0 Then
  71.             Exit Function
  72.         End If
  73. Dim N As Integer
  74.     N = FreeFile
  75.         Open F For Input As N
  76.         Close N
  77.         Reset
  78.     IsFile = True
  79. Exit Function
  80. E:
  81.     Reset
  82. IsFile = False
  83. End Function
  84.  
  85. Sub EnableTheme(ByVal hwnd As Long)
  86.     Call ActivateWindowTheme(hwnd)
  87. End Sub
  88.  
  89. Sub DisableTheme(ByVal hwnd As Long)
  90.     Call DeactivateWindowTheme(hwnd)
  91. End Sub
  92.  
  93. Sub InitTheme()
  94.     UpdateManiFest
  95. Call InitCommonControls
  96. End Sub
  97.