注册 登录
编程论坛 VB6论坛

picturebox 文本换行。

lingyuan1021 发布于 2016-11-29 02:42, 5609 次点击
第一次发帖。不好意思,可能发出来的格式什么的不好看。见谅。
用途:我在实现监视程序,并把监视结果用图片框显示出来。
问题:以下哪一个效果更棒。或者其他算法。第3途径,我该注意些什么。谢谢了大神。
途径:
    1。  硬性的规定长度x。 if len(Mystr) mod x =0 :换行。(当然会有字符长度判断。用left,right循环取值)
    2。  等提字宽法:Wordwidth。 x=int(pictue1.scalewidth / wordwidth).he   
    3.   随机字宽:  1:循环取单个字符,再用标准fontsize 对比缩放其他字体,获得字宽。 并求字宽和 与 picture1.width 比较?  大于则换行。
                     2:还是随机取字符串,求平均字宽。提高效率?
本人尝试了下。发现在系统的单位转换的基础上薄弱。  比如默认是缇,但是有疑问用像素好还是缇好?     如果代码中设置了scalemode后, 是对后面的print起作用还是前面的也行?    printer  picture  form 的默认单位都是缇一样吗?。。是15 ,20关系吗?    等等
我是在网上也百度了 , 但还是不确定,无奈再次提问大家,想问个确切的答案。

随便问一个问题,我也开发了一些按键外挂,但是还是忧郁,封包,内挂(sendkey),还是mousevent 他们的安全性比较。
谢谢大神们花时间来看。 不当之处,望见谅。

[此贴子已经被作者于2016-11-29 02:44编辑过]

18 回复
#2
xiangyue05102016-11-29 08:57
1. 硬性的规定长度x。

这个方法显然是不合理的, 比如“123”和“好的”,前者长度为3,但是显示的时候可能没有后者长度大。 另外这个还跟字体设置有关,需要来回尝试才能得到比较一个比较好的x

后面的两个方法似乎可以。我找到的代码是这样的,你测试一下
程序代码:

Dim StrLine As String, StrALL As String
StrALL = "本人在图形(PictureBox)控件上用Print 方法显示文本,但字数太多,让其自动换行。"
For i = 1 To Len(StrALL)
StrLine = StrLine & Mid(StrALL, i, 1)
If Picture1.TextWidth(StrLine) + 200 >= Picture1.Width Then
Picture1.Print StrLine
StrLine = ""
End If
Next
Picture1.Print StrLine

不过一般情况下,我会直接用textbox, multiline改成true,再设置Locked=true就可以实现了,没有必要搞的这么麻烦。
#3
风吹过b2016-11-29 09:05
单位缇还是像素区别不大。
缇与像素的换成,使用 Screen.TwipsPerPixelX  和 Screen.TwipsPerPixelY 属性得到这个比例关系


以前写的一个过程,在指定区域内,按左右上下居中显示的方式显示字符串,该过程适用于 在图像框上显示内容,也适用于在打印机上打印内容
因为是自己用的代码,所以注释量偏少
程序代码:
Private Sub viewtext(cs As String, obj As Object, lefts As Long, tops As Long)
'每一个参数格式:X1,Y1,X2,Y2,显示内容,[字体[,字号]]
'
字体为可选,字号也为可选,如果需要指定字号,就必须指定字体

On Error Resume Next

