Newsgroup: it.comp.appl.access
Titolo: Visualizzare immagini in RunTime

Ho provato sul Sito Comune, nella Sezione General,
la FAQ di Silvio Savoldi intitolata "Implementare un archivio di
immagini":
nelle istruzioni segnala che il RunTime di Acces supporta solo bitmap.
In effetti č cosě, anzi va in errore anche con qualche bitmap.
Con Imaging/Wang si aprono tutti ma da Acess no.
Io devo visualizzare delle immagini prelevate da una macchina fotografica
digitale:
1) come faccio a sapere come deve essere l'immagine per non dare problemi?
2) nell'articolo si parla di filtri di conversione: cosa sono e come si
installano?
3) si parla anche di controlli immagine Activex: dove si trovano?
Grazie a chi sa dirmi qualcosa.
Sandro

 Sandro
Guarda su Lebans, c'è un modulo molto più performante della proprietà
picture e con qualsisasi estensione e valido per il runtime.
Io sto convertendo tu i miei facili .picture con quella funzione sigh!
MAssimiliano

 Sandro
-- 
Roberto
---------------------------------------------
il Sito Comune di it.comp.appl.access:
http://www.sitocomune.com
---------------------------------------------


Puoi dirmi più precisamente di quale si tratta?  Ho trovato un PictureBoxA97
ma non mi sembra che sia quello che mi serve, che è di aprire dei file jpg
da Runtime di Access97.
Grazie
Sandro

 Grazie
Chiedo scusa a tutto il NG se appesantisco il post ma non ricordo
precisamente dove l'ho preso
Option Compare Database
Option Explicit
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Public Type RECTL
    Left As Long
    top As Long
    right As Long
    Bottom As Long
End Type
Private Type SIZEL
    cx As Long
    cy As Long
End Type
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal
hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hDC As Long,
ByVal hEMF As Long, lpRect As RECTL) As Long
Private Declare Function apiCloseEnhMetaFile Lib "gdi32" _
Alias "CloseEnhMetaFile" (ByVal hDC As Long) As Long
Private Declare Function apiCreateEnhMetaFileRECT Lib "gdi32" _
Alias "CreateEnhMetaFileA" (ByVal hDCref As Long, _
ByVal lpFileName As String, ByRef lpRect As RECTL, ByVal lpDescription As
String) As Long
Private Declare Function apiDeleteEnhMetaFile Lib "gdi32" _
Alias "DeleteEnhMetaFile" (ByVal hEMF As Long) As Long
Private Declare Function GetEnhMetaFileBits Lib "gdi32" _
(ByVal hEMF As Long, ByVal cbBuffer As Long, lpbBuffer As Byte) As Long
Private Declare Function apiSelectObject Lib "gdi32" _
 Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function apiGetDC Lib "user32" _
  Alias "GetDC" (ByVal hWnd As Long) As Long
Private Declare Function apiReleaseDC Lib "user32" _
  Alias "ReleaseDC" (ByVal hWnd As Long, _
  ByVal hDC As Long) As Long
Private Declare Function apiDeleteObject Lib "gdi32" _
  Alias "DeleteObject" (ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long)
