PureBasic Forums - English

Posted: **Tue Sep 03, 2013 10:29 am**

I have some programs with complex dialogs and everytime I have to add a single button or so, rearranging all items needs a lot of time...
...so I just started to write a simple generator, which should allow to add and remove buttons very simply. It's just a simple skeleton for now, but you can easily check, what happens, when you change the line ;~offset=60 to ;~offset=80 or inserting/removing a line starting with ;Button...

When running the program, all elements will be recalculated and the resulting source code can be copied from the clipboard into a new file.

Code: Select all


; Define
	;/v\
	;#WinX=840
	;#WinY=510

	;Num:
	;#MainMenu
	;#Panel
	;#PanelMainProfile
	;#PanelMainStart
	;#PanelMainCreateList
	;#PanelMainTest
	;#PanelMainQuit

	;#PanelMain=0
	;#PanelSettings
	;#PanelConversion
	;#PanelTitles
	;Num

	;~offset=60

	;Win,#MainMenu,0,0,#WinX,#WinY,"",#PB_Window_SystemMenu
	;Panel,#Panel,15,15,#WinX-30,#WinY-30
	;Panel+,#Panel,#PanelMain," Main Menu "
	;Button,#PanelMainProfile,~x=45,~y=60,~bx=330,~by=45,"Profile: Notebook"
	;Button,#PanelMainStart,~x,~y+=~offset,~bx,~by,"Start Processing"
	;Button,#PanelMainCreateList,~x,~y+=~offset,~bx,~by,"Create Image List"
	;Button,#PanelMainTest,~x,~y+=~offset,~bx,~by,"**** REMOVE THIS LINE ****"
	;Button,#PanelMainQuit,~x,~y+=~offset,~bx,~by,"Quit"
	;Panel+,#Panel,#PanelSettings," General Settings "
	;Panel+,#Panel,#PanelSettings," Image Conversion"
	;Panel+,#Panel,#PanelTitles," Master and Title pages"

	;Repeat
	;Until WaitWindowEvent()=#PB_Event_CloseWindow

	;\^/

; EndDefine

