Enhanced gadgets with automatic font/text fitting

Share your advanced PureBasic knowledge/code with the community.
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Enhanced gadgets with automatic font/text fitting

Post by Andre »

There are of course several approaches to do such stuff, but here is another one to support resizable gadgets (with automatic fitting text/font size), scaling and formatting. You get enhanced possibilities for gadgets and custom gadgets, e.g. for building DPI-aware apps. Should run on all OS.

It's a standalone module, but can also be used with the GFX_Wizzard_BF package.

Last update: 26th Feb. 2019

Code: Select all

; Dynamic Window / GUI creating Module and DrawText_BF Stand-Alone Fork

; Easily create gadgets and CanvasGadget based text gadgets with advanced text functions
; With dynamically adjusted text and many output options
; This GUI creating module works with the GFX_Wizzard_BF or the DrawText_BF fork module
; You can add this modules to your own developing source codes and executables
; However, it may not be offered as source code in download collections without my written permission,
; or for money, including donation buttons

; The handling of the GUI creating module is very simple and well documented
; Most of this code here consists of the DrawText_BF module, where you don't have to change anything
; It is very easy to add any gadget and create a DPI aware window or GUI without having to activate the PB DPI compiler option
; Extended, custom, or new gadgets in future PB versions, can be inserted quickly and without any problems

