PureBoard

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"