DBPix Sample Source Code: frmImages Back to sample
Option Compare Database
Option Explicit
Private Sub Form_Current()
' When moving to a different/new record, update the DBPix Control to display the image
UpdateImage
End Sub
Private Sub btnClear_Click()
' Clear the path and update the DBPix control
Me![PhotoPath] = Null
UpdateImage
End Sub
Private Sub btnLoad_Click()
Dim strInputFileName As String
' Display a 'File Open' dialog to choose a file
strInputFileName = ChooseFile
' Check that the user chose a file
If Len(strInputFileName) > 0 Then
' Check that the path is beneath 'BASE_PATH' (i.e. relative to BASE_PATH)
If (Left(strInputFileName, Len(BASE_PATH)) = BASE_PATH) Then
Dim strRelativePath As String
' Strip BASE_PATH from the chosen path to leave the relative part
strRelativePath = Right(strInputFileName, Len(strInputFileName) - Len(BASE_PATH))
' Save the relative path in the table
Me![PhotoPath] = strRelativePath
' Update the DBPix Control to display the image
UpdateImage
Else
' User chose a path that was not below BASE_PATH - display an error message
MsgBox "The selected file is not under the Photo root", Title:="Photo Error"
End If
End If
End Sub
Private Sub UpdateImage()
Dim strPhotoRelativePath As String
Dim strFullPhotoPath As String
' Get the relative path from the table, handling null values
strPhotoRelativePath = Nz(Me![PhotoPath], "")
' Check that the relative path is not empty
If Len(strPhotoRelativePath) > 0 Then
' Prepend the relative path with BASE_PATH, to create an absolute path
strFullPhotoPath = BASE_PATH + strPhotoRelativePath
' Check that the file exists
If Len(Dir(strFullPhotoPath)) > 0 Then
' Display the image and exit
Me!DBPixCtrl.ImageViewFile strFullPhotoPath
Exit Sub
End If
End If
' If we reach here one of the previous conditions was not satisfied - clear the control
Me!DBPixCtrl.ImageViewBlob Null
End Sub
Private Sub DBPixCtrl_DblClick()
' Open a popup form with a large view of the image
Dim strPhotoRelativePath As String
Dim strFullPhotoPath As String
' Get the relative path from the table, handling null values
strPhotoRelativePath = Nz(Me![PhotoPath], "")
' Check that the relative path is not empty
If Len(strPhotoRelativePath) > 0 Then
' Prepend the relative path with BASE_PATH, to create an absolute path
strFullPhotoPath = BASE_PATH + strPhotoRelativePath
' Check that the file exists
If Len(Dir(strFullPhotoPath)) > 0 Then
' Build a 'WHERE' clause to filter to the current record using the current Id
Dim strWhereCategory
strWhereCategory = "[Id ]=" & Me!Id
' Open the Zoom form as a popup, using the WHERE clause
DoCmd.OpenForm "frmZoom", acNormal, , strWhereCategory, , acDialog
End If
End If
End Sub
Back to sample
|