Auto Height of multi-line Text Gadget

[IdeasVacuum]

Potentially cross-platform, only tested on Windows, Compile Unicode. Holds the width of a given text gadget and resizes the height to neatly fit the text. You could of course reverse that rule if required. Possibly could be used to size EditorGadgets too.

Code: Select all

Enumeration
#WinHdn
#ConHdn
#TxtHdn
#Win00
#Txt01
#Txt02
#Txt03
#Txt04
#Txt05
#Txt06
#Btn01
#Font10
#Font12
#Font14
EndEnumeration

#NPB_Text_Left = 0

If OpenWindow(#WinHdn, -1024, -1024, 1000, 1000, "Off Screen Window") ;<-- ***Move window on screen to see how it works

       ContainerGadget(#ConHdn, 0, 0, 1000, 1000)
Else

       MessageRequester("Problem","Failed to open Window")
       End
EndIf

Global igFont10.i = LoadFont(#Font10, "Microsoft Sans Serif", 10, #PB_Font_HighQuality + 2)
Global igFont12.i = LoadFont(#Font12, "Microsoft Sans Serif", 12, #PB_Font_HighQuality + 2)
Global igFont14.i = LoadFont(#Font14, "Microsoft Sans Serif", 14, #PB_Font_HighQuality + 2)

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

Procedure ResizeTxtGdtHgt(iGdtID.i, iGdtW.i, iJust.i, iBorder.i, iFont.i, sText.s)
;----------------------------------------------------------------------------------
Protected iX.i, iY.i, iOffsetX.i, iGdtH.i, iTxtH.i, iTxtW.i, iTotalLines.i, iColour.i

Select iJust

            Case #NPB_Text_Left:  iOffsetX = 0
            Case #PB_Text_Center: iOffsetX = (iGdtW / 2) - 10
            Case #PB_Text_Right:  iOffsetX = iGdtW - 20
EndSelect

           If IsWindow(#WinHdn)

                    OpenGadgetList(#ConHdn)

                    If(iBorder = #False)

                           TextGadget(#TxtHdn, 0, 0, iGdtW, 1000, sText, iJust)
                    Else
                           TextGadget(#TxtHdn, 0, 0, iGdtW, 1000, sText, iJust | #PB_Text_Border)
                    EndIf

                    SetGadgetColor(#TxtHdn, #PB_Gadget_FrontColor,RGB(0,0,0))

                     SetGadgetFont(#TxtHdn, iFont)
                   CloseGadgetList()

                   If StartDrawing(WindowOutput(#WinHdn)) 

                           ;Approx text area (oversize)
                                 iTxtH = TextHeight(sText)
                                 iTxtW = TextWidth(sText)
                           iTotalLines = Round(iTxtW / iGdtW, #PB_Round_Up)
                                 iGdtH = (iTxtH * iTotalLines * 3)

                            ResizeGadget(#TxtHdn, #PB_Ignore, #PB_Ignore, #PB_Ignore, iGdtH)

                            ;Find bottom of last text line
                            For iY = iGdtH To 0 Step -1

                                 For iX = iOffsetX To (iOffsetX + 20) Step 1

                                               iColour = Point(iX, iY)
                                            ;Plot(iX, iY, RGB(255,0,0))  ;<--- ***uncomment to see how it works
                                            If(iColour = RGB(0,0,0))

                                                 iGdtH = iY + (iTxtH / 2)

                                                   Break 2
                                            EndIf
                                 Next iX

                            Next iY

                             StopDrawing()
                            ResizeGadget(iGdtID, #PB_Ignore, #PB_Ignore, #PB_Ignore, iGdtH)
                           SetGadgetText(iGdtID, sText)
                   EndIf

                   ;Delay(2000) ;<--- ***uncomment to see how it works
                   FreeGadget(#TxtHdn)
           EndIf

EndProcedure

Procedure Win()
;---------------
Protected iExit = #False, iEvent.i = 0

 If OpenWindow(#Win00, 0, 0, 640, 660, "Text Gadget Resize", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

       TextGadget(#Txt01,  10,  10, 200, 20, "TextGadget Left", #NPB_Text_Left)
       TextGadget(#Txt02, 220,  10, 200, 20, "TextGadget Center", #PB_Text_Center)
       TextGadget(#Txt03, 430,  10, 200, 20, "TextGadget Right", #PB_Text_Right)
       TextGadget(#Txt04,  10, 320, 200, 20, "TextGadget Left + Border", #NPB_Text_Left | #PB_Text_Border)
       TextGadget(#Txt05, 220, 320, 200, 20, "TextGadget Center + Border", #PB_Text_Center | #PB_Text_Border)
       TextGadget(#Txt06, 430, 320, 200, 20, "TextGadget Center + Border", #PB_Text_Center | #PB_Text_Border)
     ButtonGadget(#Btn01, 200, 640, 240, 20, "Fill Text")

    SetGadgetFont(#Txt01, igFont10)
    SetGadgetFont(#Txt02, igFont12)
    SetGadgetFont(#Txt03, igFont14)
    SetGadgetFont(#Txt04, igFont10)
    SetGadgetFont(#Txt05, igFont12)
    SetGadgetFont(#Txt06, igFont14)

    Repeat

                   iEvent = WaitWindowEvent()
           Select iEvent

                   Case #PB_Event_CloseWindow: iExit = #True
                   Case #PB_Event_Gadget

                         If(EventGadget() = #Btn01)

                                ResizeTxtGdtHgt(#Txt01, 200, #NPB_Text_Left, #False,  igFont10, sgText)
                                ResizeTxtGdtHgt(#Txt02, 200, #PB_Text_Center, #False, igFont12, sgText)
                                ResizeTxtGdtHgt(#Txt03, 200, #PB_Text_Right, #False,  igFont14, sgText)
                                ResizeTxtGdtHgt(#Txt04, 200, #NPB_Text_Left, #True,   igFont10, sgText)
                                ResizeTxtGdtHgt(#Txt05, 200, #PB_Text_Center, #True,  igFont12, sgText)
                                ResizeTxtGdtHgt(#Txt06, 200, #PB_Text_Right, #True,   igFont14, sgText)

                         EndIf

                         
           EndSelect

    Until iExit = #True

EndIf

EndProcedure

Win()
End

[Andre]

Tested on MacOS 10.5.8 as the "reason" for this code example looked interesting. But I can't see any differences - each TextGadget (visible especially at the gadgets with border) has the same height. Is this intended?

[IdeasVacuum]

Oh dear - no, each TextGadget should be a different height because of the different font sizes

You could try moving the off-screen window on screen, and un-commenting (2 code positions) to see what is happening.

[Andre]

@IdeasVacuum: sorry no, code changes didn't help - need to investigate the problem later...