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.