1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
| Option Explicit
'entête d'un fichier BITMAP
Private Type BITMAPFILEHEADER ' 14 Bytes
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
'un fichier BITMAP
Private Type Bitmap
Header As BITMAPFILEHEADER
Data() As Byte
End Type
'obtient un handle de modification de ressource
Private Declare Function BeginUpdateResource Lib "kernel32.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
'met à jour des infos de ressource
Private Declare Function UpdateResource Lib "kernel32.dll" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
'enregistre des infos de ressource dans le fichier
Private Declare Function EndUpdateResource Lib "kernel32.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
'copie une zone mémoire dans une autre
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
'ressource bitmap
'type Resource Bitmap
Private Const RT_BITMAP As Long = 2&
'extrait les données d'un fichier Bitmap pour le transformer en ressource
'========================================================================
'FileName : nom du fichier Bitmap
'renvoie une structure bitmap (entête + données)
Private Function MakeBitmapExe(FileName As String) As Bitmap
Dim FileNum As Integer
FileNum = FreeFile
Open FileName For Binary As #FileNum
Get #FileNum, , MakeBitmapExe.Header
ReDim MakeBitmapExe.Data(MakeBitmapExe.Header.bfSize - 14)
Get #FileNum, , MakeBitmapExe.Data
Close #FileNum
End Function
'remplace une bitmap du fichier
'===============================
'FileName : nom du fichier executable
'BitmapFile : nom du fichier icone
'BaseID : ID de la bitmap
'LangID : ID de la langue de la bitmap
Public Function ReplaceBitmapInExe(FileName As String, BitmapFile As String, BaseID As Long, LangID As Long) As Boolean
Dim hWrite As Long 'handle de modification
Dim ret As Long 'valeur de retour
Dim Exe As Bitmap 'contenu du fichier bitmap
Dim X As Long 'compteur
'obtient un handle de modification
hWrite = BeginUpdateResource(FileName, 0)
'si échec, on quitte
If hWrite = 0 Then ReplaceBitmapInExe = False: Exit Function
'sinon, on lit l'icone
Exe = MakeBitmapExe(BitmapFile)
'on met à jour la ressource bitmap
ret = UpdateResource(hWrite, RT_BITMAP, BaseID, LangID, ByVal VarPtr(Exe.Data(0)), UBound(Exe.Data))
'si échec, on quitte
If ret = 0 Then ReplaceBitmapInExe = False: EndUpdateResource hWrite, 1: Exit Function
'on enregsitre dans le fichier executable
ret = EndUpdateResource(hWrite, 0)
'si échec, on quitte
If ret = 0 Then ReplaceBitmapInExe = False: Exit Function
'sinon succès
ReplaceBitmapInExe = True
End Function |
Partager