介绍一种用代码制作大型空心字的方法

admin

思路：首先把最大的粗体72号字（使用72号字的原因是考虑到如果以后要放大，那么这个字号的锯齿边比较轻微）用某种颜色（例如红色）打印到图片框上，再逐个取点判断：如果该点的前后上下四个点都为红色，则可断定该点位于笔划内部，属于要“掏空”的点，那么就对该点做一个标记（不能直接更换颜色，因为更换颜色以后，下一个点的判断就不对了），最后再逐点检查标记，把凡是有标记的点更换颜色。<br />　　代码如下：<br /><br />Option Explicit<br /><br />Private Sub Form_Load()<br />Picture1&#46;Font&#46;Size = 72: Picture1&#46;Font&#46;Bold = True<br />Picture1&#46;ForeColor = vbRed: Picture1&#46;AutoRedraw = True<br />Picture1&#46;Visible = False: Picture1&#46;ScaleMode = 3: Me&#46;ScaleMode = 3<br />Me&#46;WindowState = 2<br />End Sub<br /><br />Private Sub Form_Click()<br />Dim st As String, z As String, r() As Boolean, r1 As Long<br />Dim w As Integer, h As Integer, x As Integer, y As Integer<br />Dim i As Integer, J As Integer, k As Integer<br /><br />st = &quot;新年好&quot;<br />w = Picture1&#46;TextWidth(st): h = Picture1&#46;TextHeight(st)<br />Picture1&#46;Move 0, 0, w, h<br />Picture1&#46;CurrentX = x: Picture1&#46;CurrentY = y: Picture1&#46;Print st<br /><br />ReDim r(1 To w, 1 To h)<br /><br />For i = 1 To w &#39;按行列取点，如果该点与左右上下四点的颜色相同，则标记该点<br />  For J = 1 To h<br />    r1 = Picture1&#46;Point(i, J)<br />    If r1 = vbRed Then r(i, J) = (Picture1&#46;Point(i - 1, J) = r1 And Picture1&#46;Point(i + 1, J) = r1 And Picture1&#46;Point(i, J - 1) = r1 And Picture1&#46;Point(i, J + 1) = r1)<br />  Next<br />Next<br /><br />For i = 1 To w &#39;如果某一点做了标记，则修改为白色<br />  For J = 1 To h<br />    If r(i, J) Then Picture1&#46;PSet (i, J), vbWhite<br />  Next<br />Next<br /><br />Picture1&#46;Picture = Picture1&#46;Image<br />PaintPicture Picture1, 0, 40, w * 3, h * 3 &#39;放大3倍复制到窗体<br />End Sub<br /><br /><br />　　如果你觉得笔划还要加粗，那么可将有关代码修改如下：<br /><br />st = &quot;新年好&quot;: k = 6<br />w = Picture1&#46;TextWidth(st) + (k + 1) * Len(st): h = Picture1&#46;TextHeight(st) + k<br />Picture1&#46;Move 0, 0, w, h<br /><br />For i = 1 To Len(st) &#39;逐个打印，并加粗笔划<br />  z = Mid(st, i, 1)<br />  For J = 1 To k<br />    Picture1&#46;CurrentX = x: Picture1&#46;CurrentY = y: Picture1&#46;Print z<br />    x = x + 1: y = y + 1<br />  Next<br />  x = x + Picture1&#46;TextWidth(z): y = 0<br />Next<br /><br />ReDim r(1 To w, 1 To h)<br /><br /><br /><blockquote class="blockquote">From: http://www&#46;ccworker&#46;com/read&#46;php?tid=1605  Powered by PHPWind&#46;com</blockquote>