mdlpic.bas

健身俱乐部管理系统

Attribute VB_Name = "MdlPic"
Option Explicit
Private Const BLOCK_SIZE = 10000 '每次读取的字节数

'存储会员照片
Public Function SavePic(FilePath As String, ByRef Rs_File As ADODB.Recordset) As Boolean
    On Error Resume Next
    '退出本过程
    If FilePath = "" Then
        MsgBox "会员照片文件不存在", vbInformation, "提示"
        SavePic = False '保存不成功
        Exit Function
    End If
    
    Dim FileBytes() As Byte  '存储照片图片
    Dim num_blocks As Long
    Dim left_over As Long
    Dim block_num As Long
    Dim File_num As Integer
    
    
    Dim FileType As String '存储的文件类型(后缀)
    Dim P As Integer
    'InStrRev函数
    '返回一个字符串在另一个字符串中出现的位置，从另一个字符串的末尾算起。
    P = InStrRev(FilePath, ".", -1, vbTextCompare)
    FileType = Right(FilePath, Len(FilePath) - P)
    

    
    
    
    File_num = FreeFile    'f%定义整型变量
    Open FilePath For Binary Access Read As #File_num
    If Err <> 0 Then
        MsgBox "会员照片文件不存在", vbInformation, "提示"
        SavePic = False '保存不成功
        Exit Function
    End If
    Rs_File!FileType = FileType '保存文件类型
    
    'LOF函数返回一个 Long，表示用 Open 语句打开的文件的大小，该大小以字节为单位。
    Dim file_length As Long
    file_length = LOF(File_num)
    If file_length > 0 Then
        num_blocks = file_length / BLOCK_SIZE
        left_over = file_length Mod BLOCK_SIZE
        Rs_File!FileLen = file_length '保存文件长度
        ReDim FileBytes(BLOCK_SIZE) '重新定义大小
        For block_num = 1 To num_blocks
            Get #File_num, , FileBytes()
            Rs_File!Picture.AppendChunk FileBytes()
        Next block_num

        If left_over > 0 Then
            ReDim FileBytes(left_over)
            Get #File_num, , FileBytes()
            Rs_File!Picture.AppendChunk FileBytes()
        End If
    

    End If

    Close #File_num
    
    SavePic = True '保存会员照片成功
End Function





'传image控件
Public Sub PhotoDisplay(ByRef ImageControl As Image, ByRef Rs_File As ADODB.Recordset)
    Dim bytes() As Byte
    Dim file_name As String
    Dim File_num As Integer
    Dim file_length As Long
    Dim num_blocks As Long
    Dim left_over As Long
    Dim block_num As Long
    'Screen.MousePointer = vbHourglass '鼠标样式
    DoEvents

    '注释： Get a temporary file name.
    file_name = App.Path & "/Member." & Rs_File!FileType

    '注释： Open the file.
    File_num = FreeFile
    Open file_name For Binary As #File_num

    '注释： Copy the data into the file.
    file_length = Rs_File!FileLen
    num_blocks = file_length / BLOCK_SIZE
    left_over = file_length Mod BLOCK_SIZE

    For block_num = 1 To num_blocks
        bytes() = Rs_File!Picture.GetChunk(BLOCK_SIZE)
        Put #File_num, , bytes()
    Next block_num

    If left_over > 0 Then
        bytes() = Rs_File!Picture.GetChunk(left_over)
        Put #File_num, , bytes()
    End If

    Close #File_num

    '注释： Display the picture file.
    ImageControl.Picture = LoadPicture(file_name)
End Sub