i want to save an image as a bin file for the vic20 in graphics mode.
picture is 176x176 byte.
can't do that in pure base.
Thank you.
greeting
new purebasic program (01.01.2020):
Code: Select all
Global text1.s,text2.s,byteinhalt.c,bytestueck.l,einzelbit.l,y.l,yy.l
Declare lade_bild()
Declare speicher_bild()
Enumeration
#Window_0
#Button_0
#Button_1
#String_0
EndEnumeration
InitSprite()
InitKeyboard()
OpenWindow(#Window_0,780,600,500,220,"vi20 hires", #PB_Window_SystemMenu)
ButtonGadget(#Button_0, 10,10, 80, 25, "Bild laden")
ButtonGadget(#Button_1, 10,35, 80, 25, "Bild erstellen")
StringGadget(#String_0, 10, 100, 100, 20, "")
CreateImage(0, 176,176)
StartDrawing(ImageOutput(0))
Box(0,0,176,176, RGB(255,255,255))
StopDrawing()
ImageGadget(0, 160, 10, 0, 0, ImageID(0))
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
EventGadget = EventGadget()
EventType = EventType()
If EventGadget = #Button_0
Pattern$ = "Text (*.bin;*.bmp)"
Pattern = 0
text1 = OpenFileRequester("Bitte Datei zum Laden auswählen", StandardFile$, Pattern$, Pattern)
text1=GetFilePart(text1)
SetGadgetText(#string_0, text1)
lade_bild()
EndIf
If EventGadget = #Button_1
speicher_bild()
EndIf
Case #PB_Event_CloseWindow
EventWindow = EventWindow()
If EventWindow = #Window_0
CloseWindow(#Window_0)
Break
EndIf
EndSelect
ForEver
Procedure speicher_bild()
If text1=""
Goto weiter
EndIf
text1=Left(text1,Len(text1)-4)
CreateFile(0, "d:\winvice\bilder\"+text1+".bin")
ByteInhalt=0
WriteByte(0, ByteInhalt)
ByteInhalt=17
WriteByte(0, ByteInhalt)
StartDrawing(ImageOutput(0))
For y = 0 To 175 Step 16
For bytestueck = 0 To 20
For yy=0 To 15
byteInhalt = 0
For einzelbit = 0 To 7
If Point( ByteStueck * 8 + 7 - Einzelbit,y+yy)
ByteInhalt + ( 1 << Einzelbit )
EndIf
Next
WriteByte(0, ByteInhalt)
Next
Next
Next
StopDrawing()
CloseFile(0)
SetGadgetText(#string_0, "gespeichert")
weiter:
text1=""
EndProcedure
Procedure lade_bild()
LoadImage(1,"d:\winvice\bilder\"+text1)
StartDrawing(ImageOutput(0))
DrawImage(ImageID(1), 0,0)
StopDrawing()
ImageGadget(0, 160, 10, 0, 0, ImageID(0))
EndProcedure
[code]