为什么出现溢出？

KenjiSato

参照 Trynew 看图作文--相册做了个ADP版，但进行浏览时，如果一张张以正常速度按导航按钮没有问题，如果快速点击导航按钮就出现如图错误。代码如下：

请指点问题在哪儿，谢谢！

Private Sub Command7_Click()
On Error GoTo Err_Command7_Click
    '首记录
    ReadPic (1)
    Image0.Picture = PicPathName
    TNO = CurrRecNo & " of " & PicCount

Exit_Command7_Click:
    Exit Sub

Err_Command7_Click:
    MsgBox Err.Description
    Resume Exit_Command7_Click
   
End Sub
Private Sub Command9_Click()
On Error GoTo Err_Command9_Click
    '上记录
    ReadPic (CurrRecNo - 1) '2
    Image0.Picture = PicPathName
    TNO = CurrRecNo & " of " & PicCount

Exit_Command9_Click:
    Exit Sub

Err_Command9_Click:
    MsgBox Err.Description
    Resume Exit_Command9_Click
   
End Sub
Private Sub Command10_Click()
On Error GoTo Err_Command10_Click
    '下记录
    ReadPic (CurrRecNo + 1) '3
    Image0.Picture = PicPathName
    TNO = CurrRecNo & " of " & PicCount
   
Exit_Command10_Click:
    Exit Sub

Err_Command10_Click:
    MsgBox Err.Description
    Resume Exit_Command10_Click
   
End Sub
Private Sub Command11_Click()
On Error GoTo Err_Command11_Click
    '尾记录
    ReadPic (PicCount)
    Image0.Picture = PicPathName
    TNO = CurrRecNo & " of " & PicCount

Exit_Command11_Click:
    Exit Sub

Err_Command11_Click:
    MsgBox Err.Description
    Resume Exit_Command11_Click
   
End Sub


Function ReadPic(PicNo As Integer)
    Dim RST As New ADODB.Recordset, CNN As New ADODB.Connection
    Dim FileData() As Byte, FileNo As Long, FileSize As Long
   
   
  'ole控件的名字.Action = acOLEActivate
  
   
    If PicDir = "" Then
        Set CNN = CurrentProject.Connection
        Set RST = CNN.Execute("exec Fl_系统记忆变量 '图象目录' ")
        PicDir = RST!记忆值
        RST.Close
        Set RST = Nothing
        MsgBox "ERROR"
    End If
   
    Set CNN = CurrentProject.Connection
    RST.Open "Tb_背景图库 ", CNN, adOpenStatic, adLockPessimistic
    PicCount = RST.RecordCount
    'MsgBox RST.AbsolutePosition
   
    If PicCount > 0 Then  '没有记录
        Select Case PicNo
        Case 1
            RST.MoveFirst
            CurrRecNo = 1
        Case PicCount
            RST.MoveLast
            CurrRecNo = RST.RecordCount
        Case Else
            
            RST.Move (PicNo - 1)
            CurrRecNo = PicNo
        End Select
        PicPathName = PicDir & "\" & RST!说明
        'Debug.Print CurrRecNo & ": " & PicPathName
    If Dir(PicPathName) = "" Then
        'Beep
        FileNo = FreeFile
        Open PicPathName For Binary As #FileNo
        'Open PicName For Binary As #FileNo
        ReDim FileData(RST("背景图").ActualSize)  '重新初始化数组
        FileData() = RST("背景图").GetChunk(RST("背景图").ActualSize)  '把OLE字段的内容保存到数组

        Put #FileNo, , FileData()   '把数组内容保存到文件
        Close #FileNo
        Erase FileData
    End If
    End If
    RST.Close
    Set RST = Nothing

End Function

cg1

上述问题我早就遇到了，主要是access对图片的转换导致出错，无法避免

huanghai

我也有同样的遭遇

jhzlzc29

谢谢提供代码，先先收下了：）

binbow_z

特别是在做背景窗体时最容易出现这个问题了