PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Icon erstellen

https://www.purebasic.fr/german/viewtopic.php?t=11194

Seite 3 von 3

Verfasst: 21.12.2006 17:22
von Kaeru Gaman
Thomas hat geschrieben:den hab ich aus der PureBasic-Lounge.
kannste bitte den thread mal angeben?
dann check ich mal, wo was falsch gelaufen ist...

Verfasst: 21.12.2006 17:42
von Scarabol
@Thomas
Sorry, aber ich versteh deine Frage nicht, kannst du das anders formulieren?

Verfasst: 21.12.2006 17:47
von Scarabol
So ich hab die Oberfläche von Thomas und meinen Code mal "verheiratet" und das Ergebnis wollte ich euch nicht vorenthalten:

[Edit]
kleines Update
- ProgramParameter Verarbeitung
- zusätzliche Schaltfläche zum Laden eines Bildes während das Programm läuft

Code: Alles auswählen

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

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

;*****-Fenster-*****
Enumeration
  #HauptFenster
EndEnumeration

;*****-Bilder-*****
Enumeration
  #AuswahlImage
  #OrginalBitmap
  #Bitmap
  #Icon
EndEnumeration

;*****-Gadgets-*****
Enumeration
  #Frame3DGroesse
  #Frame3DTransparent
  #Frame3DVorschau
  #TextColorTransparent
  #TextChooseColorTransparent
  #Option16
  #Option24
  #Option32
  #Option48
  #CheckTransparent
  #ColorTransparent
  #ChooseColorTransparent
  #ImageBitmap
  #ButtonSpeichern
  #ButtonAbbrechen
  #ButtonImageOpenFile
  #ButtonOpenFile
EndEnumeration

;*****-Name der Andwendung-*****
#AndwendungName = "IconCreator Professional"

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

