Bilder zu HTML Galerie
Hallo
Nein, es ist nicht so langsam, aber ist ein kleines Insekt drin.
Nimm mal einen Ordner mit z.B. 30 oder auch mehr Bildern.
Führe das Programm aus.
Wenn das Fenster mit dem Verlaufszeiger kommt, fahre mit dem Mauszeiger mal ein paar mal über das Fenster.
Wirst sehen wie fix das dann geht.
Werde, wenn ich Zeit habe, die Sache noch überarbeiten.
Kann aber ein paar Tage dauern bis ich dazu komme.
Torsten
Nein, es ist nicht so langsam, aber ist ein kleines Insekt drin.
Nimm mal einen Ordner mit z.B. 30 oder auch mehr Bildern.
Führe das Programm aus.
Wenn das Fenster mit dem Verlaufszeiger kommt, fahre mit dem Mauszeiger mal ein paar mal über das Fenster.
Wirst sehen wie fix das dann geht.
Werde, wenn ich Zeit habe, die Sache noch überarbeiten.
Kann aber ein paar Tage dauern bis ich dazu komme.
Torsten
PB 4.51 32 Windows Vista, 32 XP, PB 4.51 32 Ubuntu 10.10
-
- Beiträge: 58
- Registriert: 04.10.2008 12:10
@All
Ich bräuchte mal eure Hilfe. Habe bei mir zu Hause nur noch Vista als Windows-System. Frau und Kind haben Linux.
Und der Code von Seite1 Post1 läuft unter Vista tadellos.
Habe das jetzt 2 mal mit einerm Verzeichnis von über 300 Bildern probiert.
Habe aber diesen Fehler mit der Zeitverzögerung an einem XP-Rechner selbst gesehen.
Habe jetzt 4 Wochen Urlaub
und komme nicht an den Betriebsrechner.
Könnte da mal von einer von euch mit XP nachschauen?
Wird wohl, wie schon von KeyKon erwähnt, am WaitWindowEvent liegen.
Ist eben blos blöd, wenn ich den Fehler nicht reproduzieren kann.
Danke Torsten
Ich bräuchte mal eure Hilfe. Habe bei mir zu Hause nur noch Vista als Windows-System. Frau und Kind haben Linux.
Und der Code von Seite1 Post1 läuft unter Vista tadellos.
Habe das jetzt 2 mal mit einerm Verzeichnis von über 300 Bildern probiert.
Habe aber diesen Fehler mit der Zeitverzögerung an einem XP-Rechner selbst gesehen.
Habe jetzt 4 Wochen Urlaub

Könnte da mal von einer von euch mit XP nachschauen?
Wird wohl, wie schon von KeyKon erwähnt, am WaitWindowEvent liegen.
Ist eben blos blöd, wenn ich den Fehler nicht reproduzieren kann.
Danke Torsten
PB 4.51 32 Windows Vista, 32 XP, PB 4.51 32 Ubuntu 10.10
Ich bin mal so frei . 
Zeile 152
ändern in
oder besser
und schon läuft alles bestens unter XP.

Zeile 152
Code: Alles auswählen
Event = WaitWindowEvent()
Code: Alles auswählen
Event = WaitWindowEvent(10)
Code: Alles auswählen
Event = WindowEvent()
-
- Beiträge: 58
- Registriert: 04.10.2008 12:10
tmjuk hat geschrieben:Klar, mach doch.
Na dann...Andesdaf hat geschrieben:Interesse hätt ich auch.

