iconemaker

Programmation d'applications complexes
Répondre
Mesa
Messages : 1126
Inscription : mer. 14/sept./2011 16:59

iconemaker

Message par Mesa »

Je déterre un vieux code de purearea mais comme j'ai eu besoin de m'en servir et que la traduction de l'allemand vers le français même avec google est assez longue, autant le proposer ici.

Code : Tout sélectionner

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=11194&postdays=0&postorder=asc&start=20
; Author: Thomas (improved by Scarabol)
; Date: 21. December 2006
; OS: Windows
; Demo: Yes

;#################################
;#                               #
;#  IconCreator Professional     #
;#                               #
;#    written by Thomas          #
;#    modded by Scarabol         #
;#                               #
;#################################

;*****-Initialisation-*****
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

;*****-Fenetre-*****
Enumeration
  #fenetre_principale
EndEnumeration

;*****-Appli-*****
Enumeration
  #ImageSelectionne
  #OrginalBitmap
  #Bitmap
  #Icon
EndEnumeration

;*****-Gadgets-*****
Enumeration
  #Frame3D_Taille
  #Frame3D_Transparence
  #Frame3D_Apercu
  #TextColorTransparent
  #TextChooseColorTransparent
  #Option16
  #Option24
  #Option32
  #Option48
  #CheckTransparent
  #ColorTransparent
  #ChooseColorTransparent
  #ImageBitmap
  #Bouton_Enregistrer
  #Bouton_Quit
  #ButtonImageOpenFile
  #ButtonOpenFile
EndEnumeration

;*****-nom-*****
#Titre = "IconCreator Professionnel"

;*****-Variable, Strings-*****
Global Bitmap$
Global SaveIcon$
Global TransparentColor.l = RGB(255,255,255)

