frmmain.frm

用visual basic 开发的界面

Dim RecordLength As Integer '记录长度
Dim FileNum As Integer '系统打开文件时的可用文件编号

Dim ShowPhotoNo As Integer '当前显示的照片的顺序号

Private Sub ShowPhoto() '显示照片过程
    If ShowPhotoNo >= 1 And ShowPhotoNo <= PhotoCount Then
        Me.lblShowPhotoPath.Caption = Trim(Photos(ShowPhotoNo).FileName)
        Me.framShowPhotoPath.Caption = "第" & ShowPhotoNo & "张（共" & PhotoCount & "张）"
        If Len(Dir(Trim(lblShowPhotoPath.Caption))) = 0 Then
            Me.imgShowPhoto.Picture = LoadPicture("")
            MsgBox "此照片文件的路径或名称已改变，或者已被删除！建议删除此照片！", vbExclamation, "错误提示"
            
            Exit Sub
        Else
            Me.imgShowPhoto.Picture = LoadPicture(Trim(lblShowPhotoPath.Caption))
        End If
    Else
        Me.lblShowPhotoPath.Caption = ""
        Me.framShowPhotoPath.Caption = "第 张（共 张）"
    End If
End Sub
Private Sub ShowAllPhotos() '在列表框lstAllPhotos中列出所有像册内照片
                            '名称并把对数组Photos赋值
    Dim i As Integer
    Dim MyPhotoCount As Integer
    
    PhotoFile = App.Path & "\Photos.ini"
    If Len(Dir(PhotoFile)) = 0 Then
        MsgBox "文件" & PhotoFile & "不存在！", vbExclamation, "错误提示"
    Else
        RecordLength = LenB(CurrentRecord) '计算每条记录的长度
        FileNum = FreeFile '取出下一个可用文件编号
        
        MyPhotoCount = 0
        PhotoCount = 0
        '以下用 Open 语句打开文件
        Open PhotoFile For Random As FileNum Len = RecordLength
        
        Do
            MyPhotoCount = MyPhotoCount + 1
            ReDim Preserve Photos(1 To MyPhotoCount) As PhotoType
            
            Get FileNum, MyPhotoCount, CurrentRecord
            
            If CurrentRecord.PhotoNo = 1 Then
                PhotoCount = PhotoCount + 1
                
                Photos(PhotoCount).PhotoNo = CurrentRecord.PhotoNo
                Photos(PhotoCount).FileName = Trim(CurrentRecord.FileName)
                Photos(PhotoCount).PhotoName = Trim(CurrentRecord.PhotoName)
            End If
        Loop Until Photos(MyPhotoCount).PhotoNo = 0
         
        Close FileNum
        
        Me.lstAllPhotos.Clear
        For i = 1 To PhotoCount
            Me.lstAllPhotos.AddItem (Photos(i).PhotoName)
        Next i
    End If
End Sub



Private Sub cmdAdd_Click()
    Dim i As Integer
    Dim Result
    
    With Me.CommonDialog1
        .InitDir = App.Path & "\Photos" '设置对话框初始路径
        .Flags = cdlOFNHelpButton    '使对话框显示帮助按钮
        .ShowOpen '显示 CommonDialog 控件的“打开”对话框
    End With
    
    FileName = CommonDialog1.FileName '取得“打开”对话框中选取的文件
    If FileName = "" Then '若文件名为空则退出此Click事件过程
        Exit Sub
    End If
    If Len(Dir(FileName)) = 0 Then '若取得的文件名不存在，则提示后退出此Click事件过程
        MsgBox "照片文件" & FileName & "不存在！", vbExclamation, "提示"
        Exit Sub
    Else  '若文件存在，则将相应照片信息写入照片信息文件
        Result = InputBox("请输入照片名：", "照片名称输入", FileName)
        If Result = "" Then '若输入的照片名为空，则以其文件名为其照片名
            PhotoName = FileName
        Else
            PhotoName = Result
        End If
        
        
        
        RecordLength = LenB(CurrentRecord) '计算每条记录的长度
        
        FileNum = FreeFile '取出下一个可用文件编号
        
        PhotoCount = PhotoCount + 1
        ReDim Preserve Photos(1 To PhotoCount) As PhotoType '数组Photos动态增长
        
        '以下用 Open 语句打开文件
        Open PhotoFile For Random As FileNum Len = RecordLength
        
        '以下将照片信息写入变量CurrentRecord
        CurrentRecord.PhotoNo = 1
        CurrentRecord.PhotoName = PhotoName
        CurrentRecord.FileName = FileName
        
        '以下将CurrentRecord中数据写入存储照片信息的文件
        Put #FileNum, PhotoCount, CurrentRecord
        
        Close FileNum '关闭打开的文件
        
        '以下将新添加的照片信息写入数组Photos中
        Photos(PhotoCount).PhotoNo = CurrentRecord.PhotoNo
        Photos(PhotoCount).FileName = CurrentRecord.FileName
        Photos(PhotoCount).PhotoName = CurrentRecord.PhotoName
        
         '以下在列表框lstAllPhotos中添加新项
        Me.lstAllPhotos.AddItem (Photos(PhotoCount).PhotoName)
    End If
