Set gadget height to multiline text (Windows)

[Michael Vogel]

I am searching for a routine which calculates the needed gadget height for text precisely. I saw that there a some hickups depending if a text or editor gadget is used (#TextGadget=1/0).

So I am using a constant #TextHeightHack=6 for now which seems to work - but I fear this is not correct for all cases. So maybe there's a better solution available?

Code: Select all

; Define

	#TextGadget=1

	Enumeration
		#Win
		#Editor
		#BtnExit
		;
		#GadgetLineHeight
	EndEnumeration

	EnableExplicit
	
	Global Font=LoadFont(0,"Microsoft Sans Serif",Random(20)+5,#PB_Font_HighQuality)
	Global Font=LoadFont(0,"Segoe UI",20,#PB_Font_HighQuality)

; EndDefine

Procedure.i GetLineHeight(Window,Font)

	Protected LineHeight

	If StartDrawing(WindowOutput(Window))
		DrawingMode(#PB_2DDrawing_Default)
		DrawingFont(Font)
		LineHeight=TextHeight(".")
		StopDrawing()
	EndIf

	ProcedureReturn(LineHeight)

EndProcedure
Procedure.i GetTextHeigt(Window,Gadget,Font,Text.s)

	#TextHeightHack=6
	Protected Magic=Bool(GadgetType(Gadget)=#PB_GadgetType_Text)*#TextHeightHack

	ResizeGadget(#GadgetLineHeight,#PB_Ignore,#PB_Ignore,GadgetWidth(Gadget)+Magic,#PB_Ignore)
	SetGadgetFont(#GadgetLineHeight,Font)
	SetGadgetText(#GadgetLineHeight,Text)

	ProcedureReturn CountGadgetItems(#GadgetLineHeight) * GetLineHeight(Window,Font) + (Magic!#TextHeightHack)

EndProcedure

Procedure Main()

	Protected Text.s

	Text="Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
	Text+"Nullam molestie commodo magna, id rutrum enim suscipit ac. "
	Text+"Nunc tempor faucibus magna, vel volutpat tellus luctus et."

	;Text="TEST"

	If OpenWindow(#Win, 0, 0, 400, 500, "", #PB_Window_Invisible|#PB_Window_ScreenCentered)

		SetWindowColor(#Win, RGB(192,192,192))

		EditorGadget(#GadgetLineHeight,200,0,0,1000,#PB_Editor_WordWrap)
		HideGadget(#GadgetLineHeight,1)

		If #TextGadget
			TextGadget(#Editor,  0,0, 200,0,"")
		Else
			EditorGadget(#Editor,0,0, 200,0, #PB_Editor_WordWrap)
		EndIf

		ButtonGadget(#BtnExit,300,0,100,26, "Exit")
		SetGadgetFont(#Editor,Font)

		ResizeGadget(#Editor,#PB_Ignore,#PB_Ignore,#PB_Ignore, GetTextHeigt(#Win,#Editor,Font,Text))
		SetGadgetText(#Editor,Text)
		HideWindow(#Win,#False)

		Repeat
			Select WaitWindowEvent()
			Case #PB_Event_CloseWindow
				End
			Case #PB_Event_Gadget
				If EventGadget()=#BtnExit
					End
				EndIf
			EndSelect
		ForEver
	EndIf
EndProcedure
Main()

[RASHAD]

Hi MV

Code: Select all

If OpenWindow(0, 0, 0, 400, 250, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CanvasGadget(0, 0, 0, 400, 250)
    LoadFont(0, "Times New Roman", 20)
    
    If StartVectorDrawing(CanvasVectorOutput(0))
    
      Text$ = "Every drawing output has a default unit of measurement. The default unit is pixels " +
             "for screen or raster image outputs and points for printer or vector image outputs. " +
              "It is however possible to select a different unit of measurement for the output when " +
              "creating it with the ImageVectorOutput(), PrinterVectorOutput() or similar function."
              
      VectorFont(FontID(0), 18)
      starty = 25
      MovePathCursor(25, starty)
      DrawVectorParagraph(Text$, 350, 200)
      finishy.d = PathCursorY()
      StopVectorDrawing()
    EndIf
        
    Debug finishy - starty
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

[infratec]

If you use the right syntax (FontID() and the right font number (#PB_Any)) it woks as expected :

It seems that the EditorGadget is a bit smaller, but in my tests it looks like it is a constant value,
This works better for me:

Code: Select all

EnableExplicit

; Define

#TextGadget=1

Enumeration
  #Win
  #Editor
  #BtnExit
  ;
  #GadgetLineHeight
EndEnumeration

EnableExplicit

Global Font = LoadFont(#PB_Any, "Microsoft Sans Serif", Random(20) + 5, #PB_Font_HighQuality)
;Global Font = LoadFont(#PB_Any, "Segoe UI", 20, #PB_Font_HighQuality)

; EndDefine

Procedure.i GetLineHeight(Font.i=#PB_Default)
  
  Protected LineHeight.d, Img.i
  
  
  Img = CreateImage(#PB_Any, 1, 1)
  If Img
    If StartDrawing(ImageOutput(Img))
      If IsFont(Font)
        DrawingFont(FontID(Font))
      EndIf
      LineHeight = TextHeight(".")
      ;Debug LineHeight
      StopDrawing()
    EndIf
    FreeImage(Img)
  EndIf
  
  ProcedureReturn LineHeight
  
EndProcedure

Procedure.i GetTextHeigt(Gadget, Font, Text$)
  
  Protected WidthCorrection, HeightCorrection
  
  Select GadgetType(Gadget)
    Case #PB_GadgetType_Text : WidthCorrection = 6
    Case #PB_GadgetType_Editor : HeightCorrection = 4 ; to avoid scrollbar
  EndSelect
  
  ResizeGadget(#GadgetLineHeight, #PB_Ignore, #PB_Ignore, GadgetWidth(Gadget) + WidthCorrection, #PB_Ignore)
  SetGadgetFont(#GadgetLineHeight, FontID(Font))
  SetGadgetText(#GadgetLineHeight, Text$)
  
  ;Debug CountGadgetItems(#GadgetLineHeight)
  
  ProcedureReturn CountGadgetItems(#GadgetLineHeight) * GetLineHeight(Font) + HeightCorrection
  
EndProcedure

Procedure Main()
  
  Protected Text.s
  
  Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
  Text + "Nullam molestie commodo magna, id rutrum enim suscipit ac. "
  Text + "Nunc tempor faucibus magna, vel volutpat tellus luctus et."
  
  ;Text="TEST"
  
  If OpenWindow(#Win, 0, 0, 800, 800, "", #PB_Window_Invisible|#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
    
    SetWindowColor(#Win, RGB(192,192,192))
    
    EditorGadget(#GadgetLineHeight, 200, 0, 0, WindowHeight(#Win), #PB_Editor_WordWrap)
    ;HideGadget(#GadgetLineHeight, #True)
    
    If #TextGadget
      TextGadget(#Editor,  0,0, 200,0,"")
    Else
      EditorGadget(#Editor,0,0, 200,0, #PB_Editor_WordWrap)
    EndIf
    
    SetGadgetFont(#Editor, FontID(Font))
    
    ResizeGadget(#Editor,#PB_Ignore,#PB_Ignore,#PB_Ignore, GetTextHeigt(#Editor, Font, Text))
    SetGadgetText(#Editor,Text)
    
    HideWindow(#Win, #False)
    
    Repeat
    Until WaitWindowEvent() = #PB_Event_CloseWindow
    
  EndIf
EndProcedure

Main()

[Michael Vogel]

Thank you both.

I do avoid vector drawing as it seems to be rendered in a slightly different way.

The FontId thing is a matter if taste but the pixel values are exact what I'd need to know: I started with 2 pixels (see below), increased to 4 (which does work for the height) and ended with 6 pixels. But I am not sure if this values (x+4 / y+6) will work in all cases.

Code: Select all

TextGadget(#Editor,  0,0,10,10,"")
Debug GadgetWidth(#Editor,#PB_Gadget_RequiredSize)
Debug GadgetHeight(#Editor,#PB_Gadget_RequiredSize)

EditorGadget(#Editor,0,0,10,10, #PB_Editor_WordWrap)
Debug GadgetWidth(#Editor,#PB_Gadget_RequiredSize)
Debug GadgetHeight(#Editor,#PB_Gadget_RequiredSize)
SetGadgetText(#Editor,"*"+#LF$"*"+#LF$"*"+#LF$)
Debug GadgetWidth(#Editor,#PB_Gadget_RequiredSize)
Debug GadgetHeight(#Editor,#PB_Gadget_RequiredSize)