Ce n'est pas un jeu avec le Soldat !
Pour la fonction FontRequester(), on peut passer le nom et la taille (par défaut) d'une police.
Pourquoi on ne peut pas passer la couleur et le style ?
Yatil une autre méthode pour le faire ?
Dans la fenêtre de FontRequester(), la couleur 'Par défaut de windows' n'existe pas...
Je ne trouve pas de fonction PB pour changer la couleur de fonte d'un gadget ....
Font Color
J'ai ce code, qui fait tout un tas de chose, mais dedans il y a ce que tu cherches :
- utilisation de ColorRequester et de FontRequester et récupération pour dessiner avec les couleurs et police souhaitées.
Les évènements de la boucle principale permettent de gérer ça.
Au passage, cela permet de créer des boutons à deux états.
Si tu veux un extrait pour ne visualiser que ces parties là je te propose de reprendre ce code un peu + tard. Sinon bonne lecture.
- utilisation de ColorRequester et de FontRequester et récupération pour dessiner avec les couleurs et police souhaitées.
Les évènements de la boucle principale permettent de gérer ça.
Au passage, cela permet de créer des boutons à deux états.
Si tu veux un extrait pour ne visualiser que ces parties là je te propose de reprendre ce code un peu + tard. Sinon bonne lecture.
Code : Tout sélectionner
;
; F.Weil - dynamic_JavaScript_popup_menu
; 20021016
;
; This program makes possible to build a JavaScript corresponding to a dynamic
; popup menu to integrate with a HTML page.
;
; Source of menus entries and subentries is a text file containing labels and links
; using the following template :
;
; Menu1
; [Text1] Link1
; [Text2] Link2
; ...
; MenuN
; ...
;
; It is possible to give x and y offset of the horizontal menu bar, and / or center
; it. Also the Top cells height and subcells height is possibile to specify. Default
; values are proposed.
;
; Cells may have two possible colors (changing when mouse is over or out)
;
; An optional HTML test page can be generated and displayed.
;
; The HTML code used for integration is :
;
; <SCRIPT LANGUAGE=JavaScript>"
; document.write('<DIV class=popper id=topdeck></DIV>');
; </SCRIPT>
; <SCRIPT LANGUAGE="JavaScript" SRC="JavaScript_FileName"></SCRIPT>
;
; This code has to be pasted just after the <BODY> tag of the page.
;
; And automated batch is possible to launch from a text file containing many ini files
; to process and instant parameters to use. In order to specify possible parameters
; for each file to process a parser analyzes the batch file content using following
; parameter syntax :
;
; XOffset value
; YOffset value
; Centered (0/1)
; HTML (0/1)
; FirstCellHeight value
; CellsHeight value
;
; Any other line of this batch file is considered to be a compatible ini file
;
#MaxMenus = 20
#MaxItems = 20
#FONT_NORMAL = %00000000
#FONT_BOLD = %00000001
#FONT_ITALIC = %00000010
#FONT_UNDERLINE = %00000100
#FONT_STRIKEOUT = %00001000
Language.s
onMouseOverButton.l
Global onMouseOverButton, Language
NMenu.l
CurrentDirectory.s
EOL.s
QC.s
Dim NItems.l(#MaxMenus)
Dim Title.s(#MaxMenus)
Dim Text.s(#MaxMenus, #MaxItems)
Dim Link.s(#MaxMenus, #MaxItems)
Dim TitleLink.s(#MaxMenus)
Global NMenu, NItems, Text, Link, TitleLink, CurrentDirectory, EOL, QC
Procedure.l IMin(a.l, b.l)
If a < b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.l HTML2PBFontSize(HTMLFontSize.s)
Result.l
Select HTMLFontSize
Case "1"
Result = 7
Case "2"
Result = 10
Case "3"
Result = 12
Case "4"
Result = 14
Case "5"
Result = 18
Case "6"
Result = 24
Case "7"
Result = 36
Default
Result = 12
EndSelect
ProcedureReturn Result
EndProcedure
Procedure.s PB2HTMLFontSize(FontSize.l)
Result.s
If FontSize >= 36
Result = "7"
ElseIf FontSize >= 24 And FontSize < 36
Result = "6"
ElseIf FontSize >= 18 And FontSize < 24
Result = "5"
ElseIf FontSize >= 14 And FontSize <18
Result = "4"
ElseIf FontSize >= 12 And FontSize < 14
Result = "3"
ElseIf FontSize >= 9 And FonSize < 12
Result = "2"
ElseIf FontSize < 9
Result = "1"
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s RGB2DecList(Color.l)
ProcedureReturn Str(Red(Color)) + "," + Str(Green(Color)) + "," + Str(Blue(Color))
EndProcedure
Procedure Hex2Dec(n.s)
Result.l
Digit.l
For i = 1 To Len(n)
Select Mid(n, i, 1)
Case "A"
Digit = 10
Case "B"
Digit = 11
Case "C"
Digit = 12
Case "D"
Digit = 13
Case "E"
Digit = 14
Case "F"
Digit = 15
Default
Digit = Val(Mid(n, i, 1))
EndSelect
Result = 16 * Result + Digit
Next
ProcedureReturn Result
EndProcedure
Procedure.l HTML2RGB(ColorTag.s)
ProcedureReturn RGB(Hex2Dec(Mid(ColorTag, 2, 2)), Hex2Dec(Mid(ColorTag, 4, 2)), Hex2Dec(Mid(ColorTag, 6, 2)))
EndProcedure
Procedure MyWindowCallback(WindowID.l, Message.l, wParam.l, lParam.l)
Result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_SIZE
ResizeGadget(110, 0, 230, WindowWidth(), WindowHeight() - 230)
Case #WM_PAINT
EndSelect
If Message = #WM_SETCURSOR And wParam = GadgetID(133)
HideGadget(133, 1)
HideGadget(134, 0)
onMouseOverButton = #TRUE
EndIf
If onMouseOverButton And Message = #WM_NCHITTEST And wParam = 0
onMouseOverButton = #FALSE
HideGadget(133, 0)
HideGadget(134, 1)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.l MyColorRequester(Color.l)
Result.l = ColorRequester()
If Result = -1
ProcedureReturn Color
Else
ProcedureReturn Result
EndIf
EndProcedure
Procedure.l MyImage(ImageNumber.l, Width.l, Height.l, Color.l)
ImageID.l = CreateImage(ImageNumber, Width, Height)
StartDrawing(ImageOutput())
Box(0, 0, Width, Height, Color)
StopDrawing()
ProcedureReturn ImageID
EndProcedure
Procedure CreateFont(Name$,Size,Style)
If (Style & #FONT_BOLD) : bold = 700 : EndIf
If (Style & #FONT_ITALIC) : italic = 1 : EndIf
If (Style & #FONT_UNDERLINE) : underline = 1 : EndIf
If (Style & #FONT_STRIKEOUT) : strikeout = 1 : EndIf
ProcedureReturn CreateFont_(Size,0,0,0,bold,italic,underline,strikeout,0,0,0,0,0,Name$)
EndProcedure
Procedure.l MyLabeledImage(ImageNumber.l, Width.l, Height.l, Color.l, TColor.l, Label.s, Font.s, Bold.l, Italic.l, FontSize.l)
Debug Font
Attributes = #FONT_NORMAL
If Bold
Attributes = Attributes | #FONT_BOLD
EndIf
If Italic
Attributes = Attributes | #FONT_ITALIC
EndIf
Debug Attributes
Normal = CreateFont(Font, FontSize, #FONT_NORMAL)
Bold = CreateFont(Font, FontSize, #FONT_BOLD)
Italic = CreateFont(Font, FontSize, #FONT_ITALIC)
Bold_Italic = CreateFont(Font, FontSize, #FONT_BOLD | #FONT_ITALIC)
Select Attributes
Case #FONT_NORMAL
FontToUse = Normal
Case #FONT_BOLD
FontToUse = Bold
Case #FONT_ITALIC
FontToUse = Italic
Case #FONT_BOLD | #FONT_ITALIC
FontToUse = Bold_Italic
Default
EndSelect
ImageID.l = CreateImage(ImageNumber, Width, Height)
StartDrawing(ImageOutput())
Box(0, 0, Width, Height, Color)
FrontColor(Red(TColor), Green(TColor), Blue(TColor))
DrawingFont(FontToUse)
DrawingMode(1)
If TextLength(Label) < Width
XPos.l = (Width - TextLength(Label)) / 2
Else
XPos.l = 4
EndIf
If TextLength("M") < Height
YPos.l = (Height - TextLength("M")) / 2 - 2
Else
YPos.l = 0
EndIf
Locate(XPos, YPos)
DrawText(Label)
StopDrawing()
ProcedureReturn ImageID
EndProcedure
;
; Convert a long integer RGB value to HTML color format
;
Procedure.s RGB2HTMLColor(Color.l)
sColor.s = Hex(Color)
While Len(sColor) < 6
sColor = "0" + sColor
Wend
sColor = Mid(sColor, 5, 2) + Mid(sColor, 3, 2) + Mid(sColor, 1, 2)
sColor = "#" + sColor
ProcedureReturn sColor
EndProcedure
Procedure Generate_menu1(Path.s, FileName.s, PosXMenu.l, PosYMenu.l, Centered.l, Color1.l, Color2.l, TColor1.l, TColor2.l, FirstCellHeight.l, CellsHeight.l, MenuItemWidth.l, Font.s, FontSize.s, CellFontBold.l, CellFontItalic.l)
If CellFontBold
s1Bold.s = "<b>"
s2Bold.s = "</b>"
Else
s1Bold.s = ""
s2Bold.s = ""
EndIf
If CellFontItalic
s1Italic.s = "<i>"
s2Italic.s = "</i>"
Else
s1Italic.s = ""
s2Italic.s = ""
EndIf
sColor1.s = RGB2HTMLColor(Color1)
sColor2.s = RGB2HTMLColor(Color2)
sTColor1.s = RGB2HTMLColor(TColor1)
sTColor2.s = RGB2HTMLColor(TColor2)
If CreateFile(0, Path + "\" + FileName)
WriteStringN("/*")
WriteStringN("SCRIPT generated by F.Weil - WRP / Nasca" + EOL + "http://www.nasca.fr")
WriteStringN("*/")
WriteStringN("")
WriteStringN("/* Change this value if size is not apropriate */")
WriteStringN("FrameHeight = " + Str(CellsHeight) + ";")
WriteStringN("")
WriteStringN("xmenu = new Array;")
WriteStringN("xlink = new Array;")
WriteStringN("")
For i = 0 To NMenu
WriteStringN("xmenu[" + Str(i) + "] = '" + Title(i) + "';")
Next
WriteStringN("")
For i = 0 To NMenu
a$ = "xlink[" + Str(i) + "] = ''"
If NItems(i) = -1
a$ = ReplaceString(a$, "''", "'<A HREF=" + QC + Link(i, 0) + QC + ">" + Title(i) + "</A>'")
EndIf
WriteStringN(a$)
Next
For i = 0 To NMenu
For j = 0 To NItems(i)
WriteStringN("xlink[" + Str(i) + "] += '<A HREF=" + QC + Link(i, j) + QC + "CLASS=dynmenu3>" + Text(i, j) + "</A>';")
If j <> NItems(i)
WriteStringN("xlink[" + Str(i) + "] += ' | '")
EndIf
Next
Next
WriteStringN("")
WriteStringN("document.write('<STYLE TYPE=" + QC + "text/css" + QC + ">\nA.dynmenu3 {color:" + sTColor1 + "; text-decoration:none;}\nA:hover.dynmenu3 {color:" + sTColor2 + ";text-decoration:none;}\n</STYLE>');")
WriteStringN("")
WriteStringN("document.write('<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0 WIDTH='+(xlink.length*" + Str(MenuItemWidth) + ")+' BGCOLOR=#C0C0FF><TR><TD><TABLE CELLPADDING=2 CELLSPACING=1 BORDER=0 WIDTH=100%><TR>');")
WriteStringN("")
WriteStringN("for(i=0;i<xlink.length;i++)")
WriteStringN(" {")
WriteStringN(" document.write('<TD BGCOLOR=" + sColor2 + " onMouseOver=" + QC + "javascript:colorIt(this);MenuUpdate('+i+')" + QC + " ALIGN=center ID=td'+i+'><FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + "><A HREF=" + QC + "#" + QC + " onClick=" + QC + "Return(false)" + QC + " onMouseOver=" + QC + "MenuUpdate('+i+')" + QC + " CLASS=dynmenu3>" + s1Bold + s1Italic + "'+xmenu[i]+'" + s2Italic + s2Bold + "</A></FONT></TD>');")
WriteStringN(" }")
WriteStringN("")
WriteStringN("document.write('</TR><TR><TD COLSPAN='+(xlink.length)+' BGCOLOR=" + sColor1 + " HEIGHT='+FrameHeight+' VALIGN=top><ilayer id=" + QC + "dynamenu31" + QC + " width=100% height='+FrameHeight+'><layer id=" + QC + "dynamenu32" + QC + " width=100% height='+FrameHeight+'><div id=" + QC + "dynamenu33" + QC + "> </div></layer></ilayer></TD></TR></TABLE></TD></TR></TABLE>');")
WriteStringN("")
WriteStringN("function colorIt(tditem)")
WriteStringN(" {")
WriteStringN(" if(document.all)")
WriteStringN(" {")
For i = 0 To NMenu
WriteStringN(" document.all.td" + Str(i) + ".style.background='" + sColor1 + "';")
Next
WriteStringN(" tditem.style.background='" + sColor2 + "';")
WriteStringN(" }")
WriteStringN(" else if(document.getElementById)")
WriteStringN(" {")
For i = 0 To NMenu
WriteStringN(" document.getElementById(" + QC + "td" + Str(i) + QC + ").style.background='#00F0F0';")
Next
WriteStringN(" tditem.style.background='#00FFFF';")
WriteStringN(" }")
WriteStringN("}")
WriteStringN("")
WriteStringN("function MenuUpdate(menu)")
WriteStringN(" {")
WriteStringN(" which = xlink[menu];")
WriteStringN(" if (document.layers)")
WriteStringN(" {")
WriteStringN(" document.dynamenu31.document.dynamenu32.document.write('<FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + ">'+which+'</FONT>')")
WriteStringN(" document.dynamenu31.document.dynamenu32.document.close()")
WriteStringN(" }")
WriteStringN(" else if (document.getElementById)")
WriteStringN(" {")
WriteStringN(" document.getElementById(" + QC + "dynamenu33" + QC + ").innerHTML = '<CENTER><FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + ">" + s1Bold + s1Italic + "'+which+'" + s2Italic + s2Bold + "</FONT></CENTER>';")
WriteStringN(" }")
WriteStringN(" else if (document.all)")
WriteStringN(" {")
WriteStringN(" dynamenu33.innerHTML=' '")
WriteStringN(" dynamenu33.innerHTML='<FONT SIZE=" + FontSIze + " FACE=" + QC + Font + QC + ">'+which+'</FONT>';")
WriteStringN(" }")
WriteStringN(" }")
WriteStringN(" if (document.getElementById)")
WriteStringN(" colorIt(document.getElementById(" + QC + "td0" + QC + "));")
WriteStringN(" else if (document.all)")
WriteStringN(" {")
WriteStringN(" colorIt(document.all.td0);")
WriteStringN(" }")
WriteStringN("")
WriteStringN("MenuUpdate(0);")
CloseFile(0)
EndIf
EndProcedure
;
; Generate the JavaScript file
;
Procedure Generate_popup_menu(Path.s, FileName.s, PosXMenu.l, PosYMenu.l, Centered.l, Color1.l, Color2.l, TColor1.l, TColor2.l, FirstCellHeight.l, CellsHeight.l, MenuItemWidth.l, Font.s, FontSize.s, CellFontBold.l, CellFontItalic.l)
Debug "Generating JavaScript " + Path + " " + FileName
If CellFontBold
s1Bold.s = "<b>"
s2Bold.s = "</b>"
Else
s1Bold.s = ""
s2Bold.s = ""
EndIf
If CellFontItalic
s1Italic.s = "<i>"
s2Italic.s = "</i>"
Else
s1Italic.s = ""
s2Italic.s = ""
EndIf
Class.s = Mid(FileName, 1, FindString(FileName, ".", 1) -1)
If CreateFile(0, Path + "\" + FileName)
WriteStringN("posYmenu = " + Str(PosYMenu) + ";")
sColor1.s = RGB2HTMLColor(Color1)
sColor2.s = RGB2HTMLColor(Color2)
sTColor1.s = RGB2HTMLColor(TColor1)
sTColor2.s = RGB2HTMLColor(TColor2)
WriteStringN("bgcolor='" + sColor1 + "';")
WriteStringN("bgcolor2='" + sColor2 + "';")
If Centered
WriteStringN(" { if (document.all)")
WriteStringN(" posXmenu = (document.body.clientWidth/2)-(" + Str(MenuItemWidth * (NMenu + 1)) + "/2);")
WriteStringN(" else")
WriteStringN(" posXmenu = (window.innerWidth/2)-(" + Str(MenuItemWidth * (NMenu + 1)) + "/2);")
WriteStringN(" }")
Else
WriteStringN(" posXmenu = " + Str(PosXMenu) + ";")
EndIf
WriteStringN("document.write('<style type=" + QC + "text/css" + QC + ">');")
WriteStringN("document.write('.popper { POSITION: absolute; VISIBILITY: hidden; z-index:3; }')")
WriteStringN("document.write('#topleft { position:absolute; top:'+posYmenu+'px; left:'+posXmenu+'px; z-index:10; }')")
WriteStringN("document.write('A:hover." + Class + " {color:" + sTColor2 + "; text-decoration:none;}')")
WriteStringN("document.write('A." + Class + " {color:" + sTColor1 + "; text-decoration:none; margin-left:4; margin-right:4;}')")
WriteStringN("document.write('</style>')")
WriteStringN("document.write('<DIV class=popper id=topdeck></DIV>');")
WriteStringN("/*" + EOL + "SCRIPT generated by F.Weil - WRP / Nasca" + EOL + "http://www.nasca.fr" + EOL + "*/" + EOL)
WriteStringN("/*" + EOL + "Links" + EOL + "*/")
WriteStringN("zlink = new Array;")
For i = 0 To NMenu
WriteStringN("zlink[" + Str(i) + "] = new Array;")
Next
For i = 0 To NMenu
For j = 0 To NItems(i)
Debug "Link(" + Str(i) + "," + Str(j) + ")=" + Link(i, j) + " / " + Text(i, j)
WriteStringN("zlink[" + Str(i) + "][" + Str(j) + "] = '<A HREF=" + QC + Link(i, j) + QC + " CLASS=" + Class + ">" + Text(i, j) + "</A>';")
Next
Next
WriteStringN("var nava = (document.layers);")
WriteStringN("var dom = (document.getElementById);")
WriteStringN("var iex = (document.all);")
WriteStringN("if (nava) { skn = document.topdeck }")
WriteStringN("else if (dom) { skn = document.getElementById(" + QC + "topdeck" + QC + ").style }")
WriteStringN("else if (iex) { skn = topdeck.style }")
WriteStringN("skn.top = posYmenu+" + Str(FirstCellHeight) + ";")
WriteStringN("")
WriteStringN("function pop(msg,pos)")
WriteStringN("{")
WriteStringN("skn.visibility = " + QC + "hidden" + QC + ";")
WriteStringN("a=true")
WriteStringN("skn.left = posXmenu+pos;")
WriteStringN("var content =" + QC + "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR=#000000 WIDTH=" + Str(MenuItemWidth) + "><TR><TD><TABLE WIDTH=100% BORDER=0 CELLPADDING=0 CELLSPACING=1>" + QC + ";")
WriteStringN("pass = 0")
WriteStringN("while (pass < msg.length)")
WriteStringN(" {")
WriteStringN(" content += " + QC + "<TR><TD ALIGN=CENTER BGCOLOR=" + QC + "+bgcolor+" + QC + " onMouseOver=\" + QC + "this.style.background='" + QC + "+bgcolor2+" + QC + "'\" + QC + " onMouseOut=\" + QC + "this.style.background='" + QC + "+bgcolor+" + QC + "'\" + QC + " HEIGHT=" + Str(CellsHeight) + "><FONT SIZE=" + FontSize + " FACE=\" + QC + Font + "\" + QC + ">" + s1Bold + s1Italic + QC + "+msg[pass]+" + QC + s2Italic + s2Bold + "</FONT></TD></TR>" + QC + ";")
WriteStringN(" pass++;")
WriteStringN(" }")
WriteStringN("content += " + QC + "</TABLE></TD></TR></TABLE>" + QC + ";")
WriteStringN("if (nava)")
WriteStringN(" {")
WriteStringN(" skn.document.write(content);")
WriteStringN(" skn.document.close();")
WriteStringN(" skn.visibility = " + QC + "visible" + QC + ";")
WriteStringN(" }")
WriteStringN(" else if (dom)")
WriteStringN(" {")
WriteStringN(" document.getElementById(" + QC + "topdeck" + QC + ").innerHTML = content;")
WriteStringN(" skn.visibility = " + QC + "visible" + QC + ";")
WriteStringN(" }")
WriteStringN(" else if (iex)")
WriteStringN(" {")
WriteStringN(" document.all(" + QC + "topdeck" + QC + ").innerHTML = content;")
WriteStringN(" skn.visibility = " + QC + "visible" + QC + ";")
WriteStringN(" }")
WriteStringN("}")
WriteStringN("function kill()")
WriteStringN("{")
WriteStringN(" skn.visibility = " + QC + "hidden" + QC + ";")
WriteStringN("}")
WriteStringN("document.onclick = kill;")
WriteStringN("document.write('<DIV ID=topleft><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR=#000000 WIDTH=" + Str(MenuItemWidth * (NMenu + 1)) + "><TR><TD><TABLE CELLPADING=0 CELLSPACING=1 BORDER=0 WIDTH=100% HEIGHT=" + Str(FirstCellHeight + 1) + "><TR>')")
For i = 0 To NMenu
If NItems(i) = -1
If Link(i, 0) = ""
href.s = ""
Else
href.s = "href=" + Link(i, 0)
EndIf
Debug "Link(" + Str(i) + "," + Str(0) + ")=" + href + " / " + Title(i)
WriteStringN("document.write('<TD WIDTH=" + Str(MenuItemWidth) + " ALIGN=Center BGCOLOR='+bgcolor+' onMouseOver=" + QC + "this.style.background=\''+bgcolor2+'\';pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " onMouseOut=" + QC + "this.style.background=\''+bgcolor+'\'" + QC + "><A onMouseOver=" + QC + "pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " " + href + " CLASS=" + Class + "><FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + ">" + s1Bold + s1Italic + Title(i) + s2Italic + s2Bold + "</FONT></a></TD>')")
Else
If TitleLink(i) = ""
href.s = "href=#"
Debug "Link(" + Str(i) + "," + Str(0) + ")=" + href + " / " + Title(i)
WriteStringN("document.write('<TD WIDTH=" + Str(MenuItemWidth) + " ALIGN=Center BGCOLOR='+bgcolor+' onMouseOver=" + QC + "this.style.background=\''+bgcolor2+'\';pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " onMouseOut=" + QC + "this.style.background=\''+bgcolor+'\'" + QC + "><A onMouseOver=" + QC + "pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " href=# CLASS=" + Class + "><FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + ">" + s1Bold + s1Italic + Title(i) + s2Italic + s2Bold + "</FONT></a></TD>')")
Else
href.s = "href=" + TitleLink(i)
Debug "Link(" + Str(i) + "," + Str(0) + ")=" + href + " / " + Title(i)
WriteStringN("document.write('<TD WIDTH=" + Str(MenuItemWidth) + " ALIGN=Center BGCOLOR='+bgcolor+' onMouseOver=" + QC + "this.style.background=\''+bgcolor2+'\';pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " onMouseOut=" + QC + "this.style.background=\''+bgcolor+'\'" + QC + "><A onMouseOver=" + QC + "pop(zlink[" + Str(i) + "]," + Str(MenuItemWidth * i) + ")" + QC + " " + href + " CLASS=" + Class + "><FONT SIZE=" + FontSize + " FACE=" + QC + Font + QC + ">" + s1Bold + s1Italic + Title(i) + s2Italic + s2Bold + "</FONT></a></TD>')")
EndIf
EndIf
Next
WriteString("document.write('</TR></TABLE></TD></TR></TABLE></DIV>')")
CloseFile(0)
EndIf
EndProcedure
Procedure ParseDescriptor(FileName.s, Auto.l)
If ReadFile(0, FileName)
For i.l = 0 To #MaxItems
NItems(i) = 0
Title(i) = ""
For j.l = 0 To #MaxMenus
Text(i, j) = ""
Link(i, j) = ""
Next
Next
NMenu = -1
;
; Here is the parser. Rules are :
;
; Any [ leaded line is a text / link system
; Any other not empty line is a menu label
;
; - tabs are first replaced with spaces
; - lines are spaces trimed
; - ignored empty lines
; - a menu title is any free text
; - a submenu entry label is [] delimited followed by a free text corresponding to the link
; - an empty menu may have a direct link [] delimited
;
; Example :
;
; Menu1
; [Link1] url1
; [Link2] url2
; Menu2 [url3]
; Menu3
; [Link3] url4
; ...
;
Gadget$ = ""
Repeat
a$ = LTrim(RTrim(ReplaceString(ReadString(), Chr(9), " ")))
Debug "a$=" + a$
If Left(a$, 1) = "["
NItems(NMenu) + 1
Text(NMenu, NItems(NMenu)) = Mid(a$, 2, FindString(a$, "]", 1) - 2)
Link(NMenu, NItems(NMenu)) = LTrim(RTrim(Mid(a$, FindString(a$, "]", 1) + 1, Len(a$) - FindString(a$, "]", 1) - 1 + 1)))
Gadget$ = Gadget$ + Str(NMenu) + "." + Str(NItems(NMenu)) + Chr(9) + Text(NMenu, NItems(NMenu)) + Chr(9) + Link(NMenu, NItems(NMenu)) + EOL
;
; For JavaScript generation it is necessary to convert ' to ' if exist otherwise the '
; would be considered as a JavaScript delimiter.
;
If FindString(Text(NMenu, NItems(NMenu)), "'", 1) <> 0
Text(NMenu, NItems(NMenu)) = ReplaceString(Text(NMenu, NItems(NMenu)), "'", "'")
EndIf
ElseIf a$ <> ""
NMenu + 1
If FindString(a$, "[", 1) = 0
Title(NMenu) = a$
NItems(NMenu) = -1
Gadget$ = Gadget$ + Str(NMenu) + Chr(9) + Title(NMenu) + EOL
TitleLink(NMenu) = ""
Else
Title(NMenu) = LTrim(RTrim(Mid(a$, 1, FindString(a$, "[", 1) - 1)))
Link(NMenu, 0) = Mid(a$, FindString(a$, "[", 1) + 1, Len(a$) - FindString(a$, "[", 1) - 1 + 1 - 1)
NItems(NMenu) = -1
Gadget$ = Gadget$ + Str(NMenu) + Chr(9) + Title(NMenu) + Chr(9) + Link(NMenu, 0) + EOL
TitleLink(NMenu) = Link(NMenu, 0)
EndIf
;
; For JavaScript generation it is necessary to convert ' to ' if exist otherwise the '
; would be considered as a JavaScript delimiter.
;
If FindString(Title(NMenu), "'", 1) <> 0
Title(NMenu) = ReplaceString(Title(NMenu), "'", "'")
EndIf
EndIf
Until Eof(0)
CloseFile(0)
CurrentDirectory = GetPathPart(FileName)
If Auto = 0
SetGadgetText(110, Gadget$)
EndIf
EndIf
EndProcedure
Procedure GenerateJavaScript(MenuType.l, FileName.s, XOffset.l, YOffset.l, Centered.l, Color1.l, Color2.l, TColor1.l, TColor2.l, FirstCellHeight.l, CellsHeight.l, MenuItemWidth.l, Font.s, FontSize.s, CellFontBold.l, CellFontItalic.l, Auto)
SetWindowText_(WindowID(), "F.Weil - JavaScript popups generator : " + FileName)
Debug "FileName = " + FileName
If LCase(Right(FileName, 4)) = ".ini"
JavaScript_FileName.s = Mid(FileName, 1, Len(FileName) - 4) + ".js"
Else
JavaScript_FileName.s = FileName + ".js"
EndIf
If LCase(Right(FileName, 4)) = ".ini"
Index_FileName.s = Mid(FileName, 1, Len(FileName) - 4) + ".htm"
Else
Index_FileName.s = FileName + ".htm"
EndIf
Debug "MenuType = " + Str(MenuType)
Select MenuType
Case 1
Generate_popup_menu(GetPathPart(JavaScript_FileName), GetFilePart(JavaScript_FileName), XOffset, YOffset, Centered, Color1, Color2, TColor1, TColor2, FirstCellHeight, CellsHeight, MenuItemWidth, Font, FontSize, CellFontBold, CellFontItalic)
Case 2
Generate_menu1(GetPathPart(JavaScript_FileName), GetFilePart(JavaScript_FileName), XOffset, YOffset, Centered, Color1, Color2, TColor1, TColor2, FirstCellHeight, CellsHeight, MenuItemWidth, Font, FontSize, CellFontBold, CellFontItalic)
Default
EndSelect
If Auto = 0
If GetGadgetState(104)
If CreateFile(0, Index_FileName)
WriteStringN("<HTML>" + EOL + "<HEAD>" + EOL + "</HEAD>" + EOL + "<BODY>" + EOL)
WriteStringN("<SCRIPT LANGUAGE=JavaScript>")
WriteStringN(" document.write('<DIV class=popper id=topdeck></DIV>');")
WriteStringN("</SCRIPT>")
WriteStringN("<SCRIPT LANGUAGE=" + QC + "JavaScript" + QC + " SRC=" + QC + JavaScript_FileName + QC + "></SCRIPT>")
WriteStringN("</BODY>" + EOL + "</HTML>")
CloseFile(0)
ShellExecute_(0, "open", Index_FileName, "", "", #SW_SHOWNORMAL)
EndIf
EndIf
EndIf
EndProcedure
Procedure.s Translator(Message.s)
Select Message
Case ""
Select Language
Case "DE"
Message = ""
Case "EN"
Message = ""
Case "FR"
Message = ""
Case "IT"
Message = ""
Case "PO"
Message = ""
Case "SP"
Message = ""
Default
Message = ""
EndSelect
Default
Select Language
Case "DE"
Message = "Unknown message"
Case "EN"
Message = "Unknown message"
Case "FR"
Message = "Message inconnu"
Case "IT"
Message = "Unknown message"
Case "PO"
Message = "Unknown message"
Case "SP"
Message = "Unknown message"
Default
Message = "Unknown message"
EndSelect
EndSelect
ProcedureReturn Message
EndProcedure
Procedure Refresh2StateButton(CellsWidth.l, CellsHeight.l, Color1.l, TColor1.l, Color2.l, TColor2.l, CellFont.s, CellFontSize.s, CellFontBold.l, CellFontItalic.l)
MaxWidth.l = 110
MaxHeight.l = 35
FreeGadget(133)
ButtonImageGadget(133, 480 - IMin(CellsWidth, MaxWidth) / 2, 110 - IMin(CellsHeight, MaxHeight) / 2, IMin(CellsWidth, MaxWidth), IMin(CellsHeight, MaxHeight), MyLabeledImage(5, IMin(CellsWidth, MaxWidth), IMin(CellsHeight, MaxHeight), Color1, TColor1, "Text font", CellFont, CellFontBold, CellFontItalic, HTML2PBFontSize(CellFontSize)))
ThisText.s = CellFont
If CellFontBold
ThisText = ThisText + " Bold"
EndIf
If CellFontItalic
ThisText = ThisText + " Italic"
EndIf
GadgetToolTip(133, "Click here to change text font (actually " + ThisText + " " + CellFontSize + ")")
FreeGadget(134)
ButtonImageGadget(134, 480 - IMin(CellsWidth, MaxWidth) / 2, 110 - IMin(CellsHeight, MaxHeight) / 2, IMin(CellsWidth, MaxWidth), IMin(CellsHeight, MaxHeight), MyLabeledImage(6, IMin(CellsWidth, MaxWidth), IMin(CellsHeight, MaxHeight), Color2, TColor2, "Text font", CellFont, CellFontBold, CellFontItalic, HTML2PBFontSize(CellFontSize)))
GadgetToolTip(134, "Click here to change text font (actually " + ThisText + " " + CellFontSize + ")")
HideGadget(134, 1)
EndProcedure
Procedure AutoRun(BatchFileName.s, MenuItemWidth.l, CellsHeight.l, Color1.l, TColor1.l, Color2.l, TColor2.l, CellFont.s, CellFontSize.s, CellFontBold.l, CellFontItalic.l, MenuType)
Debug BatchFileName
If ReadFile(99, BatchFileName)
SetWindowText_(WindowID(), "F.Weil - JavaScript popups generator : Autorun " + BatchFileName)
Repeat
UseFile(99)
a$ = ReplaceString(LTrim(RTrim(ReplaceString(ReadString(), Chr(9), " "))), " ", " ")
Debug a$
If FindString(a$, " ", 1) <> 0
LHS.s = Mid(a$, 1, FindString(a$, " ", 1) - 1)
RHS.s = Mid(a$, FindString(a$, " ", 1) + 1, Len(a$) - FindString(a$, " ", 1) - 1 + 1)
Debug "LHS=" + LHS + " RHS=" + RHS
Select LHS
Case "XOffset"
XOffset = Val(RHS)
; SetGadgetText(101, Str(XOffset))
Debug "XOffset=" + Str(XOffset)
Case "YOffset"
YOffset = Val(RHS)
; SetGadgetText(102, Str(YOffset))
Debug "YOffset=" + Str(YOffset)
Case "Centered"
Centered = Val(RHS)
; SetGadgetState(103, Centered)
Debug "Centered=" + Str(Centered)
Case "HTML"
; SetGadgetState(104, Val(RHS))
Debug "HTML=" + RHS
Case "FirstCellHeight"
FirstCellHeight = Val(RHS)
; SetGadgetText(121, Str(FirstCellHeight))
Debug "FirstCellHeight=" + Str(FirstCellHeight)
Case "CellsHeight"
CellsHeight = Val(RHS)
; SetGadgetText(122, Str(CellsHeight))
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "CellsHeight=" + Str(CellsHeight)
Case "CellsWidth"
MenuItemWidth = Val(RHS)
; SetGadgetText(123, Str(MenuItemWidth))
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "CellsWidth=" + Str(MenuItemWidth)
Case "BG1"
FreeGadget(105)
Color1 = HTML2RGB(RHS)
; ButtonImageGadget(105, 120, 100, 40, 20, MyImage(1, 40, 20, Color1))
; GadgetToolTip(105, "Click here to change first background color (actually" + RHS + ") = RGB(" + RGB2DecList(Color1) + ")")
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "BG1=" + RHS + " " + Hex(Color1)
Case "BG2"
; FreeGadget(106)
Color2 = HTML2RGB(RHS)
; ButtonImageGadget(106, 200, 100, 40, 20, MyImage(2, 40, 20, Color2))
; GadgetToolTip(106, "Click here to change second background color (actually" + RHS + ") = RGB(" + RGB2DecList(Color2) + ")")
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "BG2=" + RHS + " " + Hex(Color2)
Case "TC1"
; FreeGadget(131)
TColor1 = HTML2RGB(RHS)
; ButtonImageGadget(131, 280, 100, 40, 20, MyImage(3, 40, 20, TColor1))
; GadgetToolTip(131, "Click here to change first background color (actually" + RHS + ") = RGB(" + RGB2DecList(TColor1) + ")")
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "TC1=" + RHS + " " + Hex(TColor1)
Case "TC2"
; FreeGadget(132)
TColor2 = HTML2RGB(RHS)
; ButtonImageGadget(132, 360, 100, 40, 20, MyImage(4, 40, 20, TColor2))
; GadgetToolTip(132, "Click here to change second background color (actually" + RHS + ") = RGB(" + RGB2DecList(TColor2) + ")")
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "TC2=" + RHS + " " + Hex(TColor2)
Case "Font"
CellFont = RHS
; FreeGadget(133)
; ButtonImageGadget(133, 430, 95, 100, 30, MyLabeledImage(5, 100, 30, Color1, TColor1, "Text font", CellFont, HTML2PBFontSize(CellFontSize)))
; GadgetToolTip(133, "Click here to change text font (actually " + CellFont + " " + CellFontSize + ")")
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "Font=" + CellFont
Case "Size"
CellFontSize = RHS
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "CellFontSize=" + Str(CellFontSize)
Case "Bold"
CellFontBold = Val(RHS)
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "CellFontBold=" + RHS
Case "Italic"
CellFontItalic = Val(RHS)
; Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Debug "CellFontItalic=" + RHS
Case "MenuType"
MenuType = Val(RHS)
EndSelect
Else
If Left(a$, 1) <> "'"
Debug "a$=" + a$
ParseDescriptor(a$, 1)
SetWindowText_(WindowID(), "F.Weil - JavaScript popups generator : Autorun " + BatchFileName + " " + a$)
GenerateJavaScript(MenuType, a$, XOffset, YOffset, Centered, Color1, Color2, TColor1, TColor2, FirstCellHeight, CellsHeight, MenuItemWidth, CellFont, CellFontSize, CellFontBold, CellFontItalic, 1)
SetWindowText_(WindowID(), "F.Weil - JavaScript popups generator : Autorun " + BatchFileName + " " + a$ + " done")
EndIf
EndIf
Until Eof(99)
CloseFile(99)
EndIf
EndProcedure
;
; Main starts here
;
hWnd.l
WID.l
WEvent.l
EventMenu.l
EventGadget.l
WindowXSize.l
WindowYSize.l
Quit.l
FontID.l
ImageID.l
FileName.s
CellFont.s
CellFontSize.s
Language = "EN"
;
; Set cursor displacement when using arrow keys
;
GetSystemDefaultLangID = GetSystemDefaultLangID_()
Select GetSystemDefaultLangID
Case 1036 ; = French (Standard)
Language = "FR"
Default
Language = "EN"
EndSelect
EOL = Chr(13) + Chr(10)
QC = Chr(34)
Quit = #FALSE
ProgramParameter.s = ProgramParameter()
WindowXSize = 640
WindowYSize = 480
CurrentDirectory = Space(255)
GetCurrentDirectory_(255, @CurrentDirectory)
Color1 = $804000
Color2 = $007D7D
TColor1 = $80FFFF
TColor2 = $FF0000
XOffset = 80
YOffset = 20
FirstCellHeight = 40
CellsHeight = 30
Centered = #TRUE
MenuItemWidth = 160
CellFont = "Verdana"
CellFontSize = "4"
MenuType = 1
If ProgramParameter = ""
hWnd = OpenWindow(0, 200, 200, WindowXSize, WindowYSize, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar, "F.Weil - JavaScript popups generator")
If hWnd
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
LoadFont(0, "Verdana", 8)
FontID = FontID()
If CreateGadgetList(WindowID())
SetGadgetFont(#PB_Default, FontID)
ButtonGadget(108, 280, 160, 40, 20, "Demo")
GadgetToolTip(108, "Click here to create a demo descriptor file and generate the result")
ComboBoxGadget(160, 10, 160, 140, 110)
AddGadgetItem(160, -1, "dynamic_popup_menu")
AddGadgetItem(160, -1, "dynamic_menu1")
SetGadgetState(160, MenuType - 1)
GadgetToolTip(160, "Select the menu type you want to build")
CheckBoxGadget(111, 430, 160, 50, 20, "Bold")
SetGadgetState(111, #FALSE)
GadgetToolTip(111, "Check this to use bold labels")
CheckBoxGadget(112, 510, 160, 50, 20, "Italic")
SetGadgetState(112, #FALSE)
GadgetToolTip(112, "Check this to use italic labels")
StringGadget(110, 0, 230, WindowXSize, WindowYSize - 230, "", #PB_String_Multiline | #ES_AUTOVSCROLL | #WS_VSCROLL | #WS_HSCROLL)
GadgetToolTip(110, "Control listing")
Frame3DGadget(201, 10, 10, 100, 60, "XOffset", 0)
StringGadget(101, 30, 30, 60, 20, Str(XOffset))
GadgetToolTip(101, "Enter distance of the menu bar from left border")
Frame3DGadget(202, 120, 10, 100, 60, "YOffset", 0)
StringGadget(102, 140, 30, 60, 20, Str(YOffset))
GadgetToolTip(102, "Enter distance of the menu bar from top border")
Frame3DGadget(221, 230, 10, 100, 60, "FirstCellHeight", 0)
StringGadget(121, 250, 30, 60, 20, Str(FirstCellHeight))
GadgetToolTip(121, "Enter Top cells minimum height")
Frame3DGadget(222, 340, 10, 100, 60, "CellsHeight", 0)
StringGadget(122, 360, 30, 60, 20, Str(CellsHeight))
GadgetToolTip(122, "Enter subcells minimum height")
Frame3DGadget(223, 450, 10, 100, 60, "CellsWidth", 0)
StringGadget(123, 470, 30, 60, 20, Str(MenuItemWidth))
GadgetToolTip(123, "Enter cells width")
CheckBoxGadget(103, 20, 85, 80, 20, "Centered")
SetGadgetState(103, #TRUE)
GadgetToolTip(103, "Check this for horizontal center the menu bar (XOffset will be ignored)")
CheckBoxGadget(104, 20, 115, 80, 20, "htm file")
SetGadgetState(104, #TRUE)
GadgetToolTip(104, "Check this to generate the optional HTML skeleton")
Frame3DGadget(205, 100, 80, 80, 60, "BG1", 0)
ButtonImageGadget(105, 120, 100, 40, 20, MyImage(1, 40, 20, Color1))
GadgetToolTip(105, "Click here to change first background color (actually" + RGB2HTMLColor(Color1) + ") = RGB(" + RGB2DecList(Color1) + ")")
Frame3DGadget(206, 180, 80, 80, 60, "BG2", 0)
ButtonImageGadget(106, 200, 100, 40, 20, MyImage(2, 40, 20, Color2))
GadgetToolTip(106, "Click here to change second background color (actually" + RGB2HTMLColor(Color2) + ") = RGB(" + RGB2DecList(Color2) + ")")
Frame3DGadget(231, 260, 80, 80, 60, "TC1", 0)
ButtonImageGadget(131, 280, 100, 40, 20, MyImage(3, 40, 20, TColor1))
GadgetToolTip(131, "Click here to change first text color (actually" + RGB2HTMLColor(TColor1) + ") = RGB(" + RGB2DecList(TColor1) + ")")
Frame3DGadget(232, 340, 80, 80, 60, "TC2", 0)
ButtonImageGadget(132, 360, 100, 40, 20, MyImage(4, 40, 20, TColor2))
GadgetToolTip(132, "Click here to change second text color (actually" + RGB2HTMLColor(TColor2) + ") = RGB(" + RGB2DecList(TColor2) + ")")
Frame3DGadget(233, 420, 80, 120, 60, "Font", 0)
ButtonImageGadget(133, 430, 95, 100, 30, MyLabeledImage(5, 100, 30, Color1, TColor1, "Text font", CellFont, CellFontBold, CellFontItalic, HTML2PBFontSize(CellFontSize)))
GadgetToolTip(133, "Click here to change text font (actually " + CellFont + " " + CellFontSize + ")")
Frame3DGadget(234, 420, 80, 120, 60, "Font", 0)
ButtonImageGadget(134, 430, 95, 100, 30, MyLabeledImage(6, 100, 30, Color2, TColor2, "Text font", CellFont, CellFontBold, CellFontItalic, HTML2PBFontSize(CellFontSize)))
GadgetToolTip(134, "Click here to change text font (actually " + CellFont + " " + CellFontSize + ")")
HideGadget(134, 1)
EndIf
SetWindowCallback(@MyWindowCallback())
Repeat
WID = WindowID()
WEvent = WaitWindowEvent()
Select WEvent
Case #PB_EventCloseWindow
Quit = #TRUE
Case #PB_EventMenu
EventMenu = EventMenuID()
Select EventMenu
Case 99
Quit = #TRUE
EndSelect
Case #PB_EventGadget
EventGadget = EventGadgetID()
Select EventGadget
Case 101 ; XOffset StringGadget
XOffset = Val(GetGadgetText(101))
Case 102 ; YOffset StringGadget
YOffset = Val(GetGadgetText(102))
Case 103 ; Centered CheckBox
Centered = GetGadgetState(103)
Case 105 ; Select first color
FreeGadget(105)
Color1 = MyColorRequester(Color1)
ButtonImageGadget(105, 120, 100, 40, 20, MyImage(1, 40, 20, Color1))
GadgetToolTip(105, "Click here to change first background color (actually" + RGB2HTMLColor(Color1) + ") = RGB(" + RGB2DecList(Color1) + ")")
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 106 ; Select second color
FreeGadget(106)
Color2 = MyColorRequester(Color2)
ButtonImageGadget(106, 200, 100, 40, 20, MyImage(2, 40, 20, Color2))
GadgetToolTip(106, "Click here to change second background color (actually" + RGB2HTMLColor(Color2) + ") = RGB(" + RGB2DecList(Color2) + ")")
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 108 ; Generate demo descriptor data
FileName = CurrentDirectory + "\" + "DemoTmp.ini"
If CreateFile(0, FileName)
WriteStringN("Purebasic")
WriteStringN("")
WriteStringN("[Purebasic Homepage] http://www.purebasic.com")
WriteStringN("[Purebasic Forum] http://forum.purebasic.com")
WriteStringN("[Purebasic Forum FR] http://forums.purebasic.fr/")
WriteStringN("[Ressources Site] http://www.purearea.net/pb/english/")
WriteStringN("[CodeArchiv] http://www.purearea.net/pb/CodeArchiv/French.html")
WriteStringN("")
WriteStringN("fweil [http://www.francoisweil.com]")
WriteStringN("")
WriteStringN("Local")
WriteStringN("")
WriteStringN("[Localhost] file:///C:")
CloseFile(0)
ParseDescriptor(FileName, 0)
GenerateJavaScript(MenuType, FileName, XOffset, YOffset, Centered, Color1, Color2, TColor1, TColor2, FirstCellHeight, CellsHeight, MenuItemWidth, CellFont, CellFontSize, CellFontBold, CellFontItalic, 0)
EndIf
Case 111 ; Bold check box
CellFontBold = GetGadgetState(111)
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 112 ; Italic check box
CellFontItalic = GetGadgetState(112)
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 121 ; FirstCellHeight StringGadget
FirstCellHeight = Val(GetGadgetText(121))
Case 122 ; CellsHeight StringGadget
CellsHeight = Val(GetGadgetText(122))
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 123 ; CellsWidth StringGadget
MenuItemWidth = Val(GetGadgetText(123))
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 131 ; First Text Color
FreeGadget(131)
TColor1 = MyColorRequester(TColor1)
ButtonImageGadget(131, 280, 100, 40, 20, MyImage(3, 40, 20, TColor1))
GadgetToolTip(131, "Click here to change first text color (actually" + RGB2HTMLColor(TColor1) + ") = RGB(" + RGB2DecList(TColor1) + ")")
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 132 ; Second Text Color
FreeGadget(132)
TColor2 = MyColorRequester(TColor2)
ButtonImageGadget(132, 360, 100, 40, 20, MyImage(4, 40, 20, TColor2))
GadgetToolTip(132, "Click here to change first text color (actually" + RGB2HTMLColor(TColor2) + ") = RGB(" + RGB2DecList(TColor2) + ")")
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 134 ; Font selector
Result = FontRequester(CellFont, HTML2PBFontSize(CellFontSize), 0)
If SelectedFontStyle() & #PB_Font_Bold
CellFontBold = #TRUE
CellFont = CellFont + " Bold"
SetGadgetState(111, CellFontBold)
Else
CellFontBold = #FALSE
SetGadgetState(111, CellFontBold)
EndIf
If SelectedFontStyle() & #PB_Font_Italic
CellFontItalic = #TRUE
CellFont = CellFont + " Italic"
SetGadgetState(112, CellFontItalic)
Else
CellFontItalic = #FALSE
SetGadgetState(112, CellFontItalic)
EndIf
CellFont = SelectedFontName()
CellFontSize = PB2HTMLFontSize(SelectedFontSize())
Refresh2StateButton(MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic)
Case 160
MenuType = GetGadgetState(160) + 1
EndSelect
EndSelect
Until Quit
EndIf
Else
AutoRun(ProgramParameter, MenuItemWidth, CellsHeight, Color1, TColor1, Color2, TColor2, CellFont, CellFontSize, CellFontBold, CellFontItalic, MenuType)
EndIf
End
Mon avatar reproduit l'image de 4x1.8m présentée au 'Salon international du meuble de Paris' en janvier 2004, dans l'exposition 'Shades' réunisant 22 créateurs autour de Matt Sindall. L'original est un stratifié en 150 dpi.
... ben j'ai un peu raccourci le prog parce qu'il tenait pas dans le post !
Enfin il n'y manque rien.
Tu choisis les couleurs avec les boutons colorés, la police avec le bouton actif de droite.
A+
Enfin il n'y manque rien.
Tu choisis les couleurs avec les boutons colorés, la police avec le bouton actif de droite.
A+
Mon avatar reproduit l'image de 4x1.8m présentée au 'Salon international du meuble de Paris' en janvier 2004, dans l'exposition 'Shades' réunisant 22 créateurs autour de Matt Sindall. L'original est un stratifié en 150 dpi.