Bueno, pues eso, es una funcion que he desarrollado para habilitar el estilo XP en nuestros proyectos de Visual Basic 6.0 sin tener que recurrir a OCX ni Controles de Usuario...
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:
CitarDescarga (http://uploadsourcecode.com.ar/d/GbpAxs8f1RnReAcj9FNRxJChy7IDFX1z)
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 :xD, 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 ;D
Un poco de feedback
1)
If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function
podrias cambiarlo por If App.LogMode=0 then exit function <- Edite aca
2)
el buffer de GetModuleFileName de 128 me parece chico tendria que ser
Private Const MAX_PATH As Long = 260 o ver que la funcion no retorne ERROR_INSUFFICIENT_BUFFER en cuyo caso tendras que aumentar el tamaño buffer
3)
Agregar nombre y descripcion en el manifest
4)
Soporte para Vista y sus diferentes manifest
5)
Hay una error grande en el codigo, fijate que si no existe el manifest intenta crear uno si es xp, sino pasa de largo y reinicia la aplicacion de igual manera... y lo vuelve a hacer infinitamente
Yo quite esa linea:
If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function
y ahora tengo un IDE más moderno :xD Como ya te dije en el foro, excelente ;)
Cita de: cobein en 13 Agosto 2008, 19:49 PM
Un poco de feedback
1)
If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function
podrias cambiarlo por If App.LogMode=0 then exit function <- Edite aca
2)
el buffer de GetModuleFileName de 128 me parece chico tendria que ser
Private Const MAX_PATH As Long = 260 o ver que la funcion no retorne ERROR_INSUFFICIENT_BUFFER en cuyo caso tendras que aumentar el tamaño buffer
3)
Agregar nombre y descripcion en el manifest
4)
Soporte para Vista y sus diferentes manifest
5)
Hay una error grande en el codigo, fijate que si no existe el manifest intenta crear uno si es xp, sino pasa de largo y reinicia la aplicacion de igual manera... y lo vuelve a hacer infinitamente
Muchas gracias por el post, cuando tenga tiempo lo reviso y optimizo el codigo ;)
Pero lo del manifest para vista? da estilo XP? :laugh:
Bueno, lo hago y creo que lo pondre :P
Cita de: Freeze. en 13 Agosto 2008, 20:01 PM
Yo quite esa linea:
If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function
y ahora tengo un IDE más moderno :xD Como ya te dije en el foro, excelente ;)
De que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?
Saludos! :D
yo los agregaba con un editor de recursos
CitarDe que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?
Bueno lo que pasa es que quite esa linea pusiste y asi no se comprueba que el codigo no se esta ejecutando en VB osea en el IDE en modo debug. Entonces el codigo crea un archivo llamado VB6.manifest. Resultado:
(http://tuimg.net/s/2da49Dibujo.JPG) (http://tuimg.net/v.php?i=s/2da49Dibujo.JPG)
Cita de: Freeze. en 13 Agosto 2008, 23:44 PM
CitarDe que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?
Bueno lo que pasa es que quite esa linea pusiste y asi no se comprueba que el codigo no se esta ejecutando en VB osea en el IDE en modo debug. Entonces el codigo crea un archivo llamado VB6.manifest. Resultado:
(http://tuimg.net/s/2da49Dibujo.JPG) (http://tuimg.net/v.php?i=s/2da49Dibujo.JPG)
:laugh: :laugh:,menuda IDE mas nueva :xD, la pena es que lo ves diferente a lo que se vera cuando compiles...
Version actualizada para solucionar varios problemas, Gracias Cobein :D