Page 1 of 1

get text width in pixels, cut string to a width in pixels

Posted: Sun Feb 08, 2009 5:49 pm
by luis
Tested on PB4.30 x86 / WinXP

No API used so maybe cross-platform

Code: Select all


Procedure.i GadgetString_GetWidth (nWin, nGadget, sText.s)

;/***P
;*
;* DESC
;* 	Return the width that would be used by the string sText in the nGadget gadget.
;*
;* IN
;*  nWin    ; The number of the window containing the gadget.
;*  nGadget ; The number of the gadget.
;*  sText   ; The text string to be measured.
;* 	 
;* RET
;*  The width of the string in pixels.
;* 
;* OS
;*  All
;***/ 

 Protected iWidth
 
 StartDrawing(WindowOutput(nWin))
 
  DrawingFont(GetGadgetFont(nGadget))
  
  iWidth = TextWidth(sText)
  
 StopDrawing()
 
 ProcedureReturn iWidth
 
EndProcedure

Code: Select all

Procedure.s GadgetString_CutToWidth (nWin, nGadget, sText.s, iWidth)

;/***P
;*
;* DESC
;* 	Return a cutted version of the string if the iWidth pixels are not enough to fit in.
;*
;* IN
;*  nWin    ; The number of the window containing the gadget.
;*  nGadget ; The number of the gadget.
;*  sText   ; The text string to be returned (cutted if needed).
;* 	 
;* RET
;*  The (cutted) string sText.
;* 
;* OS
;*  All
;***/ 

 Protected sOutString.s
 Protected k, iLen
 
 StartDrawing(WindowOutput(nWin))
 
  DrawingFont(GetGadgetFont(nGadget))
 
  sOutString = sText
  
  If TextWidth(sText) > iWidth
  
      iLen = Len(sText)
        
      For k = 1 To iLen    
        If TextWidth(Left(sText, k)) > iWidth        
            sOutString = Left(sText, k - 1)    
            Break
        EndIf
      Next 
  
  EndIf
           
 StopDrawing()
 
 ProcedureReturn sOutString 
 
EndProcedure


One possible use for the two functions above

Code: Select all

EnableExplicit

Enumeration ;{ Gadgets
 #WIN_MAIN
 #TXT_NORMAL
 #TXT_BIG
 #TXT_NORMAL_FILLED
 #TXT_BIG_FILLED
EndEnumeration


#TEST_STRING$           = "Hey Joe, where are you going with that gun in your hand."

#CUTTABLE_PATH$         = "c:\users\username\home\my secret stuff\my zip files\"

#UNCUTTABLE_FILENAME$   = "precious.zip"

#SUNKEN_BORDER_WIDTH    = 4


Procedure.s MergeStringsToFit (nWin, nGadget, sPath.s, sFilename.s, iAvailableWidth)
 
 Protected sOutString.s, sSeparator.s = "[*]\"
 Protected iLenStrToKeep, iLenSeparator
 
 
 If GadgetString_GetWidth (nWin, nGadget, sPath + sFilename) <= iAvailableWidth
    ProcedureReturn sPath + sFilename
 EndIf
 
 iLenStrToKeep = GadgetString_GetWidth (nWin, nGadget, sFilename)
 
 iLenSeparator = GadgetString_GetWidth(nWin, nGadget, sSeparator)
 
 sOutString = GadgetString_CutToWidth (nWin, nGadget, sPath, iAvailableWidth - iLenStrToKeep - iLenSeparator)
    
 sOutString + sSeparator + sFilename
 
 ProcedureReturn sOutString 

EndProcedure 


Procedure Main()
 
 Protected sNewString.s
 Protected iEvent, iLenStrToKeep, iLenSeparator
 Protected nFontBig
 
 nFontBig = LoadFont(#PB_Any, "Arial", 20)    
 
 OpenWindow(#WIN_MAIN, 10, 10, 410, 280, "Main Window ...  resize me", #PB_Window_SystemMenu | #PB_Window_SizeGadget)  
     
 
 ; normal text (len = 400, we will fill it up to 200 pixels)
 
 TextGadget(#TXT_NORMAL, 5, 10, 400, 20, "", #PB_Text_Border)  

    
 ; big text (len = 400, we will fill it up to 200 pixels)
 
 TextGadget(#TXT_BIG, 5, 50, 400, 40, "", #PB_Text_Border)
    
 SetGadgetFont(#TXT_BIG, FontID(nFontBig))
    
 
 ; normal text (len = 400, we will fill it up keeping the important part of the string always visible)
 
 TextGadget(#TXT_NORMAL_FILLED, 5, 120, 400, 20, "", #PB_Text_Border)  
 

 ; big text (len = 400, we will fill it up keeping the important part of the string always visible)
 
 TextGadget(#TXT_BIG_FILLED, 5, 180, 400, 40, "", #PB_Text_Border)  
 
 SetGadgetFont(#TXT_BIG_FILLED, FontID(nFontBig))
 
 

 ; fill the gadget but cut the string at 200 pixels
 
 SetGadgetText(#TXT_NORMAL, GadgetString_CutToWidth (#WIN_MAIN, #TXT_NORMAL, #TEST_STRING$, 200))
 
 
 ; fill the gadget but cut the string at 200 pixels
    
 SetGadgetText(#TXT_BIG, GadgetString_CutToWidth (#WIN_MAIN, #TXT_BIG, #TEST_STRING$, 200))
 
    
 ; fill the gadget, there is enough space so the string will be complete
  
 sNewString = MergeStringsToFit (#WIN_MAIN, #TXT_NORMAL_FILLED, #CUTTABLE_PATH$, #UNCUTTABLE_FILENAME$, 400 - #SUNKEN_BORDER_WIDTH)
 
 SetGadgetText(#TXT_NORMAL_FILLED, sNewString )
    
     
 Repeat 
    iEvent = WaitWindowEvent()
        
    Select iEvent
        Case #PB_Event_SizeWindow        
        
            ResizeGadget(#TXT_BIG_FILLED, #PB_Ignore, #PB_Ignore, WindowWidth(#WIN_MAIN) - 10, #PB_Ignore)


            ; fill the gadget, the space is variable, so the string will be adjusted as needed but always keeping the file name
            
            sNewString = MergeStringsToFit (#WIN_MAIN, #TXT_BIG_FILLED, #CUTTABLE_PATH$, #UNCUTTABLE_FILENAME$, GadgetWidth(#TXT_BIG_FILLED) - #SUNKEN_BORDER_WIDTH)
 
            SetGadgetText(#TXT_BIG_FILLED, sNewString)
            
        EndSelect        
    
 Until iEvent = #PB_Event_CloseWindow
     
 FreeFont(nFontBig)
 
EndProcedure


Main()