Private Sub TF_Click()
Dim x As Single
Dim y As Single
Dim fs, a
Dim GD() As Integer, result As String
Dim L As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(Dir1.Path & "\" & Text1.Text & ".txt", True)
result = ""
ImageFrm.Pic.ScaleMode = vbPixels
ReDim GD(0 To FontFrm.PicF.TextWidth() - 1, 0 To FontFrm.PicF.TextHeight - 1)
For y = 0 To FontFrm.PicF.TextHeight - 1
a.write ("DB ")
For x = 0 To FontFrm.PicF.TextHeight - 1 '扫描所有像
L = FontFrm.PicF.Point(x, y)
If L = 0 Then
GD(x, y) = 0
Else
GD(x, y) = 1
End If
End Sub
result = result & CStr(GD(x, y))
a.write (CStr(GD(x, y)))
If x = FontFrm.PicF.TextWidth - 1 Then
a.writeline ("")
End If
Next x
Next y
————————————————————————————————————————————————————————————————这个是我的程序
Private Declare Function GetPixel Lib "gdi32" (ByVal HDC As Long, ByVal x As Long, ByVal y As Long) As Long
Dim a() As Long
Private Sub Command1_Click()
Picture1.ForeColor = vbRed
Picture1.ScaleMode = 2
Picture1.FontSize = Picture1.ScaleWidth
Picture1.Print "怪"
Dim i As Long, j As Long
ReDim a(1 To Picture1.Width, 1 To Picture1.Height)
For i = 1 To Picture1.Width
For j = 1 To Picture1.Height
a(i, j) = &HFFFFFF - GetPixel(Picture1.HDC, i, j) '这里我用反色显示
Next
Next
Picture1.Cls
End Sub
Private Sub Command2_Click()
Picture1.ScaleMode = 3
Dim i As Long, j As Long
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
Picture1.PSet (i, j), a(i, j)
Next
Next
End Sub
我现在要做的是 读取显示在PICTUREBOX上的文本的每个点的颜色植 要用到TEXTWIDTH TEXTHEIGHT 求到每个点的坐标 X,Y值
如下
REDIM GD(X,Y)
For y = 0 To FontFrm.PicF.TextHeight(text1.text) - 1
For x = 0 To FontFrm.PicF.TextWidth(text1.text) - 1