As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, _
ByVal nStretchMode As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hDC As Long, ByVal
nMapMode As Long) As Long
Private Declare Function SetViewportExtEx Lib "gdi32" _
(ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZEL) As
Long
Private Declare Function SetViewportOrgEx Lib "gdi32" _
(ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
As Long
Private Declare Function SetWindowOrgEx Lib "gdi32" _
(ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
As Long
Private Declare Function SetWindowExtEx Lib "gdi32" _
(ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZEL) As
Long
Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps"
_
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal
nBkMode As Long) As Long
Private Const BLACKONWHITE = 1
Private Const WHITEONBLACK = 2
Private Const COLORONCOLOR = 3
Private Const HALFTONE = 4
Private Const MAXSTRETCHBLTMODE = 4
Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0
Private Const SB_LINELEFT = 0
Private Const SB_LINEDOWN = 1
Private Const SB_LINERIGHT = 1
Private Const SB_PAGEUP = 2
Private Const SB_PAGELEFT = 2
Private Const SB_PAGEDOWN = 3
Private Const SB_PAGERIGHT = 3
Private Const SB_THUMBPOSITION = 4
Private Const SB_THUMBTRACK = 5
Private Const SB_TOP = 6
Private Const SB_LEFT = 6
Private Const SB_BOTTOM = 7
Private Const SB_RIGHT = 7
Private Const SB_ENDSCROLL = 8
Private Const SRCCOPY = &HCC0020 '
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const MM_TEXT = 1
Private Const MM_LOMETRIC = 2
Private Const MM_HIMETRIC = 3
Private Const MM_LOENGLISH = 4
Private Const MM_HIENGLISH = 5
Private Const MM_TWIPS = 6
Private Const MM_ISOTROPIC = 7
Private Const MM_ANISOTROPIC = 8
Private Const vbPicTypeNone = 0 'Picture is empty
Private Const vbPicTypeBitmap = 1 'Bitmap (.bmpBMP files)
Private Const vbPicTypeMetafile = 2 'Metafile (.wmfWMF files)
Private Const vbPicTypeIcon = 3 'Icon (.icoICO files)
Private Const vbPicTypeEMetafile = 4 'Enhanced Metafile (.emfEMF files)
Private Const WHITE_BRUSH = 0
Private Const LTGRAY_BRUSH = 1
Private Const GRAY_BRUSH = 2
Private Const DKGRAY_BRUSH = 3
Private Const BLACK_BRUSH = 4
Private Const NULL_BRUSH = 5
Private Const HOLLOW_BRUSH = NULL_BRUSH
Private Const WHITE_PEN = 6
Private Const BLACK_PEN = 7
Private Const NULL_PEN = 8
Private Const OEM_FIXED_FONT = 10
Private Const ANSI_FIXED_FONT = 11
Private Const ANSI_VAR_FONT = 12
Private Const SYSTEM_FONT = 13
Private Const DEVICE_DEFAULT_FONT = 14
Private Const DEFAULT_PALETTE = 15
Private Const SYSTEM_FIXED_FONT = 16
Private Const STOCK_LAST = 16
' Background Modes
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
Private Const BKMODE_LAST = 2
' GetDeviceCaps
Private Const HORZSIZE = 4           '  Horizontal size in millimeters
Private Const VERTSIZE = 6           '  Vertical size in millimeters
Private Const HORZRES = 8            '  Horizontal width in pixels
Private Const VERTRES = 10           '  Vertical width in pixels
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88
' How many Twips in 1 inch
Private Const TWIPSPERINCH = 1440
Function fStdPicToImageData(hStdPic As Object, ctl As Access.Image, _
Optional FileNamePath As String = "", Optional AutoSize As Boolean = False)
As Boolean
On Error GoTo ERR_SHOWPIC
Dim hDCref As Long
Dim sz As SIZEL
Dim pt As POINTAPI
Dim rc As RECTL
Dim lngRet As Long
Dim s As String
Dim hMetafile As Long
Dim hDCMeta As Long
Dim arrayMeta() As Byte
Dim sngConvertX As Single
Dim sngConvertY As Single
Dim ImageWidth As Long
Dim ImageHeight As Long
Dim Xdpi As Single
Dim Ydpi As Single
Dim TwipsPerPixelX As Single
Dim TwipsPerPixely As Single
Dim sngHORZRES As Single
Dim sngVERTRES As Single
Dim sngHORZSIZE As Single
Dim sngVERTSIZE As Single
hDCref = apiGetDC(0)
If hStdPic.Type = 0 Then
 Err.Raise vbObjectError + 523, "fStdPicToImageData.modStdPic", _
    "Sorry...This function can only read Image files." & vbCrLf & "Please
Select a Valid Supported Image File"
End If
sngHORZRES = apiGetDeviceCaps(hDCref, HORZRES)
sngVERTRES = apiGetDeviceCaps(hDCref, VERTRES)
sngHORZSIZE = apiGetDeviceCaps(hDCref, HORZSIZE)
sngVERTSIZE = apiGetDeviceCaps(hDCref, VERTSIZE)
sngConvertX = (sngHORZSIZE * 0.1) / 2.54
sngConvertY = (sngVERTSIZE * 0.1) / 2.54
sngConvertX = sngHORZRES / sngConvertX
sngConvertY = sngVERTRES / sngConvertY
Xdpi = sngConvertX
Ydpi = sngConvertY
sngConvertX = hStdPic.Width * 0.001
sngConvertY = hStdPic.Height * 0.001
sngConvertX = sngConvertX / 2.54
sngConvertY = sngConvertY / 2.54
sngConvertX = sngConvertX * 1440
sngConvertY = sngConvertY * 1440
TwipsPerPixelX = TWIPSPERINCH / Xdpi
TwipsPerPixely = TWIPSPERINCH / Ydpi
ImageWidth = sngConvertX / TwipsPerPixelX
ImageHeight = sngConvertY / TwipsPerPixely
rc.right = hStdPic.Width
rc.Bottom = hStdPic.Height
s = "Massimiliano Amendola" & Chr(0) & Chr(0) & "
www.massimiianoamendola.it
"
& Chr(0) & Chr(0)
hDCMeta = apiCreateEnhMetaFileRECT(hDCref, vbNullString, rc, s)
If hDCMeta = 0 Then
    Err.Raise vbObjectError + 525, "fStdPicToImageData.modStdPic", _
    "Mi dispiace...errore nella procedura "
End If
lngRet = SetMapMode(hDCMeta, MM_TEXT) 'ANISOTROPIC) 'TEXT)
lngRet = SetWindowExtEx(hDCMeta, ImageWidth, ImageHeight, sz)
lngRet = SetWindowOrgEx(hDCMeta, 0&, 0&, pt)
lngRet = SetWindowExtEx(hDCMeta, ImageWidth, ImageHeight, sz)
lngRet = SetBkMode(hDCMeta, TRANSPARENT)
lngRet = apiSelectObject(hDCMeta, GetStockObject(NULL_BRUSH))
lngRet = apiSelectObject(hDCMeta, GetStockObject(NULL_PEN))
lngRet = SetStretchBltMode(hDCMeta, COLORONCOLOR)
hStdPic.Render CLng(hDCMeta), 0&, 0&, CLng(ImageWidth), CLng(ImageHeight), _
0&, hStdPic.Height, hStdPic.Width, -hStdPic.Height, vbNull
DoEvents
hMetafile = apiCloseEnhMetaFile(hDCMeta)
If hMetafile = 0 Then
    fStdPicToImageData = False
    Exit Function
