Platforms to show: All Mac Windows Linux Cross-Platform

/GraphicsMagick/GraphicsMagick/Console Text Drawing/Build Letter Database


Required plugins for this example: MBS Images Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /GraphicsMagick/GraphicsMagick/Console Text Drawing/Build Letter Database

This example is the version from Thu, 6th Apr 2016.

Project "Build Letter Database.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Const stBold = 1
Const stItalic = 4
Const stUnderline = 2
EventHandler Sub Open() buildCodes buf = New Picture(100,100,32) dim f as FolderItem = SpecialFolder.Desktop.Child("test.db") dim d as new REALSQLDatabase d.DatabaseFile = f if d.CreateDatabaseFile then d.SQLExecute "create table letter (font varchar, size integer, code integer, style integer, data blob)" if d.Error then MsgBox d.ErrorMessage quit end if db = d AddFont "Monaco", 12, 0 AddFont "Monaco", 18, 0 AddFont "Monaco", 24, 0 AddFont "Times", 12, 0 AddFont "Times", 18, 0 AddFont "Times", 24, 0 AddFont "Monaco", 12, stBold AddFont "Monaco", 18, stBold AddFont "Monaco", 24, stBold AddFont "Times", 12, stBold AddFont "Times", 18, stBold AddFont "Times", 24, stBold AddFont "Monaco", 12, stUnderline AddFont "Monaco", 18, stUnderline AddFont "Monaco", 24, stUnderline AddFont "Times", 12, stUnderline AddFont "Times", 18, stUnderline AddFont "Times", 24, stUnderline AddFont "Monaco", 12, stItalic AddFont "Monaco", 18, stItalic AddFont "Monaco", 24, stItalic AddFont "Times", 12, stItalic AddFont "Times", 18, stItalic AddFont "Times", 24, stItalic db.Commit end if End EventHandler
Private Sub AddCode(name as string, size as integer, code as integer, Style as integer) dim g as Graphics = buf.Graphics dim s as string = encodings.utf8.chr(code) SetStyle g, style g.TextFont = name g.TextSize = size dim w as integer = g.StringWidth(s) dim h as integer = G.StringHeight(s,100) if w<1 then Return if h<1 then Return dim p as Picture = New Picture(w,h,32) g = p.Graphics SetStyle g, style g.TextSize = size g.TextFont = name g.DrawString s, 0, size dim data as string = PictureToPNGStringMBS(p,0) dim r as new DatabaseRecord r.Column("font")=name r.IntegerColumn("size")=size r.IntegerColumn("code")=code r.IntegerColumn("style")=style r.BlobColumn("data")=data db.InsertRecord("letter",r) End Sub
Private Sub AddFont(name as string, size as integer, Style as integer) for each code as integer in codes AddCode name, size, code, Style next End Sub
Private Sub BuildCodes() // which letters do we need? // Let's take MacRoman encoding and pick all characters there. for i as integer = 32 to 255 dim s as string = encodings.MacRoman.Chr(i) s = ConvertEncoding(s, Encodings.UTF8) codes.Append asc(s) next End Sub
Private Sub SetStyle(g as Graphics, Style as integer) if BitwiseAnd(style, stBold)<>0 then g.Bold = true else g.Bold = False end if if BitwiseAnd(style, stItalic)<>0 then g.Italic = true else g.Italic = false end if if BitwiseAnd(style, stUnderline)<>0 then g.Underline = true else g.Underline = false end if End Sub
Property Private Codes() As Integer
Property Private buf As Picture
Property Private db As REALSQLDatabase
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project

See also:

The items on this page are in the following plugins: MBS GraphicsMagick Plugin.


The biggest plugin in space...