un code bien pratique qui permet de créer des icône au format windows XP.
je n'ai pas encore fait le module vraie couleur. il y a le bouton mais il ne sert encore à rien.
bon avant de donner le code, une explication du principe s'impose :
ce code permet, à partir de 2 BMP de créer un icône au formats XP
il s'appuie sur 2 images d'un même objet. la première image avec le dessin sur fonc blanc, la deuxième avec le dessin sur fond noir.
le programme reconstituant la transparence et les effets de fondu du dessin (par exemple une ombre)
puis il enregistre l'icône au format XP
il faut que l'image fasse 16*16, 32*32, ou 48*48
le programme va ensuite créer un icône au format XP de la même taille
il ne reste plus qu'à assembler les différent formats d'icones dans un éditeur d'icône pour obtenir un icone complet ( ça fait beaucoup d'icône, ça
)le but est simple, c'est de faire un dessin sous photoshop avec de la tranparence complète ou partielle( effet de fondu), de l'enregistrer en BMP sur fond blanc et sur fond noir puis d'obtenir un icône.
donc le code, il est comme d'habitude peu commenté mais je me tient à dispo en cas de question.
Code : Tout sélectionner
Global Taille
Declare Compilation_XP(Fichier.s)
Declare Compilation_VC(Fichier.s)
; Chargement des images
UseJPEGImageDecoder()
UsePNGImageDecoder()
ImageB.s = OpenFileRequester("Image avec le fond blanc", "Image - Fond blanc.bmp", "Image|*.bmp;*.png;*.jpg", 1)
If ImageB
If LoadImage(0, ImageB)
If ImageHeight() = ImageWidth()
Select ImageHeight()
Case 16
Taille = 16
Case 32
Taille = 32
Case 48
Taille = 48
Default
MessageRequester("Erreur", "La taille de l'image n'est pas égale à 16x16, 32x32 ou 48x48", 0)
End
EndSelect
Else
MessageRequester("Erreur", "La largeur de l'image est différente de la hauteur", 0)
End
EndIf
Else
MessageRequester("Erreur", "Impossible de charger l'image", 0)
End
EndIf
Else
End
EndIf
ImageN.s = OpenFileRequester("Image avec le fond blanc", "Image - Fond noir.bmp", "Image|*.bmp;*.png;*.jpg", 1)
If ImageN
If LoadImage(1, ImageN)
If ImageHeight() <> Taille Or ImageWidth() <> Taille
MessageRequester("Erreur", "La largeur de l'image est différente de la hauteur", 0)
End
EndIf
Else
MessageRequester("Erreur", "Impossible de charger l'image", 0)
End
EndIf
Else
End
EndIf
If OpenWindow(0, 0, 0, 300, 225, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget, "Test") = 0 Or CreateGadgetList(WindowID()) = 0
End
EndIf
; Affichage des images
Frame3DGadget(10, 5, 0, 140, 75, "Image avec le fond blanc")
ImageGadget(0, 20, 20, Taille, Taille, UseImage(0))
Frame3DGadget(11, 155, 0, 140, 75, "Image avec le fond noir")
ImageGadget(1, 170, 20, Taille, Taille, UseImage(1))
; Création des tableaux
Dim ImageB(Taille - 1, Taille - 1)
Dim ImageN(Taille - 1, Taille - 1)
Dim Masque(Taille - 1, Taille - 1)
; On encode les images
UseImage(0)
StartDrawing(ImageOutput())
For n = 0 To Taille - 1
For nn = 0 To Taille - 1
ImageB(n, nn) = Point(n, nn)
Next
Next
StopDrawing()
UseImage(1)
StartDrawing(ImageOutput())
For n = 0 To Taille - 1
For nn = 0 To Taille - 1
ImageN(n, nn) = Point(n, nn)
Next
Next
StopDrawing()
; Calcul de l'image et du masque
For n = 0 To Taille - 1
For nn = 0 To Taille - 1
If ImageB(n, nn) <> ImageN(n, nn)
Red0 = Red(ImageB(n, nn))
Red1 = Red(ImageN(n, nn))
Green0 = Green((ImageB(n, nn)))
Green1 = Green((ImageN(n, nn)))
Blue0 = Blue((ImageB(n, nn)))
Blue1 = Blue((ImageN(n, nn)))
Masque(n, nn) = Int((255 - Red0 + Red1 + 255 - Green0 + Green1 + 255 - Blue0 + Blue1) / 3 + 0.5)
ImageN(n, nn) = RGB(Int(Red1 * 255 / Masque(n, nn) + 0.5), Int(Green1 * 255 / Masque(n, nn) + 0.5), Int(Blue1 * 255 / Masque(n, nn) + 0.5))
Else
Masque(n, nn) = 255
EndIf
Next
Next
; Dessin de l'image
CreateImage(2, Taille, Taille)
StartDrawing(ImageOutput())
For n = 0 To Taille - 1
For nn = 0 To Taille - 1
Plot(n, nn, ImageN(n, nn))
Next
Next
StopDrawing()
; Dessin du masque
CreateImage(3, Taille, Taille)
StartDrawing(ImageOutput())
For n = 0 To Taille - 1
For nn = 0 To Taille - 1
Plot(n, nn, RGB(255 - Masque(n, nn), 255 - Masque(n, nn), 255 - Masque(n, nn)))
Next
Next
StopDrawing()
; On affiche l'image et le masque
Frame3DGadget(12, 5, 80, 140, 75, "Image")
ImageGadget(2, 20, 100, Taille, Taille, UseImage(2))
Frame3DGadget(13, 155, 80, 140, 75, "Masque")
ImageGadget(3, 170, 100, Taille, Taille, UseImage(3))
ButtonGadget(20, 5, 160, 290, 22, "Enregistrer l'icône au format XP")
ButtonGadget(21, 5, 184, 290, 22, "Enregistrer l'icône au format Vrai Couleur")
CheckBoxGadget(22, 5, 208, 290, 15, "Ouvrir l'icône après l'enregistrement")
Repeat
Event = WaitWindowEvent()
If Event = #PB_EventGadget
Select EventGadgetID() ; boutons, zone de texte, ...
Case 20
Fichier.s = SaveFileRequester("Icône", "Icône XP - " + Str(Taille), "Icône|*.ico", 1)
If Fichier
If LCase(Right(Fichier, 4)) <> ".ico"
Fichier = Fichier + ".ico"
EndIf
If IsFilename(GetFilePart(Fichier))
Compilation_XP(Fichier)
If GetGadgetState(22)
RunProgram(Fichier)
EndIf
EndIf
EndIf
Case 21
Fichier.s = SaveFileRequester("Icône", "Icône Vrai Couleur - " + Str(Taille), "Icône|*.ico", 1)
If Fichier
If LCase(Right(Fichier, 4)) <> ".ico"
Fichier = Fichier + ".ico"
EndIf
If IsFilename(GetFilePart(Fichier))
Compilation_VC(Fichier)
If GetGadgetState(22)
RunProgram(Fichier)
EndIf
EndIf
EndIf
EndSelect
EndIf
Until Event = #PB_EventCloseWindow
End
Procedure Compilation_VC(Fichier.s)
EndProcedure
Procedure Compilation_XP(Fichier.s)
If CreateFile(0, Fichier)
; On copie l'entête
Select Taille
Case 16
Restore Icone16
Case 32
Restore Icone32
Case 48
Restore Icone48
EndSelect
For n = 1 To 62
Read lecture.b
UseFile(0)
WriteByte(lecture)
Next
; On enregistre l'image
UseFile(0)
For n = Taille - 1 To 0 Step - 1
For nn = 0 To Taille - 1
; Composante bleu de la couleur
Couleur.l = Blue(ImageN(nn, n))
If Couleur > 127
Bleu.b = Couleur - 256
Else
Bleu = Couleur
EndIf
WriteByte(Bleu)
; Composante vert de la couleur
Couleur.l = Green(ImageN(nn, n))
If Couleur > 127
Vert.b = Couleur - 256
Else
Vert = Couleur
EndIf
WriteByte(Vert)
; Composante rouge de la couleur
Couleur.l = Red(ImageN(nn, n))
If Couleur > 127
Rouge.b = Couleur - 256
Else
Rouge = Couleur
EndIf
WriteByte(Rouge)
; Niveau de transparence de la couleur
; 0 = transparent
; 255 = opaque
Couleur = Masque(nn, n)
If Couleur > 127
Masque.b = Couleur - 256
Else
Masque = Couleur
EndIf
WriteByte(Masque)
Next
Next
; Ecriture du masque classique
UseFile(0)
Cpt = 0
MasqueBinaire.b = 0
For n = Taille - 1 To 0 Step -1
For nn = 0 To Taille - 1
Cpt + 1
; le masque est en binaire, un 1 signifie que le point est transparent
If Masque(nn, n) = 0
Select Cpt
Case 1
MasqueBinaire = MasqueBinaire + %10000000
Case 2
MasqueBinaire = MasqueBinaire + %01000000
Case 3
MasqueBinaire = MasqueBinaire + %00100000
Case 4
MasqueBinaire = MasqueBinaire + %00010000
Case 5
MasqueBinaire = MasqueBinaire + %00001000
Case 6
MasqueBinaire = MasqueBinaire + %00000100
Case 7
MasqueBinaire = MasqueBinaire + %00000010
Case 8
MasqueBinaire = MasqueBinaire + %00000001
EndSelect
EndIf
If Cpt = 8
WriteByte(MasqueBinaire)
Cpt = 0
MasqueBinaire = 0
EndIf
Next
; on complete avec les lignes vides en fonction de la taille de l'icône (faut pas trop chercher à comprendre, moi je trouve que c'est n'importe quoi)
Select Taille
Case 16
If n / 2 = Int(n / 2) ; une ligne sur 2
For i = 1 To 2
WriteByte(0)
Next
EndIf
Case 16
; pas de ligne vide
Case 48
If n / 3 = Int(n / 3) ; une ligne sur 3
For i = 1 To 2
WriteByte(0)
Next
EndIf
EndSelect
Next
CloseFile(0)
EndIf
EndProcedure
DataSection
Icone16 :
Data.b 0, 0, 1, 0, 1, 0, 16, 16, 0, 0, 1, 0, 32, 0, 104, 4, 0, 0, 22, 0, 0, 0, 40, 0, 0, 0, 16, 0, 0, 0, 32, 0, 0, 0, 1, 0, 32, 0, 0, 0, 0, 0, 64, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
Icone32 :
Data.b 0, 0, 1, 0, 1, 0, 32, 32, 0, 0, 1, 0, 32, 0, -88, 16, 0, 0, 22, 0, 0, 0, 40, 0, 0, 0, 32, 0, 0, 0, 64, 0, 0, 0, 1, 0, 32, 0, 0, 0, 0, 0, -128, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
Icone48 :
Data.b 0, 0, 1, 0, 1, 0, 48, 48, 0, 0, 1, 0, 32, 0, -88, 37, 0, 0, 22, 0, 0, 0, 40, 0, 0, 0, 48, 0, 0, 0, 96, 0, 0, 0, 1, 0, 32, 0, 0, 0, 0, 0, -128, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
EndDataSection
