Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/GraphicsMagick/Console Text Drawing/Display Letter Database
Function:
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/Console Text Drawing/Display Letter Database
This example is the version from Thu, 16th Nov 2016.
Project "Display Letter Database.rbp"
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:

Feedback, Comments & Corrections

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





Links
MBS FileMaker blog