Código
Option Explicit Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long 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 Public Function CreateManifest() As Boolean 'Si hay algun error sigue a la siguiente accion On Error Resume Next Dim sPath As String 'Obtenemos la ruta de nuestro ejecutables sPath = String$(260, Chr$(0)) 'Gracias Cobein sPath = Left$(sPath, GetModuleFileName(App.hInstance, sPath, Len(sPath))) 'Comprobamos qu eno existe ningun fichero .Manifest _ 'y que no estamos ejecutando la aplicacion desde el Visual Studio If App.LogMode = 0 Then Exit Function If Dir(sPath & ".manifest", vbReadOnly Or vbSystem Or vbHidden) = vbNullString Then 'Obtenemos la version del Window$ If Win2Version = "XP" Then 'Si es XP significa que es compatible con el metodo Manifest _ ', por lo tanto crea el fichero Open sPath & ".manifest" For Output As #1 'Le introduce los datos... Print #1, FormatManifest 'Todo ha ido bien... CreateManifest = True Close #1 'Estable el fichero como: Oculto/System/SoloLectura/Archivo SetAttr sPath & ".manifest", vbHidden Or vbSystem Or vbReadOnly Or vbArchive 'Y lo vuelve a ejecutar, para que los cambios tengan efecto Shell sPath, vbNormalFocus End End If End If 'LLamamos al API.... Call InitCommonControls End Function Private Function Win2Version() As String 'Declaramos las variables para esta funcion Dim OSInf As OSVERSIONINFO, iRet As Integer OSInf.dwOSVersionInfoSize = 148 OSInf.szCSDVersion = Space$(128) 'Obtenemos la informacion del Window$ iRet = GetVersionExA(OSInf) 'Si no se ha podido obtener correctamente devuelve 'Unknown' If iRet = 0 Then Win2Version = "Unk": Exit Function With OSInf Select Case .dwPlatformId Case 1 Select Case .dwMinorVersion Case 0 'En caso de que sea Win95 Win2Version = "95" Case 10 'En caso de que sea Win98 Win2Version = "98" Case 90 'En caso de que sea Win Millenium Win2Version = "Mi" End Select Case 2 Select Case .dwMajorVersion Case 3 Or 4 'En caso de que sea NT (Aqui no he distinguido entre las dos versiones...) Win2Version = "NT" Case 5 Select Case .dwMinorVersion Case 0 'En caso de que sea Win2000 Win2Version = "2000" Case 1 'En caso de que sea XP Win2Version = "XP" Case 2 'En caso de que sea Win2003 (SERVER) Win2Version = "2003" End Select Case 6 'En caso de que sea Win Vista Win2Version = "Vista" End Select Case Else 'En caso de que sea que sea desconocido... Win2Version = "Unk" End Select End With End Function Private Function FormatManifest() As String Dim Header As String 'Carga el .manifest en una variable Header = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & "?>" _ & vbCrLf & "<assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & ">" _ & vbCrLf & "<assemblyIdentity" _ & vbCrLf & "version=" & Chr(34) & "1.0.0.0" & Chr(34) _ & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) _ & vbCrLf & "name=" & Chr(34) & App.EXEName & ".exe" & Chr(34) _ & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) _ & vbCrLf & "/>" _ & vbCrLf & "<description>" & App.Comments & "</description>" _ & vbCrLf & "<dependency>" _ & vbCrLf & "<dependentAssembly>" _ & vbCrLf & "<assemblyIdentity" _ & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) _ & vbCrLf & "name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & Chr(34) _ & vbCrLf & "version=" & Chr(34) & "6.0.0.0" & Chr(34) _ & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) _ & vbCrLf & "publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34) _ & vbCrLf & "language=" & Chr(34) & "*" & Chr(34) _ & vbCrLf & "/>" _ & vbCrLf & "</dependentAssembly>" _ & vbCrLf & "</dependency>" _ & vbCrLf & "</assembly>" FormatManifest = Header End Function
Aqui esta el codigo, quien quiera descargarlo que lo haga de aqui:
Citar
Uso:
Simplemente llamando a la funcion CreateManifest se cambia solo el estilo, pero solo funciona cuando esta compilado...
Ah!! Os doy un pequeño aviso:
Por lo visto los chicos de Microsoft tuvieron algunos problemas , porque resulta, que al poner un optionbutton dentro de un frame se queda de color de fondo negro, asi que, os doy la solucion al problema: Meter los controles con los que os pase eso dentro de un Picture... eso lo soluciona