Office中国论坛/Access中国论坛

标题: 为什么出现溢出？ [打印本页]

作者: KenjiSato 时间: 2003-1-3 18:21
标题: 为什么出现溢出？

参照 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 时间: 2003-1-4 01:13
上述问题我早就遇到了，主要是access对图片的转换导致出错，无法避免

作者: huanghai 时间: 2003-1-5 03:06
我也有同样的遭遇

作者: jhzlzc29 时间: 2003-1-5 08:30
谢谢提供代码，先先收下了：）

作者: binbow_z 时间: 2003-1-5 22:00
特别是在做背景窗体时最容易出现这个问题了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)