Platforms to show: All Mac Windows Linux Cross-Platform
/GraphicsMagick/GraphicsMagick/Console Text Drawing/Display 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/Display Letter Database
This example is the version from Thu, 16th Nov 2016.
Project "Display 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
Control PopupFont Inherits PopupMenu
ControlInstance PopupFont Inherits PopupMenu
EventHandler Sub Change()
if db<>Nil then
update
end if
End EventHandler
End Control
Control PopupSize Inherits PopupMenu
ControlInstance PopupSize Inherits PopupMenu
EventHandler Sub Change()
if db<>Nil then
update
end if
End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control PopupStyle Inherits PopupMenu
ControlInstance PopupStyle Inherits PopupMenu
EventHandler Sub Change()
if db<>Nil then
update
end if
End EventHandler
End Control
EventHandler Sub Open()
dim f as FolderItem = SpecialFolder.Desktop.Child("test.db")
dim d as new REALSQLDatabase
d.DatabaseFile = f
if d.Connect then
dim r as RecordSet = d.SQLSelect("select DISTINCT font from letter")
if r<>Nil then
while not r.EOF
dim s as string = r.IdxField(1).StringValue
PopupFont.AddRow s
r.MoveNext
wend
end if
r = d.SQLSelect("select DISTINCT size from letter")
if r<>Nil then
while not r.EOF
dim s as string = r.IdxField(1).StringValue
PopupSize.AddRow s
r.MoveNext
wend
end if
r = d.SQLSelect("select DISTINCT style from letter")
if r<>Nil then
while not r.EOF
dim styles(-1) as string
dim n as integer = r.IdxField(1).IntegerValue
if n = 0 then
styles.Append "normal"
end if
if BitwiseAnd(n,stBold)<>0 then
styles.Append "bold"
end if
if BitwiseAnd(n,stItalic)<>0 then
styles.Append "italic"
end if
if BitwiseAnd(n,stUnderline)<>0 then
styles.Append "underline"
end if
dim s as string = str(n)+": "+Join(styles,", ")
PopupStyle.AddRow s
r.MoveNext
wend
end if
if PopupFont.ListCount>0 then
PopupFont.ListIndex=0
end if
if PopupSize.ListCount>0 then
PopupSize.ListIndex=0
end if
if PopupStyle.ListCount>0 then
PopupStyle.ListIndex=0
end if
db = d
update
end if
End EventHandler
Private Sub update()
if PopupSize.ListIndex = -1 then Return
if PopupFont.ListIndex = -1 then Return
if PopupStyle.ListIndex = -1 then Return
if db = nil then Return
dim p as Picture = new Picture(canvas1.Width, canvas1.Height, 32)
dim g as Graphics = p.Graphics
dim font as string = PopupFont.List(PopupFont.ListIndex)
dim size as string = PopupSize.List(PopupSize.ListIndex)
dim style as integer = val(PopupStyle.List(PopupStyle.ListIndex))
dim r as RecordSet = db.SQLSelect("select data from letter where font="""+font+""" and size="+size+" and style="+str(style))
dim x,y as integer
if db.Error then
MsgBox db.ErrorMessage
Return
end if
if r<>Nil then
while not r.EOF
dim data as string = r.Field("data").StringValue
dim q as Picture = PNGStringToPictureMBS(data, 0)
if q<>Nil then
if x+q.Width>g.Width then
x = 0
y = y + q.Height
end if
g.DrawPicture q,x,y
x = x + q.Width
end if
r.MoveNext
wend
end if
canvas1.Backdrop = p
End Sub
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.