End If
lngRet = GetEnhMetaFileBits(hMetafile, 0, ByVal 0&)
If lngRet = 0 Then
    fStdPicToImageData = False
    Exit Function
End If
ReDim arrayMeta((lngRet - 1) + 8)
lngRet = GetEnhMetaFileBits(hMetafile, lngRet, arrayMeta(8))
lngRet = apiDeleteEnhMetaFile(hMetafile)
arrayMeta(0) = CF_ENHMETAFILE
ctl.PictureData = arrayMeta
If AutoSize Then
    If sngConvertX < ctl.Parent.Width Then
       ctl.Width = sngConvertX '+ 15
    Else
        ctl.Width = ctl.Parent.Width - 200
    End If
    If sngConvertY < ctl.Parent.Detail.Height Then
        ctl.Height = sngConvertY '+ 15
    Else
        ctl.Height = ctl.Parent.Detail.Height - 200
    End If
     ctl.SizeMode = acOLESizeStretch
End If
EXIT_SHOWPIC:
lngRet = apiReleaseDC(0&, hDCref)
Exit Function
ERR_SHOWPIC:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume EXIT_SHOWPIC
End Function
Public Function fLoadPicture(ctl As Access.Image, Optional strfName As
String = "", Optional AutoSize As Boolean = False) As Boolean
' Inputs
' ctl -> Access Image control
' strfName -> Optional name of Image file to load and bypass File Dialog
On Error GoTo Err_fLoadPicture
' Temp Vars
Dim lngRet As Long
Dim blRet As Boolean
' Our StdPicture object returned by LoadPicture
Dim hPic As Object
' Were we passed the Optional FileName and Path
If Len(strfName & vbNullString) = 0 Then
    ' Call the File Common Dialog Window
    Dim clsDialog As Object
    Dim strTemp As String
    Set clsDialog = New clsCommonDialog
    ' Fill in our structure
    clsDialog.Filter = "All (*.*)" & Chr$(0) & "*.*" & Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "JPEG (*.JPG)" & Chr$(0) & "*.JPG"
& Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Gif (*.GIF)" & Chr$(0) & "*.GIF"
& Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Bitmap (*.BMP)" & Chr$(0) &
"*.BMP" & Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Enhanced Metafile (*.EMF)" &
Chr$(0) & "*.EMF" & Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Windows Metafile (*.WMF)" &
Chr$(0) & "*.WMF" & Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Icon (*.ICO)" & Chr$(0) & "*.ICO"
& Chr$(0)
    clsDialog.Filter = clsDialog.Filter & "Cursor (*.CUR)" & Chr$(0) &
"*.CUR" & Chr$(0)
    clsDialog.hDC = 0
    clsDialog.MaxFileSize = 256
    clsDialog.Max = 256
    clsDialog.FileTitle = vbNullString
    clsDialog.DialogTitle = "Please Select an Image File"
    clsDialog.InitDir = vbNullString
    clsDialog.DefaultExt = vbNullString
    ' Display the File Dialog
    clsDialog.ShowOpen
    ' See if user clicked Cancel or even selected
    ' the very same file already selected
    strfName = clsDialog.FileName
    If Len(strfName & vbNullString) = 0 Then
    ' Raise the exception
      Err.Raise vbObjectError + 513, "LoadJpegGif.modStdPic", _
      "Please Select a Valid JPEG or GIF File"
    End If