;*****-Créer une Icône-*****
Procedure CreateIcon()

  If GetGadgetState(#Option16) <> 0
    Restore IconHeader_16
  ElseIf GetGadgetState(#Option24) <> 0
    Restore IconHeader_24
  ElseIf GetGadgetState(#Option32) <> 0
    Restore IconHeader_32
  ElseIf GetGadgetState(#Option48) <> 0
    Restore IconHeader_48
  Else ; Bien que pratiquement impossible, mais mieux vaut prévenir que guérir :-)
    ProcedureReturn 0
  EndIf

  ; nouveau fichier
  If CreateFile(#Icon, SaveIcon$+".ico") = 0 : ProcedureReturn 0 : EndIf

  ; Ecrire en-tête 
  For i=1 To 62 : Read ThisValue : WriteByte(#Icon,ThisValue) : Next i

  ; juste pour être sûr
  If IsImage(#Bitmap) = 0 : ProcedureReturn 0 : EndIf

  ; StartDrawing pour les opérations ultérieures de dessin
  StartDrawing(ImageOutput(#Bitmap))

  ;Crée une palette de 256 Couleurs
  Dim UsedColors.l(255)
  UsedColors(0) = RGB(0,0,0)
  UsedColorCount.l = 1
  For y=31 To 0 Step -1
    For x=0 To 31 Step 1
      Couleur.l = Point(x,y)
      AddToList.l = 1
      For i=0 To UsedColorCount
        If Couleur = UsedColors(i)
          AddToList = 0
          i = UsedColorCount
        EndIf
      Next i
      If UsedColorCount=255 And AddToList
        MIN_I = 1
        MIN_DIF = 0
        For i=1 To UsedColorCount
          If Abs(Couleur-UsedColors(i)) < MIN_DIF Or i = 1
            MIN_I = i
            MIN_DIF = Abs(Couleur-UsedColors(i))
          EndIf
        Next i
        NEW_RED = (Red(Couleur)+Red(UsedColors(MIN_I)))/2
        NEW_GREEN = (Green(Couleur)+Green(UsedColors(MIN_I)))/2
        NEW_BLUE = (Blue(Couleur)+Blue(UsedColors(MIN_I)))/2
        UsedColors(MIN_I) = RGB(NEW_RED,NEW_GREEN,NEW_BLUE)
      ElseIf UsedColorCount <> 255 And AddToList
        UsedColors(UsedColorCount) = Couleur
        UsedColorCount+1
      EndIf
    Next x
  Next y

  ;Écrit la palette dans le fichier
  For i=0 To UsedColorCount : WriteByte(#Icon,Blue(UsedColors(i))) : WriteByte(#Icon,Green(UsedColors(i))) : WriteByte(#Icon,Red(UsedColors(i))) : WriteByte(#Icon,0) : Next i

  ;Pour toutes les entrées libres, la bande noire est ajoutée
  For i = UsedColorCount+1 To 255 : WriteLong(#Icon,0) : Next i

  ;Écrit l'image dans le fichier
  For y=31 To 0 Step -1
    For x=0 To 31 Step 1
      Couleur.l = Point(x,y)
      If Couleur <> TransparentColor
        MIN_I = 0
        For i=0 To UsedColorCount
          If Abs(Couleur-UsedColors(i)) < MIN_DIF Or i = 0
            MIN_I = i
            MIN_DIF = Abs(Couleur-UsedColors(i))
          EndIf
        Next i
        Couleur = MIN_I
      Else
        Couleur = 0
      EndIf
      WriteByte(#Icon, Couleur)
    Next x
  Next y

  ;Écrit à la fin de la liste, afin que l'ordinateur sache quels sont les pixels transparentes
  For y=31 To 0 Step -1
    For x=0 To 31 Step 8
      LastByte.l = 0
      For i=0 To 7
        Couleur.l = Point(X+I,Y)
        If Couleur = TransparentColor
          Select i
            Case 7 : OrVal=  1
            Case 6 : OrVal=  2
            Case 5 : OrVal=  4
            Case 4 : OrVal=  8
            Case 3 : OrVal= 16
            Case 2 : OrVal= 32
            Case 1 : OrVal= 64
            Case 0 : OrVal=128
          EndSelect
          LastByte|OrVal
        EndIf
      Next i
      WriteByte(#Icon, LastByte)
    Next x
  Next y

  ; StopDrawing fin
  StopDrawing()

  ; Fait! Fermer le fichier
  CloseFile(#Icon)
  ProcedureReturn 1

  ;*****-format Icone-*****
  DataSection
    IconHeader_16:
    Data.l $00, $00, $01, $00, $01, $00, $10, $10, $00, $00, $01, $00, $08, $00, $68, $05
    Data.l $00, $00, $16, $00, $00, $00, $28, $00, $00, $00, $10, $00, $00, $00, $20, $00
    Data.l $00, $00, $01, $00, $08, $00, $00, $00, $00, $00, $00, $01, $00, $00, $00, $00
    Data.l $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
    IconHeader_24:
    Data.l $00, $00, $01, $00, $01, $00, $18, $18, $00, $00, $01, $00, $08, $00, $FF, $06
    Data.l $00, $00, $16, $00, $00, $00, $28, $00, $00, $00, $18, $00, $00, $00, $30, $00
    Data.l $00, $00, $01, $00, $08, $00, $00, $00, $00, $00, $40, $02, $00, $00, $00, $00
    Data.l $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
    IconHeader_32: ;
    Data.l $00, $00, $01, $00, $01, $00, $20, $20, $00, $00, $00, $00, $00, $00, $A8, $08
    Data.l $00, $00, $16, $00, $00, $00, $28, $00, $00, $00, $20, $00, $00, $00, $40, $00
    Data.l $00, $00, $01, $00, $08, $00, $00, $00, $00, $00, $80, $04, $00, $00, $00, $00
    Data.l $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
    IconHeader_48:
    Data.l $00, $00, $01, $00, $01, $00, $30, $30, $00, $00, $01, $00, $08, $00, $FF, $0E
    Data.l $00, $00, $16, $00, $00, $00, $28, $00, $00, $00, $30, $00, $00, $00, $60, $00
    Data.l $00, $00, $01, $00, $08, $00, $00, $00, $00, $00, $00, $09, $00, $00, $00, $00
    Data.l $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
  EndDataSection

EndProcedure


;*****-Paramètres-*****
Bitmap$ = ProgramParameter()
If Bitmap$
  If LoadImage(#OrginalBitmap, Bitmap$) = 0
    MessageRequester("Fehler", "Bitmap konnte nicht geladen werden!", #MB_ICONERROR)
    End
  EndIf
  CopyImage(#OrginalBitmap, #Bitmap)
  ResizeImage(#Bitmap, 32, 32)
EndIf


;*****-La fenêtre principale-*****
If OpenWindow(#fenetre_principale, 0, 0, 330, 290, #Titre, #PB_Window_ScreenCentered | #PB_Window_SystemMenu)

  ;*****-Gadgetliste-*****
  
    Frame3DGadget(#Frame3D_Taille, 10, 10,  160, 129, "Taille")
    OptionGadget(#Option16, 20, 30,  65,  24, "16 x 16")
    OptionGadget(#Option24, 20, 55,  65,  24, "24 x 24")
    OptionGadget(#Option32, 20, 80,  65,  24, "32 x 32")
    OptionGadget(#Option48, 20, 105, 65,  24, "48 x 48")
    SetGadgetState(#Option32, 1)

    Frame3DGadget(#Frame3D_Transparence, 10, 150, 160, 129, "Transparence")
    CheckBoxGadget(#CheckTransparent, 20, 170, 140, 24, "Icone Transparente ")
    SetGadgetState(#CheckTransparent, 1)
    ContainerGadget(#ColorTransparent, 20, 205, 20, 20)
    SetGadgetColor(#ColorTransparent, #PB_Gadget_BackColor, RGB(255, 255, 255))
    CloseGadgetList()
    TextGadget(#TextColorTransparent, 50, 200, 100, 30, "Couleur transparente")
    ButtonGadget(#ChooseColorTransparent, 20, 240, 20, 20, "")
    TextGadget(#TextChooseColorTransparent, 50, 235, 140, 30, "Couleur de transparence")

    Frame3DGadget(#Frame3D_Apercu, 170, 10, 150, 130, "Aperçu")
    ImageGadget(#ImageBitmap, 190, 40, 0, 0, 0, #PB_Image_Border)
    If Bitmap$ : SetGadgetState(#ImageBitmap, ImageID(#Bitmap)) : EndIf

    ButtonGadget(#Bouton_Enregistrer, 180, 209, 130, 30, "Enregistrer");"Als Icon speichern")
    ButtonGadget(#Bouton_Quit, 180, 249, 130, 30, "Quitter");"Beenden")
    ButtonGadget(#ButtonOpenFile, 180, 163, 130, 36, "Ouvrir")
    ;ButtonImageGadget(#ButtonOpenFile, 180, 163, 130, 36, CatchImage(#ButtonImageOpenFile, ?OpenImageBinary))

    ; Certains en-têtes ne sont malheureusement pas pris en charge
    DisableGadget(#Option16, 1)
    DisableGadget(#Option24, 1)
    ;    DisableGadget(#Option32, 1)  <---- Voici l'en-tête pris en charge
    DisableGadget(#Option48, 1)
 

  ;*****-boucle principale-*****
  Repeat

    EventID = WaitWindowEvent()

    ;*****-requête Gadget-*****
    If EventID = #PB_Event_Gadget
      Select EventGadget()
        Case #Option16
          FreeImage(#Bitmap)
          CopyImage(#OrginalBitmap, #Bitmap)
          ResizeImage(#Bitmap, 16, 16)
          FreeGadget(#ImageBitmap)
          ImageGadget(#ImageBitmap, 190, 40, 0, 0, ImageID(#Bitmap), #PB_Image_Border)
        Case #Option24
          FreeImage(#Bitmap)
          CopyImage(#OrginalBitmap, #Bitmap)
          ResizeImage(#Bitmap, 24, 24)
          FreeGadget(#ImageBitmap)
          ImageGadget(#ImageBitmap, 190, 40, 0, 0, ImageID(#Bitmap), #PB_Image_Border)
        Case #Option32
          FreeImage(#Bitmap)
          CopyImage(#OrginalBitmap, #Bitmap)
          ResizeImage(#Bitmap, 32, 32)
          FreeGadget(#ImageBitmap)
          ImageGadget(#ImageBitmap, 190, 40, 0, 0, ImageID(#Bitmap), #PB_Image_Border)
        Case #Option48
          FreeImage(#Bitmap)
          CopyImage(#OrginalBitmap, #Bitmap)
          ResizeImage(#Bitmap, 48, 48)
          FreeGadget(#ImageBitmap)
          ImageGadget(#ImageBitmap, 190, 40, 0, 0, ImageID(#Bitmap), #PB_Image_Border)
        Case #Bouton_Enregistrer
          If SaveIcon$ = ""
            SaveIcon$ = SaveFileRequester("Enregistrer sou...", "", "Icon | *.ico", 0)
          EndIf
          If SaveIcon$ <> ""
            If GetGadgetState(#CheckTransparent) = 1
              TransparentColor = GetGadgetColor(#ColorTransparent, #PB_Gadget_BackColor)
            Else
              TransparentColor = -1
            EndIf
            IconCreateStatus = CreateIcon()
            If IconCreateStatus
              MessageRequester("Info", "L'icône est créée !", #MB_ICONINFORMATION)
            Else
              MessageRequester("Erreur", "L'icône n'a pas pu être créée !", #MB_ICONERROR)
            EndIf
          EndIf
          ; pour permettre le stockage de façon répétée 
          SaveIcon$ = ""
        Case #ChooseColorTransparent
          ChooseNewColor = ColorRequester(RGB(255,255,255))
          If ChooseNewColor <> -1
            TransparentColor = ChooseNewColor
            SetGadgetColor(#ColorTransparent, #PB_Gadget_BackColor, TransparentColor)
          EndIf
        Case #ButtonOpenFile
          Bitmap$ = OpenFileRequester("Ouvrir Bitmap", "", "Formats (*.bmp, *.png, *.jpeg, *.tiff, *.tga)|*.bmp;*.png;*.jpg;*.jpeg;*.tiff;*.tga", 0)
          If Bitmap$
            If LoadImage(#OrginalBitmap, Bitmap$) = 0
              MessageRequester("Erreur", "Le Bitmap ne peut être chargé", #MB_ICONERROR)
              End
            EndIf
            CopyImage(#OrginalBitmap, #Bitmap)
            ResizeImage(#Bitmap, 32, 32)
          EndIf
          If Bitmap$
            SetGadgetState(#ImageBitmap, ImageID(#Bitmap))
          EndIf
        Case #Bouton_Quit
          EventID = 16
      EndSelect
    EndIf

    If GetGadgetState(#CheckTransparent) = 1
      DisableGadget(#ChooseColorTransparent, 0)
      DisableGadget(#TextChooseColorTransparent, 0)
      DisableGadget(#TextColorTransparent, 0)
    Else
      DisableGadget(#ChooseColorTransparent, 1)
      DisableGadget(#TextChooseColorTransparent, 1)
      DisableGadget(#TextColorTransparent, 1)
    EndIf

  Until EventID = #PB_Event_CloseWindow

Else
  MessageRequester("Erreur", "La fenêtre n'a pas pu s'ouvrir", #MB_ICONERROR)
  End
EndIf

End


; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
; EnableXP
Mesa.
Haut
Anonyme 2
Messages : 183
Inscription : ven. 18/mars/2011 11:53

Re: iconemaker

Message par Anonyme 2 »

Merci pour le partage! :)
Haut
Avatar de l’utilisateur
Kwai chang caine
Messages : 6989
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: iconemaker

Message par Kwai chang caine »

Merci je ne le connaissais pas 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Haut
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: iconemaker

Message par kernadec »

bonjour Mesa
merci pour le partage.

ton code présente un soucis avec la constante "#ColorTransparent" déjà déclarée.
je l'ai renommée pour qu'il fonctionne.

Cordialement
Haut
Répondre

Revenir à « Applications »