Dim fj() As String
Dim vx As Long, vy As Long
Dim Fx As Long, Fy As Long
Dim hx As Long, hy As Long
Dim m As String, n As String
Dim i As Long, j As Long, k As Long
Dim o As Long
Dim H() As String

    fj = Split(cs, ",")             '分解传进来的参数
    If UBound(fj) > 4 Then          '有字体设置
        If Len(fj(5)) > 0 Then      '字体名不为空
            obj.FontName = fj(5)
        End If
    Else
        obj.FontName = "宋体"       '默认为宋体
    End If
   
    If UBound(fj) > 5 Then          '有字号设置
        If Val(fj(6)) > 2 Then      '字号最小不得小于2
            obj.FontSize = fj(6)
        End If
    Else
        obj.FontSize = 字体大小
    End If
   
    Fy = obj.TextHeight(fj(4))           '字体高
    Fx = obj.TextWidth(fj(4))            '字体宽
   
    hx = Val(fj(2)) - Val(fj(0))        '有效宽
    hy = Val(fj(3)) - Val(fj(1))        '有效高
   
    If Fx > hx Or InStr(1, fj(4), "\") > 0 Then         '如果需要换行或人工指定的多多行
        
        If InStr(1, fj(4), "\") > 0 Then                '如果人工指定的多多行
            H = Split(fj(4), "\")                       '直接分解为每一行
            k = UBound(H)                '取行数
        Else
        
            k = Fx / hx          '计算需要分成多少行
            
            ReDim H(k)
            i = 0
            j = 1
            o = 1
            Do
                H(i) = Mid(fj(4), j, o)                     '一个字符一个字符的试下去
                If obj.TextWidth(H(i)) > hx - 100 Then      '试到撑满格子为止
                    j = j + o                               '本行结束,保存各变量
                    o = 1
                    i = i + 1
                Else
                    o = o + 1                               '本行未结束,长度加一,继续试下去
                End If
               
            Loop While j + o < Len(fj(4)) + 2           '<原来就 要加1,因为循环前是o+1,所以这里要再加1
        
        End If
        
        For i = 0 To k                          '处理每一行
      
            Fx = obj.TextWidth(H(i))            '字体宽
            vx = lefts + Val(fj(0)) + (hx - Fx) / 2
            vy = tops + Val(fj(1)) + (hy - Fy * (k + 1 + (k) * 0.2)) / 2 + Fy * (i) * 1.2           '行距为1.2,总高度为 行数*1+(行数-1)*0.2
            obj.CurrentX = vx
            obj.CurrentY = vy
            obj.Print H(i)
        
        Next i
   
    Else                    '没有多行,直接计算坐标显示
        vx = lefts + Val(fj(0)) + (hx - Fx) / 2
        vy = tops + Val(fj(1)) + (hy - Fy) / 2
        obj.CurrentX = vx
        obj.CurrentY = vy
        obj.Print fj(4)
    End If   
End Sub
#4
xzlxzlxzl2016-11-29 09:27
有一个currentx、currenty属性可以利用,自动智能识别最大字宽,可获得满意自动换行,代码及效果如下:
Private Sub Command1_Click()
  Dim a As String, fs As Integer, oldX As Integer, i As Integer
  a = "本人尝试了下。发现在系统的单位转换的基础上薄弱。比如默认是缇,但是有疑问用像素好还是缇好?如果代码中设置了scalemode后,是对后面的print起作用还是前面的也行?printer  picture  form 的默认单位都是缇一样吗?是15 ,20关系吗?等等"
  fs = Picture1.FontSize
  oldX = 0
  For i = 1 To Len(a)
    If Picture1.ScaleWidth - Picture1.CurrentX < fs Then Picture1.Print
    If Picture1.CurrentX - oldX > fs Then fs = Picture1.CurrentX - oldX     '将字宽调整到最大字宽
    oldX = Picture1.CurrentX                                                '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
    Picture1.Print Mid(a, i, 1);
    'oldX = Picture1.CurrentX  该句放这里就会溢出图片框
  Next  
End Sub
只有本站会员才能查看附件,请 登录
#5
lingyuan10212016-11-29 09:31
回复 2楼 xiangyue0510
多谢大神回复。 起床上个wc看看,那么快速的响应,你们太好了。  不过过会上班,先继续睡一觉,,有空测试了在公布下结果。哈哈谢谢你。
#6
lingyuan10212016-11-29 09:41
回复 3楼 风吹过b
昨天上班,无意浏览到你们的网站,看到你回复的众多帖子,你真是个语重心长 技术过硬的好人,很佩服,给我很深的印象,所以回来鼓起勇气发了个求助帖子,这么多年第一次发类似帖子,以前都是自己百度,算法等自己想办法解决。但解决问题效率和运行效率,真的不敢肯定是否最优,虽然知道知识只有讨论才能升华,但个人性格问题。。。。  所以谢谢你的所有留言,当然还有其他版主,你们都给我了精神上的榜样。只有精神 才能有顶级的知识。 以后很多要向你学习,麻烦了。  此次结果有空测试就验证下,继续睡觉偷个懒,过会上班。。。。嘿嘿  谢谢你。    对了,你们的一个女版主?  哈哈看到她和别人用技术和心态和别人吵了一架,她太让人深刻了,很棒。  你们的这个团队很棒,我们众多网游的精神食粮。
#7
lingyuan10212016-11-29 09:46
回复 4楼 xzlxzlxzl
你的ID. ,虽然昨天才接触这个,但是已经足够熟悉了。我想不止是技术,更是心态和精神。  谢谢哈。  没法,要上班,只能抽空再次测试代码,但相信你们的算法肯定是ok的,对我,算法比语法本身更重要。  你们的各种方法,真的是给我的一个定心丸。  谢谢你版主,早安,不过我先睡觉了。。。
#8
lingyuan10212016-11-29 13:43
以下是引用xzlxzlxzl在2016-11-29 09:27:23的发言:

有一个currentx、currenty属性可以利用,自动智能识别最大字宽,可获得满意自动换行,代码及效果如下:
Private Sub Command1_Click()
  Dim a As String, fs As Integer, oldX As Integer, i As Integer
  a = "本人尝试了下。发现在系统的单位转换的基础上薄弱。比如默认是缇,但是有疑问用像素好还是缇好?如果代码中设置了scalemode后,是对后面的print起作用还是前面的也行?printer  picture  form 的默认单位都是缇一样吗?是15 ,20关系吗?等等"
  fs = Picture1.FontSize
  oldX = 0
  For i = 1 To Len(a)
    If Picture1.ScaleWidth - Picture1.CurrentX < fs Then Picture1.Print
    If Picture1.CurrentX - oldX > fs Then fs = Picture1.CurrentX - oldX     '将字宽调整到最大字宽
        oldX = Picture1.CurrentX                                                '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
    Picture1.Print Mid(a, i, 1);
    'oldX = Picture1.CurrentX  该句放这里就会溢出图片框
  Next  
End Sub


程序代码:
Public Sub MyPrint(myStr As String, linemark As Long)
'*******************************************************
'
picturebox换行处理
    Dim i As Integer, fs As Integer, oldX As Integer
    Dim a As String
    linemark = linemark + 1'行标
    'count8 = count8 + 1
    'count9 = count9 + 1
   
    fs = Form1.Picture3.FontSize
    oldX = 0
    For i = 1 To Len(myStr)
        If Form1.Picture3.ScaleWidth - Form1.Picture3.CurrentX < fs Then Form1.Picture3.Print Tab(Len(linemark) + 3);                   '同一记录的下一行输出位置应该在此处确定!
        
        If Form1.Picture3.CurrentX - oldX > fs Then fs = Form1.Picture3.CurrentX - oldX       '将字宽调整到最大字宽
        oldX = Form1.Picture3.CurrentX                                                        '记下当前字符位置,Picture1.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
        
        '可爱翻页。但是条件简陋,当同一个记录的下一行的可用高度大于currenty小于字体高度就发生溢出少许。办法:字体高度加入判断条件,或者改变picturebox height属性到等倍字高。
        If Form1.Picture3.ScaleHeight < Form1.Picture3.CurrentY Then
            i = 0                                                                              ' 不可以吧i初始化为i=1原因:i在next会自动+1。
        End If
        Call 图片显示清屏处理
        'oldX = Form1.Picture3.CurrentX ' 该句放这里就会"最后一个字符一些部位"可能溢出图片框. 原因:CurrentX指定的是“下一个”打印位置。解决办法:加入宽度判断或者 将此句放在print前面。
    Next
    Form1.Picture3.Print  ’这是多次打印必须的。否则乱麻。
End Sub


     你的核心源码没动,暂且称之为:自动等宽处理法?。自己理解了一下你的注释。大约增加了一个行标。  要上班 没来得及对注释中的bug处理。  另外两个版主大神的代码没来得及看。  有空再试试你们的方法,并简短封装一下,把几种方法融合,方便学习使用。再次谢谢
   
只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2016-11-29 13:52编辑过]

#9
lingyuan10212016-11-30 03:04
以下是引用xzlxzlxzl在2016-11-29 09:27:23的发言:

有一个currentx、currenty属性可以利用,自动智能识别最大字宽,可获得满意自动换行,代码及效果如下:
Private Sub Command1_Click()
  Dim a As String, fs As Integer, oldX As Integer, i As Integer
  a = "本人尝试了下。发现在系统的单位转换的基础上薄弱。比如默认是缇,但是有疑问用像素好还是缇好?如果代码中设置了scalemode后,是对后面的print起作用还是前面的也行?printer  picture  form 的默认单位都是缇一样吗?是15 ,20关系吗?等等"
  fs = Picture1.FontSize
  oldX = 0
  For i = 1 To Len(a)
    If Picture1.ScaleWidth - Picture1.CurrentX < fs Then Picture1.Print
    If Picture1.CurrentX - oldX > fs Then fs = Picture1.CurrentX - oldX     '将字宽调整到最大字宽
    oldX = Picture1.CurrentX                                                '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
    Picture1.Print Mid(a, i, 1);
    'oldX = Picture1.CurrentX  该句放这里就会溢出图片框
  Next  
End Sub


进一步改进(已经测试了不同字体和字号,和不同scalemode):
程序代码:
'picturebox换行处理
    Dim i As Integer, fs As Integer, oldX As Integer
    Dim a As String
    linemark = linemark + 1 '行标
    'count8 = count8 + 1
    'count9 = count9 + 1
    Form1.Picture3.ScaleMode = 1
    '‘fs = Form1.Picture3.FontSize
    'fs =
   
    oldX = 0
    For i = 1 To Len(mystr)
        fs = Form1.Picture3.TextWidth(Mid(mystr, i, 1))'/**/版主用字号来做判断条件太简陋了,不恰当的box宽度,肯定会出现空格。改进为宽度判断。
        If Form1.Picture3.ScaleWidth - Form1.Picture3.CurrentX < fs Then Form1.Picture3.Print Tab(Len(linemark) + 3);               '/**/同一记录的下一行输出位置应该在此处确定!
        
        'If Form1.Picture3.CurrentX - oldX > fs Then ' fs = Form1.Picture3.CurrentX - oldX '将字宽调整到最大字宽。  /**/基于上面fs的解释,这句就多余了。
            oldX = Form1.Picture3.CurrentX                                                        '记下当前字符位置,Picture1.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
        
        '可爱翻页。但是条件简陋,当同一个记录的下一行的可用高度大于currenty小于字体高度就发生溢出少许。办法:字体高度加入判断条件,或者改变picturebox height属性到等倍字高。
        If Form1.Picture3.ScaleHeight < Form1.Picture3.CurrentY Then
            i = 0                                                                              ' 不可以吧i初始化为i=1原因:i在next会自动+1。
        End If
        Call 图片显示清屏处理
        'oldX = Form1.Picture3.CurrentX ' 该句放这里就会"最后一个字符一些部位"可能溢出图片框. 原因:CurrentX指定的是“下一个”打印位置。解决办法:加入宽度判断或者 将此句放在print前面。
    Next
    Form1.Picture3.Print  '这是多次打印必须的。否则乱麻。


效果:
只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录
#10
lingyuan10212016-11-30 03:30
以下是引用xzlxzlxzl在2016-11-29 09:27:23的发言:

有一个currentx、currenty属性可以利用,自动智能识别最大字宽,可获得满意自动换行,代码及效果如下:
Private Sub Command1_Click()
  Dim a As String, fs As Integer, oldX As Integer, i As Integer
  a = "本人尝试了下。发现在系统的单位转换的基础上薄弱。比如默认是缇,但是有疑问用像素好还是缇好?如果代码中设置了scalemode后,是对后面的print起作用还是前面的也行?printer  picture  form 的默认单位都是缇一样吗?是15 ,20关系吗?等等"
  fs = Picture1.FontSize
  oldX = 0
  For i = 1 To Len(a)
    If Picture1.ScaleWidth - Picture1.CurrentX < fs Then Picture1.Print
    If Picture1.CurrentX - oldX > fs Then fs = Picture1.CurrentX - oldX     '将字宽调整到最大字宽
    oldX = Picture1.CurrentX                                                '记下当前字符位置,Picture1.CurrentX - oldX就是刚打印的字符宽度,该句放这里效果最佳
    Picture1.Print Mid(a, i, 1);
    'oldX = Picture1.CurrentX  该句放这里就会溢出图片框
  Next  
End Sub


进一步优化:翻页,简单解决行高溢出问题。重新对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  '这是多次打印必须的。否则乱麻。


效果:(谢谢大神引导,暂时告一段落,满足了我的需求。再看看另外两个版主的方法)
只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2016-11-30 03:31编辑过]

#11
xzlxzlxzl2016-11-30 12:24
嗯,要实现题主这样的效果,应该可以充分利用picture属性和方法,让函数更科学、通用,代码更精炼合理。
#12
lingyuan10212016-12-01 01:35
以下是引用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  '这是多次打印必须的。否则乱麻。

效果:(谢谢大神引导,暂时告一段落,满足了我的需求。再看看另外两个版主的方法)


进一步优化:上面那个代码原来有个大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编辑过]

