Platforms to show: All Mac Windows Linux Cross-Platform
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.xojo_binary_project"
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:
- /Win/Windows File Copy
- /Win/Windows Hot Key
- /Win/Windows Key Filter
- /Win/Windows Process Memory Info
- /Win/Windows QOS/Windows QOS with UDPSocket
- /Win/Windows Shortcuts/File Shortcut
- /Win/Windows Speech/Windows Speech with 4 windows
- /Win/Windows System Tray
- /Win/Windows System Tray with Icon file/Windows System Tray with Icon file
- /Win/Windows VM Statistics
The items on this page are in the following plugins: MBS Win Plugin.