mit diesem Programm kann man kleine Dateien (z.B. Grafiken) als PB Quellcode konvertieren um diese z.B. ins Forum zu stellen.
Gruß Michael
Code: Alles auswählen
;-
;- ProgrammStart
;////////////////////////////////////////////////////////////////
;//
;// Project Title: Image2PBSource
;// File Title: Image2PBSource.pb
;// Created On: 27.1.2009
;// Updated On:
;// Author: Michael Paulwitz
;// OS:Windows
;//
;// Erzeugt aus einer Datei ein PB Quellcode
;//
;////////////////////////////////////////////////////////////////
Procedure OFile(file.s)
d=ReadFile(1, file)
If d
ClearGadgetItems(3)
Restore StringData
Repeat
Read.s Purestring.s
AddGadgetItem(3, -1,Purestring)
Until Purestring.s = "End"
AddGadgetItem(3, -1,"")
AddGadgetItem(3, -1,"DataSection")
AddGadgetItem(3, -1," NameSect:")
AddGadgetItem(3, -1," Data.s "+Chr(34)+file+Chr(34))
AddGadgetItem(3, -1,"")
AddGadgetItem(3, -1," Filehex:" )
While Eof(1)=0
Zaehler + 1
Dump.s + RSet(Hex(ReadCharacter(1)), 2, "0")
If Zaehler = 40
Zaehler = 0
AddGadgetItem(3, -1," Data.s "+Chr(34)+Dump.s+Chr(34))
Dump.s = ""
EndIf
Wend
If Dump.s
AddGadgetItem(3, -1," Data.s "+Chr(34)+Dump.s+Chr(34))
EndIf
AddGadgetItem(3, -1," Data.s "+Chr(34)+"End"+Chr(34))
CloseFile(1)
Else
MessageRequester("Fehler","Datei könnte nicht geöffnet werden.",#MB_ICONERROR)
EndIf
EndProcedure
Procedure SFile(file.s)
d=CreateFile(2, file.s)
If d
WriteString (2,GetGadgetText(3))
CloseFile(2)
Else
MessageRequester("Fehler","Datei konnte nicht geschrieben werden.",#MB_ICONERROR)
EndIf
EndProcedure
If OpenWindow(0, 100, 200, 600, 260, "Image2PBSource Konverter", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
ButtonGadget(1,10,20,80,25,"Öffne Datei")
ButtonGadget(2,100,20,80,25,"Speicher Datei")
EditorGadget(3,10,60,580,185)
Repeat
EventID.l = WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
Quit = 1
EndIf
If EventID = #PB_Event_Gadget
Select EventGadget()
Case 1
file$ = OpenFileRequester("Öffne Datei","","Alle Dateien|*.*",1)
OFile(file$)
Case 2
file2$ = SaveFileRequester("Speicher Datei","","Alle Dateien|*.*",1)
SFile(file2$)
EndSelect
EndIf
Until Quit = 1
EndIf
End
DataSection
StringData:
Data.s ";// Project Title: CreateFilefromPBSource"
Data.s ";// Author: Michael Paulwitz on Jan 2009"
Data.s ""
Data.s "Procedure.l Hex2Dec(h$)"
Data.s " h$=UCase(h$)"
Data.s " For r=1 To Len(h$)"
Data.s " d<<4 : a$=Mid(h$,r,1)"
Data.s " If Asc(a$)>60"
Data.s " d+Asc(a$)-55"
Data.s " Else"
Data.s " d+Asc(a$)-48"
Data.s " EndIf"
Data.s " Next"
Data.s " ProcedureReturn d"
Data.s "EndProcedure"
Data.s ""
Data.s "Restore NameSect"
Data.s "Read.s File.s"
Data.s ""
Data.s "If CreateFile(0,File.s)"
Data.s " Restore Filehex"
Data.s ""
Data.s " Repeat"
Data.s " Read.s Daten.s"
Data.s " If Daten.s = "+Chr(34)+"End"+Chr(34)+" : Break : EndIf"
Data.s ""
Data.s " For n = 1 To Len(Daten.s) Step 2"
Data.s " WriteByte(0,Hex2Dec(Mid(Daten.s,n,2)))"
Data.s " Next n"
Data.s ""
Data.s " ForEver"
Data.s " CloseFile (0)"
Data.s "Else"
Data.s " MessageRequester("+Chr(34)+"Errormessage"+Chr(34)+", "+Chr(34)+"Error: can't write the file "+Chr(34)+"+File.s, 0)"
Data.s " End"
Data.s "EndIf"
Data.s "End"
- LibSGD - MP3D Engine - 
