Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/Windows Font
Function:
Required plugins for this example: MBS DynaPDF Plugin, MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/Windows Font
This example is the version from Tue, 23th Feb 2015.
Project "Windows Font.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub Change() liste.DeleteAllRows if me.ListIndex = -1 then // ignore else dim f as WindowsFontFamilyMBS = List.RowTag(List.ListIndex) Add "FontType", f.FontType // LOGFONT Add "LogFontHeight", f.LogFontHeight Add "LogFontWidth", f.LogFontWidth Add "LogFontEscapement", f.LogFontEscapement Add "LogFontOrientation", f.LogFontOrientation Add "LogFontWeight", f.LogFontWeight Add "LogFontItalic", f.LogFontItalic Add "LogFontUnderline", f.LogFontUnderline Add "LogFontStrikeOut", f.LogFontStrikeOut Add "LogFontCharSet", f.LogFontCharSet Add "LogFontOutPrecision", f.LogFontOutPrecision Add "LogFontClipPrecision", f.LogFontClipPrecision Add "LogFontQuality", f.LogFontQuality Add "LogFontPitchAndFamily", f.LogFontPitchAndFamily Add "LogFontFaceName", f.LogFontFaceName // ENUMLOGFONTEX Add "LogFontFullName", f.LogFontFullName Add "LogFontStyle", f.LogFontStyle Add "LogFontScript", f.LogFontScript // DESIGNVECTOR Add "NumberOfDesignVectors", f.NumberOfDesignVectors for i as integer = 0 to f.NumberOfDesignVectors-1 add "DesignVectorValues "+str(i+1), f.DesignVectorValues(i) next // TEXTMETRIC Add "TextMetricHeight", f.TextMetricHeight Add "TextMetricAscent", f.TextMetricAscent Add "TextMetricDescent", f.TextMetricDescent Add "TextMetricInternalLeading", f.TextMetricInternalLeading Add "TextMetricExternalLeading", f.TextMetricExternalLeading Add "TextMetricAverageCharWidth", f.TextMetricAverageCharWidth Add "TextMetricMaxCharWidth", f.TextMetricMaxCharWidth Add "TextMetricWeight", f.TextMetricWeight Add "TextMetricOverhang", f.TextMetricOverhang Add "TextMetricDigitizedAspectX", f.TextMetricDigitizedAspectX Add "TextMetricDigitizedAspectY", f.TextMetricDigitizedAspectY Add "TextMetricFirstChar", f.TextMetricFirstChar Add "TextMetricLastChar", f.TextMetricLastChar Add "TextMetricDefaultChar", f.TextMetricDefaultChar Add "TextMetricBreakChar", f.TextMetricBreakChar Add "TextMetricItalic", f.TextMetricItalic Add "TextMetricUnderlined", f.TextMetricUnderlined Add "TextMetricStruckOut", f.TextMetricStruckOut Add "TextMetricPitchAndFamily", f.TextMetricPitchAndFamily Add "TextMetricCharSet", f.TextMetricCharSet Add "TextMetricFlags", f.TextMetricFlags Add "TextMetricSizeEM", f.TextMetricSizeEM Add "TextMetricCellHeight", f.TextMetricCellHeight Add "TextMetricAverageWidth", f.TextMetricAverageWidth Add "NumberOfAxes", f.NumberOfAxes for i as integer = 0 to f.NumberOfAxes-1 add "AxisName "+str(i+1), f.AxisName(i) add "AxisMaxValue "+str(i+1), f.AxisMaxValue(i) add "AxisMinValue "+str(i+1), f.AxisMinValue(i) next end if End EventHandler
EventHandler Sub ExpandRow(row As Integer) dim f as WindowsFontFamilyMBS = List.RowTag(row) if f<>Nil then // we'd better pass a family name, but maybe this is okay, too? dim a(-1) as WindowsFontFamilyMBS = WindowsFontFamilyMBS.FontsOfFamily(f.LogFontFullName) for each x as WindowsFontFamilyMBS in a List.Addfolder x.LogFontFullName List.RowTag(List.LastIndex)=x next end if End EventHandler
End Control
Control Liste Inherits Listbox
ControlInstance Liste Inherits Listbox
End Control
Control RList Inherits Listbox
ControlInstance RList Inherits Listbox
EventHandler Sub Open() dim c as integer = FontCount-1 for i as integer = 0 to c me.AddRow font(i) next End EventHandler
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control DList Inherits Listbox
ControlInstance DList Inherits Listbox
EventHandler Sub Open() // Comment out and remove MyDynaPDFMBS class form project if you don't have the MBS REALbasic DynaPDF Plugin dim pdf as new MyDynapdfMBS call pdf.EnumHostFontsEx End EventHandler
End Control
EventHandler Sub Open() fonts = WindowsFontFamilyMBS.AllFonts for each f as WindowsFontFamilyMBS in fonts List.Addfolder f.LogFontFullName List.RowTag(List.LastIndex)=f next End EventHandler
Sub Add(name as string, value as Boolean) Liste.AddRow name if value then Liste.Cell(Liste.LastIndex,1)="Yes" else Liste.Cell(Liste.LastIndex,1)="No" end if End Sub
Sub Add(name as string, value as integer) Liste.AddRow name Liste.Cell(Liste.LastIndex,1)=str(value) End Sub
Sub Add(name as string, value as string) Liste.AddRow name Liste.Cell(Liste.LastIndex,1)=value End Sub
Property fonts() As WindowsFontFamilyMBS
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
Class MyDynaPDFMBS Inherits DynaPDFMBS
EventHandler Function EnumHostFontEx(FamilyName as string, PostScriptName as string, Style as integer, BaseType as integer, Embeddable as boolean, Flags as integer, FilePath as string) As integer window1.DList.AddRow FamilyName window1.DList.Cell(window1.DList.LastIndex,1)=PostScriptName dim styles(-1) as string if BitwiseAnd(Style, me.kfsItalic) <> 0 then styles.Append "Italic" end if if BitwiseAnd(Style, me.kfsUnderlined) <> 0 then styles.Append "Underlined" end if if BitwiseAnd(Style, me.kfsStriked) <> 0 then styles.Append "Striked" end if dim width as integer = WidthFromStyle(style) styles.Append str(width) dim weight as integer = WeightFromStyle(style) styles.Append str(weight) window1.DList.Cell(window1.DList.LastIndex,2)=Join(styles, ", ") End EventHandler
EventHandler Function Error(ErrorCode as integer, ErrorMessage as string, ErrorType as integer) As integer // output all messages on the console: System.DebugLog str(ErrorCode)+": "+ErrorMessage // and display dialog: Dim d as New MessageDialog //declare the MessageDialog object Dim b as MessageDialogButton //for handling the result d.icon=MessageDialog.GraphicCaution //display warning icon d.ActionButton.Caption="Continue" d.CancelButton.Visible=True //show the Cancel button // a warning or an error? if BitAnd(ErrorType, me.kE_WARNING) = me.kE_WARNING then // if user decided to ignore, we'll ignore if IgnoreWarnings then Return 0 d.Message="A warning occurred while processing your PDF code." // we add a third button to display all warnings d.AlternateActionButton.Caption = "Ignore warnings" d.AlternateActionButton.Visible = true else d.Message="An error occurred while processing your PDF code." end if d.Explanation = str(ErrorCode)+": "+ErrorMessage b=d.ShowModal //display the dialog Select Case b //determine which button was pressed. Case d.ActionButton Return 0 // ignore Case d.AlternateActionButton IgnoreWarnings = true Return 0 // ignore Case d.CancelButton Return -1 // stop End select End EventHandler
Property IgnoreWarnings As Boolean
End Class
End Project

See also:

Feedback, Comments & Corrections

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





Links
MBS Xojo Plugins