)Das is was für alle, die schon immer gerne fehlerbildrätsel gemacht haben.(Weihnachtsquelltext, und ich könnt am purecontest damit teilnehmen
)Ich schreibe gerade die funktionen zum speichern von icons in meinem Programm. Hierbei möchte ich Icons mit 16*16,32*32 und 64*64 Pixel erstellen. Das ganze kann man auch kombinieren, ist hier aber eher unwichtig.
Die Icons der Größe 32*32 sowie der Größe 64*64 funktionieren einwandfrei (keine transparenz, wie´s momentan noch gewollt ist)
Bei den Icons von Größe 16*16 allerdings sind wahrlos transparente pixel verteilt.
Kleines Vorwort zu dem Quelltext:
Ein IconFile baut sich folgender maßen auf
Code: Alles auswählen
Gesamtheader, sagt, wieviele dateien drin sind und so
Liste von einzelnen headern für jedes bild, die sagen, wo sich die bilder befinden im speicher,
Dann für jedes Bild jeweils:
BildHeader
Pallette
Array mit farbindexdaten
array mit transparenzparametern
das speziefische array ist 63*63 groß, wenn ich ein icon von 16*16 erstellen will, spring ich halt immer 4 Pixel.
Das Bild is im array auf dem Kopf, darum muss ich es falschrum in die datei lesen
Hier also mal der Code (nicht lauffähig, es geht ja um einen reinen vergleich der codeelemente, die unbekannten funktionen sind egal)
Code: Alles auswählen
num=0
If eb16=1
Inc num
EndIf
If eb32=1
Inc num
EndIf
If eb64=1
Inc num
EndIf
If num>0
If CreateFile(0,testname)=0
ProcedureReturn 0
EndIf
filepos=6+num*SizeOf(IconData)
mine=-1
Dim Icons.IconData(num)
If eb16
Inc mine
Icons(mine)\width=16
Icons(mine)\height=16
Icons(mine)\colors=0
Icons(mine)\reserve=0
Icons(mine)\planes=168
Icons(mine)\bitcount=8
Icons(mine)\imgsize=16*16+16*2+256*4+SizeOf(BITMAPINFOHEADER)
Icons(mine)\pos=filepos
filepos=filepos+SizeOf(BITMAPINFOHEADER)+4*256+16*16+16*2
EndIf
If eb32
Inc mine
Icons(mine)\width=32
Icons(mine)\height=32
Icons(mine)\colors=0
Icons(mine)\reserve=0
Icons(mine)\planes=168
Icons(mine)\bitcount=8
Icons(mine)\imgsize=32*32+32*4+256*4+SizeOf(BITMAPINFOHEADER)
Icons(mine)\pos=filepos
filepos=filepos+SizeOf(BITMAPINFOHEADER)+4*256+32*32+32*4
EndIf
If eb64
Inc mine
Icons(mine)\width=64
Icons(mine)\height=64
Icons(mine)\colors=0
Icons(mine)\reserve=0
Icons(mine)\planes=168
Icons(mine)\bitcount=8
Icons(mine)\imgsize=64*64+64*8+256*4+SizeOf(BITMAPINFOHEADER)
Icons(mine)\pos=filepos
EndIf
;Grundheader
WriteWord(0)
WriteWord(1)
WriteWord(num)
WriteData(Icons(0),SizeOf(IconData)*num)
;16*16
If eb16=1
IcInfo.BITMAPINFOHEADER
IcInfo\biSize=SizeOf(BITMAPINFOHEADER)
IcInfo\biWidth=16
IcInfo\biHeight=32;*2, keine ahnung, warum
IcInfo\biPlanes=1
IcInfo\biBitCount=8
IcInfo\bisizeImage =16*16
WriteData(IcInfo,SizeOf(BITMAPINFOHEADER))
;pallette reinschreiben
For index=0 To 255
WriteByte(colors256(index)\blue+128)
WriteByte(colors256(index)\green+128)
WriteByte(colors256(index)\red+128)
WriteByte(0)
Next
;Schreibt das Bild in die Datei
For y=bildhoch To 0 Step -4
For x=0 To bildlang Step 4
WriteByte(punkt_index(y,x)+128)
Next x
Next y
For y=bildhoch To 0 Step -4
For x=0 To bildlang Step 32
writewert.b=0
For i=0 To 7
If punkt(y,x+i*4)\leer=1
writewert&Int(Pow(2,7-i))
EndIf
Next
WriteByte(writewert)
Next
Next
EndIf
;32*32
If eb32=1
IcInfo.BITMAPINFOHEADER
IcInfo\biSize=SizeOf(BITMAPINFOHEADER)
IcInfo\biWidth=32
IcInfo\biHeight=64
IcInfo\biPlanes=1
IcInfo\biBitCount=8
IcInfo\bisizeImage =32*32
WriteData(IcInfo,SizeOf(BITMAPINFOHEADER))
;pallette reinschreiben
For index=0 To 255
WriteByte(colors256(index)\blue+128)
WriteByte(colors256(index)\green+128)
WriteByte(colors256(index)\red+128)
WriteByte(0)
Next
;Schreibt das Bild in die Datei
For y=bildhoch To 0 Step -2
For x=0 To bildlang Step 2
WriteByte(punkt_index(y,x)+128)
Next x
Next y
For y=bildhoch To 0 Step -2
For x=0 To bildlang Step 16
writewert.b=0
For i=0 To 7
If punkt(y,x+i*2)\leer=1
writewert|Int(Pow(2,7-i))
EndIf
Next
WriteByte(writewert)
Next
Next
EndIf
;64*64
If eb64=1
IcInfo.BITMAPINFOHEADER
IcInfo\biSize=SizeOf(BITMAPINFOHEADER)
IcInfo\biWidth=64
IcInfo\biHeight=128
IcInfo\biPlanes=1
IcInfo\biBitCount=8
IcInfo\bisizeImage =64*64
WriteData(IcInfo,SizeOf(BITMAPINFOHEADER))
;pallette reinschreiben
For index=0 To 255
WriteByte(colors256(index)\blue+128)
WriteByte(colors256(index)\green+128)
WriteByte(colors256(index)\red+128)
WriteByte(0)
Next
;Schreibt das Bild in die Datei
For y=bildhoch To 0 Step -1
For x=0 To bildlang Step 1
WriteByte(punkt_index(y,x)+128)
Next x
Next y
For y=bildhoch To 0 Step -1
For x=0 To bildlang Step 8
writewert.b=0
For i=0 To 7
If punkt(y,x+i)\leer=1
writewert|Int(Pow(2,7-i))
EndIf
Next
WriteByte(writewert)
Next
Next
EndIf
CloseFile(0)
EndIf
If sized
Undo()
EndIf
Also viel Spass beim Rätseln
[/code]