谁来帮我注释段代码，谢谢急！在线等待

Option Explicit
Private Enum MediaTypes
    MTGraphic
    MTWave
    MTAVI
    MTMP3
End EnumDim rs As Recordset
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384
Dim filename As StringDim NameWanted As String
Dim db As Database
Dim Description As StringDim lMaxHeight As Long
Dim lMaxWidth As Long
Dim CurMediaType As MediaTypesPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub FixFinalSize()Dim lTempWidth As Long
Dim lTempHeight As Long
Dim X As Single
Dim Y As Single
lMaxHeight = Shape1.Height - 20
lMaxWidth = Shape1.WidthX = lMaxHeight / Picture1.Height
With picFinal
    .Width = Picture1.Width - 10
    .Height = Picture1.Height - 10
    .Width = .Width * X
    .Height = .Height * X
    .Top = Shape1.Top    If .Width > lMaxWidth Then
        Y = lMaxWidth / .Width
        .Width = .Width * Y
        .Height = .Height * Y
    End If
End With
Me.Refresh
End SubPrivate Sub ReadFromDB()
Dim MediaTemp As String
Dim lngOffset As Long
Dim lngTotalSize As Long
Dim strChunk As String
Dim mediaid As Long
On Error Resume NextIf fa.MouseRow = 0 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))
Set rs = db.OpenRecordset("SELECT tblMedia.MediaBLOB, tblMedia.MediaType FROM tblMedia WHERE tblMedia.MediaID = " & mediaid, dbOpenSnapshot)
If rs.RecordCount = 0 Then
   MsgBox "error retrieving object"
   rs.Close
   Set rs = Nothing
   Exit Sub
End IfCurMediaType = rs!MediaType
Select Case CurMediaType
    Case MTGraphic

        MediaTemp = App.Path & "\mdiatemp.tmp"
    Case MTWave
        MediaTemp = App.Path & "\mdiatemp.wav"
    Case MTAVI
        MediaTemp = App.Path & "\mdaitemp.avi"
    Case MTMP3
        MediaTemp = App.Path & "\mdaitemp.mp3"
    Case Else
        rs.Close
        Set rs = Nothing
        MsgBox "Error retrieving object"
        Exit Sub
End Select
Kill (MediaTemp)
DataFile = 1
Open MediaTemp For Binary Access Write As DataFileIf Err.Number = 70 Then
    MsgBox Err.Number & vbCr & vbCr & Err.Description & vbCr & vbCr & "this error may be due to " & _
        "the media player holding a lock on a wav or avi file." & vbCr & "Close the mediaplayer and try again.", vbInformation, "SMITH MEDIA DEMO"
    Err.Clear
    rs.Close
    Set rs = Nothing
    Exit Sub
End If
lngTotalSize = rs!MediaBLOB.FieldSize
Chunks = lngTotalSize \ ChunkSize
Fragment = lngTotalSize Mod ChunkSize
ReDim Chunk(ChunkSize)
Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
Put DataFile, , Chunk()
lngOffset = lngOffset + ChunkSize
Do While lngOffset < lngTotalSize
   Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
   Put DataFile, , Chunk()
   lngOffset = lngOffset + ChunkSize
Loop
Close DataFile
filename = MediaTemp
  ShellPlay MediaTemp
End SubPrivate Sub RefillGrid()
Dim sSQL As String
Dim rs As Recordset
Dim lCurRow As Long
sSQL = "SELECT tblMedia.MediaID, tblMedia.MediaName, " & _
    "tblMedia.MediaType, tblMedia.MediaDescription FROM " & _
    "tblMedia ORDER BY tblMedia.MediaName"
