; German forum: ; Author: PureFan ; Date: 23. March 2003 ; OS: Windows ; Demo: Yes ;"--------------------------------------------------------------------- ; Bilder als *.ICO und *.CUR - Datei abspeichern ;"--------------------------------------------------------------------- ;Verwenden sie diese Variable, wenn sie keine transparenz verwenden wollen! Global NoTransparent PokeB(@NoTransparent.l+3,1) ;Schreibt ein Byte (0-255) in die aktuell geöffnete Datei Procedure.l WriteByte2(val.l) WriteData(@val,1) EndProcedure ;Speichert das Bild, auf dem gerade gezeichnet wird, in einer *.ICO ;(HotspotX und HotspotY muss 0 sein!) oder in einer *.CUR-Datei! Procedure.l SaveIcon(FileName.s,TransparentColor.l,HotspotX.l,HotspotY.l) ;Der Hotspot muss sich innerhalb des Bildes befinden! If HotspotX>32:HotspotX=32:ElseIf HotspotX<0:HotspotX=0:EndIf If HotspotY>32:HotspotY=32:ElseIf HotspotY<0:HotspotY=0:EndIf ;Öffnet die Datei If CreateFile(0,FileName)=0 ProcedureReturn 0 EndIf ;Schreibt zuerst den HEADER für eine 32x32 Pixel große ICO-Datei Restore ICON_HEADER_256_COLORS For I=1 To 62 Read ThisValue If I=$B WriteByte2(HotspotX) ElseIf I=$D WriteByte2(HotspotY) Else WriteByte2(ThisValue) EndIf Next I ;Erstellt eine Palette mit 256 Farben Dim UsedColors.l(255) UsedColors(0)=RGB(0,0,0) UsedColorCnt.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 UsedColorCnt If Farbe=UsedColors(I) AddToList=0 I=UsedColorCnt EndIf Next I If UsedColorCnt=255 And AddToList MIN_I=1 MIN_DIF=0 For I=1 To UsedColorCnt If Abs(Farbe-UsedColors(I))255 And AddToList UsedColors(UsedColorCnt)=Farbe UsedColorCnt+1 EndIf Next X Next Y ;Schreibt die Palette in die Datei For I=0 To UsedColorCnt WriteByte(Blue(UsedColors(I))) WriteByte(Green(UsedColors(I))) WriteByte(Red(UsedColors(I))) WriteByte(0) Next I ;Für alle freien Einträge wird die Farbe SCHWARZ eingefügt For I=UsedColorCnt+1 To 255 WriteLong(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 UsedColorCnt If Abs(Farbe-UsedColors(I))