哎,自从搞了双屏幕,整个人都变傻了!!其实副屏幕上就是把显示在主屏幕上的产品以单据的方式显示,下面代码就是副屏幕的代码,pPrintContents就是单据~~
顾客反映每次到忙的时候,都会有卡机的情况发生~~,请大家帮我看下原因出在哪里?Private Sub Form_Load()
    Call FindFile(sAdvtpicfolder)
    ImgTimer.Interval = 10000
    ImgTimer.Enabled = True
End SubPublic Function ViewReceipt(ByVal pPrintContents As Variant)
Dim iCtr            As Integer
Dim Message         As String
Dim sPrice          As String
On Error GoTo ViewReceipt_Error:
    If sViewSecScreenRept = "1" Then
        ReptHeader.Caption = ""
        txtDoubleScreen.Text = ""
        sPrintContents = pPrintContents
        
        For iPrintCount = 0 To UBound(sPrintContents, 2)
            If iPrintCount = 0 Then
                ReptHeader.Caption = sPrintContents(0, iPrintCount) 
            Else
                txtDoubleScreen.Text = txtDoubleScreen.Text & vbCrLf & sPrintContents(0, iPrintCount)
            End If
        Next
        
        With txtDoubleScreen
            .SelStart = InStr(1, .Text, "SUBTOTAL") - 1
            .SelLength = InStr(1, .Text, "Total Qty") - InStr(1, .Text, "SUBTOTAL") - 42
            .SelBold = True
            .SelFontSize = 16
            .SelColor = &HFF&
        End With
    End If
    Exit Function
ViewReceipt_Error:
    WriteToLog "Error in ViewReceipt", Me.name & "_Init"
End FunctionPrivate Sub FindFile(MyPath As String)
Dim Myname  As String
Dim dir_i() As String
Dim i, idir As Long
Dim jCtr    As Integer
On Error GoTo FindFile_Error:
    If MyPath = "0" Then Exit Sub
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath + "\"
    Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
    
    jCtr = 1
    ImageList.ListImages.Clear
    Do While Myname <> ""
        If Myname <> "." And Myname <> ".." Then
            ImageList.ListImages.Add jCtr, "'" & jCtr & "'", LoadPicture(MyPath & Myname) 'added to imagelist
            jCtr = jCtr + 1
        End If
        Myname = Dir
    Loop
    Exit Sub
FindFile_Error:
    WriteToLog "Error in FindFile", Me.name & "_Init"
End SubPrivate Sub AddContents(ByVal pContents As String, Optional ByVal pType As String = "0")
    iCounter = iCounter + 1
    ReDim Preserve sPrintContents(1, iCounter)
    sPrintContents(0, iCounter) = pContents
    sPrintContents(1, iCounter) = pType
End SubPrivate Sub Pic_Resize()
    If Pic = 0 Then Exit Sub
    Pic.PaintPicture Pic, Pic.ScaleLeft, Pic.ScaleTop, Pic.ScaleWidth, Pic.ScaleHeight
End SubPrivate Sub LoadPicPicture()
Dim iCtr As Integer
    On Error GoTo LoadErr:
    If ImageList.ListImages.Count = 0 Then
        ImgTimer.Enabled = False
        Exit Sub
    End If
    If sImglist + 1 > ImageList.ListImages.Count Then
        sImglist = 1
    Else
        sImglist = sImglist + 1
    End If
    Pic.Cls
    Pic.Picture = ImageList.ListImages(sImglist).Picture
    Call Pic_Resize
    Exit Sub
LoadErr:
    WriteToLog "Error in LoadPicPicture", Me.name & "_Init"
End Sub

解决方案 »

  1.   

    MYSQL数据库,与数据库有关系吗?
      

  2.   

    我一直都是双屏幕的,vb6对双屏幕的支持特别不好。但是我觉得在你的这个事情上面不是双屏幕的事情。什么叫忙得时候?是不是网络,数据库访问量大的时候?解决客户的问题
    1。发一个监测/监视程序过去,看看忙的时候是多忙。客户没准可以提供这些
    2。回到开发环境,模拟客户的流量。单屏幕测试我看你现在也有writetolog的,这个函数也可以用于检测时间。每个函数用了多长时间也写到log里面去。看你的代码估计就是在load picture和resize picture上面了。实在不成加doevents,这样用户感觉好点
      

  3.   

    如果屏幕刷新过快会卡,那么延缓其刷新速度就好了。刷那么快反正客户也看不到,不如把数据存在内存中,然后每隔一定时间刷新一次。在时间间距弄个什么loading...上去让客户不会无聊就好了