#13
lingyuan10212016-12-01 13:37
回复 10楼 lingyuan1021
进一步优化,和完善一些小功能。 反正没事做,,,  
连续自动打印效果(20-24 没打印就截图了):
只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2016-12-1 13:38编辑过]

#14
xzlxzlxzl2016-12-01 15:52
对你12楼的代码进行了测试,发现一些问题
1:你字宽取第一个字符的字宽,如果第一个字符是ascii码,宽度只有中文字符的一半,此时换行处中文字符可能只显示一半,另中国字为方块字,字高就是字宽,因此不需要fzy变量
2:当显示字符足够多,一个图片框装不下时,只显示后面的字符,而不是从头显示然后等待翻页
3:使用TAB作为格式符,当字体大小不同时,显示格式就对不齐
4:当显示字符里含有换行符时,显示格式就乱了
#15
xzlxzlxzl2016-12-01 16:10
下午没什么事,模仿你的功能需求也做了个,我使用了显示缓冲区概念,不管追加多少字符,均可通过翻页完成显示,自动累加并显示行号,可设置显示字符大小和颜色,不管设置字符大小如何,显示格式的对齐位置不变,反正可能出现的极端情况尽量考虑进去(比如字符显示刚好在边界处有换行符导致的重复换行),核心代码及显示效果如下:
程序代码:
Public Function picPrint(sPic As PictureBox, inChar As String) As Integer
  Dim a As String, i As Integer, j As Integer, locStart As Integer, fSize As Integer
  inChar = Trim(inChar)
  picPrint = -1                              '先假设函数调用失败
  j = sPic.FontSize
  sPic.FontSize = 9
  locStart = sPic.TextHeight("") * 8         '设置标准的格式起点,确保任何大小的字符起点一致
  sPic.FontSize = j
  fSize = sPic.TextHeight("")                '按方块字的规则,字高等于字宽
  If sPic.ScaleHeight < fSize Or sPic.ScaleWidth < locStart + fSize Then Exit Function   '如果图片没有足够的宽高则调用失败,返回-1
  If inChar = "" And sPic.DataMember = "" Then
    picPrint = 0
    sPic.Cls
    sPic.DataField = 0
    Exit Function                             '显示字符和显示缓冲字符都为空则清屏、行标清0
  End If
  If inChar <> "" Then sPic.DataMember = sPic.DataMember & Chr(1) & inChar  '待显示字符添加到显示缓冲区
  If sPic.CurrentX > 0 Then sPic.Print        '确保另起一行显示
  If sPic.CurrentY + fSize > sPic.ScaleHeight Then sPic.Cls  '如果当前显示位置不足以显示一个字符高度,说明要换页显示
  For i = 1 To Len(sPic.DataMember)
    a = Mid(sPic.DataMember, i, 1)
    If Asc(a) > 0 And Asc(a) < 14 Then
      '属于控制符的处理,1是我自定义的追加字符和缓冲区未显示完字符的分隔符
      If Asc(a) = 1 Then
        If sPic.CurrentX > 0 Then sPic.Print
        If sPic.CurrentY + fSize > sPic.ScaleHeight Then
          i = i - 1
          Exit For
        End If
        sPic.Print Val(sPic.DataField) & ":";
        sPic.DataField = Val(sPic.DataField) + 1
        sPic.CurrentX = 0
      End If
      If Asc(a) = 13 Then sPic.Print
    Else
      If sPic.CurrentX = 0 Then sPic.CurrentX = locStart
      sPic.Print a;
      If sPic.CurrentX + fSize > sPic.ScaleWidth Then sPic.Print
    End If
    If sPic.CurrentY + fSize > sPic.ScaleHeight Then Exit For
  Next
  If i > Len(sPic.DataMember) Then i = i - 1
  sPic.DataMember = Right(sPic.DataMember, Len(sPic.DataMember) - i)
  picPrint = Len(sPic.DataMember)