; Define Formerl by Michael Vogel

	Structure localtype
		name.s
		val.i
	EndStructure
	Global NewList locallist.localtype()

	Procedure.s MyTrim(s.s)

		Protected i
		Protected l=Len(s)
		Protected b

		While l
			l-1
			b=PeekB(@s+l)
			If (b<>' ') And (b<>#TAB)
				Break
			EndIf
		Wend

		While i<l
			b=PeekB(@s+i)
			If (b<>' ') And (b<>#TAB)
				Break
			EndIf
			i+1
		Wend

		ProcedureReturn PeekS(@s+i,l-i+1)

	EndProcedure
	Procedure FindChars(string.s,chars.s,start,direction)

		#FindChars_Left=0
		#FindChars_Right=1

		direction=(direction-1)*2+1
		start+direction

		While start>0 And start<=Len(string)
			If FindString(chars,Mid(string,start,1))
				ProcedureReturn start
			EndIf
			start+direction
		Wend

		ProcedureReturn #Null

	EndProcedure
	Procedure.s CalcLocal(s.s,n,mode)

		Protected a,b,c,d

		a=FindChars(s,"+-*/",n,#FindChars_Left)+1
		b=FindChars(s,"+-*/",n,#FindChars_Right)
		If b=0
			b=Len(s)+1
		EndIf
		c=Val(Mid(s,a,n-a))
		d=Val(Mid(s,n+1,b-n-1))
		Select mode
		Case '+'
			c+d
		Case '-'
			c-d
		Case '*'
			c*d
		Case '/'
			If d
				c/d
			Else
				c=0;	Error
			EndIf
		EndSelect

		ProcedureReturn Left(s,a-1)+Str(c)+Mid(s,b)

	EndProcedure
	Procedure FindLocal(name.s)

		Enumeration
			#FindLocalEmptyList
			#FindLocalNotFound
			#FindLocalFound
		EndEnumeration

		Protected flag

		ResetList(locallist())
		Repeat
			If NextElement(locallist())
				If locallist()\name=name
					flag=#FindLocalFound
				EndIf
			Else
				flag=#FindLocalNotFound
			EndIf
		Until flag

		ProcedureReturn flag

	EndProcedure
	Procedure ModeLocal(s.s,n)

		Protected mode
		Protected z=Len(s)

		While n<z And mode=0
			mode=PeekA(@s+n)
			Select mode
			Case '+','-','*','/'
			Default
				mode=0
				n+1
			EndSelect
		Wend

		ProcedureReturn n+1

	EndProcedure
	Procedure EvalLocal(s.s)

		Protected n,m,val,z
		Protected c.s

		n=FindString(s,"~")
		While n
			m=ModeLocal(s,n)
			If FindLocal(Mid(s,n,m-n))=#FindLocalFound
				val=locallist()\val
			Else
				val=0
			EndIf
			s=Left(s,n-1)+Str(val)+Mid(s,m)
			n=FindString(s,"~",n)
		Wend

		For z=1 To 4
			c=Mid("*/+-",z,1)
			n=FindString(s,c)
			While n
				s=CalcLocal(s,n,Asc(c))
				n=FindString(s,c)
			Wend
		Next z

		ProcedureReturn Val(s)

	EndProcedure
	Procedure Local(s.s)

		Protected name.s
		Protected mode.i
		Protected n.i
		Protected val.i
		Protected flag.i

		s=ReplaceString(s," ","")
		s=ReplaceString(s,#TAB$,"")
		s=LCase(s)

		n=FindString(s,"=")
		If n
			mode=PeekA(@s+n-1)
			Select mode
			Case '+','-','*','/'
				name=Left(s,n-2)
			Default
				mode='='
				name=Left(s,n-1)
			EndSelect
			s=StringField(s,2,"=")

			If FindString("+-*/",Right(name,1))
				s=name+s
				name=Left(name,Len(name)-1)
			EndIf

			val=EvalLocal(s)

			With locallist()

				If FindLocal(name)<>#FindLocalFound
					AddElement(locallist())
					\name=name
				EndIf

				Select mode
				Case #Null
					val=\val
				Case '='
					;	val=Val(s)
				EndSelect

				;Debug "Set "+name+":"+Chr(mode)+Str(val)+" ("+\name+" was "+Str(\val)+")"
				\val=val

				ProcedureReturn val
			EndWith

		Else
			If FindLocal(s)
				ProcedureReturn locallist()\val
			Else
				ProcedureReturn #Null
			EndIf
		EndIf

	EndProcedure
	Procedure.s Formerl()

		Protected n,z
		Protected s.s,ts.s,tt.s
		Protected flag
		Protected result.s

		If ReadFile(0,#PB_Compiler_File)
			While Eof(0)=#Null
				s=MyTrim(ReadString(0))

				If PeekA(@s)=';'
					If s=";/v\"
						flag=#True
					ElseIf s=";\^/"
						flag=#False
					ElseIf flag
						s=Mid(s,2)
						Select PeekA(@s)
						Case '#'
							s="  "+s
						Case '~'
							Local(s)
							s=""
						Default
							n=CountString(s,",")
							If n
								ts=s
								s=StringField(ts,1,",")
								For z=2 To n+1
									tt=StringField(ts,z,",")
									If FindString(tt,"~")
										tt=Str(Local(tt))
									EndIf
									s+","+tt
								Next z
							EndIf

							n=FindString(s,",")
							If n
								ts="("+Mid(s,n+1)+")"
								s=Left(s,n-1)
							Else
								ts=""
							EndIf

							Select s
							Case "Num:"
								s="Enumeration"
							Case "Num"
								s="EndEnumeration"
							Case "Win"
								s="OpenWindow"+ts
							Case "Panel"
								s="PanelGadget"+ts
							Case "Panel+"
								s="AddGadgetItem"+ts
							Case "Button"
								s="ButtonGadget"+ts
							Default
								s=s+"; "+ts
							EndSelect

						EndSelect

						;Debug s
						result+s+#CRLF$

					EndIf
				EndIf
			Wend
		EndIf

		ProcedureReturn result

	EndProcedure

; EndDefine

SetClipboardText(Formerl())

Next step will be to create a IDE-Tool which automatically adapt source files like the example below...

Code: Select all


#WinX=840
#WinY=510

Enumeration
	#MainMenu
	#Panel
	#PanelMainProfile
	#PanelMainStart
	#PanelMainCreateList
	#PanelMainTest
	#PanelMainQuit
	#PanelMain=0
	#PanelSettings
	#PanelConversion
	#PanelTitles
EndEnumeration

OpenWindow(#MainMenu,0,0,#WinX,#WinY,"",#PB_Window_SystemMenu)
PanelGadget(#Panel,15,15,#WinX-30,#WinY-30)
AddGadgetItem(#Panel,#PanelMain," Main Menu ")
;																		[~offset=60]
ButtonGadget(#PanelMainProfile,45,60,330,45,"Profile: Notebook");				[~x=45,~y=60,~bx=330,~by=45]
ButtonGadget(#PanelMainStart,45,120,330,45,"Start Processing");				[~x,~y+=~offset,~bx,~by]
ButtonGadget(#PanelMainCreateList,45,180,330,45,"Create Image List");		[~x,~y+=~offset,~bx,~by]
ButtonGadget(#PanelMainTest,45,240,330,45,"**** REMOVE THIS LINE ****");	[~x,~y+=~offset,~bx,~by]
ButtonGadget(#PanelMainQuit,45,300,330,45,"Quit");							[~x,~y+=~offset,~bx,~by]
AddGadgetItem(#Panel,#PanelSettings," General Settings ")
AddGadgetItem(#Panel,#PanelSettings," Image Conversion")
AddGadgetItem(#Panel,#PanelTitles," Master and Title pages")

Repeat;
Until WaitWindowEvent()=#PB_Event_CloseWindow;

...actually I don't know, how to find the beginning of a remark! Sounds silly, but how to detect, if a semicolon is part of a code or will the token for a remark, like in the example Debug ";'"+Chr(';')+';'; + ;?

Posted: **Tue Sep 03, 2013 6:57 pm**

Michael Vogel wrote:...actually I don't know, how to find the beginning of a remark! Sounds silly, but how to detect, if a semicolon is part of a code or will the token for a remark, like in the example Debug ";'"+Chr(';')+';'; + ;?

Search from the beginning of a line and match quotes and single quotes.

The flags (SQ and DQ) are set to zero at the beginning of each line.

Code: Select all

  Case '"' ;double quote
    If SQ = 0
      DQ = DQ ! 1
      ;Do a specific search from this point forward to find the matching double-quote and reposition the string pointer before the next non-string character
    EndIf
  Case 39 ;single quote
    If DQ = 0
      SQ = SQ ! 1
      ;Do a specific search from this point forward to find the matching single-quote and reposition the string pointer before the next non-string character
    EndIf
  Case ';'
    If DQ = 0 And SQ = 0
      ;found comment, process comment or end processing for this line
    EndIf

An alternative to this that may simplify things a little is to process the line three times. Make a copy of the line and check for double or single quotes, while inside quotes replace the characters with spaces. Check the line again with a FindString() and look for the first ';' and the remainder of the line is a comment (you can also replace the semi-colon character and the remainder of the line with spaces. Now step through the line again character by character and interpret the characters. Your sample line would look like this after each step:

Code: Select all

;original line first then each step
Debug ";'"+Chr(';')+';'; + ;
Debug "  "+Chr(' ')+' '; + ;
Debug "  "+Chr(' ')+' '

If the contents of the quoted sections are important you can refer back to the original line when you are between quotes to just process those contents and then move the character pointer to the ending quote to continue.

Posted: **Wed Sep 04, 2013 6:11 am**

Thanks,

works fine...

Code: Select all

Q$=#DQUOTE$

Procedure RemarkablePoint(s.s)

	Protected n,z
	Protected dflag,sflag

	z=Len(s)

	While n<z
		Select PeekC(@s+n)
		Case '"'					; double quote
			If sflag=0
				dflag!1
			EndIf
		Case 39					; single quote
			If dflag=0
				sflag!1
			EndIf
		Case ';'
			If sflag+dflag=0
				ProcedureReturn n+1
			EndIf
		EndSelect

		n+1
	Wend
	
	ProcedureReturn #Null
	
EndProcedure

z.s="Debug Chr('"+Q$+"')+"+Q$+";'"+Q$+"+Chr(';')+';'; "+Q$+"+' ;"+Q$
;z.s="Debug "+Q$+";'"+Q$+"+Chr(';')+';'; "+Q$+"+' ;"+Q$

n=RemarkablePoint(z)
If n
	Debug Left(z,n-1)
	Debug Mid(z,n)
EndIf

Posted: **Wed Sep 04, 2013 7:40 am**

And here's the tool code for the PB-IDE...
...seems to work fine, but I've only added the parameter details (z=position of first parameter, number of parameters) for ButtonGadget and PanelGadget for now:

Code: Select all

;{ Reformer Tool by Michael Vogel V1.oo}

	; INSTALLATION:
	; copy compiled exe into the directory "...\Purbasic\Catalogs"
	; install the tool using the parameter "%TEMPFILE" %SELECTION
	; use the PureBasic as the working directory (or adapt the OpenPreferences path below)
	; Select 'Wait until tool quits' And 'Reload source after tool has quit'

	;	%COMPILEFILE\..\Catalogs\Tool Reformer.exe
	;	"%TEMPFILE" %SELECTION
	;	%COMPILEFILE\..
	;	Re&former &Tool
	;	Menu Or Shortcut

	; 	× Wait until tool quits
	; 	× Reload Source after tool has quit
	; 	× into the current source


	; DESCRIPTION:
	; - allows to use internal variables (e.g. ~PosX) for calculating dialog coordinates
	; - all statements have to entered in square brackets within remarks (e.g. ;[~PosX=10] )
	; - beside gadget commands for dialogs, the given parameters will be replaced (e.g. ButtonGadget(...,0,...); [...,~PosY+=OffsetY,...]
	
	
	; EXAMPLE:
	; #WinX=840
	; #WinY=510
	;
	; Enumeration
	; 	#MainMenu
	; 	#Panel
	; 	#PanelMainProfile
	; 	#PanelMainStart
	; 	#PanelMainCreateList
	; 	#PanelMainTest
	; 	#PanelMainQuit
	; EndEnumeration
	;
	; OpenWindow(#MainMenu,0,0,#WinX,#WinY,"",#PB_Window_SystemMenu)
	; ;																			[~offset=80,~bx=500,~by=60]
	; ButtonGadget(#PanelMainProfile,80,50,500,60,"Profile: Notebook");				[~x=80,~y=50,~bx,~by]
	; ButtonGadget(#PanelMainStart,80,130,500,60,"Start Processing");				[~x,~y+=~offset,~bx,~by]
	; ButtonGadget(#PanelMainCreateList,80,210,500,60,"Create Image List");			[~x,~y+=~offset,~bx,~by]
	; ButtonGadget(#PanelMainTest,80,290,500,60,"**** REMOVE THIS LINE ****");	[~x,~y+=~offset,~bx,~by]
	; ButtonGadget(#PanelMainQuit,80,370,500,60,"Quit");							[~x,~y+=~offset,~bx,~by]
	;
	; Repeat;
	; Until WaitWindowEvent()=#PB_Event_CloseWindow;

	;}

	; Define

		#Debug=0

		EnableExplicit
		Enumeration
			#In
			#Out
		EndEnumeration

		Global InputFile.s
		Global OutputFile.s

		Global Line.i
		Global FirstlLine.i
		Global LastLine.i

		Global Text.s
		Global TextCode.s
		Global TextRem.s

		Structure LocalsType
			Name.s
			Val.i
		EndStructure
		Global NewList Locals.LocalsType()

	; EndDefine

	Procedure.s MyTrim(s.s)

		Protected i
		Protected l=Len(s)
		Protected b

		While l
			l-1
			b=PeekB(@s+l)
			If (b<>' ') And (b<>#TAB)
				Break
			EndIf
		Wend

		While i<l
			b=PeekB(@s+i)
			If (b<>' ') And (b<>#TAB)
				Break
			EndIf
			i+1
		Wend

		ProcedureReturn PeekS(@s+i,l-i+1)

	EndProcedure
	Procedure GetRemarkablePoint(s.s)

		Protected n,z
		Protected dflag,sflag

		z=Len(s)

		While n<z
			Select PeekC(@s+n)
			Case '"'					; double quote
				If sflag=0
					dflag!1
				EndIf
			Case 39					; single quote
				If dflag=0
					sflag!1
				EndIf
			Case ';'
				If sflag+dflag=0
					ProcedureReturn n+1
				EndIf
			EndSelect

			n+1
		Wend

		ProcedureReturn #Null

	EndProcedure
	Procedure FindChars(string.s,chars.s,start,direction)

		#FindChars_Left=0
		#FindChars_Right=1

		direction=(direction-1)*2+1
		start+direction

		While start>0 And start<=Len(string)
			If FindString(chars,Mid(string,start,1))
				ProcedureReturn start
			EndIf
			start+direction
		Wend

		ProcedureReturn #Null

	EndProcedure
	Procedure.s CalcLocal(s.s,n,mode)

		Protected a,b,c,d

		a=FindChars(s,"+-*/",n,#FindChars_Left)+1
		b=FindChars(s,"+-*/",n,#FindChars_Right)
		If b=0
			b=Len(s)+1
		EndIf
		c=Val(Mid(s,a,n-a))
		d=Val(Mid(s,n+1,b-n-1))
		Select mode
		Case '+'
			c+d
		Case '-'
			c-d
		Case '*'
			c*d
		Case '/'
			If d
				c/d
			Else
				c=0;	Error
			EndIf
		EndSelect

		ProcedureReturn Left(s,a-1)+Str(c)+Mid(s,b)

	EndProcedure
	Procedure FindLocal(name.s)

		Enumeration
			#FindLocalEmptyList
			#FindLocalNotFound
			#FindLocalFound
		EndEnumeration

		Protected flag

		ResetList(Locals())
		Repeat
			If NextElement(Locals())
				If Locals()\Name=name
					flag=#FindLocalFound
				EndIf
			Else
				flag=#FindLocalNotFound
			EndIf
		Until flag

		ProcedureReturn flag

	EndProcedure
	Procedure ModeLocal(s.s,n)

		Protected mode
		Protected z=Len(s)

		While n<z And mode=0
			mode=PeekA(@s+n)
			Select mode
			Case '+','-','*','/'
			Default
				mode=0
				n+1
			EndSelect
		Wend

		ProcedureReturn n+1

	EndProcedure
	Procedure EvalLocal(s.s)

		Protected n,m,val,z
		Protected c.s

		n=FindString(s,"~")
		While n
			m=ModeLocal(s,n)
			If FindLocal(Mid(s,n,m-n))=#FindLocalFound
				val=Locals()\Val
			Else
				val=0
			EndIf
			s=Left(s,n-1)+Str(val)+Mid(s,m)
			n=FindString(s,"~",n)
		Wend

		For z=1 To 4
			c=Mid("*/+-",z,1)
			n=FindString(s,c)
			While n
				s=CalcLocal(s,n,Asc(c))
				n=FindString(s,c)
			Wend
		Next z

		ProcedureReturn Val(s)

	EndProcedure
	Procedure Local(s.s)

		Protected name.s
		Protected mode.i
		Protected n.i
		Protected val.i
		Protected flag.i

		s=ReplaceString(s," ","")
		s=ReplaceString(s,#TAB$,"")
		s=LCase(s)

		n=FindString(s,"=")
		If n
			mode=PeekA(@s+n-1)
			Select mode
			Case '+','-','*','/'
				name=Left(s,n-2)
			Default
				mode='='
				name=Left(s,n-1)
			EndSelect
			s=StringField(s,2,"=")

			If FindString("+-*/",Right(name,1))
				s=name+s
				name=Left(name,Len(name)-1)
			EndIf

			val=EvalLocal(s)

			With Locals()

				If FindLocal(name)<>#FindLocalFound
					AddElement(Locals())
					\Name=name
				EndIf

				Select mode
				Case #Null
					val=\Val
					; Case '='
					; val=Val(s)
				EndSelect

				;Debug "Set "+name+":"+Chr(mode)+Str(val)+" ("+\Name+" was "+Str(\Val)+")"
				\Val=val

				ProcedureReturn val
			EndWith

		Else
			If FindLocal(s)
				ProcedureReturn Locals()\Val
			Else
				ProcedureReturn #Null
			EndIf
		EndIf

	EndProcedure

	Procedure Init()

		Protected selektion.s

		; Dateinamen holen...
		CompilerIf #Debug
			OutputFile="C:\Tools\Programmer\Source\Test.pb"
		CompilerElse
			If CountProgramParameters()<>2
				MessageBox_(0,"'Auto Reformer' benötigt Parameter!"+#CR$+"(%TEMPFILE und %SELECTION)","Fehler",#MB_ICONERROR| #MB_OK)
				End
			EndIf
			OutputFile=ProgramParameter()
		CompilerEndIf

		CompilerIf #Debug
			InputFile.s=OutputFile
			OutputFile=OutputFile+".bak"
		CompilerElse
			InputFile=OutputFile+"~"
			DeleteFile(InputFile)
			If RenameFile(OutputFile,InputFile)=0
				MessageBox_(0,"'Auto Reformer' konnte keine Temporärdatei erstellen","Fehler",#MB_ICONERROR| #MB_OK)
				End
			EndIf
		CompilerEndIf

		; Selektion abfragen...
		Line=0
		selektion.s=ProgramParameter()
		FirstlLine=Val(StringField(selektion, 1, "x"))
		LastLine=Val(StringField(selektion, 3, "x"))

		If FirstlLine>=LastLine
			FirstlLine=1
			LastLine=#MAXSHORT
		EndIf

	EndProcedure
	Procedure Main()

		Init()

		Protected i,n,m,z
		Protected s.s
		Protected Dim p(0)

		If ReadFile(#In,InputFile)
			If CreateFile(#Out,OutputFile)

				While Not(Eof(#In))
					Line+1
					Text=ReadString(#In)

					If Line>=FirstlLine And Line<=LastLine
						n=GetRemarkablePoint(Text)
						If n
							TextCode=Left(Text,n-1);		Source Code
							TextRem=Mid(Text,n+1);		Bermerkung

							s=LCase(MyTrim(TextRem))
							If PeekC(@s)='[';				[...
								n=FindString(s,"]")
								If n;					...]
									s=Mid(s,2,n-2)
									n=CountString(s,",")+1

									ReDim p(n);			Berechne 'Locals' und Parameter
									For i=1 To n
										p(i)=Local(StringField(s,i,","))
									Next i

									i=FindString(TextCode,"(")
									If i
										z=0

										Select Left(TextCode,i-1)
										Case "ButtonGadget"
											z=2 : m=4
										Case "PanelGadget"
											z=2 : m=4
										EndSelect

										If z
											If n>m
												n=m
											EndIf
											Text=""
											m=0
											i=0
											While i<z+n-1
												i+1
												s=StringField(TextCode,i,",")
												m+Len(s)+1
												If i<z
													Text+s+","
												Else
													If Right(s,1)=")"
														Text+Str(p(i-z+1))+")"
													Else
														Text+Str(p(i-z+1))+","
													EndIf
												EndIf
											Wend
											Text+Mid(TextCode,m+1)+";"+TextRem
										EndIf

									EndIf
								EndIf
							EndIf
						EndIf
					EndIf
					WriteStringN(#Out,Text)
				Wend

				CloseFile(#Out)
				CloseFile(#In)

			EndIf
		EndIf

	EndProcedure

	Main()

Posted: **Tue Sep 10, 2013 4:25 pm**

Here's an example of a form, composed by the coordinates seen in the brackets...
There are some advantages by generating complex forms like this (resorting elements, moving all buttons etc. some pixels down, enlarging all string gadgets etc.). On the other hand, it would be easier for some actions, to have a graphical user interface to move and resize the elements.

Code: Select all


; Define

	#WinX=880
	#WinY=640

	Enumeration
		#MainMenu

		#Panel
		#ActiveProfile
		#PanelProfileInfoBox
		#PanelProfileInfo
		#PanelMainProfile
		#PanelMainStart
		#PanelMainCreateList
		#PanelMainExifTools
		#PanelMainQuit

		#PanelFilelistText
		#PanelFilelist
		#PanelFilelistBrowse
		#PanelSourceText
		#PanelSourceDrives
		#PanelSourcePath
		#PanelSourceCustom
		#PanelDestinationText
		#PanelDestinationPath
		#PanelDestinationBrowse
		#PanelDestinationFilenameText
		#PanelDestinationFilename
		#PanelDestinationStartnummerText
		#PanelDestinationStartnummer
		#PanelDestinationFilenameInfo
		#PanelFiledateSourceText
		#PanelFiledateSource
		#PanelFiledateDestinationText
		#PanelFiledateDestination
		#PanelImageFileFormatText
		#PanelImageFileFormat
		#PanelTitleFileFormatText
		#PanelTitleFileFormat
		#PanelOverwriteFilesText
		#PanelOverwriteFiles
		#PanelOverwriteDirectoryText
		#PanelOverwriteDirectory
		#PanelOutputText
		#PanelOutputFilterTitles
		#PanelOutputFilterLandscapeImages
		#PanelOutputFilterPortraitImages
		#PanelSizeText
		#PanelSizeX
		#PanelSizeHor
		#PanelSizeVer
		#PanelImageQualityText
		#PanelImageQuality

		#FontDialog

		#PanelMain=0
		#PanelOpts
		#PanelConv
		#PanelTitle

	EndEnumeration

; EndDefine

Procedure InitDialog()

	#Undefined=-1
	#SliderFont=9999

	;LoadFont(#SliderFont,"Segoe UI Semilight",10)
	LoadFont(#SliderFont,"Segoe UI",10,#PB_Font_HighQuality)

	#Draw100=$FF000000
	#Draw075=$C0000000
	#Draw050=$80000000
	#Draw040=$60000000
	#Draw025=$40000000
	#Draw015=$1F000000
	#Draw010=$10000000

	#DrawBackShadow=#Draw050
	#DrawSliderShadow=#Draw015

	#Orange=$00A1FF
	#DarkGray=$808080
	#LightGray=$D0D0D0
	#DarkWhite=$FFFFFF

	#SliderColorBorder=#Draw100|$808080
	#SliderColorDisabled=#Draw050|#White
	#SliderColorYellow=$B0FFFF
	#SliderColorOrange=$A0E0FF
	#SliderColorRed=$C8C8FF
	#SliderColorGreen=$C0FFC0

	#SliderCornerSize=3
	#SliderWidth=40; %
	#SliderShadowShort=6

	#SliderOnOff=1;			Aus/Ein
	#Slider3State=2;			Aus/Ein1/Ein2

	Structure SliderGadgetListType
		Gadget.i;		gadget-ID
		Type.i;			1=Standard, 2=3-State
		State.i;			0/1[/2]
		w.i;				width
		h.i;				height
		Text.s;			text for all states [off|on]
		ColorText.i;		text color
		ColorBack.i;		background
		ColorSlider.i;		slider color
	EndStructure

	Global DialogBackgroundColor
	Global SliderGadgetCount
	Global Dim SliderGadgetList.SliderGadgetListType(0)

	DialogBackgroundColor=GetSysColor_(#COLOR_BTNFACE)
	DialogBackgroundColor=$F0E0FF

EndProcedure
Procedure GetSliderGadgetIndex(gadget)

	Protected n

	Repeat
		n+1
		If SliderGadgetList(n)\Gadget=gadget
			ProcedureReturn n
		EndIf
	Until n=SliderGadgetCount

	ProcedureReturn #False

EndProcedure
Procedure DrawSliderGadget(gadget)

	Protected c
	Protected pt,px,pw,pp,pz
	Protected s.s

	gadget=GetSliderGadgetIndex(gadget)
	If gadget
		With SliderGadgetList(gadget)
			StartDrawing(CanvasOutput(\Gadget))
			DrawingFont(FontID(#SliderFont))

			s=StringField(\Text,1+\State,"|")
			pw=#SliderWidth;			pw=MulDiv_(\w,#SliderWidth,100) for %
			pt=TextWidth(s)


			If \State
				px=\w-pw
				pt=(px-pt)/2
				cb=\ColorBack
				ct=\ColorText
				pz=0
				pp=#SliderShadowShort
			Else
				pt=pw+(\w-pw-pt)/2
				cb=#DarkWhite
				ct=#DarkGray
				pz=#SliderWidth-#SliderCornerSize
				pp=#SliderShadowShort+#SliderCornerSize
			EndIf

			Box(0,0,\w,\h,DialogBackgroundColor);										Hintergrund
			RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|cb);		Button-Hintergrund

			DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
			FrontColor(#Null)
			BackColor(#DrawBackShadow)
			;GradientColor(0.02,#DrawBackShadow)
			GradientColor(0.05,#DrawBackShadow>>1)
			GradientColor(0.15,#DrawBackShadow>>2)
			LinearGradient(0,0,0,\h);													Schatten oben
			RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize)
			LinearGradient(pz,0,pz+pp,0);												Schatten links
			RoundBox(pz,0,pp,\h,#SliderCornerSize,#SliderCornerSize)

			DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
			DrawText(pt,(\h-TextHeight("|")-1)/2,s,#Draw100|ct)

			DrawingMode(#PB_2DDrawing_Default)
			RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|\ColorSlider)

			DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
			LinearGradient(0,\h,0,0)
			BackColor(#DrawSliderShadow)
			RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#Draw100|\ColorBack)

			DrawingMode(#PB_2DDrawing_AlphaBlend)
			pz=px+pw-2
			pp=\h-2
			LineXY(pz,1,pz,pp,$30000000)
			LineXY(px+1,pp,px+#SliderWidth-2,pp,$10000000)

			DrawingMode(#PB_2DDrawing_Outlined)
			RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize,#SliderColorBorder);	Rahmen gesamt
			RoundBox(px,0,pw,\h,#SliderCornerSize,#SliderCornerSize,#SliderColorBorder);	Rahmen Slider

			If IsWindowEnabled_(GadgetID(\Gadget))!1
				DrawingMode(#PB_2DDrawing_AlphaBlend)
				RoundBox(0,0,\w,\h,#SliderCornerSize,#SliderCornerSize,#SliderColorDisabled)
			EndIf

			StopDrawing()

		EndWith

		ProcedureReturn gadget

	Else
		ProcedureReturn #False

	EndIf

EndProcedure
Procedure SetSliderGadgetState(gadget,state)

	Protected n
	n=GetSliderGadgetIndex(gadget)
	If n
		With SliderGadgetList(n)
			;Debug "Set ("+Str(gadget)+"="+Str(state)+")"
			If state<0 Or state>\Type
				state=0
			EndIf
			\State=state
			DrawSliderGadget(gadget)
		EndWith
	EndIf

EndProcedure
Procedure GetSliderGadgetState(gadget)

	gadget=GetSliderGadgetIndex(gadget)
	If gadget
		;Debug "Get (#"+Str(gadget)+"="+Str(SliderGadgetList(gadget)\State)+")"
		ProcedureReturn SliderGadgetList(gadget)\State
	Else
		ProcedureReturn #Undefined
	EndIf

EndProcedure
Procedure DisableSliderGadget(gadget,state)

	If GetSliderGadgetIndex(gadget)
		DisableGadget(gadget,state)
		DrawSliderGadget(gadget)
	Else
		ProcedureReturn #Undefined
	EndIf

EndProcedure
Procedure SliderGadget(gadget,x,y,w,h,text.s,type=#SliderOnOff,backgroundcolor=#White,textcolor=#Black,slidercolor=#White)

	SliderGadgetCount+1
	ReDim SliderGadgetList(SliderGadgetCount)

	With SliderGadgetList(SliderGadgetCount)
		\Gadget=gadget
		\Type=type
		\w=w
		\h=h
		\Text=text
		\ColorSlider=slidercolor
		\ColorBack=backgroundcolor
		\ColorText=textcolor
	EndWith

	CanvasGadget(gadget,x,y,w,h,#PB_Canvas_Keyboard|#PB_Canvas_DrawFocus)
	DrawSliderGadget(gadget)

EndProcedure
Procedure SliderGadgetEvents()

	Protected gadget

	If GadgetType(EventGadget())=#PB_GadgetType_Canvas

		gadget=EventGadget()

		Select EventType()
		Case #PB_EventType_KeyDown
			;Debug "Key down"
		Case #PB_EventType_KeyUp
			;Debug "Key up"
			Select GetGadgetAttribute(gadget,#PB_Canvas_Key)
			Case #PB_Shortcut_Space
				SetSliderGadgetState(gadget,GetSliderGadgetState(gadget)+1)
			EndSelect

		Case #PB_EventType_Input
			;Debug "Key Input"
			;Debug GetGadgetAttribute(gadget,#PB_Canvas_Input)

		Case #PB_Canvas_LeftButton
		Case #PB_EventType_MouseMove
			;	Debug "move"
		Case #PB_EventType_LeftButtonDown
			;Debug "Click ("+Str(EventGadget())+")"
		Case #PB_EventType_LeftButtonUp
			;Debug "Up ("+Str(EventGadget())+")"
			SetSliderGadgetState(gadget,GetSliderGadgetState(gadget)+1)
		EndSelect

		ProcedureReturn #True

	Else
		ProcedureReturn #False

	EndIf

EndProcedure

InitDialog()

;LoadFont(#FontDialog,"Segoe UI Semilight",11)
LoadFont(#FontDialog,"Segoe UI",10,#PB_Font_HighQuality)

OpenWindow(#MainMenu,0,0,#WinX,#WinY,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetGadgetFont(#PB_Default,FontID(#FontDialog))

PanelGadget(#Panel,15,15,#WinX-30,#WinY-75)
; [~f=1]
AddGadgetItem(#Panel,#PanelMain," Main Menu ")
; [~oy=80,~gy=14,~x=180,~y=65-~oy,~bx=480,~by=60]
ButtonGadget(#PanelMainProfile,180,65,480,60,"Choose Profile");								[~x,~y+=~oy,~bx,~by]
ButtonGadget(#PanelMainStart,180,145,480,60,"Start Processing");							[~x,~y+=~oy,~bx,~by]
ButtonGadget(#PanelMainCreateList,180,239,480,60,"Create Image List");						[~x,~y+=~oy+~gy,~bx,~by]
ButtonGadget(#PanelMainExifTools,180,319,480,60,"Exif-Tools");								[~x,~y+=~oy,~bx,~by]
ButtonGadget(#PanelMainQuit,180,413,480,60,"Quit");										[~x,~y+=~oy+~gy,~bx,~by]

AddGadgetItem(#Panel,#PanelOpts," General Settings ")
; [~oy=48,~y=38-~oy,~x1=30,~x2=175,~b1=120,~b2=460,~b3=150,~by=30,~x3=~x2+~b2+20]
TextGadget(#PanelFilelistText,30,38,120,30,"Image File List:",#SS_CENTERIMAGE);				[~x1,~y+=~oy,~b1,~by]
StringGadget(#PanelFilelist,175,39,460,28,"Stuffer Mini.lst");									[~x2,~y+~f,~b2,~by-~f*2]
ButtonGadget(#PanelFilelistBrowse,655,38,150,30,"Browse");									[~x3,~y,~b3,~by]
TextGadget(#PanelSourceText,30,86,120,30,"Source Drive(s)/Path:",#SS_CENTERIMAGE);		[~x1,~y+=~oy,~b1,~by]
StringGadget(#PanelSourceDrives,175,87,80,28,"C:");											[~x2,~y+~f,80,~by-~f*2]
StringGadget(#PanelSourcePath,265,87,370,28,"\Bilder\");										[~x2+90,~y+~f,~b2-90,~by-~f*2]
SliderGadget(#PanelSourceCustom,655,86,150,30,"Automatic|Custom");						[~x3,~y,~b3,~by] - StringGadgets disablen
TextGadget(#PanelDestinationText,30,134,120,30,"Output Path:",#SS_CENTERIMAGE);			[~x1,~y+=~oy,~b1,~by]
StringGadget(#PanelDestinationPath,175,135,460,28,"Stuffer Mini.lst");							[~x2,~y+~f,~b2,~by-~f*2]
ButtonGadget(#PanelDestinationBrowse,655,134,150,30,"Browse");								[~x3,~y,~b3,~by]
TextGadget(#PanelDestinationFilenameText,30,182,120,30,"Output Filename:",#SS_CENTERIMAGE);	[~x1,~y+=~oy,~b1,~by]
StringGadget(#PanelDestinationFilename,175,183,360,28,"<#> <f>");							[~x2,~y+~f,~b2-100,~by-~f*2]
TextGadget(#PanelDestinationStartnummerText,455,182,50,30,"#:",#SS_CENTERIMAGE);			[~x3-200,~y,50,~by]
StringGadget(#PanelDestinationStartnummer,545,183,90,28,"0000");							[~x2+370,~y+~f,~b2-370,~by-~f*2]
ButtonGadget(#PanelDestinationFilenameInfo,655,182,150,30,"Info");							[~x3,~y,~b3,~by]
; [~gap=25,~y+=~gap,~x5=~x3,~x4=~x1+400,~bx=200]
TextGadget(#PanelFiledateSourceText,30,255,120,30,"File Date Source:",#SS_CENTERIMAGE);	[~x1,~y+=~oy,~b1,~by]
SliderGadget(#PanelFiledateSource,175,255,150,30,"File|Exif");								[~x2,~y,~b3,~by]
TextGadget(#PanelFiledateDestinationText,430,255,200,30,"File Date for created images:",#SS_CENTERIMAGE); [~x4,~y,~bx,~by]
SliderGadget(#PanelFiledateDestination,655,255,150,30,"Keep Original|Change Date");			[~x5,~y,~b3,~by]
TextGadget(#PanelImageFileFormatText,30,303,120,30,"Image File Format:",#SS_CENTERIMAGE);	[~x1,~y+=~oy,~b1,~by]
SliderGadget(#PanelImageFileFormat,175,303,150,30,"Original|PNG|JPG",#Slider3State);			[~x2,~y,~b3,~by]
TextGadget(#PanelTitleFileFormatText,430,303,200,30,"File Format for title pages:",#SS_CENTERIMAGE); [~x4,~y,~bx,~by]
SliderGadget(#PanelTitleFileFormat,655,303,150,30,"PNG|JPG");								[~x5,~y,~b3,~by]
TextGadget(#PanelOverwriteDirectoryText,30,351,120,30,"Check Directory:",#SS_CENTERIMAGE); [~x1,~y+=~oy,~b1,~by];		Zeigt Dialog an Verzeichnis existiert mit 20 Dateien, welche Aktion? (Dateien löschen, weitermachen, abbrechen)
SliderGadget(#PanelOverwriteDirectory,175,351,150,30,"No|Yes",#SliderOnOff,#SliderColorGreen);	[~x2,~y,~b3,~by]
TextGadget(#PanelOverwriteFilesText,430,351,200,30,"Overwrite Existing Files:",#SS_CENTERIMAGE); [~x4,~y,~bx,~by]
SliderGadget(#PanelOverwriteFiles,655,351,150,30,"No|Ask|Yes",#Slider3State,#SliderColorYellow); [~x5,~y,~b3,~by]
; [~y=~y+~gap,~badd=48,~bgap=18,~bb=~b3+~badd,~b5=20,~b6=65]
TextGadget(#PanelSizeText,30,424,120,30,"Image Size:",#SS_CENTERIMAGE);					[~x1,~y+=~oy,~b1,~by]
StringGadget(#PanelSizeHor,175,424,65,30,"0");												[~x2,~y,~b6,~by]
TextGadget(#PanelSizeX,240,424,20,30,"x",#SS_CENTERIMAGE|#SS_CENTER);					[~x2+~b6,~y,~b5,~by]
StringGadget(#PanelSizeVer,260,424,65,30,"0");												[~x2+~b6+~b5,~y,~b6,~by]
TextGadget(#PanelImageQualityText,430,424,120,30,"Image Quality:",#SS_CENTERIMAGE);		[~x4,~y,~b1,~by]
SliderGadget(#PanelImageQuality,655,424,150,30,"Standard|High|Low",#Slider3State,#SliderColorYellow); [~x5,~y,~b3,~by]; 90%,100%,80%+Quick (oder80,90,80 quick)
; [~y=~y+~gap*0,~badd=48,~bgap=18,~bb=~b3+~badd]
TextGadget(#PanelOutputText,30,472,120,30,"File Creation:",#SS_CENTERIMAGE);				[~x1,~y+=~oy,~b1,~by]
SliderGadget(#PanelOutputFilterTitles,175,472,198,30,"Title Pages|No Titles",#SliderOnOff,#SliderColorRed); [~x5-~bb*2-~bgap*2-~badd,~y,~bb,~by]
SliderGadget(#PanelOutputFilterLandscapeImages,391,472,198,30,"Landscape Images|No Landscapes",#SliderOnOff,#SliderColorRed); [~x5-~bb*1-~bgap-~badd,~y,~bb,~by]
SliderGadget(#PanelOutputFilterPortraitImages,607,472,198,30,"Portrait Images|No Portraits",#SliderOnOff,#SliderColorRed); [~x5-~badd,~y,~bb,~by]

CloseGadgetList()
TextGadget(#PanelProfileInfo,16,#WinY-50,#WinX-33,35,"' I m a g e   T i n y   P r e s e n t a t i o n '  (1024 x 800)",#SS_CENTERIMAGE|#SS_CENTER|#WS_BORDER)
SetGadgetColor(#PanelProfileInfo,#PB_Gadget_BackColor,$C6F3D7)

SetGadgetState(#Panel,#PanelOpts)
Repeat;
	Event = WaitWindowEvent()

	Select event
	Case #PB_Event_Gadget,#PB_Event_Menu
	Case #PB_Event_CloseWindow;
		End
	EndSelect
ForEver

PureBasic Forums - English

Generate forms

Generate forms

Re: Generate forms

Re: Generate forms

Re: Generate forms

Re: Generate forms