PureBoard

Code: Alles auswählen

Global DateiName.s
Global Ordner.l
Global DateiName.s
Ordner = MessageRequester("Clipersteller 1.0 by Bruegge", "wollen sie zu jedem Clip einen Ordner erstellen?", #PB_MessageRequester_YesNo)
DateiName = PathRequester(Titel$, UrsprungsPfad$)

If Ordner = #PB_MessageRequester_Yes :Ordner = 1 :Else : Ordner = 0:EndIf



Global Dim liste.s(1000)
Global Dim liste2.s(1000,1)

Procedure.s getDirectory(text.s)
  Text1.s = UCase(text)
  Text2.s = LCase(text)
  text = ""
  
  For i = 1 To Len(text1.s)
    If Mid(text1.s,i,1) <> Mid(text2.s,i,1)
      text = text +Mid(text2.s,i,1)
    EndIf
  Next i
  
  text = Left(text,Len(text)-3)
  
  ProcedureReturn text
EndProcedure


Procedure listefuellen()
  If ExamineDirectory(0, DateiName, "*.*")  
    i = 0
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        If DirectoryEntryName(0) <> "Thumbs.db"
          liste(i) = DirectoryEntryName(0)
          i = i +1
        EndIf
      EndIf    
    Wend
    FinishDirectory(0)
  EndIf
EndProcedure

Procedure createLog(ort.s,Anzahl.l,laenge.l,hoehe.l)
  OpenFile(0,ort+"\info.log")
    WriteStringN(0,Str(Anzahl))
    WriteStringN(0,Str(laenge))
    WriteStringN(0,Str(hoehe))
  CloseFile(0)
EndProcedure

Procedure.s erhoehen(Text.s,zahl.l)
  Text1.s = UCase(text)
  Text2.s = LCase(text)
  Text = ""
  hilfsvariable = 1

  For i = 1 To Len(text1)
    If Mid(text1,i,1) <> Mid(text2,i,1) Or Mid(text1,i,1) = "." Or Mid(text1,i,1) = "\"Or Mid(text1,i,1) = "/"Or Mid(text1,i,1) = " "
      If hilfsvariable = 1
        Teil1.s = teil1.s + Mid(text2,i,1)
      Else
        teil3.s = teil3.s +Mid(text2,i,1)
      EndIf
    Else
      teil2.s = teil2.s +Mid(text2,i,1)
      hilfsvariable = 0
    EndIf
  Next i

  t2laenge.l =Len(teil2.s)
  t2lang = t2laenge - Len(Str(zahl)) 
  
  neuzahl.s = ""
  For i = 1 To t2lang
    neuzahl.s = neuzahl.s + "0"
  Next i
  
  ProcedureReturn teil1.s+neuzahl.s+Str(zahl)+teil3.s

EndProcedure

Procedure Createclipimage()
  For i = 0 To 1000
    If liste2(i,0)<> ""
      For j = 1 To Val(liste2(i,1))
        Debug erhoehen(liste2(i,0),j-1)+"<--"
        LoadImage(j,Dateiname+erhoehen(liste2(i,0),j-1))
      Next j
      
      CreateImage(0,ImageWidth(1)*Val(liste2(i,1)),ImageHeight(1))
      
      StartDrawing(ImageOutput(0))
        For j = 1 To Val(liste2(i,1))
          DrawImage(ImageID(j),ImageWidth(j)*(j-1),0)
        Next j
      StopDrawing()
      
      If Ordner = 1
        CreateDirectory(DateiName+getdirectory(liste2(i,0)))
        Debug Dateiname+getdirectory(liste2(i,0))+"\"+getdirectory(liste2(i,0))+".png"
        Debug SaveImage(0,Dateiname+getdirectory(liste2(i,0))+"\"+getdirectory(liste2(i,0))+".bmp")
      Else
        Debug SaveImage(0,Dateiname+getdirectory(liste2(i,0))+".bmp")
      EndIf
            
      createLog(Dateiname+getDirectory(liste2(i,0)),Val(liste2(i,1)),ImageWidth(1),ImageHeight(1))
    EndIf
  Next i

EndProcedure


listefuellen()
l2 = 0
For i = 0 To 1000
  If liste(i)<>""
    Debug liste(i)
    head.s = getdirectory(liste(i))
    zaehler = 1
    While(getdirectory(liste(i+zaehler)) = head.s)
        zaehler = zaehler + 1
    Wend
    liste2(l2,0) = liste(i)
    liste2(l2,1) = Str(zaehler)
    i = i + zaehler -1
    l2 = l2 +1
  EndIf
Next i

For i = 0 To 1000
  If liste2(i,0) <> ""
    Debug liste2(i,0)+"   :    "+liste2(i,1)
  EndIf
Next i


createclipimage()