none
请教vb6.0自编的打印预览程序如何实现象word页面视图类似的效果? RRS feed

  • 问题

  • 请教vb6.0自编的打印预览程序如何实现象word页面视图类似的效果(预览显示载体用picture控件?)?
    即:就象word的页面视图一样,打印预览内容页数超过一页时可以前翻页和后翻页,一屏可显示两个页面,可用滚动条框的箭头前后滚动显示,也可拖动滚动条迅速到达指定页面。急......谢谢!

    2008年5月4日 1:03

全部回复

  •      谢谢feiyun0112

         你给的帮助并没有解决我的问题,可能是我的表达有问题,再次详细说明一下问题:

         比如我的数据库中有100条记录,我要用picture控件用print,line等语句把他们显示在图片框中,要求实现象word页面视图类似的效果,即实现分页打印预览,当打印预览内容页数超过一页时可以前翻页和后翻页,一屏可显示两个页面(前一页滚出屏幕一半时,下一页滚上屏幕,两页都可看到,页跟页之间是连续的),可用滚动条框的箭头前后滚动显示,也可拖动滚动条迅速到达指定页面。

         目前我用三个picture控件(一个为容器,名称为pic,两个为预览显示区:名称为p1和p2,A4纸大小)、一个HScroll和一个VScroll控件实现了以上一半的功能。Vscroll用滚动条框的箭头可以前后连续滚动显示(VScroll1_change事件),但拖动滚动条迅速连续显示及到达指定页面却有问题了(VScroll1_Scroll)。下面附上我的程序,请帮助查找原因或给出另外的实现方法,不胜感激。急.........

     

    '标准模块代码
      Option Explicit
       
      Public Const GWL_WNDPROC = -4
      Public Const WM_MOUSEWHEEL = &H20A
      Public prevWndProc     As Long
       
      Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
      Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
      Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
       
      Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
       
              If uMsg = WM_MOUSEWHEEL Then
                      With Form1.VScroll1
                              If wParam < 0 Then
                                      If .Value < .Max Then
                                              .Value = .Value + 10
                                      End If
                              Else
                                      If .Value > .Min Then
                                              .Value = .Value - 10
                                      End If
                              End If
                      End With
              Else
                      WndProc = CallWindowProc(prevWndProc, hWnd, uMsg, wParam, lParam)
              End If
       
      End Function

     

     

     

         Dim yh As Integer
    Dim p1wz As Integer
    Dim p2wz As Integer
    Dim old As Integer
    Dim zys As Integer
    Dim yh1 As Integer, yh2 As Integer

     

    Private Sub Form_Load()
      Me.Height = 11520
        '设置 ScaleMode 为像素。
        Form1.ScaleMode = 1 ' vbPixels
        Pic.ScaleMode = 1 'vbPixels
        '将 Autosize 设置为 True,以使 p1 的边界
        '扩展到实际的位图大小。p1.AutoSize = True
        '将每个图片框的 BorderStyle 属性设置为 None。
        Pic.BorderStyle = 1
        P1.BorderStyle = 1
        P2.BorderStyle = 1

        '加载位图。
        
       Pictures\b_5EB94894FF41F09888AC8B36BB41DD59.jpg")
        P1.AutoRedraw = True
        P2.AutoRedraw = True
       
        P1.Height = 300 * 60: P1.Width = 210 * 60 '为了示例方便,纸张定义改了一下
        P2.Height = 300 * 60: P2.Width = 210 * 60 ' 210
        
        
        'P1.ScaleHeight = 297.0039
        'P2.ScaleHeight = 297.0039
      
        '初始化两个图片框的位置。
        Pic.Move 0, 0, ScaleWidth - VScroll1.Width, Me.ScaleHeight - HScroll1.Height - 3 + 48 - 1200 + 600
        P1.Move 0, 0
        P2.Top = 300 * 60 + Pic.Height
        P2.Left = 0
       
        '将水平滚动条定位。
        HScroll1.Top = Pic.Height
        HScroll1.Left = 0
        HScroll1.Width = Pic.Width
        '将垂直滚动条定位。
        VScroll1.Top = Pic.Top
        VScroll1.Left = Pic.Width
       
       
        VScroll1.Height = Pic.Height 'ScaleHeight - HScroll1.Height   ' Pic.Height
       
       
        '设置滚动条的 Max 属性。
        HScroll1.Max = P1.Width - Pic.Width
       
       
        zys = 6
        VScroll1.Max = 300 * (zys - 1) + (18000 - Pic.Height) / 60
       
       
        '判断子图片框是否将充满屏幕。'若如此,则无需使用滚动条。
        VScroll1.Visible = (Pic.Height < P1.Height)
        HScroll1.Visible = (Pic.Width < P1.Width)

       yh = 1
      
      
        P1.Cls
             P1.CurrentY = 20 * 60
             For i = 1 To 50
                P1.CurrentX = 20 * 60
                P1.Print "第" & yh & "页"
             Next
             'P1.Line (0, 295)-(210, 297), QBColor(8), BF
     
        'yh = 2
       
         P2.Cls
             P2.CurrentY = 20 * 60
             For i = 1 To 50
                P2.CurrentX = 20 * 60
                P2.Print "第2页"
             Next
             'P2.Line (0, 295)-(210, 297), QBColor(8), BF
        
       
        p1wz = 0
        p2wz = 300 * 60
        old = 0
      
       
        prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
              SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
       
    End Sub

     

    Private Sub Form_Unload(Cancel As Integer)
      SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    End Sub

     

    Private Sub HScroll1_Change()
      P1.Left = -HScroll1.Value
    End Sub


    Private Sub VScroll1_change()
       Dim a As Integer
      
      
       a = VScroll1.Value
       mm = a - old
     
      ' If VScroll1.Value > old Then    '向下移动(拖动),则p1和p2应向上滚屏移动
     
         
          p1wz = p1wz - (a - old) * 60
          If p1wz < -18000 Or p1wz > 18000 Then
            
             'yh = IIf(p1wz < -18000, IIf(yh + 2 > zys, zys, yh + 2), IIf(yh - 2 < 1, 1, yh - 2))
            
             If p1wz < -18000 Then
            
               If yh Mod 2 = 0 Then
                 yh = IIf(yh + 1 > zys, zys, yh + 1)
               Else
                 yh = IIf(yh + 2 > zys, zys, yh + 2)
               End If
                
             End If
            
             If p1wz > 18000 Then
            
              
              ' If yh Mod 2 = 0 Then
              '   yh = IIf(yh - 1 < 1, 1, yh - 1)
              ' Else
                 yh = IIf(yh - 2 < 1, 1, yh - 2)
              
              ' End If
                
             End If
            
            
            
             p1wz = IIf(p1wz < -18000, 18000 - (a - old) * 60, -18000 - (a - old) * 60)
                   
               'MsgBox yh
                    
             P1.Cls
             P1.CurrentY = 20 * 60
             For i = 1 To 50
                P1.CurrentX = 20 * 60
                P1.Print "第" & yh & "页    p1"
             Next
             'P1.Line (0, 295)-(210, 297), QBColor(8), BF
          End If
          P1.Move 0, p1wz
          P1.Refresh
         
          p2wz = p2wz - (a - old) * 60
          If p2wz < -18000 Or p2wz > 18000 Then
            
             yh = IIf(p2wz < -18000, IIf(yh + 1 > zys, zys, yh + 1), IIf(yh - 1 < 2, 2, yh - 1))
            
             p2wz = IIf(p2wz < -18000, 18000 - (a - old) * 60, -18000 - (a - old) * 60)
            
             P2.Cls
             P2.CurrentY = 20 * 60
             For i = 1 To 50
                P2.CurrentX = 20 * 60
                P2.Print "第" & yh & "页    p2"
             Next
            'P2.Line (0, 295)-(210, 297), QBColor(8), BF
          End If
          P2.Move 0, p2wz
          P2.Refresh
       'Else    '向下移动(拖动),则p1和p2应向上滚屏移动
       
      
       'End If
     
       old = VScroll1.Value
     
    End Sub

    Private Sub VScroll1_Scroll()
      Dim a As Integer
      
      
       a = VScroll1.Value
       mm = a - old
     
      ' If VScroll1.Value > old Then    '向下移动(拖动),则p1和p2应向上滚屏移动
     
         
          p1wz = p1wz - (a - old) * 60
          If p1wz < -18000 Or p1wz > 18000 Then
            
             'yh = IIf(p1wz < -18000, IIf(yh + 2 > zys, zys, yh + 2), IIf(yh - 2 < 1, 1, yh - 2))
            
             If p1wz < -18000 Then
            
               If yh Mod 2 = 0 Then
                 yh = IIf(yh + 1 > zys, zys, yh + 1)
               Else
                 yh = IIf(yh + 2 > zys, zys, yh + 2)
               End If
                
             End If
            
             If p1wz > 18000 Then
            
              
              ' If yh Mod 2 = 0 Then
              '   yh = IIf(yh - 1 < 1, 1, yh - 1)
              ' Else
                 yh = IIf(yh - 2 < 1, 1, yh - 2)
              
              ' End If
                
             End If
            
            
             Text3 = "p1"
            
            
             p1wz = IIf(p1wz < -18000, 18000 - (a - old) * 60, -18000 - (a - old) * 60)
                     
               'MsgBox yh
                    
             P1.Cls
             P1.CurrentY = 20 * 60
             For i = 1 To 50
                P1.CurrentX = 20 * 60
                P1.Print "第" & yh & "页    p1"
             Next
             'P1.Line (0, 295)-(210, 297), QBColor(8), BF
          End If
          P1.Move 0, p1wz
          P1.Refresh
         
          p2wz = p2wz - (a - old) * 60
          If p2wz < -18000 Or p2wz > 18000 Then
             
             yh = IIf(p2wz < -18000, IIf(yh + 1 > zys, zys, yh + 1), IIf(yh - 1 < 2, 2, yh - 1))
             
             p2wz = IIf(p2wz < -18000, 18000 - (a - old) * 60, -18000 - (a - old) * 60)
            
            
            Text3 = "p2"
             'MsgBox yh
                     
             P2.Cls
             P2.CurrentY = 20 * 60
             For i = 1 To 50
                P2.CurrentX = 20 * 60
                P2.Print "第" & yh & "页    p2"
             Next
            'P2.Line (0, 295)-(210, 297), QBColor(8), BF
          End If
          P2.Move 0, p2wz
          P2.Refresh
       'Else    '向下移动(拖动),则p1和p2应向上滚屏移动
       
      
       'End If
        
       old = VScroll1.Value
     
    End Sub

     

    2008年5月5日 0:39
  • 为什么不这样

     

    Code Snippet

    VScroll1.Max =pic1.height+pic2.height

     

     

    2008年5月5日 10:49
    版主
  • 谢谢feiyun0112 !

    VScroll1.Max =pic1.height+pic2.height这样只能显示两页,到vscroll1的max值时,下面的页只能又清屏换页了,无法连续查看,我要的是象word页面视图一样的效果!

    请各位高手继续给予帮助。谢谢!

     

    2008年5月6日 0:11
  • 可以用pic数组,有几页就用几个

    2008年5月6日 1:41
    版主
  • 谢谢feiyun0112 !

    可我的预览内容正常几十页,最多可达100多页,如用pic数组,那内存的开销会呈几何级增长,同时还的自己控制每个pic的移动位置,因为在scalemode=6方式下,pic的top位置最多只能设置为-4000多——4000多之间,我这个问题想了好长时间,真是麻烦!

     

    不知word页面视图是怎么实现的,如知请指教,谢谢!

     

    2008年5月7日 0:11