制作大型空心字的代码

　　笔者所说的空心字，是指笔划边缘颜色保持不变，而将字符笔划内部“掏空”，填上另一种颜色。可以有多种方法达到这个要求。但笔者这种方法是自动的，不需要人工干预，非常简单实用。
　　思路（分三步）：
　　①首先将屏幕所能显示的最大字体（可能＞700号字体）用某种颜色（例如红色）打印到窗体上；
　　②再逐个取点判断：如果为红色，那么就对该点做一个标记；
　　③最后逐点检查标记，如果标记点的前后上下四个点均为红色，则可断定该点位于笔划内部，属于要“掏空”的点，将之更换颜色。
　　在新建窗体上建立一个名为“设置”的菜单项。代码如下：

Option Explicit

Private WithEvents CD As VBControlExtender

Private Sub Form_Load()
AutoRedraw = True: ScaleMode = 3: WindowState = 2
Licenses.Add "
Set CD = Controls.Add(", "CD") '创建公用对话框
End Sub

Private Sub 设置_Click()
On Error GoTo 100
Dim i As Integer, j As Integer, st As String, r() As Boolean, tw As Long, th As Long

With CD.object
  .CancelError = True
  .Flags = &H103
  .ShowFont
  Font.Name = .FontName
  Font.Size = .FontSize
  Font.Bold = .FontBold
  Font.Italic = .FontItalic
  ForeColor = .Color
End With

If Font.Size < 74 Then MsgBox "文字大小必须≥74号，请重新设置": Exit Sub
st = InputBox$("请输入文字：")
tw = TextWidth(st) - 20 * Font.Italic * Font.Size \ 72: th = TextHeight(st) '获取文本宽高
If tw > Screen.Width \ 15 Or th > Screen.Height \ 15 Then MsgBox "文本宽(高)度超出屏幕宽(高)度，请重新设置": Exit Sub

Screen.MousePointer = 11
Cls
CurrentX = 0: CurrentY = 0: Print st
ReDim r(1 To tw, 1 To th)

For i = 1 To tw '按行列取点，如果为文字的颜色，则标记该点
  For j = 1 To th
    r(i, j) = (Point(i, j) = ForeColor)
  Next
Next

For i = 1 To tw - 1 '如果某一标记点左右上下均为文字的颜色，则修改该点为背景色
  For j = 1 To th
    If r(i, j) Then If r(i - 1, j) And r(i + 1, j) And r(i, j - 1) And r(i, j + 1) Then PSet (i, j), BackColor
  Next
Next

100
Screen.MousePointer = 0
End Sub


　　简要说明：
　　在“设置”过程中，有一句“tw = TextWidth(st) - 20 * Font.Italic * Font.Size \ 72”的代码，这是因为如果字体为斜体，文本长度在“TextWidth”属性中是体现不出来的，要另外增加像素，并且，字体大小也与斜体要增加的像素有关，我这里是每增加72号文本宽度就增加20像素，你可根据需要修改。