Set rs = db.OpenRecordset(sSQL, dbOpenForwardOnly)
With fa
    'setup grid
    .Cols = 5
    .FixedCols = 1
    .ColWidth(1) = 0
    .ColWidth(0) = 300
    .AllowUserResizing = flexResizeBoth
    .Rows = 1
    .TextMatrix(0, 2) = "MediaName"
    .TextMatrix(0, 3) = "Type"
    .TextMatrix(0, 4) = "Description"
    'fill grid
    Do While Not rs.EOF
        lCurRow = .Rows
        .Rows = .Rows + 1
        .TextMatrix(lCurRow, 1) = CStr(rs!mediaid)
        .TextMatrix(lCurRow, 2) = rs!MediaName
        .TextMatrix(lCurRow, 3) = rs!MediaType
        .TextMatrix(lCurRow, 4) = rs!MediaDescription

    rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End WithEnd Sub
Private Sub ResetForm()
txtName = ""
txtDescription = ""
Label3.Caption = ""
End Sub
Private Sub ShellPlay(ByVal sPath As String)
    Dim lret As Long
    Dim sText As String
    sText = Trim$(sPath)
    lret = ShellExecute(hwnd, "open", sText, vbNull, vbNull, SW_SHOWNORMAL)
    If lret >= 0 And lret <= 32 Then
        MsgBox "error opening viewer program"
    End If
End SubPrivate Sub Command1_Click()
Dim sSQL As String
sSQL = "DELETE * FROM tblMedia"
db.Execute sSQL, dbFailOnError
RefillGrid
End SubPrivate Sub fa_Click()
Dim mediaid As LongIf fa.MouseRow = 1 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))
did = mediaid
End SubPrivate Sub fa_DblClick()If fa.MouseRow = 0 Then Exit Sub'quick demo style
ResetForm
ReadFromDBEnd Sub
Private Sub FileName_Change()
SaveToDB.Enabled = filename <> ""
If filename = "" Then Exit Sub
If CurMediaType = MTGraphic Then
    Picture1.Picture = LoadPicture(filename)
    If Picture1.Picture = 0 Then Exit Sub

    picFinal.Visible = False
    FixFinalSize
    CenterPic


    Dim SourceX As Long, SourceY As Long
    SourceX = 0
    SourceY = 0
    Dim DestX As Long, DestY As Long
    DestX = 0
    DestY = 0
    Dim SourceWidth As Long, SourceHeight As Long
    SourceWidth = Picture1.ScaleWidth
    SourceHeight = Picture1.ScaleHeight
    Dim DestWidth As Long
    Dim DestHeight As Long
    DestWidth = picFinal.ScaleWidth
    DestHeight = picFinal.ScaleHeight
    Dim RasterOp As Long
    RasterOp = &HCC0020



    picFinal.PaintPicture Picture1.Picture, DestX, DestY, DestWidth, DestHeight, 0, 0, SourceWidth, SourceHeight, RasterOp&
    picFinal.Visible = TrueElse
    ShellPlay filename
End If
End SubPrivate Sub Form_Load()
Set db = Workspaces(0).OpenDatabase(App.Path & "\grx.mdb")
ResetForm
RefillGrid
End Sub
Private Sub SaveToDB_Click()
Dim MediaName As String
MediaName = Trim$(txtName)
If Len(MediaName) = 0 Then
    MsgBox "请输入媒体文件的名称！"
    Exit Sub
End IfSet rs = db.OpenRecordset("SELECT * FROM tblMedia WHERE tblMedia.MediaName = " & Chr(34) & MediaName & Chr(34), dbOpenDynaset)
If rs Is Nothing Or rs.Updatable = False Then
   MsgBox "不能打开或写入记录集！"
   Exit Sub
End If
If rs.EOF Then
   rs.AddNew
Else
    rs.Edit
End If
    rs!MediaName = MediaName
    Description = Trim$(txtDescription)
    rs!MediaDescription = Description
    rs!MediaType = CurMediaType
DataFile = 1
Open filename For Binary Access Read As DataFile
    Fl = LOF(DataFile)    ' 文件中数据长度
    If Fl = 0 Then
        Close DataFile
        Exit Sub
    End If
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    rs!MediaBLOB.AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
    For I = 1 To Chunks
        Get DataFile, , Chunk()
        rs!MediaBLOB.AppendChunk Chunk()
    Next I
