注册 登录
编程论坛 VB6论坛

将字符串转换为图片并保存

VBlover0 发布于 2015-01-28 23:56, 592 次点击
有数组str(0)="A B CDEF *",str(1)="*****A B CDEF *",如何在VB中将两个字符串转换为png或其它格式的图片,图片宽为字符串的长度,高为两行字符串的高度。
2 回复
#2
lianyicq2015-01-29 08:48
可以用抓屏,稍显麻烦.
更简单可以用print方法
程序代码:
Dim myString As String

Private Sub Command1_Click()
myString = "A B CDEF *"
Picture1.Print myString
SavePicture Picture1.Image, "c:\mystring.bmp"
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub
把字符串打印到picturebox中,再用savepicture的方法将图片框中内容保存为bmp格式的文件

[ 本帖最后由 lianyicq 于 2015-1-29 08:52 编辑 ]
#3
风吹过b2015-01-29 09:10
好吧,我写函数用了 30分钟。

说明:函数内用到的控件名为 P1,类型为 PictureBox ,会自动创建。窗体中内不能出现同名的,但类型不是 PictureBox 的控件,该控件你可以手动创建,会自动引用。
该函数代码需要放到窗体内才能正确运行。放在BAS里就会出现错误(未测试)
传入的字符串数组,下标从0开始,然后自动取所有的元素,如果该元素空白,会导致空行。如果该元素保存了 VBCRLF 字符,会导致跳行。
调用如
程序代码:
Dim s(2) As String
s(0) = "0sdfbsad"
s(1) = "1asnvfgjhdfh"
s(2) = "2dghghjtydfgnsabnsvb"
Debug.Print texttopic(s(), "F:\A.bmp", 20)


函数完整代码
程序代码:
Public Function texttopic(s() As String, FileName As String, Optional FontSize As Long = 12) As Long

Dim P As PictureBox
Dim i As Long, j As Long
Dim w As Long, h As Long

'文件名为空,传回 -1
If FileName = "" Then
    texttopic = -1
    Exit Function
End If

On Error Resume Next

j = 0                                   '临时标志
For i = 0 To Me.Controls.Count - 1      '查找所有的控件
    If Me.Controls(i).Name = "P1" Then  '找到P1
        Set P = Me.Controls(i)          '引用
        j = 1                           '写标志
        Exit For                        '退出循环
    End If
Next i

If j = 0 Then                           '如果没有找到P1,说明第一次运行本函数
    Set P = Controls.Add("VB.PictureBox", "P1")     '创建P1并引用
End If

P.AutoRedraw = True                     '自动重绘开
P.Appearance = 0                        '样式为普通
P.BackColor = &HFFFFFF                  '背景

'此处定义字号的大小
If FontSize > 1 And FontSize < 128 Then     '最大值未测试,随手写了 128
    P.Font.Size = FontSize                  '字号,按传入的参数
End If

'计算字符总高度及最大宽度,未计算上下左右边界及行距
For i = 0 To UBound(s())
    j = P.TextHeight(s(i))
    h = h + j                       '未计算字符间距,未考虑字符上下边距
   
    j = P.TextWidth(s(i))
    If j > w Then w = j
Next i

P.Width = w
P.Width = w + (P.Width - P.ScaleWidth)              '把控件的边距加进去
P.Height = h
P.Height = h + (P.Height - P.ScaleHeight)           '把控件边距加进去

P.Cls                               '清除内容,以确保原点回左上角

'打印字符
For i = 0 To UBound(s())
    P.Print s(i)
Next i

'保存为BMP格式
SavePicture P.Image, FileName

texttopic = Err                 '如果有错误产生,把错误号传回去

End Function
1