纯代码启用 XP 样式 (不用额外的资源或 manifest 文件)

纯代码启用 XP 样式 (不用额外的资源或 manifest 文件)
manifest, 资源, 样式, 文件, 代码
将以下代码存为模块, 然后在第一个窗口的 Form_Initialize 事件或之前调用 EnableXPStyle 函数即可.

函数返回值为 True 表示成功, 注意必须编译后才有效果.
Option Explicit

Private Type ACTCTX

cbSize As Long

dwFlags As Long

lpSource As String

wProcessorArchitecture As Integer

wLangId As Integer

lpAssemblyDirectory As String

lpResourceName As String

lpApplicationName As String

hModule As Long

End Type

Private Declare Function GetWindowsDirectoryW Lib "kernel32.dll" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long

Private Declare Function CreateActCtxW Lib "kernel32.dll" (ByVal pActCtx As Long) As Long

Private Declare Function ActivateActCtx Lib "kernel32.dll" (ByVal hActCtx As Long, ByRef lpCookie As Long) As Long

Dim IDEMode As Boolean

Private Function SetIDE() As Boolean

IDEMode = True

SetIDE = True

End Function

Public Function EnableXPStyle() As Boolean

Dim Length As Long, Path As String, Ctx As ACTCTX, hActCtx As Long, Cookie As Long

Debug.Assert SetIDE

If IDEMode = False Then

Length = GetWindowsDirectoryW(0, 0)

If Length <> 0 Then

Path = Space(Length - 1)

If GetWindowsDirectoryW(StrPtr(Path), Length) <> 0 Then

Ctx.cbSize = Len(Ctx)

Ctx.lpSource = Path & "/WindowsShell.manifest"

hActCtx = CreateActCtxW(VarPtr(Ctx))

If hActCtx <> -1 Then

If ActivateActCtx(hActCtx, Cookie) <> 0 Then

EnableXPStyle = True

End If

End If

End If

End If

End If

End Function