Code: Alles auswählen
EnableExplicit
;- Constants
;CreateWindow()
#Window=0
#WinWidth=300
#WinHeight=200
#WinTitle$="Html-Gallery"
#WinView=#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered
;GetDirectory()
#RootDir$="C:"
;ThumbnailSize
#ThumbWidth=200
#ThumbHeight=150
;MessageRequester()
#YN=4
#Y=6
#N=7
;
Enumeration ; File-ID´s
#File_Index
#Dir=0
EndEnumeration
;
Enumeration ; Image-ID`s
#Image
EndEnumeration
;
Enumeration ; Function: LayerSwitch()
#F0T1
#F1T0
#F1T2
#F2T1
#F2T3
#F3T0
EndEnumeration
;
Enumeration ; Function: GetDirectory()
#Source
#Target
EndEnumeration
;
Enumeration ; Function: Html_Wizard()
#Body_Create
#Body_Finish
#Table_Create
#Table_Finish
#Table_NewRow
#Table_FinishRow
#Table_NewCell
#Table_FinishCell
EndEnumeration
;
Enumeration ; Var: Alignment
#Vertical
#Horizontal
EndEnumeration
;
Enumeration ; Function: CleanUp()
#Termination
#PartyMess
EndEnumeration
;
Enumeration ; Function: AddEntry(), FileAction()
#Bmp
#Png
#Jpg
EndEnumeration
;
Enumeration ; Function: FileAction()
#Save_Original
#Save_Bmp
#Save_Png
#Save_Jpg
EndEnumeration
;
Enumeration ; Function: Guru()
#Err_OpenWindow
#Err_SrcDir
#Err_NoImages
#Err_CreateImgSub
#Err_CreateThumbSub
#Err_CreateIndexFile
EndEnumeration
;
Enumeration ; Gadgets
#G_Layer0
#G_Frame1
#G_Frame2
#G_BtnSrc
#G_BtnTrg
#G_StrSrc
#G_StrTrg
#G_CheckHeader
#G_CheckAuthor
#G_StrHeader
#G_StrAuthor
#G_BtnQuit
#G_BtnNext
#G_Layer1
#G_Frame3
#G_CheckAlt
#G_CheckSize
#G_TextComp
#G_TextTrans
#G_SpinCom
#G_Combo
#G_BtnBack
#G_BtnNext2
#G_Layer2
#G_Frame4
#G_Frame5
#G_Text1
#G_Spin
#G_CheckDate
#G_OptionCopy
#G_OptionLink
#G_BtnBack2
#G_BtnStart
#G_Layer3
#G_Frame6
#G_Frame7
#G_Frame8
#G_Text2
#G_Text3
#G_Text4
#G_Text5
#G_Text6
#G_Text7
#G_Text8
#G_Progress
#G_BtnAbort
#G_BtnPauRes
EndEnumeration
;-Structures
Structure Finder
PicSrc.s
PicTrg.s
EndStructure
;
Structure Stuff
Bool_Header.b
Bool_Author.b
Bool_Alt.b
Bool_Size.b
Bool_Date.b
Bool_ImgCopy.b
Bool_OpenRow.b
Bool_Pause.b
Bool_Abort.b
Compress.b
Transform.b
ImgsPerRow.b
ImgsTotal.l
Errors.l
Error_Copy.l
Error_Load.l
Error_Save.l
Thumb_Align.b
Thumb_Name.s
Str_Header.s
Str_Author.s
EndStructure
;
Structure Description
FileName.s
GFormat.b
EndStructure
;
Global Path.Finder, Misc.Stuff
Global Dim GFormats.s(11)
Global NewList Image.Description()
;
Declare Init()
Declare CreateWindow()
Declare GadgetControl(Gadget.l)
Declare LayerSwitch(Direction.l)
Declare GetDirectory(Which.l)
Declare.l GetContent()
Declare AddEntry(FileName.s,FileType.l)
Declare.s Html_Translator(Text.s)
Declare Html_Wizard(Spell.l)
Declare TableDance(FileName.s)
Declare Start()
Declare FileAction(FileName.s,FileType.l)
Declare PauseRefresh()
Declare PauseButton()
Declare.s ShortLine(Text.s)
Declare.l CleanUp(What.l)
Declare Guru(Attack.l)
Declare Quit()
;
;Start-Up
Init()
CreateWindow()
;
;-Main()
Repeat
Select WaitWindowEvent(100)
Case #PB_Event_Gadget : GadgetControl(EventGadget())
Case #PB_Event_CloseWindow : Quit()
EndSelect
ForEver
;
;-
;Functions()
;
Procedure GadgetControl(Gadget.l)
Select Gadget
Case #G_BtnSrc : GetDirectory(#Source)
Case #G_BtnTrg : GetDirectory(#Target)
Case #G_CheckHeader : Misc\Bool_Header!1 : DisableGadget(#G_StrHeader,1-Misc\Bool_Header)
Case #G_CheckAuthor : Misc\Bool_Author!1 : DisableGadget(#G_StrAuthor,1-Misc\Bool_Author)
Case #G_BtnQuit : Quit()
Case #G_BtnNext : LayerSwitch(#F0T1)
;
Case #G_SpinCom : SetGadgetText(#G_SpinCom,Str(GetGadgetState(#G_SpinCom)))
Case #G_CheckAlt : Misc\Bool_Alt!1
Case #G_CheckSize : Misc\Bool_Size!1
Case #G_BtnBack : LayerSwitch(#F1T0)
Case #G_BtnNext2 : LayerSwitch(#F1T2)
;
Case #G_Spin : SetGadgetText(#G_Spin,Str(GetGadgetState(#G_Spin)))
Case #G_CheckDate : Misc\Bool_Date!1
Case #G_BtnBack2 : LayerSwitch(#F2T1)
Case #G_BtnStart : LayerSwitch(#F2T3)
;
Case #G_BtnAbort : Misc\Bool_Abort!1
Case #G_BtnPauRes : Misc\Bool_Pause!1 : PauseButton()
EndSelect
EndProcedure
;
Procedure Init()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
;
GFormats(0)="BMP"
GFormats(1)="Bmp"
GFormats(2)="bmp"
GFormats(3)="PNG"
GFormats(4)="Png"
GFormats(5)="png"
GFormats(6)="JPG"
GFormats(7)="Jpg"
GFormats(8)="jpg"
GFormats(9)="JPEG"
GFormats(10)="Jpeg"
GFormats(11)="jpeg"
EndProcedure
;
Procedure CreateWindow()
If Not OpenWindow(#Window,0,0,#WinWidth,#WinHeight,#WinTitle$,#WinView)
Guru(#Err_OpenWindow)
EndIf
;
ContainerGadget(#G_Layer0,0,0,300,200)
HideGadget(#G_Layer0,#True)
Frame3DGadget(#G_Frame1,5,5,290,75,"Quell- und Zielverzeichnis auswählen")
Frame3DGadget(#G_Frame2,5,90,290,75,"Titelleiste/Kopfzeile und Autor")
ButtonGadget(#G_BtnSrc,10,25,50,20,"Quelle")
ButtonGadget(#G_BtnTrg,10,50,50,20,"Ziel")
StringGadget(#G_StrSrc,65,25,225,20,"",#PB_String_ReadOnly)
StringGadget(#G_StrTrg,65,50,225,20,"",#PB_String_ReadOnly)
CheckBoxGadget(#G_CheckHeader,15,110,20,20,"")
CheckBoxGadget(#G_CheckAuthor,15,135,20,20,"")
StringGadget(#G_StrHeader,35,110,255,20,"Seitenkennung & Überschrift")
StringGadget(#G_StrAuthor,35,135,255,20,"Autor")
ButtonGadget(#G_BtnQuit,30,170,100,20,"Beenden")
ButtonGadget(#G_BtnNext,170,170,100,20,"Weiter")
SetGadgetColor(#G_StrSrc,#PB_Gadget_BackColor,$EFEFEF)
SetGadgetColor(#G_StrTrg,#PB_Gadget_BackColor,$EFEFEF)
DisableGadget(#G_StrHeader,#True)
DisableGadget(#G_StrAuthor,#True)
DisableGadget(#G_BtnNext,#True)
CloseGadgetList()
;
ContainerGadget(#G_Layer1,0,0,300,200)
HideGadget(#G_Layer1,#True)
Frame3DGadget(#G_Frame3,5,5,290,155,"Thumbnails")
CheckBoxGadget(#G_CheckAlt,15,25,250,20,"Dateiname als Alternativtext einfügen")
CheckBoxGadget(#G_CheckSize,15,50,250,20,"Bildgröße festlegen")
TextGadget(#G_TextComp,80,82,200,20,"Kompression (0=niedrigste, 10=höchste)")
TextGadget(#G_TextTrans,130,112,150,20,"Grafikformat umwandeln")
SpinGadget(#G_SpinCom,15,80,60,20,0,10,#PB_Spin_ReadOnly)
ComboBoxGadget(#G_Combo,15,110,110,20)
ButtonGadget(#G_BtnBack,30,170,100,20,"Zurück")
ButtonGadget(#G_BtnNext2,170,170,100,20,"Weiter")
SetGadgetState(#G_SpinCom,3) : SetGadgetText(#G_SpinCom,"3")
AddGadgetItem(#G_Combo,0,"Original belassen")
AddGadgetItem(#G_Combo,1,"Als Bmp speichern")
AddGadgetItem(#G_Combo,2,"Als Png speichern")
AddGadgetItem(#G_Combo,3,"Als Jpg speichern")
SetGadgetState(#G_Combo,0)
CloseGadgetList()
;
ContainerGadget(#G_Layer2,0,0,300,200)
HideGadget(#G_Layer2,#True)
Frame3DGadget(#G_Frame4,5,5,290,55,"Galerie")
Frame3DGadget(#G_Frame5,5,65,290,95,"Sonstiges")
TextGadget(#G_Text1,70,28,200,20,"Bilder pro Reihe")
SpinGadget(#G_Spin,15,25,50,20,2,10,#PB_Spin_ReadOnly)
CheckBoxGadget(#G_CheckDate,15,85,250,20,"Erstellungsdatum einbinden")
OptionGadget(#G_OptionCopy,15,110,250,20,"Bilder in das Verzeichnis "+#DQUOTE$+"Images"+#DQUOTE$+" kopieren")
OptionGadget(#G_OptionLink,15,135,250,20,"Bilder zum Quellverzeichnis verlinken")
ButtonGadget(#G_BtnBack2,30,170,100,20,"Zurück")
ButtonGadget(#G_BtnStart,170,170,100,20,"Starten")
SetGadgetState(#G_Spin,2) : SetGadgetText(#G_Spin,"2")
SetGadgetState(#G_OptionCopy,#True)
CloseGadgetList()
;
ContainerGadget(#G_Layer3,0,0,300,200)
HideGadget(#G_Layer3,#True)
Frame3DGadget(#G_Frame6,5,0,290,90,"")
Frame3DGadget(#G_Frame7,5,90,290,60,"")
Frame3DGadget(#G_Frame8,5,155,290,40,"")
TextGadget(#G_Text2,10,15,60,20,"Quelle :")
TextGadget(#G_Text3,72,15,220,20,"")
TextGadget(#G_Text4,10,40,60,20,"Ziel :")
TextGadget(#G_Text5,72,40,220,20,"")
TextGadget(#G_Text6,10,65,60,20,"Akt. Bild :")
TextGadget(#G_Text7,72,65,220,20,"")
TextGadget(#G_Text8,10,128,280,20,"",#PB_Text_Center)
ProgressBarGadget(#G_Progress,10,107,280,20,0,100)
ButtonGadget(#G_BtnAbort,30,170,100,20,"Abbrechen")
ButtonGadget(#G_BtnPauRes,170,170,100,20,"Pause")
SetGadgetColor(#G_Text8,#PB_Gadget_FrontColor,#Blue)
CloseGadgetList()
;
HideGadget(#G_Layer0,#False)
EndProcedure
;
Procedure LayerSwitch(Direction.l)
Select Direction
Case #F0T1
If GetContent()
If Misc\ImgsTotal>=100
If MessageRequester("Info","Verzeichnis enthält "+Str(Misc\ImgsTotal)+" Dateien ! "+Chr(10)+"Trotzdem fortsetzen ? ",#YN)=#N
ProcedureReturn
EndIf
EndIf
Misc\Str_Header=GetGadgetText(#G_StrHeader)
Misc\Str_Author=GetGadgetText(#G_StrAuthor)
HideGadget(#G_Layer0,#True)
HideGadget(#G_Layer1,#False)
Else
Guru(#Err_NoImages)
EndIf
Case #F1T0
HideGadget(#G_Layer1,#True)
HideGadget(#G_Layer0,#False)
Case #F1T2
Misc\Compress=GetGadgetState(#G_SpinCom)
Misc\Transform=GetGadgetState(#G_Combo)
HideGadget(#G_Layer1,#True)
HideGadget(#G_Layer2,#False)
Case #F2T1
HideGadget(#G_Layer2,#True)
HideGadget(#G_Layer1,#False)
Case #F2T3
Misc\ImgsPerRow=GetGadgetState(#G_Spin)
Misc\Bool_ImgCopy=GetGadgetState(#G_OptionCopy)
HideGadget(#G_Layer2,#True)
HideGadget(#G_Layer3,#False)
Start()
Case #F3T0
HideGadget(#G_Layer3,#True)
HideGadget(#G_Layer0,#False)
EndSelect
EndProcedure
;
Procedure GetDirectory(Which.l)
Protected ImgSrc.s, ImgTrg.s
Static LastSrc.s=#RootDir$, LastTrg.s=#RootDir$
Select Which
Case #Source
ImgSrc=PathRequester("Quellverzeichnis auswählen...",LastSrc)
Path\PicSrc=ImgSrc
If Path\PicSrc="" Or Path\PicSrc=""
Path\PicSrc=#RootDir$
EndIf
LastSrc=Path\PicSrc
Case #Target
ImgTrg=PathRequester("Zielverzeichnis auswählen...",LastTrg)
Path\PicTrg=ImgTrg
If Path\PicTrg="" Or Path\PicTrg=""
Path\PicTrg=#RootDir$
EndIf
LastTrg=Path\PicTrg
EndSelect
;
SetGadgetText(#G_StrSrc,Path\PicSrc)
SetGadgetText(#G_StrTrg,Path\PicTrg)
If Path\PicSrc<>"" And Path\PicTrg<>""
DisableGadget(#G_BtnNext,#False)
EndIf
EndProcedure
;
Procedure.l GetContent()
Protected Loop.l, FileName.s, FileExt.s
;
ClearList(Image())
Misc\ImgsTotal=0
;
If ExamineDirectory(#Dir,Path\PicSrc,"*.*")
While NextDirectoryEntry(#Dir)
If DirectoryEntryType(#Dir)=#PB_DirectoryEntry_File
FileName=DirectoryEntryName(#Dir)
FileExt=GetExtensionPart(FileName)
For Loop=0 To 11
If FileExt=GFormats(Loop)
AddEntry(FileName,Loop) : Break
EndIf
Next
EndIf
Wend
FinishDirectory(#Dir)
Else : Guru(#Err_SrcDir) : EndIf
;
If Misc\ImgsTotal=0 : ProcedureReturn #False : EndIf
ProcedureReturn #True
EndProcedure
;
Procedure AddEntry(FileName.s,FileType.l)
AddElement(Image())
Misc\ImgsTotal+1
Image()\FileName=FileName
Select FileType
Case 0,1,2 : Image()\GFormat=#Bmp
Case 3,4,5 : Image()\GFormat=#Png
Case 6,7,8,9,10,11 : Image()\GFormat=#Jpg
EndSelect
EndProcedure
;
Procedure.s Html_Translator(Text.s)
Text=ReplaceString(Text,"ä","ä")
Text=ReplaceString(Text,"Ä","Ä")
Text=ReplaceString(Text,"ö","ö")
Text=ReplaceString(Text,"Ö","Ö")
Text=ReplaceString(Text,"ü","ü")
Text=ReplaceString(Text,"Ü","Ü")
Text=ReplaceString(Text,"ß","ß")
Text=ReplaceString(Text,"å","å")
Text=ReplaceString(Text,"Å","Å")
;
ProcedureReturn Text
EndProcedure
;
Procedure Html_Wizard(Spell.l)
Protected Date.s, Header.s, Author.s
;
Select Spell
Case #Body_Create
If Misc\Bool_Header : Header=Html_Translator(Misc\Str_Header) : EndIf
If Misc\Bool_Author : Author=Html_Translator(Misc\Str_Author) : EndIf
If Misc\Bool_Date : Date=FormatDate("%yyyy-%mm-%dd", Date()) : EndIf
;
If CreateFile(#File_Index,Path\PicTrg+"index.html")
WriteStringN(#File_Index,"<html>")
WriteStringN(#File_Index," <head>")
WriteStringN(#File_Index," <title>"+Header+"</title>")
WriteStringN(#File_Index," </head>")
WriteStringN(#File_Index,"")
WriteStringN(#File_Index," <body>")
If Misc\Bool_Header
WriteStringN(#File_Index," <h2>"+Header+"</h2>")
EndIf
If Misc\Bool_Author And Misc\Bool_Date
WriteStringN(#File_Index," <h4>Autor: "+Author+"<br>Datum: "+Date+"</h4>")
ElseIf Misc\Bool_Author
WriteStringN(#File_Index," <h4>Autor: "+Author+"</h4>")
ElseIf Misc\Bool_Date
WriteStringN(#File_Index," <h4>Datum: "+Date+"</h4>")
EndIf
Else
Guru(#Err_CreateIndexFile)
EndIf
Case #Body_Finish
WriteStringN(#File_Index," </body>")
WriteStringN(#File_Index,"")
WriteStringN(#File_Index,"</html>")
CloseFile(#File_Index)
Case #Table_Create
WriteStringN(#File_Index," <table>")
Case #Table_Finish
WriteStringN(#File_Index," </table>")
Case #Table_NewRow
WriteStringN(#File_Index," <tr>")
Case #Table_FinishRow
WriteStringN(#File_Index," </tr>")
Case #Table_NewCell
WriteStringN(#File_Index," <td align=center>")
Case #Table_FinishCell
WriteStringN(#File_Index," </td>")
EndSelect
EndProcedure
;
Procedure TableDance(FileName.s)
Protected X.l, Y.l, ImagePath.s
Static CurrentCell.l, ImagesDone.l
;
If Misc\Bool_ImgCopy
ImagePath="Images"+FileName
ElseIf Not Misc\Bool_ImgCopy
If Path\PicSrc=Path\PicTrg
ImagePath=FileName
Else
ImagePath="file://localhost/"+Path\PicSrc+FileName
EndIf
EndIf
;
If Misc\Thumb_Align=#Horizontal
X=#ThumbWidth : Y=#ThumbHeight
Else
X=#ThumbHeight : Y=#ThumbWidth
EndIf
;
If CurrentCell=0 : Html_Wizard(#Table_NewRow) : Misc\Bool_OpenRow=#True : EndIf
CurrentCell+1
Html_Wizard(#Table_NewCell)
;
If Misc\Bool_Alt And Misc\Bool_Size
WriteStringN(#File_Index," <a href='"+ImagePath+"' target='_blank'><img class='photo' src='thumbs/"+Misc\Thumb_Name+"' width='"+Str(X)+"' height='"+Str(Y)+"' alt='"+Misc\Thumb_Name+"' title='"+FileName+"'></a>")
WriteStringN(#File_Index," <p>"+FileName+"</p>")
ElseIf Not Misc\Bool_Alt And Misc\Bool_Size
WriteStringN(#File_Index," <a href='"+ImagePath+"' target='_blank'><img class='photo' src='thumbs/"+Misc\Thumb_Name+"' width='"+Str(X)+"' height='"+Str(Y)+"' title='"+FileName+"'></a>")
WriteStringN(#File_Index," <p>"+FileName+"</p>")
ElseIf Misc\Bool_Alt And Not Misc\Bool_Size
WriteStringN(#File_Index," <a href='"+ImagePath+"' target='_blank'><img class='photo' src='thumbs/"+Misc\Thumb_Name+"' alt='"+Misc\Thumb_Name+"' title='"+FileName+"'></a>")
WriteStringN(#File_Index," <p>"+FileName+"</p>")
ElseIf Not Misc\Bool_Alt And Not Misc\Bool_Size
WriteStringN(#File_Index," <a href='"+ImagePath+"' target='_blank'><img class='photo' src='thumbs/"+Misc\Thumb_Name+"' title='"+FileName+"'></a>")
WriteStringN(#File_Index," <p>"+FileName+"</p>")
EndIf
;
Html_Wizard(#Table_FinishCell)
ImagesDone+1
;
If CurrentCell=Misc\ImgsPerRow
CurrentCell=0 : Misc\Bool_OpenRow=#False
Html_Wizard(#Table_FinishRow)
EndIf
;
If ImagesDone=Misc\ImgsTotal
If Misc\Bool_OpenRow : Html_Wizard(#Table_FinishRow) : EndIf
CurrentCell=0 : ImagesDone=0 : Misc\Bool_OpenRow=#False
EndIf
;
EndProcedure
;
Procedure Start()
Protected Percent.l, Done.l
;
If Misc\Bool_ImgCopy
If Not ExamineDirectory(#Dir,Path\PicTrg+"Images","")
If Not CreateDirectory(Path\PicTrg+"Images")
Guru(#Err_CreateImgSub) : ProcedureReturn
EndIf
Else
FinishDirectory(#Dir)
EndIf
EndIf
;
If Not ExamineDirectory(#Dir,Path\PicTrg+"Thumbs","")
If Not CreateDirectory(Path\PicTrg+"Thumbs")
Guru(#Err_CreateThumbSub) : ProcedureReturn
EndIf
Else
FinishDirectory(#Dir)
EndIf
;
Html_Wizard(#Body_Create)
Html_Wizard(#Table_Create)
SetGadgetText(#G_Text3,ShortLine(Path\PicSrc))
SetGadgetText(#G_Text5,ShortLine(Path\PicTrg))
;
ForEach Image()
SetGadgetText(#G_Text7,Image()\FileName)
PauseRefresh()
If Misc\Bool_Abort
If CleanUp(#Termination) : ProcedureReturn : EndIf
EndIf
FileAction(Image()\FileName,Image()\GFormat)
TableDance(Image()\FileName)
Done+1 : Percent=Done*100/Misc\ImgsTotal
SetGadgetText(#G_Text8,Str(Done)+" / "+Str(Misc\ImgsTotal)+" ( "+Str(Percent)+"% )")
SetGadgetState(#G_Progress,Percent)
Next
;
Html_Wizard(#Table_Finish)
Html_Wizard(#Body_Finish)
CleanUp(#PartyMess)
EndProcedure
;
Procedure FileAction(FileName.s,FileType.l)
Protected SaveAs.b
;
If Misc\Bool_ImgCopy
If Not CopyFile(Path\PicSrc+FileName,Path\PicTrg+"Images"+FileName)
Misc\Errors+1 : Misc\Error_Copy+1
EndIf
EndIf
;
If Not LoadImage(#Image,Path\PicSrc+FileName)
Misc\Errors+1 : Misc\Error_Load+1 : ProcedureReturn
EndIf
;
If ImageHeight(#Image)<ImageWidth(#Image)
ResizeImage(#Image,#ThumbWidth,#ThumbHeight)
Misc\Thumb_Align=#Horizontal
Else
ResizeImage(#Image,#ThumbHeight,#ThumbWidth)
Misc\Thumb_Align=#Vertical
EndIf
;
FileName=RemoveString(FileName,GetExtensionPart(FileName))
;
Select Misc\Transform
Case #Save_Original : SaveAs=FileType
Case #Save_Bmp : SaveAs=#Bmp
Case #Save_Png : SaveAs=#Png
Case #Save_Jpg : SaveAs=#Jpg
EndSelect
;
Select SaveAs
Case #Bmp
Misc\Thumb_Name=FileName+"bmp"
If Not SaveImage(#Image,Path\PicTrg+"Thumbs"+Misc\Thumb_Name)
Misc\Errors+1 : Misc\Error_Save+1
EndIf
Case #Png
Misc\Thumb_Name=FileName+"png"
If Not SaveImage(#Image,Path\PicTrg+"Thumbs"+Misc\Thumb_Name,#PB_ImagePlugin_PNG,10-Misc\Compress)
Misc\Errors+1 : Misc\Error_Save+1
EndIf
Case #Jpg
Misc\Thumb_Name=FileName+"jpg"
If Not SaveImage(#Image,Path\PicTrg+"Thumbs"+Misc\Thumb_Name,#PB_ImagePlugin_JPEG,10-Misc\Compress)
Misc\Errors+1 : Misc\Error_Save+1
EndIf
EndSelect
;
FreeImage(#Image)
EndProcedure
;
Procedure PauseRefresh()
Protected Event.i
;
If Not Misc\Bool_Pause
Repeat
Event=WaitWindowEvent(10)
If Event=#PB_Event_Gadget : GadgetControl(EventGadget()) : EndIf
Until Not Event
Else
DisableGadget(#G_BtnAbort,#True)
While Misc\Bool_Pause
Event=WaitWindowEvent()
If Event=#PB_Event_Gadget : GadgetControl(EventGadget()) : EndIf
Wend
DisableGadget(#G_BtnAbort,#False)
EndIf
;
EndProcedure
;
Procedure PauseButton()
If Misc\Bool_Pause
SetGadgetText(#G_BtnPauRes,"Fortsetzen")
Else
SetGadgetText(#G_BtnPauRes,"Pause")
EndIf
EndProcedure
;
Procedure.s ShortLine(Text.s)
Protected TextLength.l, TextOut.s
;
TextLength=Len(Text)
If Right(Text,1)="" : TextLength-1 : Text=Left(Text,TextLength) : EndIf
;
If TextLength>=40
TextOut=Left(Text,3)+"..."+Right(Text,34)
Else
TextOut=Text
EndIf
;
ProcedureReturn TextOut
EndProcedure
;
Procedure.l CleanUp(What.l)
Protected ErrorMessage.s
;
Select What
Case #Termination
If MessageRequester("Abbruch","Vorgang wirklich abbrechen ?",#YN)=#N
Misc\Bool_Abort!1 : ProcedureReturn #False
EndIf
If Misc\Bool_OpenRow
Html_Wizard(#Table_FinishRow)
Misc\Bool_OpenRow=#False
EndIf
Html_Wizard(#Table_Finish)
Html_Wizard(#Body_Finish)
Case #PartyMess
If Misc\Errors=0
ErrorMessage="Es sind keine Fehler aufgetreten"
Else
ErrorMessage="Es sind insgesamt "+Str(Misc\Errors)+" Fehler aufgetreten"
ErrorMessage+Chr(10)+Str(Misc\Error_Copy)+" Kopierfehler"
ErrorMessage+Chr(10)+Str(Misc\Error_Load)+" Ladefehler"
ErrorMessage+Chr(10)+Str(Misc\Error_Save)+" Speicherfehler"
EndIf
MessageRequester("Info",ErrorMessage)
EndSelect
;
If Misc\Bool_Pause : Misc\Bool_Pause!1 : PauseButton() : EndIf
If Misc\Bool_Abort : Misc\Bool_Abort!1 : EndIf
Misc\Errors=0 : Misc\Error_Copy=0
Misc\Error_Load=0 : Misc\Error_Save=0
SetGadgetText(#G_Text3,"")
SetGadgetText(#G_Text5,"")
SetGadgetText(#G_Text7,"")
SetGadgetText(#G_Text8,"")
SetGadgetState(#G_Progress,0)
LayerSwitch(#F3T0)
ProcedureReturn #True
EndProcedure
;
Procedure Guru(Attack.l)
Select Attack
Case #Err_OpenWindow
MessageRequester("Fataler Fehler","Es konnte kein Fenster geöffnet werden !")
End
Case #Err_SrcDir
MessageRequester("Fehler","Quellverzeichnis konnte nicht durchsucht werden !")
Case #Err_NoImages
MessageRequester("Fehler","Es konnten keine Bilder gefunden werden !")
Case #Err_CreateImgSub
MessageRequester("Fehler","Im Zielverzeichnis konnte der Unterordner"+Chr(10)+"'Images' nicht erstellt werden !")
LayerSwitch(#F3T0)
Case #Err_CreateThumbSub
MessageRequester("Fehler","Im Zielverzeichnis konnte der Unterordner"+Chr(10)+"'Thumbs' nicht erstellt werden !")
LayerSwitch(#F3T0)
Case #Err_CreateIndexFile
MessageRequester("Fehler","Datei 'Index.html' konnte nicht erstellt werden !")
LayerSwitch(#F3T0)
EndSelect
EndProcedure
;
Procedure Quit()
If MessageRequester("Beenden...","Wirklich beenden ?!",#YN)=#Y : End : EndIf
EndProcedure
Mfg,
Burstnibbler
Edith hat: 3 Schusselfehler entfernt, Andesdafs Anregung übernommen und 1 möglichen Fix eingebaut.
Zuletzt geändert von Burstnibbler am 08.07.2009 23:52, insgesamt 1-mal geändert.
Hallo,
bei mir kommt beim Abbrechen beider Requester der Fehler
und
Bei Auswahl eines existierenden Verzeichnis kommt
Gruss Torsten
PS: Habe Code im ersten Post geändert. Haut das jetzt so hin?
bei mir kommt beim Abbrechen beider Requester der Fehler
Code: Alles auswählen
[ERROR] testgalerie.pb (Zeile:377)
[ERROR] Invalid memory access. (read error at adress 0)
Code: Alles auswählen
[ERROR] testgalerie.pb (Zeile:383)
[ERROR] Invalid memory access. (read error at adress 0)
Code: Alles auswählen
[ERROR] testgalerie.pb (Zeile:393)
[ERROR] Invalid memory access. (read error at adress 1)
PS: Habe Code im ersten Post geändert. Haut das jetzt so hin?
PB 4.51 32 Windows Vista, 32 XP, PB 4.51 32 Ubuntu 10.10