;*****-Icon erstellen-*****
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 ; ist zwar eigentlich unmöglich aber sicher ist sicher :-)
    ProcedureReturn 0
  EndIf
  
  ; neue Datei erstellen
  If CreateFile(#Icon, SaveIcon$+".ico") = 0 : ProcedureReturn 0 : EndIf
  
  ; Header in Datei schreiben
  For i=1 To 62 : Read ThisValue : WriteByte(#Icon,ThisValue) : Next i
  
  ; nur um ganz sicher zu gehen
  If IsImage(#Bitmap) = 0 : ProcedureReturn 0 : EndIf
  
  ; StartDrawing für die folgenden Zeichenoperationen
  StartDrawing(ImageOutput(#Bitmap))
  
  ;Erstellt eine Palette mit 256 Farben
  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
      Farbe.l = Point(x,y)
      AddToList.l = 1
      For i=0 To UsedColorCount
        If Farbe = 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(Farbe-UsedColors(i)) < MIN_DIF Or i = 1
            MIN_I = i
            MIN_DIF = Abs(Farbe-UsedColors(i))
          EndIf
        Next i
        NEW_RED = (Red(Farbe)+Red(UsedColors(MIN_I)))/2
        NEW_GREEN = (Green(Farbe)+Green(UsedColors(MIN_I)))/2
        NEW_BLUE = (Blue(Farbe)+Blue(UsedColors(MIN_I)))/2
        UsedColors(MIN_I) = RGB(NEW_RED,NEW_GREEN,NEW_BLUE)
      ElseIf UsedColorCount <> 255 And AddToList
        UsedColors(UsedColorCount) = Farbe
        UsedColorCount+1
      EndIf
    Next x
  Next y
  
  ;Schreibt die Palette in die Datei
  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
  
  ;Für alle freien Einträge wird die Farbe SCHWARZ eingefügt
  For i = UsedColorCount+1 To 255 : WriteLong(#Icon,0) : Next i
  
  ;Schreibt das Bild in die Datei
  For y=31 To 0 Step -1
    For x=0 To 31 Step 1
      Farbe.l = Point(x,y)
      If Farbe <> TransparentColor
        MIN_I = 0
        For i=0 To UsedColorCount
          If Abs(Farbe-UsedColors(i)) < MIN_DIF Or i = 0
            MIN_I = i
            MIN_DIF = Abs(Farbe-UsedColors(i))
          EndIf
        Next i
        Farbe = MIN_I
      Else
        Farbe = 0
      EndIf
      WriteByte(#Icon, Farbe)
    Next x
  Next y
  
  ;Schreibt am Ende eine Liste, damit der Computer weiß, welche Pixel transparent sind
  For y=31 To 0 Step -1
    For x=0 To 31 Step 8
      LastByte.l = 0
      For i=0 To 7
        Farbe.l = Point(X+I,Y)
        If Farbe = 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 beenden
  StopDrawing()
  
  ; Fertig! Datei schließen
  CloseFile(#Icon)
  ProcedureReturn 1

;*****-Iconformate-*****
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: ;<--- Dieser Header funktioniert, die anderen leider nicht
    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


;*****-ProgramParameter verarbeiten-*****
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


;*****-Hauptfenster öffnen-*****
If OpenWindow(#HauptFenster, 0, 0, 330, 290, #AndwendungName, #PB_Window_ScreenCentered | #PB_Window_SystemMenu)

  ;*****-Gadgetliste-*****
  If CreateGadgetList(WindowID(#HauptFenster))
    Frame3DGadget(#Frame3DGroesse, 10, 10,  140, 129, "Größe")
      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(#Frame3DTransparent, 10, 150, 140, 129, "Transparents")
      CheckBoxGadget(#CheckTransparent, 20, 170, 120, 24, "Transparentes Icon")
        SetGadgetState(#CheckTransparent, 1)
      ContainerGadget(#ColorTransparent, 20, 205, 20, 20)
        SetGadgetColor(#ColorTransparent, #PB_Gadget_BackColor, RGB(255, 255, 255))
      CloseGadgetList()
      TextGadget(#TextColorTransparent, 50, 200, 70, 30, "Transparente Farbe")
      ButtonGadget(#ChooseColorTransparent, 20, 240, 20, 20, "")
      TextGadget(#TextChooseColorTransparent, 50, 235, 70, 30, "Transparente Farbe wählen")

    Frame3DGadget(#Frame3DVorschau, 170, 10, 150, 130, "Vorschau")
      ImageGadget(#ImageBitmap, 190, 40, 0, 0, 0, #PB_Image_Border)
      If Bitmap$ : SetGadgetState(#ImageBitmap, ImageID(#Bitmap)) : EndIf

    ButtonGadget(#ButtonSpeichern, 180, 209, 130, 30, "Als Icon speichern")
    ButtonGadget(#ButtonAbbrechen, 180, 249, 130, 30, "Beenden")
    ButtonImageGadget(#ButtonOpenFile, 180, 163, 130, 36, CatchImage(#ButtonImageOpenFile, ?OpenImageBinary))
    
    ; wegen fehlender Header werden einige Gadgets leider gesperrt
    DisableGadget(#Option16, 1)
    DisableGadget(#Option24, 1)
;    DisableGadget(#Option32, 1)  <---- hier ist ein funktionierender Header vorhanden
    DisableGadget(#Option48, 1)
  EndIf

  ;*****-Hauptschleife-*****
  Repeat

    EventID = WaitWindowEvent()

    ;*****-Gadgetabfrage-*****
    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 #ButtonSpeichern
          If SaveIcon$ = ""
            SaveIcon$ = SaveFileRequester("Icon Speichern als...", "", "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", "Das Icon wurde erfolgreich erstellet!", #MB_ICONINFORMATION)
            Else
              MessageRequester("Error", "Das Icon konnte nicht erstellt werden!", #MB_ICONERROR)
            EndIf
          EndIf
          ; um wiederholtes Speichern zu ermöglichen
          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("Bitmap öffnen", "", "Alle Formate (*.bmp, *.png, *.jpeg, *.tiff, *.tga)|*.bmp;*.png;*.jpg;*.jpeg;*.tiff;*.tga", 0)
          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
          If Bitmap$
            SetGadgetState(#ImageBitmap, ImageID(#Bitmap))
          EndIf
        Case #ButtonAbbrechen
          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("Fehler", "Fenster konnte nicht geöffnet werden!", #MB_ICONERROR)
  End
EndIf

End

DataSection
  OpenImageBinary:
    IncludeBinary "OpenFile.png"
EndDataSection
Gruß
Scarabol

Verfasst: 21.12.2006 21:29
von Scarabol
@Kaeru Gaman and all others
Die Header die Thomas verwendet hat findest du unter folgendem Link:
http://www.purebasic-lounge.de/viewtop ... ighlight=

Ich habe folgenden Header aus dem Codearchiv

Code: Alles auswählen

  IconHeader_32: ;<--- Dieser Header funktioniert, die anderen leider nicht
    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
Wieso funktioniert der Header aus dem Codearchiv aber der aus der Purebasic-Lounge nicht?

Gruß
Scarabol

Verfasst: 21.12.2006 21:32
von Kaeru Gaman
.... I'm on it...

Verfasst: 23.12.2006 18:36
von Scarabol
Und?
Wats on?

Verfasst: 23.12.2006 18:39
von Kaeru Gaman
...noch kei zeit gehabt...

Verfasst: 23.12.2006 21:32
von Thomas
Habt ihr irgendwo brauchbare Header für 16x16, 24x24, 32x32 Icons rumliegen?

Da gibts doch 2 verschiedene Icon-Arten; die eine kann man einfach in Paint öffnen, die andere nicht.
Wo ist der Unterschied?

Welchen aufbau haben die Header?
Alle Zeiten sind UTC+02:00
Seite 3 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de