纯代码启用 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