include datei (include.pb):
Code: Alles auswählen
; PureBasic Visual Designer v3.90 build 1360
;- Window Constants
;
Enumeration
#Window_0
EndEnumeration
Global path.s
Global pics.w
Global Format.s
Global position.s
Global installpfad.s
Global farbe.l
Global textfarbe.l
;- MenuBar Constants
;
Enumeration
#MenuBar_0
EndEnumeration
;- Gadget Constants
;
Enumeration
#Text_1
#Text_2
#Frame3D_1
#Text_4
#Text_5
#Text_6
#Hoehe
#breite
#anderung
#select
#Text_7
#Text_8
#zeilen
#spalten
#Text_9
#titel
#Text_10
#Datei
#Text_12
#border
#vor
#nach
#erstellen
#clr1
#clr2
#format
#colour
#rahmen
#text_r
#pos_t
#pos1
#pos2
#pos3
#maxpics
#picsges
#warning
#pfad
#pfadwahl
#pfad_t
#info1
#info2
#progress
#fontfarbe
#bildtext
EndEnumeration
;- StatusBar Constants
;
Enumeration
#StatusBar_0
EndEnumeration
;- Fonts
;
Global FontID1
FontID1 = LoadFont(1, "DiagramTTHabsburg", 10)
Global FontID2
FontID2 = LoadFont(2, "Times New Roman", 10, #PB_Font_Bold)
Global FontID3
FontID3 = LoadFont(3, "Andy", 14, #PB_Font_Bold)
Procedure Open_Window_0()
If OpenWindow(#Window_0, 292, 176, 629, 341, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar , "Thumbnail maker")
If CreateMenu(#MenuBar_0, WindowID())
MenuTitle("")
EndIf
If CreateStatusBar(#StatusBar_0, WindowID())
EndIf
If CreateGadgetList(WindowID())
TextGadget(#Text_1, 230, 10, 120, 20, "BenpiccoSoft´s", #PB_Text_Center)
SetGadgetFont(#Text_1, FontID2)
TextGadget(#Text_2, 220, 30, 140, 20, "Thumbnail Maker", #PB_Text_Center)
SetGadgetFont(#Text_2, FontID3)
Frame3DGadget(#Frame3D_1, 200, 0, 170, 60, "")
TextGadget(#Text_4, 10, 10, 40, 20, "Höhe:")
TextGadget(#Text_5, 10, 30, 40, 20, "Breite:")
TextGadget(#Text_6, 10, 50, 50, 20, "Änderung:")
SpinGadget(#Hoehe, 40, 10, 50, 15, 1, 1024)
SpinGadget(#breite, 50, 30, 40, 15, 1, 768)
SpinGadget(#anderung, 70, 50, 40, 15, 0, 30)
ButtonGadget(#select, 460, 130, 100, 20, "Bildordner wählen")
ComboBoxGadget(#format,560,130,60,160, #PB_ComboBox_Editable)
TextGadget(#Text_7, 440, 10, 40, 20, "Zeilen:")
TextGadget(#Text_8, 440, 30, 40, 20, "Spalten:")
SpinGadget(#zeilen, 480, 10, 40, 15, 1, 1000)
SpinGadget(#spalten, 480, 30, 40, 15, 1, 100)
TextGadget(#Text_9, 450, 60, 30, 20, "Titel:")
StringGadget(#titel, 490, 60, 100, 20, "Bildvorschau")
TextGadget(#Text_10, 420, 90, 60, 20, "Dateiname:")
StringGadget(#Datei, 490, 90, 110, 20, "Bildvorschau.html")
TextGadget(#Text_12, 10, 70, 70, 20, "Rahmendicke:")
SpinGadget(#border, 80, 70, 50, 15, 0, 10)
EditorGadget(#vor, 30, 120, 190, 150)
SetGadgetText(#vor, "Hier können sie etwas Text eingeben, ")
AddGadgetItem(#vor,1, "der vor der Bildertabelle gezeigt " )
AddGadgetItem(#vor,2, "werden soll. Es kann sogar html sein.")
EditorGadget(#nach, 240, 120, 190, 150)
SetGadgetText(#nach, "Und hier können sie schreiben,")
AddGadgetItem(#nach,1," was später unter den Bildern steht.")
ButtonGadget(#erstellen, 460, 160, 110, 40, "Website erstellen!", #PB_Button_MultiLine)
TextGadget(#Text_2, 220, 30, 140, 20, "Thumbnail Maker", #PB_Text_Center)
SetGadgetFont(#Text_2, FontID3)
ButtonGadget(#clr1, 85,270,100,20,"löschen")
ButtonGadget(#clr2, 295,270,100,20,"löschen")
DisableGadget(#erstellen,1)
ButtonGadget(#colour, 10,90,90,20,"Hintergrundfarbe")
TextGadget(#text_r, 135,70,90,15,"Bilderrahmendicke")
SpinGadget(#rahmen, 223,70,50,15,0,10)
TextGadget(#pos_t,460,210,150,15,"tabellenausrichtung")
OptionGadget(#pos1,460,223,50,15,"rechts")
OptionGadget(#pos2,460,236,50,15,"mitte")
OptionGadget(#pos3,460,249,50,15,"links")
StringGadget(#maxpics,540,20,30,15,Str(4*3), #PB_String_ReadOnly|#PB_String_Numeric )
StringGadget(#picsges,580,20,30,15,"0",#PB_String_ReadOnly)
TextGadget(#warning, 530,37,100,20," ")
TextGadget(#pfad_t, 105,90,100,20,"Bitte Zielpfad wählen")
StringGadget(#pfad,210,90,120,20,"c:\")
ButtonGadget(#pfadwahl, 335,90,80,20,"Durchsuchen")
TextGadget(#info1, 540,8,30,15,"max")
TextGadget(#info2, 575,8,30,15,"total")
ProgressBarGadget(#progress, 80,295,300,10,0,200,#PB_ProgressBar_Smooth )
ButtonGadget(#fontfarbe, 280,68,80,20,"Textfarbe")
CheckBoxGadget(#bildtext, 460,264,90,15,"Text im Bild")
EndIf
EndIf
EndProcedure
Code: Alles auswählen
; PureBasic Visual Designer v3.90 build 1360
IncludeFile "include.pb"
Global verz.s
Open_Window_0()
format = "*.bmp"
AddGadgetItem(#format,-1, "*.bmp")
AddGadgetItem(#format,-1, "*.jpg")
AddGadgetItem(#format,-1, "*.png")
AddGadgetItem(#format,-1, "*.gif")
AddGadgetItem(#format,-1, "*.tga")
AddGadgetItem(#format,-1, "*.*")
SetGadgetState(#format,0)
SetGadgetState (#Hoehe,120) : SetGadgetText(#Hoehe,"120")
SetGadgetState (#Breite,220) : SetGadgetText(#Breite,"220")
SetGadgetState (#anderung,5) : SetGadgetText(#anderung,"5")
SetGadgetState (#border,0) : SetGadgetText(#border,"0")
SetGadgetState (#zeilen,4) : SetGadgetText(#zeilen,"4")
SetGadgetState (#spalten,3) : SetGadgetText(#spalten,"3")
SetGadgetState(#rahmen,0): SetGadgetText(#rahmen,"0")
SetGadgetState(#pos2,1)
position = "center"
farbe = RGB(255,255,255)
;MessageRequester("farbe", Str(farbe)+" "+Str(Red(farbe))+" "+Str(Green(farbe))+" "+Str(Blue(farbe))+" " +Hex(Red(farbe))+" "+Hex(Green(farbe))+" "+Hex(Blue(farbe)))
DisableGadget(#select,1)
Repeat
back:
Event = WaitWindowEvent()
If Event = #PB_EventMenu
;Debug "WindowID: " + Str(EventWindowID())
MenuID = EventMenuID()
EndIf
If Event = #PB_EventGadget
;Debug "WindowID: " + Str(EventWindowID())
GadgetID = EventGadgetID()
If GadgetID = #Hoehe
SetGadgetText(#Hoehe,Str(GetGadgetState(#Hoehe)))
ElseIf GadgetID = #Breite
SetGadgetText(#Breite,Str(GetGadgetState(#Breite)))
ElseIf GadgetID = #anderung
SetGadgetText(#anderung,Str(GetGadgetState(#anderung)))
ElseIf GadgetID = #select
Path = PathRequester("Bitte Bildordner wählen","" )
If path
If ExamineDirectory(0, path, format)
Repeat
FileType = NextDirectoryEntry()
If FileType
FileName$ = DirectoryEntryName()
If FileType = 1
pics = pics + 1
EndIf
EndIf
Until FileType = 0
Else
MessageRequester("Error!", "Fehler beim Laden der Bilder im Ordner. Stellen sie fest, ob sich Bilder im Ordner Befinden")
Goto back
EndIf
If pics = 0
MessageRequester("Error!", "Keine Bilder im Ordner")
Goto back
EndIf
Dim bilder.s(pics)
Dim bilder_v.s(pics)
CreateDirectory(installpfad+GetGadgetText(#titel))
ExamineDirectory(0, path, verz+format)
UseJPEGImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
For x = 1 To pics
SetGadgetState(#progress, Int(((x/pics)*100)*2))
FileType = NextDirectoryEntry()
If FileType
CopyFile(path+DirectoryEntryName(), installpfad+GetGadgetText(#titel)+"\"+DirectoryEntryName())
bilder(x) = GetGadgetText(#titel)+"\"+DirectoryEntryName()
CreateImage(x,GetGadgetState(#breite), GetGadgetState(#hoehe))
LoadImage(X,installpfad+bilder(x))
StartDrawing(WindowOutput())
DrawImage(UseImage(x),1000,1000)
ResizeImage(x, (GetGadgetState(#breite)+GetGadgetState(#anderung)),( GetGadgetState(#hoehe))+GetGadgetState(#anderung))
StopDrawing()
SaveImage(X, installpfad+GetGadgetText(#titel)+"\Vorschau_"+Str(x)+".bmp",#PB_ImagePlugin_BMP)
bilder_v(x) = GetGadgetText(#titel)+"\Vorschau_"+Str(x)+".bmp"
FreeImage(x)
EndIf
Next
;MessageRequester("test0", bilder(x-1))
;MessageRequester("test1",path+DirectoryEntryName() + " quelle")
;MessageRequester("test2",installpfad+GetGadgetText(#titel)+"\"+DirectoryEntryName() + " ziel")
For x = 1 To pics
CopyFile(bilder(x),GetGadgetText(#titel))
bilder(x) = GetGadgetText(#titel) +"\"+ GetFilePart(bilder(x))
Next
DisableGadget(#erstellen,0)
MessageRequester("Success!", "Es befinden sich " + Str(pics) + " Bilder im ordner " + path + " , die erfolgreich geladen umd nach "+installpfad+GetGadgetText(#titel)+"\ kopiert wurden!")
EndIf
SetGadgetText(#picsges, Str(pics))
If pics > GetGadgetState(#zeilen)*GetGadgetState(#spalten)
SetGadgetText(#warning,"too much pics!")
EndIf
ElseIf GadgetID = #zeilen
SetGadgetText(#zeilen,Str(GetGadgetState(#zeilen)))
SetGadgetText(#maxpics,Str(GetGadgetState(#zeilen)*GetGadgetState(#spalten)))
If pics > GetGadgetState(#zeilen)*GetGadgetState(#spalten)
SetGadgetText(#warning,"too much pics!")
Else
SetGadgetText(#warning," ")
EndIf
ElseIf GadgetID = #spalten
SetGadgetText(#spalten,Str(GetGadgetState(#spalten)))
SetGadgetText(#maxpics,Str(GetGadgetState(#zeilen)*GetGadgetState(#spalten)))
If pics > GetGadgetState(#zeilen)*GetGadgetState(#spalten)
SetGadgetText(#warning,"too much pics!")
Else
SetGadgetText(#warning," ")
EndIf
ElseIf GadgetID = #rahmen
SetGadgetText(#rahmen,Str(GetGadgetState(#rahmen)))
ElseIf GadgetID = #titel
ElseIf GadgetID = #Datei
ElseIf GadgetID = #format
;SetGadgetText(1, Str(GetGadgetState(1)))
format = GetGadgetText(#format)
ElseIf GadgetID = #border
SetGadgetText(#border,Str(GetGadgetState(#border)))
ElseIf GadgetID = #vor
ElseIf GadgetID = #nach
ElseIf GadgetID = #colour
farbe = ColorRequester()
ElseIf GadgetID = #fontfarbe
textfarbe = ColorRequester()
ElseIf GadgetID = #clr1
ClearGadgetItemList(#vor)
ElseIf GadgetID = #clr2
ClearGadgetItemList(#nach)
ElseIf GadgetID = #pos1
position="right"
ElseIf GadgetID = #pos2
position="center"
ElseIf GadgetID = #pos3
position="left"
ElseIf GadgetID = #pfadwahl
installpfad = PathRequester("Bitte Speicherpfad der Datei angeben","")
SetGadgetText(#pfad, installpfad)
DisableGadget(#select,0)
ElseIf GadgetID = #pfad
installpfad = GetGadgetText(#pfad)
DisableGadget(#select,0)
ElseIf GadgetID = #erstellen
;If GetGadgetState(#zeilen)*GetGadgetState(#spalten) <= pics
Goto erstell
;Else
;MessageRequester("Error", "Nicht genügend bilder vorhanden um Tabelle vollständig auszufüllen. Bitte ändern sie die Zeilen oder Die Spalten!")
;EndIf
EndIf
EndIf
Until Event = #PB_EventCloseWindow
End
erstell:
Z = 0
;DeleteDirectory(installpfad+GetGadgetText(#titel), "*.*" , #PB_FileSystem_Recursive)
CreateDirectory(installpfad+GetGadgetText(#titel))
ExamineDirectory(0, path, verz+format)
UseJPEGImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
For x = 1 To pics
SetGadgetState(#progress, Int((x/pics)*100))
FileType = NextDirectoryEntry()
If FileType
CopyFile(path+DirectoryEntryName(), installpfad+GetGadgetText(#titel)+"\"+DirectoryEntryName())
bilder(x) = GetGadgetText(#titel)+"\"+DirectoryEntryName()
CreateImage(x,GetGadgetState(#breite), GetGadgetState(#hoehe))
LoadImage(X,installpfad+bilder(x))
StartDrawing(WindowOutput())
DrawImage(UseImage(x),1000,1000)
ResizeImage(x, (GetGadgetState(#breite)+GetGadgetState(#anderung)),( GetGadgetState(#hoehe))+GetGadgetState(#anderung))
StopDrawing()
SaveImage(X, installpfad+GetGadgetText(#titel)+"\Vorschau_"+Str(x)+".bmp",#PB_ImagePlugin_BMP)
bilder_v(x) = GetGadgetText(#titel)+"\Vorschau_"+Str(x)+".bmp"
FreeImage(x)
EndIf
Next
;MessageRequester("test0", bilder(x-1))
;MessageRequester("test1",path+DirectoryEntryName() + " quelle")
;MessageRequester("test2",installpfad+GetGadgetText(#titel)+"\"+DirectoryEntryName() + " ziel")
For x = 1 To pics
CopyFile(bilder(x),GetGadgetText(#titel))
bilder(x) = GetGadgetText(#titel) +"\"+ GetFilePart(bilder(x))
Next
red$= Hex(Red(farbe))
If Len(red$)=1
red$ = "0"+red$
EndIf
green$= Hex(Green(farbe))
If Len(green$)=1
green$ = "0"+green$
EndIf
blue$= Hex(Blue(farbe))
If Len(blue$)=1
blue$ = "0"+blue$
EndIf
red2$= Hex(Red(textfarbe))
If Len(red2$)=1
red2$ = "0"+red2$
EndIf
green2$= Hex(Green(textfarbe))
If Len(green2$)=1
green2$ = "0"+green2$
EndIf
blue2$= Hex(Blue(textfarbe))
If Len(blue2$)=1
blue2$ = "0"+blue2$
EndIf
CreateFile(1,installpfad+"\"+GetGadgetText(#Datei))
OpenFile(1,installpfad+"\"+GetGadgetText(#Datei))
UseFile(1)
WriteStringN("<html>")
WriteStringN("<head>")
WriteStringN("<meta name="+Chr(34)+"generator"+Chr(34)+" content="+Chr(34)+"Benpicco´s Thumbnail Maker"+Chr(34)+">")
WriteStringN("<title>"+ GetGadgetText(#titel) + "</title>")
WriteStringN("</head>")
WriteStringN("<body bgcolor = "+Chr(34) +"#"+red$+green$+blue$+Chr(34) + " text="+Chr(34) +"#"+red2$+green2$+blue2$+Chr(34) + ">")
WriteStringN(GetGadgetText(#vor)+"<br>")
WriteString("<div align="+position+">")
WriteStringN("<table border="+Chr(34) + GetGadgetText(#border) + Chr(34) +">")
For Y = 1 To GetGadgetState(#zeilen)
WriteStringN("<tr>")
For x = 1 To GetGadgetState(#spalten)
Z = Z+1
SetGadgetState(#progress, Int((((GetGadgetState(#zeilen)+GetGadgetState(#spalten))/Z)*100)+100))
OnErrorResume()
If Z > pics
Goto weiter
EndIf
If GetGadgetState(#bildtext)=1
WriteStringN("<div style="+Chr(34)+"position:absolute;"+Chr(34)+">")
EndIf
WriteStringN("<td><a href="+Chr(34)+bilder(z)+Chr(34)+" target = "+Chr(34)+"_blank"+Chr(34)+"><img src="+Chr(34)+bilder_v(z)+Chr(34)+"height = "+Chr(34)+GetGadgetText(#hoehe)+Chr(34)+" border="+GetGadgetText(#rahmen)+" width = "+Chr(34)+GetGadgetText(#breite)+Chr(34)+" alt="+Chr(34)+GetFilePart(bilder(z))+Chr(34)+"+ onMouseOver="+Chr(34)+"this.width ="+Chr(39)+Str(GetGadgetState(#breite)+GetGadgetState(#anderung))+Chr(39)+Chr(59)+" this.height = "+Chr(39)+ Str(GetGadgetState(#hoehe)+GetGadgetState(#anderung))+Chr(39)+ Chr(59)+Chr(34)+" onMouseOut = "+Chr(34)+"this.width="+Chr(39)+GetGadgetText(#breite)+Chr(39)+Chr(59)+" this.height="+Chr(39)+GetGadgetText(#hoehe)+Chr(39)+Chr(59)+Chr(34)+"></a></td>")
If GetGadgetState(#bildtext) = 1
textbild$=RemoveString(GetFilePart(bilder(Z)), GetExtensionPart(("."+bilder(Z))),1)
WriteStringN( "<p style="+Chr(34)+"position:absolute; top:3%; left:25%; width:100%;"+Chr(34)+"><font size=2%>"+Chr(34)+textbild$+Chr(34)+"</font></div></p>")
EndIf
Next
weiter:
WriteStringN("</tr>")
Next
WriteStringN("</table></div><br>")
WriteStringN(GetGadgetText(#nach)+"<br>")
WriteStringN("</body></html>")
CloseFile(1)
SetGadgetState(#progress,200)
MessageRequester("Sucess!", "Bildvorschau wurde erfolgreich erstellt!")
RunProgram(installpfad+"\"+GetGadgetText(#Datei))
Ich hab nämlich nur die demo, da gehen nicht mehr als ca. 800 Zeilen... (tatsächlich ca. um die 650)
ups, kann das mal jemand nach Anwendungen verschieben?
. Ich hab jetzt auch mal einen Härtetest gemacht, ich hab ca. 2800 Bilder aus dem Bildarchiv (rtp) des rpg-makers *g*.Die hab ich auf 29 Seiten verteilt, damit war der Übersicht wohl genüge getan ^^. Sowas läd zwar kein normaler Mensch als Bildvorschau hoch, aber das es funktioniert hat, zeigt, das es jetzt geht, und hier ist nochmal der jetzt überarbeitete code: