嗯,要实现题主这样的效果,应该可以充分利用picture属性和方法,让函数更科学、通用,代码更精炼合理。
以下是引用lingyuan1021在2016-11-30 03:30:05的发言:
进一步优化:翻页,简单解决行高溢出问题。重新对oldx 和oldy 优化。
'*******************************************************
'picturebox
Dim i As Integer, fsx As Integer, fsy As Integer, oldX As Integer, oldY As Integer
Dim a As String
linemark = linemark + 1 '行标
Form1.Picture3.ScaleMode = 4
'‘fs = Form1.Picture3.FontSize
'fs =
oldX = 0
For i = 1 To Len(mystr)
fsx = Form1.Picture3.TextWidth(Mid(mystr, i, 1))
fsy = Form1.Picture3.TextHeight(Mid(mystr, i, 1))
oldX = Form1.Picture3.CurrentX '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
oldY = Form1.Picture3.CurrentY
If Form1.Picture3.ScaleWidth - Form1.Picture3.CurrentX < fsx Then Form1.Picture3.Print Tab(Len(linemark) + 3); '同一记录的下一行输出位置应该在此处确定!
'If Form1.Picture3.CurrentX - oldX > fs Then ' fs = Form1.Picture3.CurrentX - oldX '将字宽调整到最大字宽(已取消)
If i = 1 Then
Form1.Picture3.Print linemark; Tab(Len(linemark) + 3); ":"; Mid(mystr, i, 1);
Else
Form1.Picture3.Print Mid(mystr, i, 1);
End If
'可爱翻页。
If Form1.Picture3.ScaleHeight - oldY - fsy < 0 Then
i = 0 ' 不可以吧i初始化为i=1原因:i在next会自动+1。
End If
If Form1.Picture3.ScaleHeight - oldY - fsy < 0 Then
Form1.Picture3.Cls
End If
'Call 图片显示清屏处理
'oldX = Form1.Picture3.CurrentX ' 该句放这里就会"最后一个字符一些部位"可能溢出图片框. 原因:CurrentX指定的是“下一个”打印位置。解决办法:加入宽度判断或者 将此句放在print前面。
Next
Form1.Picture3.Print '这是多次打印必须的。否则乱麻。
效果:(谢谢大神引导,暂时告一段落,满足了我的需求。再看看另外两个版主的方法)
进一步优化:翻页,简单解决行高溢出问题。重新对oldx 和oldy 优化。
'*******************************************************
'picturebox
Dim i As Integer, fsx As Integer, fsy As Integer, oldX As Integer, oldY As Integer
Dim a As String
linemark = linemark + 1 '行标
Form1.Picture3.ScaleMode = 4
'‘fs = Form1.Picture3.FontSize
'fs =
oldX = 0
For i = 1 To Len(mystr)
fsx = Form1.Picture3.TextWidth(Mid(mystr, i, 1))
fsy = Form1.Picture3.TextHeight(Mid(mystr, i, 1))
oldX = Form1.Picture3.CurrentX '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
oldY = Form1.Picture3.CurrentY
If Form1.Picture3.ScaleWidth - Form1.Picture3.CurrentX < fsx Then Form1.Picture3.Print Tab(Len(linemark) + 3); '同一记录的下一行输出位置应该在此处确定!
'If Form1.Picture3.CurrentX - oldX > fs Then ' fs = Form1.Picture3.CurrentX - oldX '将字宽调整到最大字宽(已取消)
If i = 1 Then
Form1.Picture3.Print linemark; Tab(Len(linemark) + 3); ":"; Mid(mystr, i, 1);
Else
Form1.Picture3.Print Mid(mystr, i, 1);
End If
'可爱翻页。
If Form1.Picture3.ScaleHeight - oldY - fsy < 0 Then
i = 0 ' 不可以吧i初始化为i=1原因:i在next会自动+1。
End If
If Form1.Picture3.ScaleHeight - oldY - fsy < 0 Then
Form1.Picture3.Cls
End If
'Call 图片显示清屏处理
'oldX = Form1.Picture3.CurrentX ' 该句放这里就会"最后一个字符一些部位"可能溢出图片框. 原因:CurrentX指定的是“下一个”打印位置。解决办法:加入宽度判断或者 将此句放在print前面。
Next
Form1.Picture3.Print '这是多次打印必须的。否则乱麻。
效果:(谢谢大神引导,暂时告一段落,满足了我的需求。再看看另外两个版主的方法)
进一步优化:上面那个代码原来有个大bug:惹高度溢出为第一行时,下页输出会出错。嘿嘿 还好细心分析了下。麻雀虽小,强迫症。。。 优化下算法(解决bug。同时提升利用率。)。如下:
程序代码:
Public Sub MyPrint(mystr As String, linemark As Long, obj As Object) '’如obj=form1.picture3 'picturebox Dim i As Integer, fsx As Integer, fsy As Integer, oldX As Integer, oldY As Integer Dim a As String linemark = linemark + 1 '行标 obj.ScaleMode = 1 oldX = 0 For i = 1 To Len(mystr) fsx = obj.TextWidth(Mid(mystr, i, 1)) fsy = obj.TextHeight(Mid(mystr, i, 1)) oldX = obj.CurrentX oldY = obj.CurrentY If obj.ScaleWidth - obj.CurrentX < fsx Then obj.Print Tab(Len(linemark) + 3); If obj.ScaleHeight - oldY - fsy < 0 Then If i = 1 Then obj.Cls Else obj.Cls obj.Print Tab(Len(linemark) + 3); End If End If If i = 1 Then obj.Print linemark; Tab(Len(linemark) + 3); ":"; Mid(mystr, i, 1); Else obj.Print Mid(mystr, i, 1); End If Next obj.Print End Sub
[此贴子已经被作者于2016-12-1 01:44编辑过]