DeclareModule DrawText_BF
  ; Module DrawText_BF - GFX_Wizzard_BF Stand-Alone Fork - For PureBasic
  ; Author : W. Albus © 2019 - www.nachtoptik.de - www.quick-aes-256.de
  ; For creating canvas based custom gadgets and gadgets with automatically fitted text
  ; This code is a part from GFX_Wizzard_BF and use a simplificated, but compatible, DrawText_BF Stand-Alone version
  
  ; This module you can add to your own developing source codes and executables
  ; However, it may not be offered as source code in download collections without my written permission,
  ; or for money, including donation buttons
  
  ;; Create a font array for using the functions Calculate_fitted_Font_BF, SetCanvasCustomText_BF and SetGadgetText_BF
  ;; Mostly 30pt > 40pt is enough - smaller is faster
  ;   max_needed_font_size=40 ; Set the max needed font size for any output with this function
  ;   Global Dim Font_Georgia(max_needed_font_size) ; For using in a callback procedure define as Global 
  ;   Define needed_font_size
  ;   For needed_font_size=1 To max_needed_font_size ; Get the fonts
  ;     Font_Georgia(needed_font_size)=LoadFont(#PB_Any, "Georgia", needed_font_size, #PB_Font_Bold)
  ;   Next needed_font_size
  
  ; Flags : Text center=1 - Text right=2 - Text vertical=3
  ; Modes : Revers text mode=1 - RTL text mode=2 - Give only back the needed width mode=3 , height mode=4
  ; Mono line output give back the xx output coordinate - Multi line output give back the yy output coordinate
  ; For stretched text on a textured background often DrawingMode (#PB_2DDrawing_Transparent) is needed
  ; Multi-line output achieves the fastest speed with line breaks #lf$
  Declare DrawText_BF(txt_x, txt_y, txt$, f_col=#White, b_col=#Black, flag=0, mode=0, stretch_x=0, stretch_y=0)
  
  ; Create a image from the output, for post processing or using as image, give back a image (ID) - Padding -1 is automatic padding
  Declare DrawTextCreateImage_BF(txt$, f_col=#White, b_col=#Black, flag=0, mode=0, font_ID=0, stretch_x=0, stretch_y=0, padding=0)
  
  Declare PresetLineWidth_BF(max_1_) ; Preset the min output length for easy centric or right align outputs - Deactivate = 0
                                     ; Important for permanent changed outputs
  
  Declare DrawText_BF_AutoBox(padding_=-1, ; Automatic padding = -1 - Deactivate = -2
                              box_color_=0,
                              offset_x_=0,
                              offset_y_=0,
                              offset_xx_=0,
                              offset_yy_=0)
  
  Declare DrawText_BF_Box(activate_=1, box_color_1_=0, offset_x_1=0, offset_y_1_=0, width_=0, height_=0) ; Activate = 1 - Deactivate = 0
  
  ; This function calculate a fitted font for any gadgets or rectangles
  Declare Calculate_fitted_Font_BF(text$,
                                   width_rectangle,
                                   height_rectangle,
                                   Array font(1),
                                   vertical=0,
                                   padding_x=0,
                                   padding_y=0,
                                   stretch_x=0,
                                   stretch_y=0,
                                   resize_factor.f=1)
  
  Declare Get_Fitted_Font_Padding_X_BF() ; Get the actual padding X
  
  Declare Get_Fitted_Font_Padding_Y_BF() ; Get the actual padding Y
  
  Declare GetTextWidth_BF(text$, ; Get text width - Multiline supported
                          font_ID,
                          vertical=0,
                          stretch_x=0,
                          padding_x=0)
  
  Declare GetTextHeight_BF(text$, ; Get text height - Multiline supported
                           font_ID,
                           vertical=0,
                           stretch_y=0,
                           padding_y=0)
  
  ; Create a enhanced text output for any CanvasGadgets PB
  ; The function returns the determined font size so that it can easily be inherit on to other gadgets
  ; This is also possible on gadgets of other sizes - Sample : alterable_size=calculated_font_size/my_resize_factor
  Declare SetCanvasCustomText_BF(canvas_ID,               ; Any CanvasGadget ID
                                 Array Font(1),           ; Set a Font array, for simple creating any look the sample here
                                 output_x=0,              ; Output pos x  - Ignore = -1
                                 output_y=0,              ; Output pos y  - Ignore = -1
                                 canvas_width=0,          ; Canvas width  - Ignore = -1
                                 canvas_height=0,         ; Canvas height - Ignore = -1
                                 canvas_text$=" ",        ; Text
                                 text_color=#Black,       ; Text color
                                 background_color=#White, ; Background color
                                 flag=1,                  ; Flags : Text center=1 - Text right=2 - Text vertical=3
                                 mode=0,                  ; Modes : Revers text mode=1 - RTL text mode=2
                                 padding_x=0,             ; Text padding x
                                 padding_y=0,             ; Text padding y
                                 text_stretching_x=0,     ; Headletter text stretching x
                                 text_stretching_y=0,     ; Headletter text stretching y
                                 resize_factor.f=1,       ; Text resize factor
                                 get_all_window_events=1) ; For using inside a callback procedure deactivate 
  
  
  ; Create a enhanced text output for Gadgets PB
  ; The function returns the determined font size so that it can easily be inherit on to other gadgets
  ; This is also possible on gadgets of other sizes - Sample : alterable_size=calculated_font_size/my_resize_factor
  Declare SetGadgetText_BF(gadget_ID,               ; Any Gadget ID
                           Array Font(1),           ; Set a Font array, for simple creating any look the sample above
                           output_x,                ; Output pos x  - Ignore = -1
                           output_y,                ; Output pos x  - Ignore = -1
                           gadget_width,            ; Gadget width  - Ignore = -1
                           gadget_height,           ; Gadget height - Ignore = -1
                           gadget_text$=" ",        ; Text
                           padding_x=0,             ; Text padding x
                           padding_y=0,             ; Text padding y
                           resize_factor.f=1,       ; Text resize factor
                           get_all_window_events=1) ; For using inside a callback procedure deactivate 
  
  Declare GetResolution_DPI_X_BF() ; Get resolution x
  
  Declare GetResolution_DPI_Y_BF() ; Get resolution y 
  
  Declare GetOS_PPI_BF() ; Points pro inch from the used OS
  
  Declare.f DPI_ResizeFactor_BF() ; The actual DPI resize factor 
  
  Declare Deactivate_DPI_ResizeFactor_BF(deactivate_dpi_resize_factor_) ; This function set the resulted value from DPI_ResizeFactor_BF = 1
  
EndDeclareModule

Module DrawText_BF
  
  EnableExplicit
  
  #PPI_Windows=96 ; Points pro inch
  #PPI_MacOS=72
  #PPI_Linux=96
  
  Global max_1, padding=-2, box_color, offset_x, offset_y, offset_xx, offset_yy
  Global activate, box_color_1, offset_x_1, offset_y_1, width, height, from_image, image_color
  Global fitted_font_padding_x, fitted_font_padding_y, deactivate_dpi_resize_factor
  
  Procedure DrawText_BF(txt_x, txt_y, txt$, f_col=#White, b_col=#Black, flag=0, mode=0, stretch_x=0, stretch_y=0)
    If txt$="" : ProcedureReturn -26 : EndIf
    Protected i1=TextHeight(Space(1))+stretch_y, i2, i3, i4, i5, i6, i7, padding_1
    Protected result, max, max_len, max_2, max_3, txt_x_0=txt_x, txt_y_0=txt_y, amount_lines
    Protected txt1$, chr$, ln$, ln1$
    Protected Dim f1$(0), Dim f2$(0)
    
    If FindString(txt$, #CR$)
      txt$=ReplaceString(txt$, #CRLF$, #LF$)
      txt$=ReplaceString(txt$, #LFCR$, #LF$)
      ReplaceString(txt$, #CR$, #LF$, #PB_String_InPlace)
    EndIf
    txt1$=txt$
    
    i7=Len(txt1$)
    
    If flag<>3 And FindString(txt1$, #LF$)
      amount_lines=CountString(txt1$, #LF$)+1
      txt_y-i1
      For result=1 To i7
        ln$=StringField(txt1$, result, #LF$)
        i4=Len(ln$)
        If i4
          max_2=TextWidth(ln$)+stretch_x*i4
          If max_2>max_3
            max_3=max_2
            ln1$=ln$
            i2+i1
            max=TextWidth(ln$)+i4
            max_len=i4
          EndIf
        EndIf
      Next
      
      If max_1>0
        max=max_1
      EndIf
      
      If flag=1 ; Centered
        txt_x+max_len*(stretch_x>>1)-max_len>>1
      ElseIf flag=2 ; Right
        txt_x+max_len*(stretch_x)-max_len
      EndIf
    EndIf
    
    If mode=3 And flag<>3
      If i2
        If Not stretch_x
          ProcedureReturn TextWidth(ln1$)+2
        Else
          i6=Len(ln1$)
          For i4=1 To i6
            i5+TextWidth(Mid(ln1$, i4, 1))
          Next
          ProcedureReturn i5+stretch_x*i6+stretch_x/12
        EndIf
      Else
        If Not stretch_x
          ProcedureReturn TextWidth(txt1$)+2
        Else
          For i4=1 To i7
            i5+TextWidth(Mid(txt1$, i4, 1))
          Next
          ProcedureReturn i5+stretch_x*Len(txt1$)+stretch_x/12
        EndIf
      EndIf
    EndIf
    
    If mode=4 And flag<>3
      If i2
        ProcedureReturn amount_lines*(i1+1)-stretch_y
      Else
        ProcedureReturn i1+1-stretch_y
      EndIf
    EndIf
    
    Macro first_char_width
      i5=0
      For i4=1 To i7
        i6=TextWidth(Mid(txt1$, i4, 1))
        If i6>i5
          i5=i6
        EndIf
      Next
    EndMacro
    
    If padding=-1
      padding_1=TextWidth(Space(3))
    Else
      padding_1=padding
    EndIf
    
    If mode=3 And flag=3
      first_char_width
      ProcedureReturn i5
    EndIf
    
    If mode=4 And flag=3
      ProcedureReturn i1*i7-stretch_y
    EndIf
    
    If activate=1
      Box(txt_x_0+offset_x_1,
          txt_y_0+offset_y_1,
          width,
          height,
          box_color_1)
    EndIf
    
    If Not from_image
      If padding<>-2
        If i2
          Box(txt_x_0-padding_1+offset_x,
              txt_y_0-padding_1+offset_y,
              max+max_len*(stretch_x)-stretch_x-max_len+padding_1<<1+offset_xx,
              amount_lines*i1-stretch_y+padding_1<<1+offset_yy,
              box_color)
        Else
          If flag<>3
            Box(txt_x_0-padding_1+offset_x,
                txt_y_0-padding_1+offset_y,
                TextWidth(txt1$)+stretch_x*(i7-1)+padding_1<<1+offset_xx,
                i1+padding_1<<1+offset_yy,
                box_color)
          Else ; Vertical box
            first_char_width
            Box(txt_x_0-padding_1+offset_x>>1,
                txt_y_0-padding_1+offset_y,
                i5+padding_1<<1+offset_xx,
                i1*i7+padding_1<<1+offset_yy,
                box_color)
          EndIf
        EndIf
      EndIf
    Else
      DrawingMode(#PB_2DDrawing_Transparent)
    EndIf
    
    Macro spread_x(txt_x, txt_y, ln)
      i6=0
      i4=Len(ln)
      For i5=1 To Len(ln)
        ln1$=Mid(ln, i5, 1)
        If flag=1 And i2
          DrawText(txt_x+i6-i4*stretch_x>>1, txt_y, ln1$, f_col, b_col)
        ElseIf flag=2 And i2
          DrawText(txt_x+i6-i4*stretch_x, txt_y, ln1$, f_col, b_col)
        Else
          DrawText(txt_x+i6, txt_y, ln1$, f_col, b_col)
        EndIf
        i6+TextWidth(ln1$)+stretch_x
      Next   
    EndMacro
    
    Macro rtl(txt)
      i5=0
      i3=Len(txt)
      For i4=1 To i3
        If Mid(txt, i4, 1)=" "
          i6+1
        EndIf
        ln1$=StringField(txt, i4, " ")
        If ln1$<>""
          ReDim f1$(i5)
          ReDim f2$(i5)
          f1$(i5)=ln1$
          f2$(i5)=ReverseString(ln1$)
          i5+1
        EndIf
      Next
      txt=ReverseString(txt)
      For i4=0 To i5-1
        txt=ReplaceString(txt, f2$(i4), f1$(i4))
      Next
      i3=0 : i5=0 : i6=0
    EndMacro 
    
    Macro txt_out
      If mode=1
        ln$=ReverseString(ln$)
      ElseIf mode=2
        rtl(ln$)
      EndIf
      If flag=2 ; Right
        If stretch_x
          spread_x(txt_x+max-TextWidth(ln$), txt_y+i2, ln$)
        Else
          DrawText(txt_x+max-TextWidth(ln$), txt_y+i2, ln$, f_col, b_col)
        EndIf
      ElseIf flag=1 ; Centered
        If stretch_x
          spread_x(txt_x+max>>1-TextWidth(ln$)>>1, txt_y+i2, ln$)
        Else
        DrawText(txt_x+max>>1-TextWidth(ln$)>>1, txt_y+i2, ln$, f_col, b_col) : EndIf
      Else ; Left
        If stretch_x
          spread_x(txt_x, txt_y+i2, ln$)
        Else
          DrawText(txt_x, txt_y+i2, ln$, f_col, b_col)
        EndIf
      EndIf
    EndMacro
    
    If flag=3 And mode=1
      rtl(txt1$)
    EndIf
    If flag=3 ; Vertical
      txt1$=ReplaceString(txt1$, #LF$, " ")
      If mode
        txt1$=ReverseString(txt1$)
      EndIf
      For result=1 To i7
        chr$=Mid(txt1$, result, 1)
        first_char_width
        DrawText(i5>>1+txt_x-TextWidth(chr$)>>1, txt_y+i3, chr$, f_col, b_col)
        i3+i1
      Next
      ProcedureReturn txt_y+i3
    Else ; Horizontal
      If i2
        i2=0 : ln$=""
        For result=1 To i7
          chr$=Mid(txt1$, result, 1)
          If chr$=#LF$
            i2+i1
            txt_out
            ln$=""
          Else
            ln$+chr$
          EndIf
        Next
        i2+i1
        txt_out
        ProcedureReturn txt_y+i2+i1
      Else ; One line
        If mode=1
          txt$=ReverseString(txt$)
        ElseIf mode=2
          rtl(txt$)
        EndIf
        If stretch_x
          spread_x(txt_x, txt_y, txt$)
        Else
          DrawText(txt_x, txt_y, txt$, f_col, b_col)
        EndIf
      EndIf
    EndIf
    
    If i6
      ProcedureReturn txt_x+i6
    Else
      ProcedureReturn txt_x+TextWidth(txt$)
    EndIf
  EndProcedure
  
  Procedure DrawTextCreateImage_BF(txt$, f_col=#White, b_col=#Black, flag=0, mode=0, font_ID=0, stretch_x=0, stretch_y=0, padding=0)
    If txt$="" : ProcedureReturn -26 : EndIf
    Static little_temporary_image_ID
    If Not little_temporary_image_ID
      little_temporary_image_ID=CreateImage(#PB_Any, 16, 16)
    EndIf
    
    If Not StartDrawing(ImageOutput(little_temporary_image_ID)) ; Get the needed width and height for the output
      ProcedureReturn -4
    EndIf
    
    If IsFont(font_ID) : DrawingFont(FontID(font_ID)) : EndIf
    
    If padding=-1
      padding=TextWidth(Space(3))
    EndIf
    
    If max_1>0
      Protected output_width=max_1 ; Get the needed width
    Else
      If mode<>4
        output_width=DrawText_BF(0, 0, txt$, 0, 0, flag, 3, stretch_x, stretch_y)-stretch_x ; Get the needed width
      EndIf
      If mode=3
        StopDrawing()
        ProcedureReturn output_width+padding
      EndIf
    EndIf
    Protected output_height=DrawText_BF(0, 0, txt$, 0, 0, flag, 4, stretch_x, stretch_y)-stretch_y ; Get the needed height
    StopDrawing()
    
    If mode=4
      ProcedureReturn output_height+padding
    EndIf
    
    Protected image_ID=CreateImage(#PB_Any, output_width+padding<<1, output_height+padding<<1)
    
    If Not image_ID : ProcedureReturn -6 : EndIf
    
    If Not StartDrawing(ImageOutput(image_ID)) ; Draw the text in the image
      FreeImage(image_ID)
      ProcedureReturn -4
    EndIf
    
    Box(0, 0, output_width+padding<<1, output_height+padding<<1, b_col)
    If IsFont(font_ID) : DrawingFont(FontID(font_ID)) : EndIf 
    
    Protected old_activate=activate
    activate=0
    from_image=1
    image_color=b_col
    DrawText_BF(padding, padding, txt$, f_col, 0, flag, mode, stretch_x, stretch_y)
    activate=old_activate
    from_image=0
    StopDrawing()
    
    ProcedureReturn image_ID
  EndProcedure
  
  Procedure PresetLineWidth_BF(max_1_)
    max_1=max_1_
  EndProcedure
  
  Procedure DrawText_BF_AutoBox(padding_=-1,
                                box_color_=0, 
                                offset_x_=0,
                                offset_y_=0,
                                offset_xx_=0,
                                offset_yy_=0)
    padding=padding_
    box_color=box_color_
    offset_x=offset_x_
    offset_y=offset_y_
    offset_xx=offset_xx_
    offset_yy=offset_yy_
  EndProcedure
  
  Procedure DrawText_BF_Box(activate_=1, box_color_1_=0, offset_x_1_=0, offset_y_1_=0, width_=0, height_=0)
    activate=activate_
    box_color_1=box_color_1_
    offset_x_1=offset_x_1_
    offset_y_1=offset_y_1_
    width=width_
    height=height_
  EndProcedure
  
  Procedure Calculate_fitted_Font_BF(text$,
                                     width_rectangle,
                                     height_rectangle,
                                     Array font(1),
                                     vertical=0,
                                     padding_x=0,
                                     padding_y=0,
                                     stretch_x=0,
                                     stretch_y=0,
                                     resize_factor.f=1)
    If text$="" : ProcedureReturn 0 : EndIf
    Protected max_needed_font_size=ArraySize(font())
    If vertical>0 : Protected flag=3 : EndIf
    While max_needed_font_size>1
      Protected text_width=DrawTextCreateImage_BF(text$, 0, 0, flag, 3, font(max_needed_font_size), stretch_x, 0, 0)
      Protected text_height=DrawTextCreateImage_BF(text$, 0, 0, flag, 4, font(max_needed_font_size), 0, stretch_y, 0)
      If text_width=<width_rectangle+-padding_x And text_height=<height_rectangle+-padding_y : Break : EndIf
      max_needed_font_size-1
    Wend
    
    If text_width+padding_x>>1>width_rectangle
      fitted_font_padding_x=padding_x-((text_width+padding_x>>1)-width_rectangle)
    Else
      fitted_font_padding_x=padding_x
    EndIf
    If text_height+padding_y>>1>height_rectangle
      fitted_font_padding_y=padding_y-((text_height+padding_y>>1)-height_rectangle)
    Else
      fitted_font_padding_y=padding_y
    EndIf
    
    If resize_factor
      max_needed_font_size/resize_factor
    EndIf
    If max_needed_font_size<1 : max_needed_font_size=1 : EndIf
    If max_needed_font_size>ArraySize(font())-1 : max_needed_font_size=ArraySize(font())-1 : EndIf
    ProcedureReturn max_needed_font_size
  EndProcedure
  
  Procedure Get_Fitted_Font_Padding_X_BF()
    ProcedureReturn fitted_font_padding_x
  EndProcedure
  
  Procedure Get_Fitted_Font_Padding_Y_BF()
    ProcedureReturn fitted_font_padding_y
  EndProcedure
  
  Procedure GetTextWidth_BF(text$,
                            font_ID,
                            vertical=0,
                            stretch_x=0,
                            padding_x=0)
    
    If vertical>0 : Protected flag=3 : EndIf
    ProcedureReturn DrawTextCreateImage_BF(text$, 0, 0, flag, 3, font_ID, stretch_x, 0, padding_x)
  EndProcedure
  
  Procedure GetTextHeight_BF(text$,
                             font_ID,
                             vertical=0,
                             stretch_y=0,
                             padding_y=0)
    
    If vertical>0 : Protected flag=3 : EndIf
    ProcedureReturn DrawTextCreateImage_BF(text$, 0, 0, flag, 4, font_ID, 0, stretch_y, padding_y)
  EndProcedure
  
  Procedure SetCanvasCustomText_BF(canvas_ID,
                                   Array Font(1),
                                   output_x=0,
                                   output_y=0,
                                   canvas_width=0,
                                   canvas_height=0,
                                   canvas_text$=" ",
                                   text_color=#Black,
                                   background_color=#White,
                                   flag=1,
                                   mode=0,
                                   padding_x=0,
                                   padding_y=0,
                                   text_stretching_x=0,
                                   text_stretching_y=0,
                                   resize_factor.f=1,
                                   get_all_window_events=1)
    
    If Not IsGadget(canvas_ID) : ProcedureReturn -1 : EndIf
    
    If output_x=-1 : output_x=GadgetX(canvas_ID) : EndIf
    If output_y=-1 : output_y=GadgetY(canvas_ID) : EndIf
    If canvas_width<0 : canvas_width=GadgetWidth(canvas_ID) : EndIf
    If canvas_height<0 : canvas_height=GadgetHeight(canvas_ID) : EndIf
    
    If canvas_text$="" : canvas_text$=" " : EndIf
    
    If flag=3 : Protected vertical=1 : EndIf
    
    Protected calculated_font_size=Calculate_fitted_Font_BF(canvas_text$,
                                                            canvas_width,
                                                            canvas_height,
                                                            Font(),
                                                            vertical,
                                                            padding_x, 
                                                            padding_y,
                                                            text_stretching_x,
                                                            text_stretching_y,
                                                            resize_factor.f)
    
    ResizeGadget(canvas_ID, output_x, output_y, canvas_width, canvas_height)
    
    Protected text_width=GetTextWidth_BF(canvas_text$, Font(calculated_font_size), vertical, text_stretching_x)
    Protected text_height=GetTextHeight_BF(canvas_text$, Font(calculated_font_size), vertical, text_stretching_y)
    
    If Not StartDrawing(CanvasOutput(canvas_ID)) ; Use DrawText_BF for text output on canvas
      ProcedureReturn -5
    EndIf
    Box(0, 0, canvas_width, canvas_height, background_color)
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(Font(calculated_font_size)))
    
    Protected output_x_=(canvas_width/2-text_width/2)
    Protected output_y_=canvas_height/2-text_height/2
    
    DrawText_BF(output_x_,
                output_y_,
                canvas_text$,
                text_color,
                background_color,
                flag,
                mode,
                text_stretching_x,
                text_stretching_y)
    
    StopDrawing()
    If get_all_window_events : While WindowEvent() : Wend : EndIf
    ProcedureReturn calculated_font_size
  EndProcedure
  
  Procedure SetGadgetText_BF(gadget_ID,
                             Array Font(1),
                             output_x,
                             output_y,
                             gadget_width,
                             gadget_height,
                             gadget_text$=" ",
                             padding_x=0,
                             padding_y=0,
                             resize_factor.f=1,
                             get_all_window_events=1)
    
    If Not IsGadget(gadget_ID) : ProcedureReturn -25 : EndIf
    
    If output_x=-1 : output_x=GadgetX(gadget_ID) : EndIf
    If output_y=-1 : output_y=GadgetY(gadget_ID) : EndIf
    If gadget_width<0 : gadget_width=GadgetWidth(gadget_ID) : EndIf
    If gadget_height<0 : gadget_height=GadgetHeight(gadget_ID) : EndIf
    
    If gadget_text$="" : gadget_text$=" " : EndIf
    
    Protected calculated_font_size=Calculate_fitted_Font_BF(gadget_text$,
                                                            gadget_width,
                                                            gadget_height,
                                                            Font(),
                                                            0,
                                                            padding_x, 
                                                            padding_y,
                                                            0,
                                                            0,
                                                            resize_factor.f)
    
    ResizeGadget(gadget_ID, output_x, output_y, gadget_width, gadget_height)
    SetGadgetFont(gadget_ID, FontID(Font(calculated_font_size)))
    SetGadgetText(gadget_ID, gadget_text$)
    If get_all_window_events : While WindowEvent() : Wend : EndIf
    ProcedureReturn calculated_font_size
  EndProcedure
  
  Procedure GetResolution_DPI_X_BF()
    Static little_temporary_image_ID
    If Not little_temporary_image_ID
      little_temporary_image_ID=CreateImage(#PB_Any, 16, 16)
    EndIf
    If little_temporary_image_ID
      If StartVectorDrawing(ImageVectorOutput(little_temporary_image_ID))
        Protected dpi=VectorResolutionX()
        StopDrawing()
      EndIf
      ProcedureReturn dpi
    Else
      ProcedureReturn -6
    EndIf
  EndProcedure
  
  Procedure GetResolution_DPI_Y_BF()
    Static little_temporary_image_ID
    If Not little_temporary_image_ID
      little_temporary_image_ID=CreateImage(#PB_Any, 16, 16)
    EndIf 
    If little_temporary_image_ID
      If StartVectorDrawing(ImageVectorOutput(little_temporary_image_ID))
        Protected dpi=VectorResolutionY()
        StopDrawing()
      EndIf
      ProcedureReturn dpi
    Else
      ProcedureReturn -6
    EndIf
  EndProcedure
  
  Procedure GetOS_PPI_BF()
    CompilerSelect #PB_Compiler_OS    
      CompilerCase #PB_OS_Windows : ProcedureReturn #PPI_Windows    
      CompilerCase #PB_OS_MacOS   : ProcedureReturn #PPI_MacOS 
      CompilerCase #PB_OS_Linux   : ProcedureReturn #PPI_Linux 
    CompilerEndSelect
  EndProcedure
  
  Procedure.f DPI_ResizeFactor_BF()
    If deactivate_dpi_resize_factor
      ProcedureReturn 1
    Else
      ProcedureReturn GetResolution_DPI_X_BF()/GetOS_PPI_BF()
    EndIf
  EndProcedure
  
  Procedure Deactivate_DPI_ResizeFactor_BF(deactivate_dpi_resize_factor_)
    If deactivate_dpi_resize_factor_<>0 : deactivate_dpi_resize_factor_=1 : EndIf
    deactivate_dpi_resize_factor=deactivate_dpi_resize_factor_
  EndProcedure
  
EndModule

; ************** Dynamic Window / GUI creating module ***************
;********************************************************************
; You can use the module DrawText_BF above or the GFX_Wizzard_BF for running this code 
CompilerIf #PB_Compiler_IsMainFile 
  
  ; XIncludeFile("./GFX_Wizzard_BF.pbi")
  
  DeclareModule CreateGUI_1
    EnableExplicit
    ; UseModule GFX_Wizzard_BF
    UseModule DrawText_BF
    Declare CreateGUI_1(window_x, window_y, window_width_output, window_height_output)
  EndDeclareModule
  
  Module CreateGUI_1
    
    Global window_width_developing=920 ; Developing size
    Global window_height_developing=400
    
    Global window_min_width=240 ; Minimum window size
    Global window_min_height=180
    
    Global window_x, window_y, window_width_output, window_height_output
    Global window_flags=#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_Invisible 
    Global window_ID=OpenWindow(#PB_Any, 0, 0, window_width_developing, window_height_developing,
                                "Dynamic Window and GUI creating", Window_flags)
    WindowBounds(window_ID, window_min_width, window_min_height, #PB_Ignore, #PB_Ignore)
    Global get_all_window_events ; Auxiliary variable for callback procedure WindowEvent handling
    
    ; Create a font array
    ; Mostly 30pt > 40pt is enough - smaller is faster
    Global max_needed_font_size=72
    Global needed_font_size
    Global Dim Font_Georgia(max_needed_font_size)
    For needed_font_size=1 To max_needed_font_size ; Get the fonts
      Font_Georgia(needed_font_size)=LoadFont(#PB_Any, "Georgia", needed_font_size, #PB_Font_Bold)
    Next needed_font_size
    
    ; Create a font array
    ; Mostly 30pt > 40pt is enough - smaller is faster
    Global max_needed_font_size=72
    Global needed_font_size
    Global Dim Font_Arial(max_needed_font_size) ; For using in a callback procedure define as global 
    For needed_font_size=1 To max_needed_font_size ; Get the fonts
      Font_Arial(needed_font_size)=LoadFont(#PB_Any, "Arial", needed_font_size, #PB_Font_Bold)
    Next needed_font_size
    
    ; Create ButtonGadget 1 for using ==========================================
    Global ButtonGadget_1_x=310
    Global ButtonGadget_1_y=20
    Global ButtonGadget_1_width=300
    Global ButtonGadget_1_height=90
    Global ButtonGadget_1_text$="Resizable Window Demo"+#LF$+"This is a ButtonGadget"+#LF$+" - Resize the Window -"
    Global ButtonGadget_1_ID=ButtonGadget(#PB_Any, 0, 0, 0, 0, "", #PB_Button_MultiLine)
    
    ; Create ButtonGadget 2 for using ==========================================
    Global ButtonGadget_2_x=20
    Global ButtonGadget_2_y=135
    Global ButtonGadget_2_width=450
    Global ButtonGadget_2_height=240
    Global ButtonGadget_2_text$="Create Gadgets with automatically fitted Text"+#LF$+#LF$+
                                "This is a Stand-Alone Fork from GFX_Wizzard_BF"+#LF$+#LF$+
                                "For simple solving many Gadget Problems"+#LF$+#LF$+
                                "Try any Text"+#LF$+
                                "Fontsizes up to 72pt are supported here"+#LF$+#LF$+
                                "Works with any Rectangles"+#LF$+
                                "and Gadgets with Font changing Feature"
    
    Global ButtonGadget_2_ID=ButtonGadget(#PB_Any, 0, 0, 0, 0, "", #PB_Button_MultiLine)
    
    ; Create CanvasGadget 1 for using ==========================================
    Global CanvasGadget_1_x=500
    Global CanvasGadget_1_y=135
    Global CanvasGadget_1_width=400
    Global CanvasGadget_1_height=240
    Global text_color=#Blue
    Global background_color=#Yellow
    Global headletter_mode_text_stretching_x=0
    Global headletter_mode_text_stretching_y=0
    Global flag=1 ; Text center=1 - Text right=2 - Text vertical=3
    Global mode=0 ; Revers text mode=1 - RTL text mode=2
    
    Global CanvasGadget_1_text$=" The colored Gadget is a CanvasGadget"+#LF$+#LF$+
                                "Try any text"+#LF$+
                                "Without Subsystem Problems"+#LF$+#LF$+
                                "All OS"+#LF$+" - Click me -"+#LF$+#LF$+
                                "Supports"+#LF$+
                                "Headline, Multiline"+#LF$+
                                "Vertical, Center, Right, Left, RTL"
    
    Global CanvasGadget_ID=CanvasGadget(#PB_Any, 0, 0, 0, 0, #PB_Canvas_Border)
    
    ; Create HyperlinkGadget 1 for using =======================================
    Global HyperlinkGadget_1_x=30
    Global HyperlinkGadget_1_y=90
    Global HyperlinkGadget_1_width=260
    Global HyperlinkGadget_1_height=25
    Global HyperlinkGadget_1_text$="This is a HyperlinkGadget"
    
    Global HyperlinkGadget_1_ID=HyperLinkGadget(#PB_Any, 0, 0, 0, 0, "", $FF0000, #PB_HyperLink_Underline)
    
    ; Create TextGadget 1 for using ============================================
    Global TextGadget_1_x=650
    Global TextGadget_1_y=95
    Global TextGadget_1_width=225
    Global TextGadget_1_height=30
    Global TextGadget_1_text$="This is a TextGadget"
    
    Global TextGadget_1_ID=TextGadget(#PB_Any, 0, 0, 0, 0, "")
    
    ; Create SpinGadget 1 for using ============================================
    Global SpinGadget_1_x=650
    Global SpinGadget_1_y=20
    Global SpinGadget_1_width=225
    Global SpinGadget_1_height=25
    Global SpinGadget_1_Text$="This is a SpinGadget"
    
    Global SpinGadget_1_ID=SpinGadget(#PB_Any, 0, 0, 0, 0, 0, 100)
    
    ; Create StringGadget 1 for using ==========================================
    Global StringGadget_1_x=30
    Global StringGadget_1_y=20
    Global StringGadget_1_width=225
    Global StringGadget_1_height=25
    Global StringGadget_1_Text$="This is a StringGadget"
    Global StringGadget_2_Text$="With enhanced text fitting"
    
    Global StringGadget_1_ID=StringGadget(#PB_Any, 0, 0, 0, 0, StringGadget_1_Text$)
    
    ; ==========================================================================
    
    ; ############## Resize procedure for callback ##############################
    Procedure WindowResizing_BindEvent_CreateGUI_1()
      
      ; ============= Init the scaling variables ==============
      Protected set_x.f=100/window_width_developing*WindowWidth(window_ID)/100
      Protected set_y.f=100/window_height_developing*WindowHeight(window_ID)/100
      
      ; Resize ButtonGadget 1 ===================================================
      SetGadgetText_BF(ButtonGadget_1_ID,
                       Font_Arial(),
                       ButtonGadget_1_x*set_x,
                       ButtonGadget_1_y*set_y,
                       ButtonGadget_1_width*set_x,
                       ButtonGadget_1_height*set_y,
                       ButtonGadget_1_text$,
                       30, ; Padding x
                       15, ; Padding y
                       1,  ; resize_factor.f
                       get_all_window_events)
      
      ; Resize ButtonGadget 2 ===================================================
      SetGadgetText_BF(ButtonGadget_2_ID,
                       Font_Arial(),
                       ButtonGadget_2_x*set_x,
                       ButtonGadget_2_y*set_y,
                       ButtonGadget_2_width*set_x,
                       ButtonGadget_2_height*set_y,
                       ButtonGadget_2_text$,
                       15, ; Padding x
                       15, ; Padding y
                       1,  ; resize_factor.f
                       get_all_window_events)
      
      ; Resize CanvasGadget 1 ===================================================
      SetCanvasCustomText_BF(CanvasGadget_ID,
                             Font_Georgia(),
                             CanvasGadget_1_x*set_x,
                             CanvasGadget_1_y*set_y,
                             CanvasGadget_1_width*set_x,
                             CanvasGadget_1_height*set_y,
                             CanvasGadget_1_text$,
                             text_color,
                             background_color,
                             flag,
                             mode,
                             25, ; Padding x, 
                             15, ; Padding y,
                             0,  ; Headletter mode - text stretching x
                             0,  ; Headletter_mode - text stretching y
                             1,  ; resize_factor.f
                             get_all_window_events)
      
      ; Resize HyperlinkGadget 1 ================================================
      SetGadgetText_BF(HyperlinkGadget_1_ID,
                       Font_Arial(),
                       HyperlinkGadget_1_x*set_x,
                       HyperlinkGadget_1_y*set_y,
                       HyperlinkGadget_1_width*set_x,
                       HyperlinkGadget_1_height*set_y,
                       HyperlinkGadget_1_text$,
                       0,   ; Padding x
                       5,   ; Padding y
                       1.2, ; resize_factor.f
                       get_all_window_events)
      
      ; Resize TextGadget 1 =====================================================
      SetGadgetText_BF(TextGadget_1_ID,
                       Font_Arial(),
                       TextGadget_1_x*set_x,
                       TextGadget_1_y*set_y,
                       TextGadget_1_width*set_x,
                       TextGadget_1_height*set_y,
                       TextGadget_1_text$,
                       0,   ; Padding x
                       10,  ; Padding y
                       1.2, ; resize_factor.f
                       get_all_window_events)
      
      ; Resize SpinGadget 1 =====================================================
      SetGadgetText_BF(SpinGadget_1_ID,
                       Font_Arial(),
                       SpinGadget_1_x*set_x,
                       SpinGadget_1_y*set_y,
                       SpinGadget_1_width*set_x,
                       SpinGadget_1_height*set_y,
                       SpinGadget_1_Text$,
                       20,  ; Padding x
                       5,   ; Padding y
                       1.2, ; resize_factor.f
                       get_all_window_events)
      
      ; Resize StringGadget 1 ===================================================
      SetGadgetText_BF(StringGadget_1_ID,
                       Font_Arial(),
                       StringGadget_1_x*set_x,
                       StringGadget_1_y*set_y,
                       StringGadget_1_width*set_x,
                       StringGadget_1_height*set_y,
                       StringGadget_1_Text$,
                       5,   ; Padding x
                       5,   ; Padding y
                       1.2, ; resize_factor.f
                       get_all_window_events) 
      
      ; =========================================================================
      
      ; The Set...BF functions returns the determined font size so that it can easily be inherit on to other gadgets
      ; This is also possible on gadgets of other sizes - Sample : alterable_size=calculated_font_size/my_resize_factor
      
      ; As you can see above, the Set...BF functions can not only set the text, but also reposition and resize the gadgets
      
      ; You can also check the actual padding on demand - Call this functions after a monitored Set...BF function  
      ; Debug "canvas Custom Gadget - Padding X : "+Str(Get_Fitted_Font_Padding_X_BF())
      ; Debug "canvas Custom Gadget - Padding Y: "+Str(Get_Fitted_Font_Padding_Y_BF())
      
    EndProcedure
    
    ; ===========================================================================
    
    Procedure CreateGUI_1(window_x, window_y, window_width_output, window_height_output)
      
      ; ================= Init the resize procedure callback ======================
      BindEvent(#PB_Event_SizeWindow, @WindowResizing_BindEvent_CreateGUI_1())
      
      ; =============== Calculate the output position and size =================
      window_width_output*DPI_ResizeFactor_BF() : window_height_output*DPI_ResizeFactor_BF()
      If window_x=-1 : window_x=WindowX(window_ID)-(window_width_output-WindowWidth(window_ID))/2
        Else : window_x*DPI_ResizeFactor_BF() : EndIf
      If window_y=-1 : window_y=WindowY(window_ID)-(window_height_output-WindowHeight(window_ID))/2
        Else : window_y*DPI_ResizeFactor_BF() : EndIf
      ResizeWindow(window_ID, window_x, window_y, window_width_output, window_height_output)
      
      ; ====== Init all gadgets - Call simple the resize callback procedure =======
      Macro Refresh_all_Gadgets ; Refresh the gadgets
        get_all_window_events=1 : WindowResizing_BindEvent_CreateGUI_1() : get_all_window_events=0 
        ; No WindowEvent may be called during a callback
        ; However, if the callback procedure is only called to refresh or the first initializing the gadgets,
        ; is a WindowEvent after updating each gadget recommended as flicker protection
        ; and must be triggered manually with get_all_window_events=1
      EndMacro
      
      Refresh_all_Gadgets
      
      ; ============================= Show the result =============================
      HideWindow(window_ID, 0)
      
      Repeat
        Define win_event=WaitWindowEvent()
        
        Select EventGadget()
            
          Case ButtonGadget_1_ID, ButtonGadget_2_ID, HyperlinkGadget_1_ID ; Gadget events
            If Not EventType()
              Swap text_color, background_color
              Define temp_text$=CanvasGadget_1_text$ : CanvasGadget_1_text$=ButtonGadget_2_Text$ : ButtonGadget_2_text$=temp_text$ 
              Define temp_text$=StringGadget_1_text$ : StringGadget_1_text$=StringGadget_2_Text$ : StringGadget_2_text$=temp_text$
              Refresh_all_Gadgets ; Refresh all gadgets
            EndIf
          Case CanvasGadget_ID ; CanvasGadget 1 event
            If EventType()=#PB_EventType_LeftButtonDown
              Swap text_color, background_color
              Refresh_all_Gadgets ; Refresh all gadgets
            EndIf
        EndSelect
        
      Until win_event=#PB_Event_CloseWindow
      
    EndProcedure
    
  EndModule
  UseModule CreateGUI_1
  UseModule DrawText_BF
  ; UseModule GFX_Wizzard_BF
  
  ; ========================== Run the module, ====================================
  ; Debug DPI_ResizeFactor_BF() ; Get the actual DPI resize factor  
  ; Deactivate_DPI_ResizeFactor_BF(1) ; This function deactivate the DPI aware feature 
  CreateGUI_1(-1, -1, 900, 500) ; x, y, width, height - x=-1 center the output x - y=-1 center the output y
  
CompilerEndIf
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Enhanced gadgets with automatic font/text fitting

Post by Kwai chang caine »

Work great here :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Enhanced gadgets with automatic font/text fitting

Post by Andre »

You're welcome, Kwai :D

I've just updated the code in the first post:
walbus wrote: New added features:
SetCanvasCustomText_BF
SetGadgetText_BF

These two features provide an easy way to add customized and optimized text to gadgets and canvas gadgets.
The possibilities go far beyond the usual.

These two special features also support everything necessary to easily create on demand resizable gadgets.
A manual font size calculation is completely eliminated.

The function returns the specified font size so that it can be easily inherited to other gadgets.
This is also possible on gadgets of other sizes - sample: alterable_size=calculated_font_size/my_resize_factor
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
m4u
New User
New User
Posts: 5
Joined: Mon Dec 31, 2018 8:47 am

Re: Enhanced gadgets with automatic font/text fitting

Post by m4u »

Three notes

1
; This code is a part from GFX_Wizzard_BF,
; and use a simplificated GFX_Wizzard_BF compatible DrawText_BF Stand-Alone version
; Using of the GFX-Wizzard_BF is free, but the distribution is reserved for me
; Exceptions require my written permission
Does the same restriction stands for using only this standalone module, DrawText_BF ?

2
; Create a font array
; Mostly 30pt > 40pt is enough - smaller is faster
Define max_needed_font_size=72
Define needed_font_size
72 is really slowing things down. 48, and even 24, is more than enough en keeps things going fluently.

3
Can I use PureVision to create a compatible form with this module ?

Thank you.
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Enhanced gadgets with automatic font/text fitting

Post by Andre »

@m4u: Here are the answers I got according to your questions/notes...
walbus wrote: To 1:
You can use the module DrawText_BF in your software and also make it available as source code with your software.
It's just to prevent the source code from being offered for download by other people. As a result, outdated versions come into circulation, which should be prevented.

To 2:
Font sizes of 72 are in fact almost never necessary, perhaps only for headlines.
In the next few days there will be an update, which accelerates the font calculation by about 50%

To 3 :
I do not use PureVision, but it should be easy to add the necessary extensions.
I do not know if PureVision will support this directly, but I would not mind.
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Enhanced gadgets with automatic font/text fitting

Post by Andre »

Code in the first topic was updated, with several optimizations (Linux-specific, but the general module usage too).
Now it can be called "final" :D

Probably further changes/additions will be part of the GFX_Wizzard_BF package.

Edit: removed following off-topic posts...
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Post Reply