Close DataFile
rs.Update
rs.Close
Set rs = NothingResetForm
RefillGrid
End SubPrivate Sub LoadFromFile_Click() 'On Error Resume Next
With CommonDialog1
    .CancelError = True
    .Filter = "Pictures(*.bmp;*.ico;*.gif;*.jpg)|*.bmp;*.ico;*.gif;*.jpg|Wave Files(*.wav)|*.wav|MS Video(*.avi)|*.avi|all files(*.*)|*.*"
     .Flags = cdlOFNHideReadOnly
    .ShowOpen
    If Err.Number = cdlCancel Then
        Err.Clear
        Exit Sub
    End If
    CurMediaType = .FilterIndex - 1
    Label3.Caption = .filename
    filename = .filename
    txtName.Text = .FileTitle
End With
End Sub

上面是代码，大家帮我注释下，和实现删除某一记录和以文件名查询的功能一定给分,
数据库grx.mdb中只有一个表tblMedia,结构如下:
字段名字段类型字段长度
MediaID LONG 4
MediaBLOB BINARY
MediaName TEXT 50
MediaDescription MEMO
MediaType Integer 2

'++++++++++++++++++++
'********************
Option ExplicitPrivate Enum MediaTypes '枚举各媒体文件类型
    MTGraphic
    MTWave
    MTAVI
    MTMP3
End EnumDim rs As Recordset '记录集,用于存放打开的纪录
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384
Dim filename As StringDim NameWanted As String
Dim db As Database
Dim Description As StringDim lMaxHeight As Long
Dim lMaxWidth As Long
Dim CurMediaType As MediaTypesPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub FixFinalSize()
'设置各控件大小与位置
Dim lTempWidth As Long
Dim lTempHeight As Long
Dim X As Single
Dim Y As Single
lMaxHeight = Shape1.Height - 20
lMaxWidth = Shape1.WidthX = lMaxHeight / Picture1.Height
With picFinal
    .Width = Picture1.Width - 10
    .Height = Picture1.Height - 10
    .Width = .Width * X
    .Height = .Height * X
    .Top = Shape1.Top    If .Width > lMaxWidth Then
        Y = lMaxWidth / .Width
        .Width = .Width * Y
        .Height = .Height * Y
    End If
End With
Me.Refresh
End SubPrivate Sub ReadFromDB()
'从数据库中读出文件
Dim MediaTemp As String
Dim lngOffset As Long
Dim lngTotalSize As Long
Dim strChunk As String
Dim mediaid As Long
On Error Resume NextIf fa.MouseRow = 0 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))
Set rs = db.OpenRecordset("SELECT tblMedia.MediaBLOB, tblMedia.MediaType FROM tblMedia WHERE tblMedia.MediaID = " & mediaid, dbOpenSnapshot)
'打开选中的纪录的记录集If rs.RecordCount = 0 Then
'若为空纪录，退出
   MsgBox "error retrieving object"
   rs.Close
   Set rs = Nothing
   Exit Sub
End IfCurMediaType = rs!MediaType
Select Case CurMediaType
'针对各种媒体文件类型以下将数据库中文件存为对应的媒体文件名
    Case MTGraphic
        MediaTemp = App.path & "\mdiatemp.tmp"
    Case MTWave
        MediaTemp = App.path & "\mdiatemp.wav"
    Case MTAVI
        MediaTemp = App.path & "\mdaitemp.avi"
    Case MTMP3
        MediaTemp = App.path & "\mdaitemp.mp3"
    Case Else
        rs.Close
        Set rs = Nothing
        MsgBox "Error retrieving object"
        Exit Sub