End Sub

Private Sub cmdDelete_Click()
    Dim i As Integer
    Dim Response
    Dim NameStr As String
    
    If lstAllPhotos.ListIndex = -1 Then '若没有选择任何照片，则提示后退出
        MsgBox "请先选择照片！", vbExclamation, "系统提示"
        Exit Sub
    End If
    NameStr = lstAllPhotos.List(lstAllPhotos.ListIndex) '取得选中的照片名
    Response = MsgBox("你确定要删除照片【" & Trim(NameStr) & "】吗？", vbQuestion + vbYesNo, "照片删除确认")
    If Response = vbNo Then '若不想删除，则退出；否则继续
        Exit Sub
    End If

    RecordLength = LenB(CurrentRecord) '计算每条记录的长度
    FileNum = FreeFile '取出下一个可用文件编号
    
    Open PhotoFile For Random As FileNum Len = RecordLength
                        '用 Open 语句打开文件
    CurrentRecord.PhotoNo = -1 '设置照片顺序号为－1
    '以下将变量CurrentRecord写入文件，更改要删除的记录
    Put #FileNum, lstAllPhotos.ListIndex + 1, CurrentRecord
      
    '以下用来删除数组Photos中已删除的照片信息
    For i = lstAllPhotos.ListIndex + 1 To PhotoCount - 1
        Photos(i) = Photos(i + 1)
    Next i
    PhotoCount = PhotoCount - 1
    
    Me.lstAllPhotos.Clear '列表框清空
    For i = 1 To PhotoCount '在列表框中重新显示所有照片名
        Me.lstAllPhotos.AddItem (Photos(i).PhotoName)
    Next i
End Sub

Private Sub cmdExit_0_Click()
    End
End Sub

Private Sub cmdExit_1_Click()
    End
End Sub



Private Sub cmdfd_Click()
imgShowPhoto.Width = imgShowPhoto.Width * 1.2
imgShowPhoto.Height = imgShowPhoto.Height * 1.2
End Sub

Private Sub cmdFirst_Click()
    ShowPhotoNo = 1
    Call ShowPhoto '调用显示照片过程
End Sub


Private Sub cmdLast_Click()
    ShowPhotoNo = PhotoCount
    Call ShowPhoto
End Sub

Private Sub cmdNext_Click()
    If ShowPhotoNo = PhotoCount Then
        MsgBox "当前已是最后一张照片！", vbExclamation, "提示"
        Exit Sub
    Else
        ShowPhotoNo = ShowPhotoNo + 1
    End If
    
    Call ShowPhoto
End Sub

Private Sub cmdPre_Click()
    If ShowPhotoNo = 1 Then
        MsgBox "当前已是第一张照片！", vbExclamation, "提示"
        Exit Sub
    Else
        ShowPhotoNo = ShowPhotoNo - 1
    End If
    
    Call ShowPhoto
End Sub



Private Sub cmdsx_Click()
imgShowPhoto.Width = imgShowPhoto.Width / 1.2
imgShowPhoto.Height = imgShowPhoto.Height / 1.2
End Sub

Private Sub Form_Activate()
    If PhotoCount = 0 Then
        MsgBox "相册内现无照片，请先添加照片！", vbExclamation, "提示"
    End If
End Sub

Private Sub Form_Load()
    Call ShowAllPhotos  '调用显示所有照片过程
    Call cmdFirst_Click '调用命令按钮"第一张"事件过程
    
    SSTab1.Tab = 0
End Sub



Private Sub imgYulanPhoto_DblClick()
    ShowPhotoNo = Me.lstAllPhotos.ListIndex + 1
    Call ShowPhoto
    
    SSTab1.Tab = 0 '设定初始页面为"照片显示"
End Sub

Private Sub lstAllPhotos_Click()
    If Me.lstAllPhotos.ListIndex <> -1 Then
        '显示文件路径
        Me.lblPhotoPath.Caption = Trim(Photos(Me.lstAllPhotos.ListIndex + 1).FileName)
        If Len(Dir(Trim(lblPhotoPath.Caption))) = 0 Then
            Me.imgYulanPhoto.Picture = LoadPicture("")
            MsgBox "此照片文件的路径或名称已改变，或者已被删除！建议删除此照片！", vbExclamation, "错误提示"
            
            Exit Sub
        Else
            '装载相应图片
            Me.imgYulanPhoto.Picture = LoadPicture(Trim(lblPhotoPath.Caption))
        End If
    End If
End Sub