There is probably a much better way to do it, but here a somehow succint
example (without much comments) with API calls:
======================
Option Compare Database
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
(ByVal hInst As Long, ByVal lpsz As String, _
ByVal un1 As Long, ByVal n1 As Long, ByVal n2 _
As Long, ByVal un2 As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, _
lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject _
As Long) As Long
Const LR_LOADFROMFILE = &H10
Const LR_CREATEDIBSECTION = &H2000
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Sub TestImage()
Dim hBitMap As Long
Dim dBitmap As BITMAP
Dim FileName As String
FileName = "C:\Users\Public\Games\FreeCellMCE.bmp"
hBitMap = LoadImage(ByVal 0&, FileName, 0, 0, 0, LR_LOADFROMFILE Or
LR_CREATEDIBSECTION)
If 0 = hBitMap Then
MsgBox "Cannot Load this image"
Exit Sub
End If
GetObject hBitMap, Len(dBitmap), dBitmap
MsgBox "h*w=" & dBitmap.bmHeight & ", " & dBitmap.bmHeight
DeleteObject hBitMap
End Sub
====================================
About DeleteObject: Each time you create some 'monster' which appears just
as a LONG for VBA, which is the case, here, of hBitMap:
DIM hBitMap AS LONG
hBitMap = ...
As bright as VBA can be, it sees only a long (integer) and when the variable
will get out of scope, VBA would do, by itself, only what it does in
general, with long integers. But here, it is a reference (handle) to some
monstrous data too! To release that blob, you have to explicitly use
DELETEOBJECT. Note that you have to do it also BEFORE re-assigning the
LONG. Example:
Dim h AS LONG
h=LoadImage( ... "Image1" ...)
....
h=LoadImage( ... "Image2" ... )
you should DeleteObject before the second LoadImage, to avoid losing memory
(until you close the Access app.).
If you are afraid to ever 'forget' it, then make a CLASS which will call
the DeleteObject in its Terminate events handling procedure.
I took part of the declarations from an old DirectX tutorial, by Adam Hoult,
still available at
http://allapi.mentalis.org/vbtutor/directx22p.htm
I am not sure of what kind of image files the API function LoadImage can
handle, but clearly, it can handle "bmp".
Vanderghast, Access MVP
Dale Fye said:
Albert,
Glad I could help
Sorry, I have not worked with images at all (other than in a personnel
database).
But would be interested in hearing what you find out, as I'm starting work
on a picture management tool for my wife, and will need to be able to
rotate images as well.
Dale
Albert S. said:
Ok, sorry. There was one more problem. Is there a way for VBA to
determine if
the image is horizontal? For example, most of our pictures are (w x h -
in
pixels) 135x180. But some are 180x135. Can the dimensions be read from
the
directory? And then, based on that information, the image display
changed?
Thanks for all the help!
--
Albert S.
Albert S. said:
Thanks for sticking with me! I moved the call to the Detail_Format event
and
it worked perfectly! Can't thank you enough!
--
Albert S.
:
Try moving your call to DisplayImage to the Detail_Format event.
Dale
Yeah, still can't get it to work. It may be because it is a report
and not
a
form. I tried a number of settings and the immediate window, but it
won't
accept the parameters. I might try making duplicate fields and then
hiding
the ones we want to move.
Thanks!
--
Albert S.
:
Have you put a breakpoint in your code and stepped through it? Do
so,
and
as you step through the code, use the immediate or the watch window
to
check
the values of the various controls visible, left, width, ...
properties.
My guesses are:
1. Your controls are not actually named text1 and text2.
2. The form is too narrow to allow text1 and text2 to have a left
margin
at
2 and display the entire width of those controls in the width of
the
form.
If your form is only 5 inches wide, and the text boxes are more
than 3
inches wide, you will get an error if you try to set their left
margin at
2".
HTH
Dale
Here it is. Thanks!
Private Sub Detail_Print(Cancel As Integer, PrintCount As
Integer)
Me!txtImageNote = DisplayImage(Me!ImageFrame, Me![ID])
End Sub
Public Function DisplayImage(ctlImageControl As Control,
strImageID As
Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strImagePathGif As String
Dim strImagePathJpg As String
strImagePathGif = "Z:\" & strImageID & ".gif"
strImagePathJpg = "Z:\" & strImageID & ".jpg"
With ctlImageControl
If IsNull(strImageID) Then
.Visible = False
strResult = "No image name specified."
ElseIf Dir(strImagePathGif) <> "" Then
.Visible = True
.Picture = strImagePathGif
strResult = "GIF image found and displayed"
ElseIf Dir(strImagePathJpg) <> "" Then
.Visible = True
.Picture = strImagePathJpg
strResult = "JPG image found and displayed"
Else
.Visible = False
strResult = "Image not found"
End If
End With
If ctlImageControl.Visible Then
Me.Text1.Left = 2 * 1440
Me.Text2.Left = 2 * 1440
Else
Me.Text1.Left = ctlImageControl.Left
Me.Text2.Left = ctlImageControl.Left
End If
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
--
Albert S.
:
Albert,
Copy your code and post it back, so I can review it.
Dale
Ok, I tried this, but I'm getting the error:
2101 - The setting you entered isn't valid for this property
Any ideas?
Thanks!
--
Albert S.
:
Right below the previous code, you could do something like:
if ctlImageControl.visible then
me.text1.left = 2 * 1440
me.text2.left = 2* 1440
Else
me.text1.left = ctlImageControl.left
me.text2.left = ctlImageControl.left
endif
Remember if your change the position you can use the Left,
Top,
Left +
Width, Top + Height or any other combination of the
properties,
without
multiplying by 1440. But if you use an absolute distance
(.0417),
you
must
multiply it by 1440 (the number of twips per inch)
HTH
Dale
Excellent! That works perfectly!
Now on to part 2 - is there a way when the picture is
missing to
move
my
text boxes to the left and over the ImageFrame?
In other words, do something like:
Me.Text1.Left = 0.0417
Me.Text2.Left = 0.0417
...
Where would I put this?
Thanks for all the help!
--
Albert S.
:
Albert, what you need to do is test to see whether either
the
gif
or
jpg
file
exists, using the DIR function().
Try:
If IsNull(strImageID) Then
.Visible = False
strResult = "No image name specified."
Elseif DIR(strImagePathGif) <> "" then
.visible = true
.picture = strImagePathGif
strResult = "GIF image found and displayed"
Elseif DIR(strImagePathJPG) <> "" then
.visible = true
.picture = strImagePathJPG
strResult = "JPG image found and displayed"
Else
.Visible = false
strResult = "Image not found"
End If
----
HTH
Dale
:
Hello,
I need to display some images on a report. The images
are
stored
on
another
PC - mapped to the Z:\ drive. The images are all named
with
the
number
corresponding to the [ID] field. The images can be
either a
.jpg
or
.gif or
missing - there is no way to know except to look for it.
I am using a bound object frame with an embedded
picture. Here
is
the
code
so far (adapted from the help file):
'from the report detail - on print:
Private Sub Detail_Print(Cancel As Integer, PrintCount
As
Integer)
Me!txtImageNote = DisplayImage(Me!ImageFrame,
Me![ID])
End Sub
'function:
Public Function DisplayImage(ctlImageControl As Control,
strImageID
As
Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strImagePathGif As String
Dim strImagePathJpg As String
strImagePathGif = "Z:\" & strImageID & ".gif"
strImagePathJpg = "Z:\" & strImageID & ".jpg"
With ctlImageControl
If IsNull(strImageID) Then
.Visible = False
strResult = "No image name specified."
Else
.Visible = True
.Picture = strImagePathGif
strResult = "Image found and displayeed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the
specified
name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying
image."
Resume Exit_DisplayImage:
End Select
End Function
The problem is that it never triggers the first IF,
since
every
item
has an
[ID] number. This code does display some images, but
obviously,
only
with the
gifs. The only way I can tell that it is not a .gif when
it
goes
to
the
eh.
My Questions:
1) How can I search for, and find the image if it is
either a
.gif
or
.jpg
or missing?
2) If the image is missing, how can I shift some text
fields
left
to
