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