怎样将文字转换为图片文件

[qjzrd]

我想将一段文字转换为图片

如：我要将 vb我爱你 这段文字转换为图片文件怎么 弄呢？

谢谢

[熊孩子开学喽]

使用TEXTOUT这个API，把文字输出到picture控件中

[sworddx]

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long


Private Sub Form_Load()
Const sStr = "vb我爱你"
TextOut Picture1.hdc, 0, 0, sStr, tLen(sStr)
SavePicture Picture1.Picture, "c:\1.bmp"
End Sub
Private Function tLen(ByVal expression As String) As String
tLen = Len(expression)
For i = 1 To Len(expression)
If Asc(Mid(expression, i, 1)) < 0 Then
tLen = tLen + 1
End If
Next
End Function

[qjzrd]

好像效果还是不是太好的，反锯齿怎么写呀，
谁有哪个反锯齿的代码呢

[qjzrd]

这样做，用打印机打出来的图片上的字形有点走样，就是字看上去不流畅，特别是在撇的时候

就不那么的连贯的感觉，不知道你们有没有注意到这个，这是怎么会事呢

应该如何处理呢

[cso]

http://blog.csdn.net/cso/archive/2004/08/19/79084.aspx

[sworddx]

反锯齿写起来麻烦了，我到现在也才看见过一个能给直线、椭圆和曲线反锯齿的例程，没见过VB写文字反锯齿的。

[sworddx]

例程发给你了，查收。

[qjzrd]

老兄你发到我的哪个信箱了呀

如果是yahoo的，我没有收到你能重发一次吗？

[e-mail]

[sworddx]

那是因为输出字符时没有经过反锯齿处理。
如果你在使用Windows XP，打开显示 属性->外观->效果，在“使用下列方式使屏幕字体的边缘平滑”前打钩，确定->确定。
接下来在输出时使用除小字号宋体或者新宋体以外的Truetype字体就会得到反锯齿的效果。
如果要输出小字号宋体或者新宋体或者非truetype字体或者你使用的是wxp以前的windows，就只有自己写反锯齿算法了，很麻烦的。

[sworddx]

这儿有一个例子，接近你需要的结果。

Form1的代码（1个PictureBox:Picture2，1个CommandButtom:Command1）
Option Explicit

Const SRCCOPY = &HCC0020

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal _
Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Dim AF As APIFont
Dim X, Y As Integer

Private Sub Command1_Click()
Dim i As Integer

Set AF = Nothing
Set AF = New APIFont
Picture2.Cls
For i = 0 To 3600 Step 360
AF.Escapement = i
AF.SelectFont Picture2
X = Picture2.ScaleWidth / 2
Y = Picture2.ScaleHeight / 2
AF.FontOut "vb我爱你 ", Picture2, X, Y
AF.SelectOrg Picture2
Next i
End Sub

Private Sub Form_Load()
Picture2.ScaleMode = 3
End Sub

类模块APIFont.cls代码

Option Explicit

Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal _
X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont _
As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const TA_LEFT = 0
Private Const TA_RIGHT = 2
Private Const TA_CENTER = 6
Private Const TA_TOP = 0
Private Const TA_BOTTOM = 8
Private Const TA_BASELINE = 24

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 50
End Type

Private m_LF As LOGFONT
Private NewFont As Long
Private OrgFont As Long
Public Sub CharPlace(o As Object, txt$, X, Y)
Dim Throw As Long
Dim hregion As Long
Dim R As RECT

R.Left = X
R.Right = X + o.TextWidth(txt$) * 2
R.Top = Y
R.Bottom = Y + o.TextHeight(txt$) * 2

hregion = CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom)
Throw = SelectClipRgn(o.hdc, hregion)
Throw = TextOut(o.hdc, X, Y, txt$, Len(txt$))
DeleteObject (hregion)
End Sub
Public Sub SetAlign(o As Object, Top, BaseLine, Bottom, Left, Center, Right)
Dim Vert As Long
Dim Horz As Long

If Top = True Then Vert = TA_TOP
If BaseLine = True Then Vert = TA_BASELINE
If Bottom = True Then Vert = TA_BOTTOM
If Left = True Then Horz = TA_LEFT
If Center = True Then Horz = TA_CENTER
If Right = True Then Horz = TA_RIGHT
SetTextAlign o.hdc, Vert Or Horz
End Sub
Public Sub setcolor(o As Object, CValue As Long)
Dim Throw As Long

Throw = SetTextColor(o.hdc, CValue)
End Sub
Public Sub SelectOrg(o As Object)
Dim Throw As Long

NewFont = SelectObject(o.hdc, OrgFont)
Throw = DeleteObject(NewFont)
End Sub
Public Sub SelectFont(o As Object)
NewFont = CreateFontIndirect(m_LF)
OrgFont = SelectObject(o.hdc, NewFont)
End Sub
Public Sub FontOut(text$, o As Control, XX, YY)
Dim Throw As Long

Throw = TextOut(o.hdc, XX, YY, text$, Len(text$))
End Sub

Public Property Get Width() As Long
Width = m_LF.lfWidth
End Property

Public Property Let Width(ByVal W As Long)
m_LF.lfWidth = W
End Property

Public Property Get Height() As Long
Height = m_LF.lfHeight
End Property

Public Property Let Height(ByVal vNewValue As Long)
m_LF.lfHeight = vNewValue
End Property

Public Property Get Escapement() As Long
Escapement = m_LF.lfEscapement
End Property

Public Property Let Escapement(ByVal vNewValue As Long)
m_LF.lfEscapement = vNewValue
End Property

Public Property Get Weight() As Long
Weight = m_LF.lfWeight
End Property

Public Property Let Weight(ByVal vNewValue As Long)
m_LF.lfWeight = vNewValue
End Property

Public Property Get Italic() As Byte
Italic = m_LF.lfItalic
End Property

Public Property Let Italic(ByVal vNewValue As Byte)
m_LF.lfItalic = vNewValue
End Property

Public Property Get UnderLine() As Byte
UnderLine = m_LF.lfUnderline
End Property

Public Property Let UnderLine(ByVal vNewValue As Byte)
m_LF.lfUnderline = vNewValue
End Property

Public Property Get StrikeOut() As Byte
StrikeOut = m_LF.lfStrikeOut
End Property

Public Property Let StrikeOut(ByVal vNewValue As Byte)
m_LF.lfStrikeOut = vNewValue
End Property

Public Property Get FaceName() As String
FaceName = m_LF.lfFaceName
End Property

Public Property Let FaceName(ByVal vNewValue As String)
m_LF.lfFaceName = vNewValue
End Property

Private Sub Class_Initialize()
m_LF.lfHeight = 30
m_LF.lfWidth = 10
m_LF.lfEscapement = 0
m_LF.lfWeight = 400
m_LF.lfItalic = 0
m_LF.lfUnderline = 0
m_LF.lfStrikeOut = 0
m_LF.lfOutPrecision = 0
m_LF.lfClipPrecision = 0
m_LF.lfQuality = 0
m_LF.lfPitchAndFamily = 0
m_LF.lfCharSet = 0
m_LF.lfFaceName = "Arial" + Chr(0)
End Sub

[qjzrd]

谢谢 你们，有问题在问，呵呵