[code]Attribute VB_Name = "modLanguage"
Option Explicit
Public gstrLanguageFile As String
Public gstrFormatFile As String
Public gstrPrintLanguageFile As String
Public gstrPrintFormatFile As String
Public strSeperateChar As String
Dim DefaultCtrl As VarCtrlFont
Dim DefComboBox As VarCtrlFont
Dim DefCommandButton As VarCtrlFont
Dim DefSstab As VarCtrlFont
Dim DefLabel As VarCtrlFont
Dim DefCheckBox As VarCtrlFont
Dim DefFrame As VarCtrlFont
Dim DefTextBox As VarCtrlFont
Dim DefListBox As VarCtrlFont
Dim DefOptionButton As VarCtrlFont
Dim DefStatusBar As VarCtrlFont
Dim DefMsFlexGrid As VarCtrlFont
Dim DefVSFlexGrid As VarCtrlFont
Dim DefTabStrip As VarCtrlFont
Dim DefCaptionLabel As VarCtrlFont
Dim DefDTPicker As VarCtrlFont
Public DefRptLabel As VarCtrlFont
Public DefRptField As VarCtrlFont
Type VarCtrlFont
FontName As String
FontSize As Integer
FontBold As Boolean
FontItalic As Boolean
FontStrikethrough As Boolean
FontUnderline As Boolean
End Type
Public Sub LoadFontVar()
gstrLanguageFile = App.Path & "\language.ini"
gstrFormatFile = App.Path & "\format.ini"
gstrPrintLanguageFile = App.Path & "\printlanguage.ini"
gstrPrintFormatFile = App.Path & "\printformat.ini"
strSeperateChar = ReadINIFile(gstrLanguageFile, "General", "SeperateChar", ";")
End Sub
Public Sub FormatCtrl(tmpctrl As Control, Optional tmpFontStr As String)
Dim fnt As Object
Dim intX As Integer
Select Case LCase(TypeName(tmpctrl))
Case "label"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefLabel.FontName
fnt.Size = DefLabel.FontSize
fnt.Bold = DefLabel.FontBold
fnt.Italic = DefLabel.FontItalic
fnt.Underline = DefLabel.FontUnderline
fnt.Strikethrough = DefLabel.FontStrikethrough
End If
Case "tabstrip"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefTabStrip.FontName
fnt.Size = DefTabStrip.FontSize
fnt.Bold = DefTabStrip.FontBold
fnt.Italic = DefTabStrip.FontItalic
fnt.Underline = DefTabStrip.FontUnderline
fnt.Strikethrough = DefTabStrip.FontStrikethrough
End If
Case "commandbutton"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefCommandButton.FontName
fnt.Size = DefCommandButton.FontSize
fnt.Bold = DefCommandButton.FontBold
fnt.Italic = DefCommandButton.FontItalic
fnt.Underline = DefCommandButton.FontUnderline
fnt.Strikethrough = DefCommandButton.FontStrikethrough
End If
Case "statusbar"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefStatusBar.FontName
fnt.Size = DefStatusBar.FontSize
fnt.Bold = DefStatusBar.FontBold
fnt.Italic = DefStatusBar.FontItalic
fnt.Underline = DefStatusBar.FontUnderline
fnt.Strikethrough = DefStatusBar.FontStrikethrough
End If
Case "frame"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefFrame.FontName
fnt.Size = DefFrame.FontSize
fnt.Bold = DefFrame.FontBold
fnt.Italic = DefFrame.FontItalic
fnt.Underline = DefFrame.FontUnderline
fnt.Strikethrough = DefFrame.FontStrikethrough
End If
Case "checkbox"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefCheckBox.FontName
fnt.Size = DefCheckBox.FontSize
fnt.Bold = DefCheckBox.FontBold
fnt.Italic = DefCheckBox.FontItalic
fnt.Underline = DefCheckBox.FontUnderline
fnt.Strikethrough = DefCheckBox.FontStrikethrough
End If
Case "optionbutton"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefOptionButton.FontName
fnt.Size = DefOptionButton.FontSize
fnt.Bold = DefOptionButton.FontBold
fnt.Italic = DefOptionButton.FontItalic
fnt.Underline = DefOptionButton.FontUnderline
fnt.Strikethrough = DefOptionButton.FontStrikethrough
End If
Case "textbox"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefTextBox.FontName
fnt.Size = DefTextBox.FontSize
fnt.Bold = DefTextBox.FontBold
fnt.Italic = DefTextBox.FontItalic
fnt.Underline = DefTextBox.FontUnderline
fnt.Strikethrough = DefTextBox.FontStrikethrough
End If
Case "combobox"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefComboBox.FontName
fnt.Size = DefComboBox.FontSize
fnt.Bold = DefComboBox.FontBold
fnt.Italic = DefComboBox.FontItalic
fnt.Underline = DefComboBox.FontUnderline
fnt.Strikethrough = DefComboBox.FontStrikethrough
End If
Case "listbox"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefListBox.FontName
fnt.Size = DefListBox.FontSize
fnt.Bold = DefListBox.FontBold
fnt.Italic = DefListBox.FontItalic
fnt.Underline = DefListBox.FontUnderline
fnt.Strikethrough = DefListBox.FontStrikethrough
End If
Case "msflexgrid"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefMsFlexGrid.FontName
fnt.Size = DefMsFlexGrid.FontSize
fnt.Bold = DefMsFlexGrid.FontBold
fnt.Italic = DefMsFlexGrid.FontItalic
fnt.Underline = DefMsFlexGrid.FontUnderline
fnt.Strikethrough = DefMsFlexGrid.FontStrikethrough
End If
Case "vsflexgrid"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefMsFlexGrid.FontName
fnt.Size = DefMsFlexGrid.FontSize
fnt.Bold = DefMsFlexGrid.FontBold
fnt.Italic = DefMsFlexGrid.FontItalic
fnt.Underline = DefMsFlexGrid.FontUnderline
fnt.Strikethrough = DefMsFlexGrid.FontStrikethrough
End If
Case "dtpicker"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefDTPicker.FontName
fnt.Size = DefDTPicker.FontSize
fnt.Bold = DefDTPicker.FontBold
fnt.Italic = DefDTPicker.FontItalic
fnt.Underline = DefDTPicker.FontUnderline
fnt.Strikethrough = DefDTPicker.FontStrikethrough
End If
Case "sstab"
If Len(tmpFontStr) > 0 Then
LoadFontStr tmpctrl, tmpFontStr
Else
Set fnt = tmpctrl.Font
fnt.name = DefSstab.FontName
fnt.Size = DefSstab.FontSize
fnt.Bold = DefSstab.FontBold
fnt.Italic = DefSstab.FontItalic
fnt.Underline = DefSstab.FontUnderline
fnt.Strikethrough = DefSstab.FontStrikethrough
End If
End Select
Set fnt = Nothing
End Sub
Public Function cuGetFontProperty(tmpProperty As String, tmpArray() As String, Optional tmpFontStr As String) As String
Dim tmpResult As String
Dim intX As Integer
Dim FinalFontStr As String
Dim SepFontStr() As String
Dim tmpProperties As String
Dim tmpValue As String
Dim startParam As Boolean
If Len(tmpFontStr) > 0 Then
startParam = False
For intX = 0 To UBound(tmpArray, 1)
If LCase(tmpArray(intX, 0)) = LCase(tmpFontStr) Then
FinalFontStr = tmpArray(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(FinalFontStr)
If Mid(FinalFontStr, intX, 1) <> strSeperateChar Then
If Mid(FinalFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperties = tmpProperties & Mid(FinalFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(FinalFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
If tmpProperty = tmpProperties Then
Select Case tmpProperties
Case "fontname"
tmpResult = tmpValue
Case "fontsize"
tmpResult = Val(tmpValue)
Case "fontbold"
tmpResult = CBool(tmpValue)
Case "fontitalic"
tmpResult = CBool(tmpValue)
Case "fontunderline"
tmpResult = CBool(tmpValue)
Case "fontstrikethrough"
tmpResult = CBool(tmpValue)
End Select
Exit For
End If
startParam = False
tmpProperties = ""
tmpValue = ""
End If
Next
End If
cuGetFontProperty = tmpResult
End Function
Public Sub cuFormatCtrl(tmpobj As Object, tmpArray() As String, Optional tmpFontStr As String)
Dim fnt As Object
Dim intX As Integer
Dim FinalFontStr As String
Dim SepFontStr() As String
Dim tmpProperties As String
Dim tmpValue As String
Dim startParam As Boolean
If Len(tmpFontStr) > 0 Then
startParam = False
For intX = 0 To UBound(tmpArray, 1)
If LCase(tmpArray(intX, 0)) = LCase(tmpFontStr) Then
FinalFontStr = tmpArray(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(FinalFontStr)
If Mid(FinalFontStr, intX, 1) <> strSeperateChar Then
If Mid(FinalFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperties = tmpProperties & Mid(FinalFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(FinalFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
Set fnt = tmpobj.Font
Select Case tmpProperties
Case "fontname"
fnt.name = tmpValue
Case "fontsize"
fnt.Size = Val(tmpValue)
Case "fontbold"
fnt.Bold = CBool(tmpValue)
Case "fontitalic"
fnt.Italic = CBool(tmpValue)
Case "fontunderline"
fnt.Underline = CBool(tmpValue)
Case "fontstrikethrough"
fnt.Strikethrough = CBool(tmpValue)
End Select
startParam = False
tmpProperties = ""
tmpValue = ""
End If
Next
Else
Set fnt = tmpobj.Font
fnt.name = DefRptField.FontName
fnt.Size = DefRptField.FontSize
fnt.Bold = DefRptField.FontBold
fnt.Italic = DefRptField.FontItalic
fnt.Underline = DefRptField.FontUnderline
fnt.Strikethrough = DefRptField.FontStrikethrough
End If
Set fnt = Nothing
End Sub
Private Function GetSeparateStr(tmpString As String, tmpPosition As Integer, Optional ByRef tmpFontStr As String) As String
Dim tmpResult As String
Dim intX As Integer
Dim tmpDestination As Integer
For intX = 1 To Len(tmpString)
If Mid(tmpString, intX, 1) <> strSeperateChar Then
tmpResult = tmpResult & Mid(tmpString, intX, 1)
Else
If tmpDestination = tmpPosition Then
GetSeparateStr = tmpResult
Exit Function
Else
tmpResult = Empty
tmpDestination = tmpDestination + 1
End If
End If
Next
GetSeparateStr = Empty
End Function
Public Function LoadArytoStr(tmpArray() As String, tmpTag As String) As String
Dim tmpResult As String
Dim tmpPos As Integer
Dim intX As Integer
On Error Resume Next
tmpPos = Val(tmpTag)
If tmpPos <= UBound(tmpArray, 1) Then
If tmpArray(tmpPos, 0) = tmpTag Then
tmpResult = tmpArray(tmpPos, 1)
Else
If Len(tmpArray(tmpPos, 0)) > 0 Then
If tmpPos > Val(tmpArray(tmpPos, 0)) Then
For intX = tmpPos To UBound(tmpArray, 1)
If tmpArray(intX, 0) = tmpTag Then
tmpResult = tmpArray(intX, 1)
Exit For
End If
Next intX
Else
For intX = tmpPos To 0 Step -1
If tmpArray(intX, 0) = tmpTag Then
tmpResult = tmpArray(intX, 1)
Exit For
End If
Next intX
End If
Else
For intX = tmpPos To 0 Step -1
If tmpArray(intX, 0) = tmpTag Then
tmpResult = tmpArray(intX, 1)
Exit For
End If
Next intX
End If
End If
Else
For intX = 0 To UBound(tmpArray, 1)
If tmpArray(intX, 0) = tmpTag Then
tmpResult = tmpArray(intX, 1)
Exit For
End If
Next intX
End If
LoadArytoStr = tmpResult
End Function
Public Function GetFontProperty(tmpArray() As String, tmpIndex As String) As VarCtrlFont
Dim intX As Integer
Dim tmpVarCtrlFont As VarCtrlFont
Dim tmpFontStr As String
Dim tmpProperty As String
Dim tmpValue As String
Dim startParam As Boolean
tmpVarCtrlFont.FontBold = False
tmpVarCtrlFont.FontSize = 9
tmpVarCtrlFont.FontItalic = False
tmpVarCtrlFont.FontStrikethrough = False
tmpVarCtrlFont.FontUnderline = False
tmpVarCtrlFont.FontName = "MS Sans Serif"
For intX = 0 To UBound(tmpArray, 1)
If LCase(tmpArray(intX, 0)) = LCase(tmpIndex) Then
tmpFontStr = tmpArray(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(tmpFontStr)
If Mid(tmpFontStr, intX, 1) <> strSeperateChar Then
If Mid(tmpFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperty = tmpProperty & Mid(tmpFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(tmpFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
Select Case LCase(tmpProperty)
Case "fontname"
tmpVarCtrlFont.FontName = tmpValue
Case "fontsize"
tmpVarCtrlFont.FontSize = Val(tmpValue)
Case "fontbold"
tmpVarCtrlFont.FontBold = CBool(tmpValue)
Case "fontitalic"
tmpVarCtrlFont.FontItalic = CBool(tmpValue)
Case "fontunderline"
tmpVarCtrlFont.FontUnderline = CBool(tmpValue)
Case "fontstrikethrough"
tmpVarCtrlFont.FontStrikethrough = CBool(tmpValue)
End Select
startParam = False
tmpProperty = Empty
tmpValue = Empty
End If
Next
GetFontProperty = tmpVarCtrlFont
End Function
Private Function GetDefaultFont() As VarCtrlFont
Dim intX As Integer
Dim tmpFontStr As String
Dim tmpProperties As String
Dim tmpValue As String
Dim startParam As Boolean
startParam = False
GetDefaultFont.FontBold = False
GetDefaultFont.FontItalic = False
GetDefaultFont.FontStrikethrough = False
GetDefaultFont.FontUnderline = False
GetDefaultFont.FontName = "MS Sans Serif"
GetDefaultFont.FontSize = 12
For intX = 0 To UBound(garyCtrlSetting, 1)
If LCase(garyCtrlSetting(intX, 0)) = "default" Then
tmpFontStr = garyCtrlSetting(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(tmpFontStr)
If Mid(tmpFontStr, intX, 1) <> strSeperateChar Then
If Mid(tmpFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperties = tmpProperties & Mid(tmpFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(tmpFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
Select Case LCase(tmpProperties)
Case "fontname"
GetDefaultFont.FontName = tmpValue
Case "fontsize"
GetDefaultFont.FontSize = Val(tmpValue)
Case "fontbold"
GetDefaultFont.FontBold = CBool(tmpValue)
Case "fontitalic"
GetDefaultFont.FontItalic = CBool(tmpValue)
Case "fontunderline"
GetDefaultFont.FontUnderline = CBool(tmpValue)
Case "fontstrikethrough"
GetDefaultFont.FontStrikethrough = CBool(tmpValue)
End Select
startParam = False
tmpProperties = ""
tmpValue = ""
End If
Next
End Function
Private Function GetCtrlFont(tmpCtrlName As String) As VarCtrlFont
Dim intX As Integer
Dim tmpFontStr As String
Dim tmpProperties As String
Dim tmpValue As String
Dim startParam As Boolean
startParam = False
GetCtrlFont = DefaultCtrl
For intX = 0 To UBound(garyCtrlSetting, 1)
If LCase(garyCtrlSetting(intX, 0)) = tmpCtrlName Then
tmpFontStr = garyCtrlSetting(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(tmpFontStr)
If Mid(tmpFontStr, intX, 1) <> strSeperateChar Then
If Mid(tmpFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperties = tmpProperties & Mid(tmpFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(tmpFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
Select Case LCase(tmpProperties)
Case "fontname"
GetCtrlFont.FontName = tmpValue
Case "fontsize"
GetCtrlFont.FontSize = Val(tmpValue)
Case "fontbold"
GetCtrlFont.FontBold = CBool(tmpValue)
Case "fontitalic"
GetCtrlFont.FontItalic = CBool(tmpValue)
Case "fontunderline"
GetCtrlFont.FontUnderline = CBool(tmpValue)
Case "fontstrikethrough"
GetCtrlFont.FontStrikethrough = CBool(tmpValue)
End Select
startParam = False
tmpProperties = ""
tmpValue = ""
End If
Next
End Function
Public Sub LoadCtrlDefaultFont()
DefaultCtrl = GetDefaultFont
DefLabel = GetCtrlFont("label")
DefComboBox = GetCtrlFont("combobox")
DefListBox = GetCtrlFont("listbox")
DefCommandButton = GetCtrlFont("commandbutton")
DefCheckBox = GetCtrlFont("checkbox")
DefStatusBar = GetCtrlFont("statusbar")
DefFrame = GetCtrlFont("frame")
DefTextBox = GetCtrlFont("textbox")
DefMsFlexGrid = GetCtrlFont("msflexgrid")
DefVSFlexGrid = GetCtrlFont("vsflexgrid")
DefSstab = GetCtrlFont("sstab")
DefOptionButton = GetCtrlFont("optionbutton")
DefRptLabel = GetCtrlFont("rptlabel")
DefRptField = GetCtrlFont("rptfield")
DefTabStrip = GetCtrlFont("TabStrip")
DefCaptionLabel = GetCtrlFont("captionlabel")
DefDTPicker = GetCtrlFont("dtpicker")
End Sub
Private Sub LoadFontStr(tmpctrl As Control, tmpFontStr As String)
Dim intX As Integer
Dim FinalFontStr As String
Dim SepFontStr() As String
Dim tmpProperties As String
Dim tmpValue As String
Dim startParam As Boolean
startParam = False
For intX = 0 To UBound(garyFontSetting, 1)
If garyFontSetting(intX, 0) = tmpFontStr Then
FinalFontStr = garyFontSetting(intX, 1)
Exit For
End If
Next
For intX = 1 To Len(FinalFontStr)
If Mid(FinalFontStr, intX, 1) <> strSeperateChar Then
If Mid(FinalFontStr, intX, 1) <> ":" Then
If startParam = False Then
tmpProperties = tmpProperties & Mid(FinalFontStr, intX, 1)
Else
tmpValue = tmpValue & Mid(FinalFontStr, intX, 1)
End If
Else
startParam = True
End If
Else
FineTuneCtrl tmpctrl, tmpProperties, tmpValue
startParam = False
tmpProperties = ""
tmpValue = ""
End If
Next
End Sub
Private Sub FineTuneCtrl(tmpctrl As Control, tmpProperties As String, tmpValue As String)
Dim fnt As Object
On Error GoTo ErrFineTuneCtrl
Set fnt = tmpctrl.Font
Select Case tmpProperties
Case "fontname"
fnt.name = tmpValue
Case "fontsize"
fnt.Size = Val(tmpValue)
Case "fontbold"
fnt.Bold = CBool(tmpValue)
Case "fontitalic"
fnt.Italic = CBool(tmpValue)
Case "fontunderline"
fnt.Underline = CBool(tmpValue)
Case "fontstrikethrough"
fnt.Strikethrough = CBool(tmpValue)
End Select
Set fnt = Nothing
ErrFineTuneCtrl:
End Sub
Public Sub LoadDefaultFormat(tmpForm As Form)
Dim ctl As Control
Dim fnt As Object
For Each ctl In tmpForm.Controls
Select Case LCase(TypeName(ctl))
Case "label"
If LCase(ctl.name) = "lblcap" Then
Set fnt = ctl.Font
fnt.name = DefLabel.FontName
fnt.Bold = DefLabel.FontBold
fnt.Italic = DefLabel.FontItalic
fnt.Underline = DefLabel.FontUnderline
fnt.Strikethrough = DefLabel.FontStrikethrough
If Len(ctl.Caption) > 18 Then
If UCase(fnt.name) = "ARIAL" Then
If ctl.Width = 1800 Then
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.name = "arial narrow"
fnt.Size = DefLabel.FontSize
End If
Else
If Len(ctl.Caption) > ctl.Width / 120 Then
fnt.name = "arial narrow"
fnt.Size = DefLabel.FontSize
End If
End If
Else
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.Size = DefLabel.FontSize - 1
Else
fnt.Size = DefLabel.FontSize
End If
End If
Else
fnt.Size = DefLabel.FontSize
End If
Else
Set fnt = ctl.Font
fnt.name = DefCaptionLabel.FontName
fnt.Size = DefCaptionLabel.FontSize
fnt.Bold = DefCaptionLabel.FontBold
fnt.Italic = DefCaptionLabel.FontItalic
fnt.Underline = DefCaptionLabel.FontUnderline
fnt.Strikethrough = DefCaptionLabel.FontStrikethrough
End If
Case "commandbutton"
Set fnt = ctl.Font
fnt.name = DefCommandButton.FontName
fnt.Size = DefCommandButton.FontSize
fnt.Bold = DefCommandButton.FontBold
fnt.Italic = DefCommandButton.FontItalic
fnt.Underline = DefCommandButton.FontUnderline
fnt.Strikethrough = DefCommandButton.FontStrikethrough
Case "statusbar"
Set fnt = ctl.Font
fnt.name = DefStatusBar.FontName
fnt.Size = DefStatusBar.FontSize
fnt.Bold = DefStatusBar.FontBold
fnt.Italic = DefStatusBar.FontItalic
fnt.Underline = DefStatusBar.FontUnderline
fnt.Strikethrough = DefStatusBar.FontStrikethrough
Case "frame"
Set fnt = ctl.Font
fnt.name = DefFrame.FontName
fnt.Size = DefFrame.FontSize
fnt.Bold = DefFrame.FontBold
fnt.Italic = DefFrame.FontItalic
fnt.Underline = DefFrame.FontUnderline
fnt.Strikethrough = DefFrame.FontStrikethrough
Case "checkbox"
Set fnt = ctl.Font
fnt.name = DefCheckBox.FontName
fnt.Size = DefCheckBox.FontSize
fnt.Bold = DefCheckBox.FontBold
fnt.Italic = DefCheckBox.FontItalic
fnt.Underline = DefCheckBox.FontUnderline
fnt.Strikethrough = DefCheckBox.FontStrikethrough
If Len(ctl.Caption) > 12 Then
If UCase(fnt.name) = "ARIAL" Then
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.name = "arial narrow"
End If
Else
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.Size = DefCheckBox.FontSize - 1
Else
fnt.Size = DefCheckBox.FontSize
End If
End If
Else
fnt.Size = DefCheckBox.FontSize
End If
Case "optionbutton"
Set fnt = ctl.Font
fnt.name = DefOptionButton.FontName
fnt.Size = DefOptionButton.FontSize
fnt.Bold = DefOptionButton.FontBold
fnt.Italic = DefOptionButton.FontItalic
fnt.Underline = DefOptionButton.FontUnderline
fnt.Strikethrough = DefOptionButton.FontStrikethrough
If Len(ctl.Caption) > 12 Then
If UCase(fnt.name) = "ARIAL" Then
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.name = "arial narrow"
End If
Else
If Len(ctl.Caption) > ctl.Width / 100 Then
fnt.Size = DefOptionButton.FontSize - 1
Else
fnt.Size = DefOptionButton.FontSize
End If
End If
Else
fnt.Size = DefOptionButton.FontSize
End If
Case "textbox"
Set fnt = ctl.Font
fnt.name = DefTextBox.FontName
fnt.Size = DefTextBox.FontSize
fnt.Bold = DefTextBox.FontBold
fnt.Italic = DefTextBox.FontItalic
fnt.Underline = DefTextBox.FontUnderline
fnt.Strikethrough = DefTextBox.FontStrikethrough
Case "combobox"
Set fnt = ct