End Select
Kill (MediaTemp)
'若已经存在对应的媒体文件，则删除
DataFile = 1
Open MediaTemp For Binary Access Write As DataFile
'打开对应的媒体文件(MediaTemp)往里写If Err.Number = 70 Then
    '如果格式不支持，则报错并退出
    MsgBox Err.Number & vbCr & vbCr & Err.Description & vbCr & vbCr & "this error may be due to " & _
        "the media player holding a lock on a wav or avi file." & vbCr & "Close the mediaplayer and try again.", vbInformation, "SMITH MEDIA DEMO"
    Err.Clear
    rs.Close
    Set rs = Nothing
    Exit Sub
End If
lngTotalSize = rs!MediaBLOB.FieldSize
'得到文件大小
Chunks = lngTotalSize \ ChunkSize
'得到每个数据块大小
Fragment = lngTotalSize Mod ChunkSize
ReDim Chunk(ChunkSize)
'从新申请所需的空间
Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
Put DataFile, , Chunk()
'写入第一块
lngOffset = lngOffset + ChunkSize
Do While lngOffset < lngTotalSize
'连续写入，直至完成
   Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
   Put DataFile, , Chunk()
   lngOffset = lngOffset + ChunkSize
Loop
Close DataFile
'关闭
filename = MediaTemp
  ShellPlay MediaTemp
'打开媒体文件
End SubPrivate Sub RefillGrid()
'刷新网格显示纪录
Dim sSQL As String
Dim rs As Recordset
Dim lCurRow As Long
sSQL = "SELECT tblMedia.MediaID, tblMedia.MediaName, " & _
    "tblMedia.MediaType, tblMedia.MediaDescription FROM " & _
    "tblMedia ORDER BY tblMedia.MediaName"
Set rs = db.OpenRecordset(sSQL, dbOpenForwardOnly)
'得到新的纪录集
With fa
    'setup grid
    .Cols = 5
    .FixedCols = 1
    .ColWidth(1) = 0
    .ColWidth(0) = 300
    .AllowUserResizing = flexResizeBoth
    .Rows = 1
    .TextMatrix(0, 2) = "MediaName"
    .TextMatrix(0, 3) = "Type"
    .TextMatrix(0, 4) = "Description"
    '设置列头
    'fill grid
    Do While Not rs.EOF
    '一行一行的添加纪录
        lCurRow = .Rows
        .Rows = .Rows + 1
        .TextMatrix(lCurRow, 1) = CStr(rs!mediaid)
        .TextMatrix(lCurRow, 2) = rs!MediaName
        .TextMatrix(lCurRow, 3) = rs!MediaType
        .TextMatrix(lCurRow, 4) = rs!MediaDescription

    rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End WithEnd Sub
Private Sub ResetForm()
'清空各提示
txtName = ""
txtDescription = ""
Label3.Caption = ""
End Sub
Private Sub ShellPlay(ByVal sPath As String)
'调用API函数ShellExecute打开对应的文件
    Dim lret As Long
    Dim sText As String
    sText = Trim$(sPath)
    lret = ShellExecute(hwnd, "open", sText, vbNull, vbNull, SW_SHOWNORMAL)
    If lret >= 0 And lret <= 32 Then
        MsgBox "error opening viewer program"
    End If
End SubPrivate Sub Command1_Click()
'删除纪录
Dim sSQL As String
sSQL = "DELETE * FROM tblMedia" '你这没加条件where...，应该是删除所有的纪录
db.Execute sSQL, dbFailOnError
RefillGrid
End SubPrivate Sub fa_Click()
'得到选中纪录的ID值，用于标志选中的纪录
Dim mediaid As LongIf fa.MouseRow = 1 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))
did = mediaid
End SubPrivate Sub fa_DblClick()
'双击时先清空个提示信息，然后打开选中的文件If fa.MouseRow = 0 Then Exit Sub'quick demo style
ResetForm
ReadFromDBEnd Sub

