如何把文本文件转化成图像方式?并将文本文件显示出来,无论文件有多大?并随时可更改文件内容.
如题 问题点数：100、回复次数：2Top
1 楼lzj34（缘来如此）回复于 2003-09-04 14:49:22 得分 100
不好意思抢了你名字,不要生气,答案我也带来了如下
'图象效果API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Dim mstr_total As String '文本中所有字符
Dim mint_now_pst As Integer '当前页
Option Base 1
Dim mpagegroup(200) As String '每一页的字符集合用一个数组元素存储
Dim mint_max_pst As Integer '当前的最后一页
Dim mint_charinfile_counted As Long '当前已存储的在整个文本中的字符位置
Public Function filegeter(file_path As String) As String
Dim lstr As String, lstrall As String
Open file_path For Input As #1
While Not EOF(1)
Line Input #1, lstr
lstrall = lstrall + lstr + Chr(13)
Wend
Close #1
filegeter = lstrall
If Len(lstrall) < 3 Then filegeter = Space(20)
End Function
Public Sub textshowmode()
Dim w As Integer, h As Integer
Static icount As Integer, if_end As Integer
'保留图片
If if_end = mint_now_pst Then textshow.Refresh: Exit Sub
if_end = mint_now_pst
icount = icount + 1
If icount > 2 Then icount = 0
w = textshow.Width
h = textshow.Height
Select Case icount
Case 0
'清除文本
sX = textshow.Width / 600
sY = textshow.Height / 600
For kuan = 0 To sX + 1
For i = 0 To 600
BitBlt textshow.hDC, 0, sY * i, textshow.Width, kuan, _
textshowcls.hDC, 0, sY * i, vbSrcCopy
BitBlt textshow.hDC, sX * i, 0, kuan, textshow.Height, _
textshowcls.hDC, sX * i, 0, vbSrcCopy
Next i
Sleep (10)
Next kuan
'打印文本
sX = textshow.Width / 600
sY = textshow.Height / 600
For kuan = 0 To sX + 1
For i = 0 To 600
BitBlt textshow.hDC, 0, sY * i, textshow.Width, kuan, _
textshowtemp.hDC, 0, sY * i, vbSrcCopy
BitBlt textshow.hDC, sX * i, 0, kuan, textshow.Height, _
textshowtemp.hDC, sX * i, 0, vbSrcCopy
Next i
Sleep (10)
Next kuan
Case 1
'清除文本
sX = textshow.Width / 600
For kuan = 0 To sX + 1
For i = 0 To 600
BitBlt textshow.hDC, sX * i, 0, kuan, textshow.Height, _
textshowcls.hDC, sX * i, 0, vbSrcCopy
Next i
Sleep (10)
Next kuan
'打印文本
sX = textshow.Width / 600
For kuan = 0 To sX + 1
For i = 0 To 600
BitBlt textshow.hDC, sX * i, 0, kuan, textshow.Height, _
textshowtemp.hDC, sX * i, 0, vbSrcCopy
Next i
Sleep (10)
Next kuan
Case 2
'清除文本
sY = textshow.Height / 600
For kuan = 0 To sY + 1
For i = 0 To 600
BitBlt textshow.hDC, 0, sY * i, textshow.Width, kuan, _
textshowcls.hDC, 0, sY * i, vbSrcCopy
Next i
Sleep (10)
Next kuan
'打印文本
sY = textshow.Height / 600
For kuan = 0 To sY + 1
For i = 0 To 600
BitBlt textshow.hDC, 0, sY * i, textshow.Width, kuan, _
textshowtemp.hDC, 0, sY * i, vbSrcCopy
Next i
Sleep (10)
Next kuan
End Select
textshow.Picture = textshowtemp.Image
End Sub
Private Sub Form_Load()
'Me.Picture = LoadPicture(App.Path & "\pic\textshow.bmp") '在此添入背景图路径
Me.Height = Screen.Height
Me.Width = Screen.Width
Me.Left = 0
Me.Top = 0
'flash1.Movie = App.Path & "\fla\sui.swf"
Call textshow.PaintPicture(Me.Picture, 0, 0, textshow.Width, textshow.Height, textshow.Left, textshow.Top, textshow.Width, textshow.Height, vbSrcCopy)
mstr_total = filegeter(gstrpath) '显示的文本
textshowtemp.Picture = textshow.Image
textshowcls.Picture = textshow.Image
textshow.AutoRedraw = False
mint_now_pst = 1
mint_max_pst = 0
mint_charinfile_counted = 0
End Sub
Private Sub getpst()
Dim now_countcharcopy As Long '用来保存当前的mint_max_pst，以便确定当前的数组中的字符个数
Dim strtemp_in_group As String '当前用来显示的字符集合
Dim exit_thiswhile As Boolean '确定是否换行了，若换了就退出当前循环以便判断是否文本越界
Dim strtemp_in_grouptemp As String '保存当前strtemp_in_group，以便strtemp_in_group更改后可以确定当前数组的字符个数
exit_thiswhile = False
If mint_now_pst <= mint_max_pst Then
strtemp_in_group = mpagegroup(mint_now_pst)
Else
If mint_charinfile_counted < Len(mstr_total) Then
strtemp_in_group = Right(mstr_total, Len(mstr_total) - mint_charinfile_counted)
strtemp_in_grouptemp = strtemp_in_group
now_countcharcopy = mint_charinfile_counted
Else
strtemp_in_group = mpagegroup(mint_max_pst)
mint_now_pst = mint_max_pst
End If
End If
textshowtemp.Cls
While Len(strtemp_in_group) > 0 And (textshowtemp.CurrentY + 600 < textshowtemp.Height)
If Not exit_thiswhile Then
textshowtemp.Print
textshowtemp.CurrentX = textshowtemp.CurrentX + 200
textshowtemp.CurrentY = textshowtemp.CurrentY + 100
End If
exit_thiswhile = False
While ((Len(strtemp_in_group) > 0) And (textshowtemp.CurrentX + 400 < textshowtemp.Width) And (Not (exit_thiswhile)))
textshowtemp.Print Left(strtemp_in_group, 1);
If mint_now_pst > mint_max_pst Then mint_charinfile_counted = mint_charinfile_counted + 1
If textshowtemp.Width - textshowtemp.CurrentX > textshowtemp.Width - 2 Then
textshowtemp.CurrentX = textshowtemp.CurrentX + 200
textshowtemp.CurrentY = textshowtemp.CurrentY + 100
exit_thiswhile = True
End If
If Len(strtemp_in_group) > 0 Then
strtemp_in_group = Right(strtemp_in_group, Len(strtemp_in_group) - 1)
End If
Wend
Wend
If mint_now_pst > mint_max_pst Then
mint_max_pst = mint_max_pst + 1
mpagegroup(mint_max_pst) = Left(strtemp_in_grouptemp, mint_charinfile_counted - now_countcharcopy)
End If
textshowtemp.Refresh
'textshowtemp.Picture = textshowtemp.Image
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Form2 = Nothing
End Sub
Private Sub Label1_Click(Index As Integer)
Dim pid As Long
Select Case Index
Case 0
If mint_now_pst > 1 Then
mint_now_pst = mint_now_pst - 1
Call getpst
Call textshowmode
End If
Case 1
If mint_charinfile_counted < Len(mstr_total) Then
mint_now_pst = mint_now_pst + 1
Call getpst
Call textshowmode
Else
If mint_now_pst < mint_max_pst Then mint_now_pst = mint_now_pst + 1
Call getpst
Call textshowmode
End If
Case 2
If ind = 1 Then
Erase mpagegroup
Form1.Show
Unload Me
Else
Form5.Show
Unload Me
End If
'ret1 = Shell(App.Path & "\国家产业政策.exe", vbNormalFocus)
End Select
End Sub
Private Sub Timer1_Timer()
Call getpst
Call textshowmode
Timer1.Enabled = False
End Sub
试一下行不行,我这里是行的Top
2 楼lzj341（）回复于 2003-09-04 14:57:17 得分 0
谢谢楼上的同名兄弟
有效我会给分的Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
