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

2005-01-15 03:31:47 822 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

批量识别图片中文字（python、百度开发者工具）进来一直为各种课程的实验报告困扰，字数很多，百度文库、豆瓣等资源网站又无法免费下载。就想着如果我能把他们截图下来，然后批量转换成文字该多好呢？笔者决定通过python程序，调用百度api完成这项功能。认证百度开发者首先要在百度开发者平台认证成为百度开发者，创建应用后即会获得ID、API Key、Secret Key 如图：图中为笔者自己的账号，所以进行了打码。后文进行编程时，笔者将使用网络上分... 阅读详情

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

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

谢谢

...全文

如何用ABBYY FineReader提取图片中的文字作为OCR文字识别软件中的佼佼者，可能大家对于ABBYY FineReader的使用还不熟练，没关系，今天小编就为大家演示，如何用ABBYY FineReader这款文字识别软件，将一张截图中的文字识别出来。图1：《宋史》中的截图图1是《宋史》第一册，宋太祖本纪中的一段内容，下面小编就演示就用ABBYY FineReader 15（Win系统）文字识别软件将此截图中的文字识别出来，再保存到文本文件中。具体操作步骤如下：图2：启动软件 1.提取文字第一步启动ABBYY... 阅读详情

qjzrd

API 1,488 成员 23,270 内容

+ 关注 + 加入社区

切换为时间正序

qjzrd 2005-01-24

打赏
举报

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

sworddx 2005-01-16

打赏
举报

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

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

sworddx 2005-01-16

打赏
举报

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

qjzrd 2005-01-16

打赏
举报

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

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

rongdong_zhu@yahoo.com.cn

sworddx 2005-01-16

打赏
举报

例程发给你了，查收。

sworddx 2005-01-16

打赏
举报

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

cso 2005-01-16

打赏
举报

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

qjzrd 2005-01-16

打赏
举报

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

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

应该如何处理呢

qjzrd 2005-01-16

打赏
举报

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

sworddx 2005-01-15

打赏
举报

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

熊孩子开学喽 2005-01-15

打赏
举报

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

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

相关推荐