-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathFontCh.frm
233 lines (205 loc) · 7.13 KB
/
FontCh.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
VERSION 5.00
Begin VB.Form frmChangeFont
BorderStyle = 1 'Fixed Single
Caption = "Change Formula Font"
ClientHeight = 1440
ClientLeft = 3090
ClientTop = 1305
ClientWidth = 5025
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
HelpContextID = 4060
Icon = "FONTCH.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 1440
ScaleWidth = 5025
Tag = "8000"
Begin VB.ComboBox cboFontSize
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1680
Style = 2 'Dropdown List
TabIndex = 1
Tag = "8020"
Top = 960
Width = 1335
End
Begin VB.ComboBox cboFonts
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 240
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 0
Tag = "8010"
Top = 480
Width = 4575
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "Cl&ose"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 3600
TabIndex = 2
Tag = "4000"
Top = 960
Width = 1155
End
Begin VB.Label lblFontSize
Caption = "Font Size:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 4
Tag = "8070"
Top = 960
Width = 1335
End
Begin VB.Label lblFonts
Caption = "Change Formula Font to:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 3
Tag = "8060"
Top = 120
Width = 4695
End
End
Attribute VB_Name = "frmChangeFont"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const MIN_FONT_SIZE = 6
Private Sub LoadFontsIntoComboBox()
Dim intIndex As Integer, intFontCount As Integer
intFontCount = Screen.FontCount - 1
'If intFontCount > 25 Then frmMain.lblStatus.Caption = "Building font list 0%"
' Load Fonts in the Combo Box
For intIndex = 0 To intFontCount
cboFonts.AddItem Screen.Fonts(intIndex)
If intIndex Mod 25 = 0 Then
frmMain.lblStatus.Caption = "Building font list " & _
Trim(Str(CIntSafeDbl(intIndex / intFontCount * 100))) & "%"
DoEvents
End If
Next intIndex
With cboFontSize
For intIndex = MIN_FONT_SIZE To 14
.AddItem intIndex
If intIndex = objMwtWin.RtfFontSize Then .ListIndex = .ListCount - 1
Next intIndex
'' ' In order to use larger fonts, I need to make rtfFormula().Height be dependent on a variable
'' ' This variable would also have to be used by the frmMain.PositionFormControls() function
'' For intIndex = 16 To 32 Step 2
'' .AddItem intIndex
'' If intIndex = objMwtWin.RtfFontSize Then .ListIndex = .ListCount - 1
'' Next intIndex
End With
End Sub
Private Sub PositionFormControls()
Me.Caption = LookupLanguageCaption(8000, "Change Formula Font")
CmdOK.Caption = LookupLanguageCaption(4000, "Cl&ose")
lblFonts.Top = 120
lblFonts.Left = 240
lblFonts.Caption = LookupLanguageCaption(8060, "Change Formula Font to:")
cboFonts.Top = 480
cboFonts.Left = lblFonts.Left
lblFontSize.Top = 960
lblFontSize.Left = lblFonts.Left
lblFontSize.Caption = LookupLanguageCaption(8070, "Font Size:")
cboFontSize.Top = lblFontSize.Top
cboFontSize.Left = (frmChangeFont.ScaleWidth - CmdOK.Width) / 4
cboFontSize.Left = (frmChangeFont.ScaleWidth - CmdOK.Width) / 4
CmdOK.Top = lblFontSize.Top
CmdOK.Left = (frmChangeFont.ScaleWidth - CmdOK.Width) * 3 / 4
End Sub
Private Sub cboFonts_Click()
SetFonts cboFonts.Text, objMwtWin.RtfFontSize
End Sub
Private Sub cboFontSize_Click()
SetFonts cboFonts.Text, Val(cboFontSize.Text)
End Sub
Private Sub cmdOK_Click()
frmChangeFont.Hide
End Sub
Private Sub Form_Activate()
' Put window in center of screen
SizeAndCenterWindow Me, cWindowExactCenter, 5200, 1850
Dim intIndex As Integer
' Display the current font in the combo box
For intIndex = 0 To Screen.FontCount - 1
If cboFonts.List(intIndex) = objMwtWin.RtfFontName Then
cboFonts.ListIndex = intIndex
Exit For
End If
Next intIndex
End Sub
Private Sub Form_Load()
' Position Form Controls
PositionFormControls
' Change mouse pointer to hourglass
MousePointer = vbHourglass
' Load fonts
LoadFontsIntoComboBox
frmMain.LabelStatus
' Change mouse pointer back to default
MousePointer = vbDefault
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
QueryUnloadFormHandler Me, Cancel, UnloadMode
End Sub