Hmmm… Well, perhaps I missed a step when I was first trying to do it without the code. I’m “flying by the seat of my pants” as I don’t have much experience with this, so it wouldn’t be unusual for me to screw it up. lol
.
If you want to see the code and its 6 functions, I have copied it below. Mr. Johnson said he wrote it after reading a book he found to be very helpful: “Database Programming with OpenOffice.org Base and Basic.”
OPTION EXPLICIT
' When the record is changed on the form various events are fired, this routine
' is designed to capture the "After Record Changed" event. Information pertaining
' to this event is captured in the event object e below.
' We use the custom function that I wrote "getFormFromEvent" to get a reference to the
' form which also acts as a datasource (object the contains the records, Microsoft would
' call this a recordset).
' From the form/Recordset dsVideos we can get a reference to the Image Control
Sub AfterRecord_Change(byref e as Object)
Dim dsVideos as Object
Dim oImageControl as Object
Dim oGraphic as Object
dim szFullImagePath as String, szFile as String
' Get reference to the form that threw this event
dsVideos = getFormFromEvent(e) ' Get Reference to form / resultset
oImageControl = dsVideos.getByName("ctrlPictures") ' Get Reference to Image Control
szFile = getColumnValue(dsVideos, "fldImagePath") ' Get value from VideoID field
szFullImagePath = getDbPath() & "RecipePictures/" & szFile 'This is the name of the folder where pictures reside.
if imageFileMissing(szFullImagePath, oImageControl) then Exit Sub
oGraphic = createGraphic(szFullImagePath)
oImageControl.Graphic = oGraphic
oImageControl.ScaleImage = true
End Sub
Private Function imageFileMissing(byval szPath as String, byref oImageControl as Object) as Boolean
Dim szTest as String
' Exit the code if no image file present
szTest = Dir(szPath, 0)
If szTest = "" Then
oImageControl.Graphic = Nothing
Exit Function
End If
End Function
' This function returns the Path (as a URL, which is best for LibreOffice as this handles cross platform issues best)
' meaning if you put other files in subdirectory of database file will always be in the correct place
Function getDbPath() as String
Dim szPathFile as String
Dim oDoc as Object
Dim lErr as Long
Dim szModuleRoutineName as String
szModuleRoutineName = "m_frmReviewBigPicture.getDbPath"
On Error Resume Next
szPathFile = ThisComponent.getURL()
If err <> 0 Or szPathFile = "" Then
On Error Resume Next
szPathFile = ThisComponent.Parent.getURL()
if err <> 0 Or szPathFile = "" Then
lErr = err
On Error Goto ErrorCheck ' Reset Error Handling
error(err) ' Throw Error
Exit Function
End if
End if
On Error Goto ErrorCheck ' Reset Error Handling
'szPathFile = mid(szPathFile, 8) ' Remove file:// from start of string
getDbPath = removeFileNameFromPath(szPathFile)
Exit Function
ErrorCheck:
MsgBox "Error in " & szModuleRoutineName & chr(13) & "Error Number: " & err & " " & Error$ & chr(13) & "Error Line : " & erl
error(err) ' Throw unresolved error up the stack
End Function
Function createGraphic(byval szFilePath as String) as Object
Dim oSFA as Object ' SFA is Simple File Access
Dim oInputStream as Object
Dim arrArgs(0) as New com.sun.star.beans.PropertyValue
Dim vGraphicProvider as Variant
Dim szURL as String
oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
szURL = ConvertToURL(szFilePath) ' Built in Basic Function
oInputStream = oSFA.openFileRead(szURL)
arrArgs(0).Name = "InputStream"
arrArgs(0).Value = oInputStream
vGraphicProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider")
createGraphic = vGraphicProvider.queryGraphic(arrArgs)
End Function
Function getFormFromEvent(e as Object) as Object
Dim szModuleRoutineName as String
szModuleRoutineName = "m_frmReviewBigPicture..GetFormFromEvent"
On Error Goto ErrorCheck
select case e.Source.ImplementationName
case "com.sun.star.form.FmXFormController"
GetFormFromEvent = e.source.model
case "com.sun.star.form.OButtonControl"
GetFormFromEvent = e.source.model.parent
case "com.sun.star.comp.forms.ODatabaseForm"
GetFormFromEvent = e.source
case else
msgbox e.Source.ImplementationName
msgbox "Unknown event in mSwitchboard.LoadMainKeywordFile"
msgbox "Need to look at the locals window to trace up the stack" & chr(13) & "to find the form reference."
end select
Exit Function
ErrorCheck:
MsgBox "Error in " & szModuleRoutineName & chr(13) & "Error Number: " & err & " " & Error$ & chr(13) & "Error Line : " & erl
End Function
' This is just a wrapper function to make calling getColumnData (below) simpler
Private Function getColumnValue(byref ds as Object, byval szColumnName as String) as Variant
getColumnValue = getColumnData(ds.Columns.getByName(szColumnName))
End Function
Private function getColumnData(oCol) as variant
' Do not return Error code from this function
' do checks in calling function
Dim vOut as variant
select case oCol.TypeName
case "INTEGER": vOut=oCol.Int
case "INT" : vOut=oCol.Int
case "LONG": vOut=oCol.Long
case "VARCHAR": vOut=oCol.String
case "DOUBLE": vOut=oCol.Double
case "BOOLEAN": vOut=oCol.Boolean
case "DECIMAL": vOut=oCol.Double
case "NULL": vOut=oCol.Null
case "SHORT": vOut=oCol.Short
case "ARRAY": vOut=oCol.Array
case "BLOB": vOut=oCol.Blob
case "BYTE": vOut=oCol.Byte
case "BYTES": vOut=oCol.Bytes
case "CLOB": vOut=oCol.Clob
case "DATE": vOut=oCol.Date
case "OBJECT": vOut=oCol.Object
case "REF": vOut=oCol.Ref
case "TIME": vOut=oCol.Time
case "TIMESTAMP": vOut=oCol.TimeStamp
case else: vOut=oCol.String
End Select
getColumnData = vOut
End Function
Function removeFileNameFromPath(byval szPath as string)
Dim i as integer, iLen as Integer, iPos as integer
Dim szModuleRoutineName as String
szModuleRoutineName = "mSharedFunctions.removeFileNameFromPath"
On Error Goto ErrorCheck
iLen = len(szPath)
for i = iLen to 1 Step -1
select case mid(szPath, i, 1)
case "/","\"
iPos = i
exit for
end select
next
if iPos > 0 Then
removeFileNameFromPath = left(szPath,ipos)
else
removeFileNameFromPath = "[Not a Path]"
end if
Exit Function
ErrorCheck:
MsgBox "Error in " & szModuleRoutineName & chr(13) & "Error Number: " & err & " " & Error$ & chr(13) & "Error Line : " & erl
End Function
