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
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