27 Desember 2011

Merubah tampilan vb6 dengan manifest internal

1.tambah module
Code:

Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
(iccex As tagInitCommonControlsEx) As Boolean

Private Const ICC_USEREX_CLASSES = &H200
Public Sub adit()
On Error Resume Next
Dim F As String
F = App.Path & "\" & App.EXEName & ".exe.manifest"
If Dir(F) = "" Then
Open F For Output As #3
Print #3, "<?xml version=" & Chr(&H22) & "1.0" & _
Chr(&H22) & " encoding=" & Chr(&H22) & "UTF-8" & _
Chr(&H22) & " standalone=" & Chr(&H22) & "yes" & _
Chr(&H22) & " ?>"
Print #3, "<assembly xmlns=" & Chr(&H22) & _
"urn:schemas-microsoft-com:asm.v1" & Chr(&H22) & _
" manifestVersion=" & Chr(&H22) & "1.0" & Chr(&H22) & ">"
Print #3, vbTab & "<assemblyIdentity"
Print #3, vbTab & vbTab & "version=" & Chr(&H22) & _
"1.0.0.0" & Chr(&H22)
Print #3, vbTab & vbTab & "processorArchitecture=" & _
Chr(&H22) & "X86" & Chr(&H22)
Print #3, vbTab & vbTab & "name=" & Chr(&H22) & _
App.CompanyName & "." & App.ProductName & "." & _
App.EXEName & Chr(&H22)
Print #3, vbTab & vbTab & "type=" & Chr(&H22) & _
"win32" & Chr(&H22) & " />"
Print #3, vbTab & "<description>" & App.Comments & _
"</description>"
Print #3, vbTab & "<dependency>"
Print #3, vbTab & "<dependentAssembly>"
Print #3, vbTab & "<assemblyIdentity"
Print #3, vbTab & vbTab & "type=" & Chr(&H22) & _
"win32" & Chr(&H22)
Print #3, vbTab & vbTab & "name=" & Chr(&H22) & _
"Microsoft.Windows.Common-Controls" & Chr(&H22)
Print #3, vbTab & vbTab & "version=" & Chr(&H22) _
& "6.0.0.0" & Chr(&H22)
Print #3, vbTab & vbTab & "processorArchitecture=" & _
Chr(&H22) & "X86" & Chr(&H22)
Print #3, vbTab & vbTab & "publicKeyToken=" & _
Chr(&H22) & "6595b64144ccf1df" & Chr(&H22)
Print #3, vbTab & vbTab & "language=" & Chr(&H22) & _
"*" & Chr(&H22) & " />"
Print #3, vbTab & "</dependentAssembly>"
Print #3, vbTab & "</dependency>"
Print #3, "</assembly>"
Print #3, ""
Close #3
Shell App.Path & "\" & App.EXEName & ".exe", vbNormalFocus
DoEvents
End
End If
Dim Ticce As tagInitCommonControlsEx
Ticce.lngSize = LenB(iccex)
Ticce.lngICC = ICC_USEREX_CLASSES
InitCommonControlsEx Ticce
Kill App.Path & "\" & App.EXEName & ".exe.manifest"
On Error GoTo 0


End Sub


2.klik2x pada form load
Code:
adit







0 komentar:

cursor: url("http://i137.photobucket.com/albums/q210/kyawsawdin/FireRed.gif"), default;

ShoutMix chat widget