Use a font with Dialogs

[Mesa]

We need a xml tag <Font> or a UpdateDialog() function as a wish but without that :

Code: Select all

CompilerIf #PB_Compiler_Unicode
  #XmlEncoding = #PB_UTF8
CompilerElse 
  #XmlEncoding = #PB_Ascii
CompilerEndIf

#Dialog = 0
#Xml = 0

Global Arial24

Arial24=LoadFont(1, "Arial", 24) 
If Arial24=0
  Debug "Error font"
  End
EndIf


Procedure.s NewTextWidth(text$, font=-1, margin=0)
  ;font=-1 => Font sytem
  Protected W
  
  
  If CreateImage(0, 200,200)
    StartDrawing(ImageOutput(0))
    If font <> -1 
      DrawingFont(font)
    EndIf
    W=TextWidth(text$) + margin
    StopDrawing()
  Else
    Debug "Error in NewTextWidth()"
    End
  EndIf
  FreeImage(0)
  ProcedureReturn "width='"+Str(W)+"' "
EndProcedure

Procedure.s NewTextHeight(text$, font=-1, margin=0)
  ;font=-1 => Font sytem
  Protected H
  
  If CreateImage(0, 200,200)
    StartDrawing(ImageOutput(0))
    If font <> -1 
      DrawingFont(font)
    EndIf
    H=TextHeight(text$) + margin
    StopDrawing()
  Else
    Debug "Error in NewTextHeight()"
    End
  EndIf
  FreeImage(0)
  ProcedureReturn "height='"+Str(H)+"' "
EndProcedure


XML$ = "<window id='#PB_Any' name='test' text='test' minwidth='auto' minheight='auto' flags='#PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget'>" +
       "  <panel>" +
       "    <tab text='Tab'>" +
       "      <vbox expand='item:2'>" +
       "        <hbox>" +
       "          <button name='but1' text='Button 1' "  +
       NewTextWidth("Button 1",  Arial24, 60) +
       NewTextHeight("Button 1", Arial24, 60) +
       "           /> " +
       "          <checkbox name='check1' text='CheckBox 1'/>" +
       "        <singlebox expand='no' align='center,right'>" +
       "          <button name='but2' text='Button 2' " + 
       "           /> " +
       "        </singlebox>" +
       "        </hbox>" +
       "        <editor text='Ok...' height='150'/>" +
       "      </vbox>" +
       "    </tab>" +  
       "  </panel>" +
       "</window>"

;Debug XML$

If CatchXML(#Xml, @XML$, StringByteLength(XML$), 0, #XmlEncoding) And XMLStatus(#Xml) = #PB_XML_Success
  
  If CreateDialog(#Dialog) And OpenXMLDialog(#Dialog, #Xml, "test")
    
    SetGadgetFont(DialogGadget(#Dialog, "but1"), FontID(1))
    ;SetGadgetText(DialogGadget(#Dialog, "but1"), "azerty")
    
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow 
    
  Else  
    Debug "Error  -Dialog- : " + DialogError(#Dialog)
  EndIf
Else
  Debug "Error XML : " + XMLError(#Xml) + " (Line: " + XMLErrorLine(#Xml) + ")"
EndIf

Mesa.

[davido]

Interesting!

Thank you.

[Andre]

Cool

But I would also like to see this as a native feature...

[Andre]

Have posted a feature request about this here: http://www.purebasic.fr/english/viewtop ... =3&t=57272