End Function

只有本站会员才能查看附件,请 登录
#16
lingyuan10212016-12-01 16:43
回复 14楼 xzlxzlxzl
手机回复。  十二楼代码的确有问题。十三楼就解决了一些。  不过  那个字宽,是每一个字符宽度,不是第一个字符。     不过你说的那几个问题要回家才能测试。   你说的是不是同一行不同字体带来的问题?       初步猜想是没有最大字宽变量下,     原代码又没有考虑字高来设计打印位置 ,另一方面,不同字体间可能间隙,width 函数不能测出的原因。   回家再看看,同时发上新代码。
#17
lingyuan10212016-12-01 16:48
回复 15楼 xzlxzlxzl
谢谢新的思路,缓冲区这些。  有点不同的是,那是个自动打印,要把指定字符加颜色,就像十三效果。  现在是ok了。    回家再把你的新方式和可能bug考虑进去。。

[此贴子已经被作者于2016-12-1 16:54编辑过]

#18
lingyuan10212016-12-02 05:01
以下是引用xzlxzlxzl在2016-12-1 15:52:58的发言:

对你12楼的代码进行了测试,发现一些问题
1:你字宽取第一个字符的字宽,如果第一个字符是ascii码,宽度只有中文字符的一半,此时换行处中文字符可能只显示一半,另中国字为方块字,字高就是字宽,因此不需要fzy变量
2:当显示字符足够多,一个图片框装不下时,只显示后面的字符,而不是从头显示然后等待翻页
3:使用TAB作为格式符,当字体大小不同时,显示格式就对不齐
4:当显示字符里含有换行符时,显示格式就乱了