' If we jumped to here then user supplied a FileName
End If
' It may take a few seconds to render larger JPEGs.
' Set the MousePointer to "HOURGLASS"
Application.Screen.MousePointer = 11
' Load the Picture as a StandardPicture object
Set hPic = LoadPicture(strfName)
If hPic = 0 Then
    Err.Raise vbObjectError + 514, "LoadJpegGif.modStdPic", _
    "Please Select a Valid JPEG or GIF File"
End If
' Call our function to convert the StdPicture object
' into a DIB wrapped within an Enhanced Metafile
blRet = fStdPicToImageData(hPic, ctl, , AutoSize)
' need error handling here
' Cleanup
fLoadPicture = True
Exit_LoadPic:
' Set the MousePointer back to Default
Application.Echo True
Application.Screen.MousePointer = 0
Err.Clear
Set hPic = Nothing
Set clsDialog = Nothing
Exit Function
Err_fLoadPicture:
fLoadPicture = False
Application.Screen.MousePointer = 0
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume Exit_LoadPic
End Function
' This function only works if the contents of the Image control
' are an Enhanced Metafile, which it will always be in
' this project. There is a general purpose solution
' for all formats on my site that uses the Clipboard to convert formats.
Public Function fSaveImagetoDisk(ctl As Access.Image) As Boolean
' User selected FileName from our File Dialog window
Dim sName As String
' Junk var
Dim lngRet As Long
' handle to Clipboard memory EMF
Dim hEMF As Long
' handle to our Disk based Metafile
Dim hMetafile As Long
' Array to hold binary copy of Enhanced Metafile
' we will create.
Dim arrayMeta() As Byte
' Open File Dialog
sName = fSavePicture
    If Len(sName & vbNullString) = 0 Then
    fSaveImagetoDisk = False
    Exit Function
End If
' resize our byte array to match length of PictureData prop
ReDim arrayMeta((LenB(ctl.PictureData) - 1))
arrayMeta = ctl.PictureData
' Verify CF_ENHMETAFILE
If arrayMeta(0) <> CF_ENHMETAFILE Then
    fSaveImagetoDisk = False
    MsgBox "Sorry..not a valid Enhanced Metafile contained in the Image
control"
    Exit Function
End If
' Grab a local copy of the memory EMF
CopyMem hEMF, arrayMeta(4), 4
' Create a disk based copy of the Metafile
hMetafile = CopyEnhMetaFile(hEMF, sName)
' Delete EMF memory footprint.
lngRet = apiDeleteEnhMetaFile(hMetafile)
End Function
Public Function fSavePicture(Optional strfName As String = "") As String
' Inputs
' strfName -> Optional name of Image file to Save
On Error GoTo Err_fSavePicture
' Temp Vars
Dim lngRet As Long
Dim blRet As Boolean
' Were we passed the Optional FileName and Path
If Len(strfName & vbNullString) = 0 Then
    ' Call the File Common Dialog Window
    Dim clsDialog As Object
    Dim strTemp As String
    Set clsDialog = New clsCommonDialog
    ' Fill in our structure
    ' ***********************************************
    ' WARNING
    ' You must specify lowercase "emf" for the file extension. I will
explain this
    ' and how it is related to the office graphics filters in detail on my
web site.
       clsDialog.Filter = clsDialog.Filter & "Enhanced Metafile (*.emf)" &
Chr$(0) & "*.emf" & Chr$(0)
    clsDialog.hDC = 0
    clsDialog.MaxFileSize = 256
    clsDialog.Max = 256
    clsDialog.FileTitle = vbNullString
    clsDialog.DialogTitle = "Please Enter a Valid FileName"
    clsDialog.InitDir = vbNullString
    clsDialog.DefaultExt = ".emf" 'vbNullString
    ' Display the File Dialog
    clsDialog.ShowSave
    ' See if user clicked Cancel or even selected
    ' the very same file already selected
    strfName = clsDialog.FileName
    If Len(strfName & vbNullString) = 0 Then
    ' Raise the exception
      Err.Raise vbObjectError + 513, "fSavePicture.modStdPic", _
      "Please Enter a Valid EMF Filename"
    End If
' If we jumped to here then user supplied a FileName
End If
' Cleanup
fSavePicture = strfName
Exit_SavePic:
Err.Clear
Set clsDialog = Nothing
Exit Function
Err_fSavePicture:
fSavePicture = strfName
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume Exit_SavePic
End Function
Public Sub ScrollToHome(ctl As Control)
Dim lngRet As Long
Dim lngTemp As Long
On Error Resume Next
Application.Echo False
For lngTemp = 1 To 9
lngRet = SendMessage(ctl.Parent.hWnd, WM_VSCROLL, SB_PAGEUP, 0&)
lngRet = SendMessage(ctl.Parent.hWnd, WM_HSCROLL, SB_PAGELEFT, 0&)
Next lngTemp
Application.Echo True
End Sub
MAssimiliano

Denghiu.
Sandro