Automatically changes controls to XP themed style in XP based OS.

  '************************************** 'Windows API/Global Declarations for :_ ' Automatically Create Manifest File _ '************************************** Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type '************************************** ' Name: _ Automatically Create Manifest ' File _ ' Description:Automatically changes cont ' rols to XP themed style in XP based OS. ' By: KRYO_11 ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:None ' 'Side Effects:None 'This code is copyrighted and has limite ' d warranties. 'Please see http://www.Planet-Source-Cod ' e.com/xq/ASP/txtCodeId.51893/lngWId.1/qx ' /vb/scripts/ShowCode.htm 'for details. '************************************** Public Function CreateManifest() As Boolean On Error Resume Next Dim EXEPath As String 'Get The EXE Path EXEPath = App.Path & IIf(Right(App.Path, 1) = "/", vbNullString, "/") EXEPath = EXEPath & App.EXEName & IIf(LCase(Right(App.EXEName, 4)) = ".exe", ".manifest", ".exe.manifest") 'Checks if the manifest has already been ' created If Dir(EXEPath, vbReadOnly Or vbSystem Or vbHidden) <> vbNullString Then GoTo ErrorHandler 'Makes sure you are using windows xp If WinVersion = "Windows XP" Then Dim iFileNumber As Integer iFileNumber = FreeFile 'Save the .manifest file Open EXEPath For Output As #iFileNumber Print #iFileNumber, FormatManifest CreateManifest = True Else Kill EXEPath End If 'set the file to be hidden Close #iFileNumber SetAttr EXEPath, vbHidden Or vbSystem Or vbReadOnly Or vbArchive ErrorHandler: Call InitCommonControls End Function 'get windows version (from Microsoft.com ' ) Private Function WinVersion() As String Dim osinfo As OSVERSIONINFO Dim retvalue As Integer osinfo.dwOSVersionInfoSize = 148 osinfo.szCSDVersion = Space$(128) retvalue = GetVersionExA(osinfo) With osinfo Select Case .dwPlatformId Case 1 If .dwMinorVersion = 0 Then WinVersion = "Windows 95" ElseIf .dwMinorVersion = 10 Then WinVersion = "Windows 98" End If Case 2 If .dwMajorVersion = 3 Then WinVersion = "Windows NT 3.51" ElseIf .dwMajorVersion = 4 Then WinVersion = "Windows NT 4.0" ElseIf .dwMajorVersion >= 5 Then WinVersion = "Windows XP" End If Case Else WinVersion = "Failed" End Select End With End Function 'Create the string for the manifest file ' Private Function FormatManifest() As String Dim Header As String Header = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & "?>" Header = Header & vbCrLf & "<assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & ">" Header = Header & vbCrLf & "<assemblyIdentity" Header = Header & vbCrLf & "version=" & Chr(34) & "1.0.0.0" & Chr(34) Header = Header & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) Header = Header & vbCrLf & "name=" & Chr(34) & "Microsoft.VisualBasic6.IDE" & Chr(34) Header = Header & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) Header = Header & vbCrLf & "/>" Header = Header & vbCrLf & "<description>Microsoft Visual Basic 6 IDE</description>" Header = Header & vbCrLf & "<dependency>" Header = Header & vbCrLf & "<dependentAssembly>" Header = Header & vbCrLf & "<assemblyIdentity" Header = Header & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) Header = Header & vbCrLf & "name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & Chr(34) Header = Header & vbCrLf & "version=" & Chr(34) & "6.0.0.0" & Chr(34) Header = Header & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) Header = Header & vbCrLf & "publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34) Header = Header & vbCrLf & "language=" & Chr(34) & "*" & Chr(34) Header = Header & vbCrLf & "/>" Header = Header & vbCrLf & "</dependentAssembly>" Header = Header & vbCrLf & "</dependency>" Header = Header & vbCrLf & "</assembly>" FormatManifest = Header End Function