Android Code Snippet FontAwesome To Bitmap

Unlike an older "TextToBitmap" sub that you can find in the forum, this code vertically centers the icon.
It can also be used in B4J and B4i (only need to change the font line).
B4X:
Sub Activity_Create(FirstTime As Boolean)
  'usage example
   Activity.AddMenuItem3("Android", "Test", FontAwesomeToBitmap(Chr(0xF17B), 28), True)
   Activity.AddMenuItem3("Eye", "Test", FontAwesomeToBitmap(Chr(0xF06E), 28), True)
End Sub

Sub FontAwesomeToBitmap (Text As String, FontSize As Float) As B4XBitmap
   Dim xui As XUI
   Dim p As Panel = xui.CreatePanel("")
   p.SetLayoutAnimated(0, 0, 0, 32dip, 32dip)
   Dim cvs1 As B4XCanvas
   cvs1.Initialize(p)
   Dim fnt As B4XFont = xui.CreateFontAwesome(FontSize)
   Dim r As B4XRect = cvs1.MeasureText(Text, fnt)
   Dim BaseLine As Int = cvs1.TargetRect.CenterY - r.Height / 2 - r.Top
   cvs1.DrawText(Text, cvs1.TargetRect.CenterX, BaseLine, fnt, xui.Color_White, "CENTER")
   Dim b As B4XBitmap = cvs1.CreateBitmap
   cvs1.Release
   Return b
End Sub
Depends on: XUI

SS-2018-07-16_15.00.12.png
 
Last edited:
D

Deleted member 103

Guest
I think that's better. ;)

B4X:
Public Sub FontToBitmap (text As String, IsMaterialIcons As Boolean, FontSize As Float, color As Int) As B4XBitmap
    Dim xui As XUI
    Dim p As Panel = xui.CreatePanel("")
    p.SetLayoutAnimated(0, 0, 0, 32dip, 32dip)
    Dim cvs1 As B4XCanvas
    cvs1.Initialize(p)
    Dim t As Typeface
    If IsMaterialIcons Then t = Typeface.MATERIALICONS Else t = Typeface.FONTAWESOME
    Dim fnt As B4XFont = xui.CreateFont(t, FontSize)
    Dim r As B4XRect = cvs1.MeasureText(text, fnt)
    Dim BaseLine As Int = cvs1.TargetRect.CenterY - r.Height / 2 - r.Top
    cvs1.DrawText(text, cvs1.TargetRect.CenterX, BaseLine, fnt, color, "CENTER")
    Dim b As B4XBitmap = cvs1.CreateBitmap
    cvs1.Release
    Return b
End Sub
 

b4x-de

Active Member
Licensed User
Longtime User
Hi,

thank you for this! For easy use in BJ4 you might want to replace the following lines:

B4X:
Dim t As Typeface
If IsMaterialIcons Then t = Typeface.MATERIALICONS Else t = Typeface.FONTAWESOME
Dim fnt As B4XFont = xui.CreateFont(t, FontSize)

with:

B4X:
Dim fnt As B4XFont
If IsMaterialIcons Then
    fnt = xui.CreateMaterialIcons(FontSize)
Else
    fnt = xui.CreateFontAwesome(FontSize)
End If

Thomas
 
Hi,
Thanks for All
For more Sample

B4X:
Public Sub FontToBitmap (Text As String, FontSize As Float, color As Int) As B4XBitmap
    Dim xui As XUI
    Dim p As Panel = xui.CreatePanel("")
    p.SetLayoutAnimated(0, 0, 0, 32dip, 32dip)
    Dim cvs1 As B4XCanvas
    cvs1.Initialize(p)
    Dim fnt As B4XFont
    If  Asc(Text.CharAt(0))<61440  Then
        fnt = xui.CreateMaterialIcons(FontSize)
    Else
        fnt = xui.CreateFontAwesome(FontSize)
    End If
    Dim r As B4XRect = cvs1.MeasureText(Text, fnt)
    Dim BaseLine As Int = cvs1.TargetRect.CenterY - r.Height / 2 - r.Top
    cvs1.DrawText(Text, cvs1.TargetRect.CenterX, BaseLine, fnt, color, "CENTER")
    Dim b As B4XBitmap = cvs1.CreateBitmap
    cvs1.Release
    Return b
End Sub
 
Top