现在程序运行到很符合我的要求。但有你说的一些问题,但是为了进一步完善,再啰嗦几天 呵呵,实在没时间写代码,完善了再发上来让你们修改。 以后网友感兴趣的也可以直接引用,不用那么麻烦了。

回家看了下,找了你说的原因。
    1。 ASCII VBLF TAB 等相当于"操作" 。  我封装的那个函数功能是对 “字符串” 做出处理。   
        ASCII 暂时测试正常。放第一个位置也是正常的。 特殊ASCII无法显示的会用?表示。但是格式不受影响。
        VBLF 这些换行之类的 行为操作,暂时没有单独对他们处理,不支持而已,如果存在,所以会错位。 因为该操作会暂时中断,或者说优先于函数体对后面字符的处理,所以会错排。需要单独解决。但是感觉没有必要,这不是该函数的功能。现在考虑下。
        字体大小突然变换引起排版问题: 这个的确没有注意到。回头按照你说的,设置标准点阵。或者回头我想用等比缩放试试。
    2。。。  完了 忘了要说什么。刚才还想起的。那就先这样吧。
    3。。。  对了,翻页显示问题。那个我就做的 可爱翻页,因为很简单,至少不会出现溢出。可以溢出了重新显示。  但是时间太少了,没有考虑太多,你说的存-显模式,提醒了我。早这样交流就不会这么笨了。。有空试试罗。。

[此贴子已经被作者于2016-12-2 05:05编辑过]

#19
dsasada2018-04-17 14:03
学习了,不错
1