DBPix Sample Source Code: frmXMLHTTP
Back to sample
Option Compare Database
Option Explicit
Dim XMLHTTP As Object
Private Sub Form_Open(Cancel As Integer)
' Create the XMLHTTP Object
On Error GoTo ErrHandler:
Set XMLHTTP = CreateObject("Msxml2.XMLHTTP")
Exit Sub
ErrHandler:
MsgBox "Cound not create XMLHTTP Object"
Resume Next
End Sub
Private Sub Form_Close()
' Destroy the XMLHTTP Object
Set XMLHTTP = Nothing
End Sub
Private Sub Form_Current()
UpdateImage
End Sub
Private Sub UpdateImage()
On Error Resume Next
' Clear the DBPix Control
DBPixCtrl.ImageViewBlob Null
' Check the XMLHTTP object was created
If XMLHTTP Is Nothing Then Exit Sub
' Check for valid URL
If Len(Nz(Me!url, "")) > 0 Then
With XMLHTTP
' Fetch the image and wait for completion
.Open "GET", Me!url, False
.setRequestHeader "CONTENT-TYPE", "image/jpeg"
.send
If .readyState > 1 Then
Do Until .readyState = 4
DoEvents
Loop
End If
End With
' If status = OK display the image
If XMLHTTP.status = 200 Then
DBPixCtrl.ImageViewBlob (XMLHTTP.responseBody)
End If
End If
End Sub
Private Sub DBPixCtrl_DblClick()
' Open a popup form with a large view of the image
' Check the XMLHTTP object was created
If XMLHTTP Is Nothing Then Exit Sub
' Check for valid URL
If Len(Nz(Me!url, "")) > 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 Sub
Back to sample
|
Home
Tutorials