Private Sub FileName_Change()
SaveToDB.Enabled = filename <> ""
If filename = "" Then Exit Sub
If CurMediaType = MTGraphic Then
'如果打开的纪录存的是图像，那么在Picture控件中显示对应图像
    Picture1.Picture = LoadPicture(filename)
    If Picture1.Picture = 0 Then Exit Sub

    picFinal.Visible = False
    FixFinalSize
    CenterPic


    Dim SourceX As Long, SourceY As Long
    SourceX = 0
    SourceY = 0
    Dim DestX As Long, DestY As Long
    DestX = 0
    DestY = 0
    Dim SourceWidth As Long, SourceHeight As Long
    SourceWidth = Picture1.ScaleWidth
    SourceHeight = Picture1.ScaleHeight
    Dim DestWidth As Long
    Dim DestHeight As Long
    DestWidth = picFinal.ScaleWidth
    DestHeight = picFinal.ScaleHeight
    Dim RasterOp As Long
    RasterOp = &HCC0020



    picFinal.PaintPicture Picture1.Picture, DestX, DestY, DestWidth, DestHeight, 0, 0, SourceWidth, SourceHeight, RasterOp&
    picFinal.Visible = TrueElse
    '否则，调用相关程序打开文件
    ShellPlay filename
End If
End SubPrivate Sub Form_Load()
'打开文件grx.mdb，并初始化网格与提示信息
Set db = Workspaces(0).OpenDatabase(App.path & "\grx.mdb")
ResetForm
RefillGrid
End Sub
Private Sub SaveToDB_Click()
'添加新的纪录或修改纪录
Dim MediaName As String
MediaName = Trim$(txtName)
If Len(MediaName) = 0 Then
    MsgBox "请输入媒体文件的名称！"
    Exit Sub
End IfSet rs = db.OpenRecordset("SELECT * FROM tblMedia WHERE tblMedia.MediaName = " & Chr(34) & MediaName & Chr(34), dbOpenDynaset)
'打开记录集
If rs Is Nothing Or rs.Updatable = False Then
    '若打不开，提示报错退出
   MsgBox "不能打开或写入记录集！"
   Exit Sub
End If
If rs.EOF Then
    '如果是最后，则添加新纪录
   rs.AddNew
Else
    '否则，修改纪录
    rs.Edit
End If
    '赋值
    rs!MediaName = MediaName
    Description = Trim$(txtDescription)
    rs!MediaDescription = Description
    rs!MediaType = CurMediaType
DataFile = 1
Open filename For Binary Access Read As DataFile
    '读取文件到对应字段rs!MediaBLOB
    Fl = LOF(DataFile)    ' 文件中数据长度
    If Fl = 0 Then
        Close DataFile
        Exit Sub
    End If
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    rs!MediaBLOB.AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
    For I = 1 To Chunks
        Get DataFile, , Chunk()
        rs!MediaBLOB.AppendChunk Chunk()
    Next I
Close DataFile
rs.Update
rs.Close
Set rs = NothingResetForm
RefillGrid
End SubPrivate Sub LoadFromFile_Click() '
'选择文件，得到要打开的文件名
On Error Resume Next
With CommonDialog1
    .CancelError = True
    .Filter = "Pictures(*.bmp;*.ico;*.gif;*.jpg)|*.bmp;*.ico;*.gif;*.jpg|Wave Files(*.wav)|*.wav|MS Video(*.avi)|*.avi|all files(*.*)|*.*"
     .Flags = cdlOFNHideReadOnly
    .ShowOpen
    If Err.Number = cdlCancel Then
        Err.Clear
        Exit Sub
    End If
    CurMediaType = .FilterIndex - 1
    Label3.Caption = .filename
    filename = .filename
    txtName.Text = .FileTitle
End With
End Sub

调试易

谁来帮我注释段代码，谢谢急！在线等待

解决方案 »

谁来帮我注释段代码，谢谢 急！在线等待

解决方案 »

谁来帮我注释段代码，谢谢急！在线等待