Newsgroup: it.comp.appl.access
Titolo: Caricamento immagine in campo OLE

Salve a tutti, sono qui a richiamare la magari annosa questione sulle 
immagini, perchè qualcosa non mi è chiaro.
In una maschera che contiene delle anagrafiche avrei bisogno di inserire una 
foto, una per ogni record ovviamente. Attualmente ho un campo OLE che si 
riferisce ad una tabella, contenente una ipotetica immagine incorporata (sì, 
perchè collegata mi darebbe dei problemi....l'immagine non è più grande di 
4*3 cm, quindi non è un problema di dimensioni del database).
Il mio problema è che non riesco a gestire l'inserimento delle immagini in 
modo serio ed efficace... se faccio click destro sull'immagine e inserisco 
un oggetto da file, spesso mi compare solo il nome dell'immagine, altre 
volte non succede niente, altre ancora mi compare solo una piccola icona.... 
i filtri grafici in sede di installazione li ho installati tuti, quindi 
vorrei evitare questa procedura "entropica" e fare una cosa seria..
Ho letto la FAQ 6.22 di Stefano Bettini per aprire una finestra di dialogo 
che consenta la selezione del file....ecco per me questa cosa sarebbe 
perfetta, devo solo capire come far entrare quel file nell'oggetto OLE che 
ho nella maschera... (e senza avere i soliti problemi dei filtri grafici).
Insomma, voglio cliccare su un bottone, selezionare una immagine dal 
percorso, e vedere l'immagine nella cornice, tutto qua.
Ho visto anche delle meravigliose applicazioni di Roberto sulla galleria di 
immagini, ma sono troppo oltre il reale utilizzo che ne devo fare...
Spero mi possiate aiutare...
Grazie

"R1[[ky" <ric...@NOSPAMlibero.it> ha scritto nel messaggio 
news:n4Gje.110572$IN.18...@twister2.libero.it...

Ciao,
prova a dare un'occhiata al sito comune -> 6.13 Come implementare 
correttamente un archivio di immagini...potrebbe essere una soluzione 

"R1[[ky" <ric...@NOSPAMlibero.it> ha scritto nel messaggio 
news:n4Gje.110572$IN.18...@twister2.libero.it...

Puoi utilizzare le Api (Sito comune6.22 Richiamare la finestra di dialogo 
per la selezione di un file)
per aprire un file d'immagine e l'articolo di questo link 
http://support.microsoft.com/default.aspx?scid=kb;en-us;103257
 per leggere e 
scrivere un file in formato binario 

 e scrivere un file in formato binario
Sě ma come "dare in pasto" al modulo BLOB il file che seleziono dal modulo 
che mi fa scegliere il file? 

 che mi fa scegliere il file?
Metodo AppendChunk sul Field associato al Blob del recordset aperto sulla
Tabella
In ogni caso sempre nel SitoComune trovi le 2 Routine già fatte sia per
importare che per esportare proprio nell'articolo che ti ha suggerito
Gaspare
il 6.13, l'hai letto prima di fare la domanda......???????
Sono fatte con DAO, e spezzano il Pacchetto in un numero di blocchi
non sò se per un problema di DAO di inglobare BlockSize maggiori
di un TOT oppure se per gusto grafico di vedere l'aggiornamento della
barra, non ho mai verificato la questione.
Sono certo però che non ADO non hai problemi ed eventualmente
tralasciando l'estetica il tutto si risolve in 3 righe di codice.
Saluti
-- 
@Alex (Alessandro Baraldi)
---------------------------------------------------------------------------
http://www.sitocomune.com/
http://www.mantuanet.it/alessandro.baraldi/
---------------------------------------------------------------------------


Ciao,
la funzione  Function ReadBLOB(Source As String, T As Recordset,  sField As 
String)
come vedi richiede 3 parametri
--------
1) Source -> es. "c:\windows\img.gif" oppure se usi le Api di windows il 
valore che identifica il tuo file
2) T->  Nome tabella dove viene archiviata l'immagine quindi crei il solito 
codice...
 Dim db As Database
 Dim rs As Recordset
 Set db = CurrentDb()
 Set rs = db.OpenRecordset("nometabella")
3) Field -> il nome del campo di tipo OLE  - es. "image"
quindi nel tuo caso richiamerai la funzione nel seguente modo
    Dim val As Variant
        val = ReadBLOB(  "c:\windows\img.gif", rs, "image")
      If val <= 0 Then
             MsgBox "Si è verificato il seguente errore: " & Err.Description
            Exit sub
      End if
Occhio sempre alla gestione degli errori...
--------------------------------------
Per la funzione Function WriteBLOB(T As Recordset, sField As String, 
Destination As String) ed anch'essa richiede 3 parametri
  T    -> tabella contenente informazioni circa l'immagine
  sField  -> Nomecampo di tipo OLE
  Destination -> l'imagine viene ricreata al volo (quindi path+filename) per 
poi essere visualizzata all'interno di una control di tipo "picture"
-------------------------------------------
Se dovessi avere altri "inconvenienti" ho un db formato da 2 maschere: 1 
nella quale selezioni e memorizzi il file e l'altra nella quale lo 
visualizza: onde evitare di postare "molte" righe di codice posso spedirtelo 
ma devi chiedere in giro perchè non è previsto dal regolamento
Spero di essere stato in qulche modo d'ausilio...
Buon fine-settimana
Gaspare

 ha scritto nel messaggio 
news:d6nseo$3bc$1...@domitilla.aioe.org...

Ciao Alessandro...scusa ma non avevo letto la tua risposta
Buon fine-settimana :-)
A presto
Gaspare 

 Gaspare
Ciao Gaspare, non preoccuparti, hai dato un chiaro suggerimento.
Buon fine settimana a te e famiglia.


 ha scritto nel messaggio 
news:d6nv6o$9bp$1...@domitilla.aioe.org...

Grazie e altrettante :-) 

[CUT] Ciao,

Quindi la cosa verrebbe più o meno così? (anche se nella seconda parte mi dà 
"tipo non corrispondente" per il primo argomento della funzione)
Private Sub IMMAGINE_DblClick(Cancel As Integer)
    Dim db As Database
    Dim T As Recordset
    Set db = CurrentDb()
    Set T = db.OpenRecordset("Anag_Mac")
    Dim Source As String
    Dim Campo As String
    Dim Destinazione As String
    'Si collega alla funzione che mi fa scegliere il file
    Source = cmdlg_file()
    Campo = IMMAGINE
    'File temporaneo di destinazione
    Destinazione = "C:\Programmi\Manutenzione\Temp.jpg"
 Dim val As Variant
        val = ReadBLOB("Source", T, "Campo")
      If val <= 0 Then
             MsgBox "Si è verificato il seguente errore: " & Err.Description
      End If
 Dim val2 As Variant
        val2 = WriteBLOB("T", Campo, "Destinazione")
      If val2 <= 0 Then
             MsgBox "Si è verificato il seguente errore: " & Err.Description
      End If
End Sub
Dove sta l'errore? Come avrai capito sono un Newbie che più di così non si 
può.....se hai la pazienza di rispondermi te ne sarei grato, in ogni caso ti 
ringrazio già per l'immenso aiuto che mi hai già dato ;-) 


Allora: in 1 modulo ho le 2 funzioni ReadBLOB e WriteBLOB + il seguente 
codice
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias 
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Public Const BlockSize = 32768
-------------------
Ho 1 tabella "tb" contenente:
1) Oggetto OLE -> "image"
2) Testo - "estensione"
--------------
Ho 1 maschera contenente:
1) 1 immagine -> nome "image" con la proprietà tipo d'immagine "incorporata"
1) 1 pulsante -> "cmdOK"
-------------------
Private Sub cmdOK_Click()
    Dim File As OPENFILENAME
    File.lStructSize = Len(File)
    'Assegna l'handle della finestra principale
    File.hwndOwner = Me.Hwnd
    'Seleziona un filtro
    File.lpstrFilter = "Immagini -> GIF (*.gif)" + Chr$(0) + "*.gif" + 
Chr$(0) + "Immagini -> JPG (*.jpg)" + Chr$(0) + "*.jpg" + Chr$(0) + 
"Immagini ->TIFF (*.tiff)" + Chr$(0) + "*.tiff" + Chr$(0) + "Tutti gli altri 
files(*.*)" + Chr$(0) + "*.*" + Chr$(0)
    'Crea un buffer per il file
    File.lpstrFile = Space$(254)
    'Assegna la massima lunghezza che può avere il file
    File.nMaxFile = 255
    'Crea un buffer per il titolo del file
    File.lpstrFileTitle = Space$(254)
    'Assegna la massima lunghezza che può avere il titolo del file
    File.nMaxFileTitle = 255
    'Determina la directory iniziale
    File.lpstrInitialDir = "C:\"
    'Assegna il titolo della finestra
    File.lpstrTitle = "Seleziona il file da aprire"
    'Non imposta alcun flags
    File.flags = 0
    Dim db As Database
    Dim rs As Recordset
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tb")
    Dim val As Variant
    'Visualizza la finestra
    If GetOpenFileName(File) Then
        Me.image.Picture = Trim$(File.lpstrFile)
          val = ReadBLOB(Me.image.Picture, rs, "image")
        If val <= 0 Then
          MsgBox "Si è verificato il seguente errore: " & Err.Description
          Exit Sub
        End If
      rs("estensione") = Right(Me![image].Picture, 3)
      rs.Update
        Set rs = Nothing
        Set db = Nothing
        MsgBox "File to Open: " + Trim$(File.lpstrFile)
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub
---------------
Prova a vedere se riesci ad archiviare il file  e poi passiamo alla fase di 
lettura...

Praticamente per la GetOpenFileName puoi loggarti al seguente link 
http://www.mentalis.org/apilist/GetOpenFileName.shtml
 e quindi vedere 
l'esempio riportato cliccando su "Open Dialog" dove trovi il seguente codice 
commentato
      Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias 
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
      Private Type OPENFILENAME
          lStructSize As Long
          hwndOwner As Long
          hInstance As Long
          lpstrFilter As String
          lpstrCustomFilter As String
          nMaxCustFilter As Long
          nFilterIndex As Long
          lpstrFile As String
          nMaxFile As Long
          lpstrFileTitle As String
          nMaxFileTitle As Long
          lpstrInitialDir As String
          lpstrTitle As String
          flags As Long
          nFileOffset As Integer
          nFileExtension As Integer
          lpstrDefExt As String
          lCustData As Long
          lpfnHook As Long
          lpTemplateName As String
      End Type
      Private Sub Form_Load()
          'KPD-Team 1998
          'URL: 
http://www.allapi.net/
          'E-Mail: KPD...@Allapi.net
          Dim OFName As OPENFILENAME
          OFName.lStructSize = Len(OFName)
          'Set the parent window
          OFName.hwndOwner = Me.hWnd
          'Set the application's instance
          OFName.hInstance = App.hInstance
          'Select a filter
          OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + 
Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
          'create a buffer for the file
          OFName.lpstrFile = Space$(254)
          'set the maximum length of a returned file
          OFName.nMaxFile = 255
          'Create a buffer for the file title
          OFName.lpstrFileTitle = Space$(254)
          'Set the maximum length of a returned file title
          OFName.nMaxFileTitle = 255
          'Set the initial directory
          OFName.lpstrInitialDir = "C:\"
          'Set the title
          OFName.lpstrTitle = "Open File - KPD-Team 1998"
          'No flags
          OFName.flags = 0
          'Show the 'Open File'-dialog
          If GetOpenFileName(OFName) Then
              MsgBox "File to Open: " + Trim$(OFName.lpstrFile)


 ha scritto nel messaggio 
news:CqMje.1421111$35.53...@news4.tin.it...

Ok adesso mi č tutto piů chiaro e finalmente la prima FUNZIONE FUNZIONA :-)
E per la scrittura?
Ti meriteresti una medaglia per quanto ti sto scocciando! :-)
Grazie cmq.... 


Allora,
sempre nel modulo inserisci il seguente codice
-----------------------------------------------
Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" _
  (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "Kernel32" Alias _
"GetTempFileNameA" _
  (ByVal lpszPath As String, ByVal lpPrefixString As String, _
  ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Function TempDir() As String
  Dim lngRet As Long
  Dim strTempDir As String
  Dim lngBuf As Long
  strTempDir = String$(255, 0)
  lngBuf = Len(strTempDir)
  lngRet = GetTempPath(lngBuf, strTempDir)
  If lngRet > lngBuf Then
    strTempDir = String$(lngRet, 0)
    lngBuf = Len(strTempDir)
    lngRet = GetTempPath(lngBuf, strTempDir)
  End If
  TempDir = Left(strTempDir, lngRet)
End Function
Function TempFile(Create As Boolean, Optional lpPrefixString As Variant, _
Optional lpszPath As Variant) As String
  Dim lpTempFileName As String * 255
  Dim strTemp As String
  Dim lngRet As Long
  If IsMissing(lpszPath) Then
    lpszPath = TempDir
  End If
  If IsMissing(lpPrefixString) Then
    lpPrefixString = "tmp"
  End If
  lngRet = GetTempFileName(lpszPath, lpPrefixString, 0, lpTempFileName)
  strTemp = lpTempFileName
  lngRet = InStr(lpTempFileName, Chr$(0))
  strTemp = Left(lpTempFileName, lngRet - 1)
  If Create = False Then
    Kill strTemp
    Do Until Dir(strTemp) = "": DoEvents: Loop
  End If
  TempFile = strTemp
End Function
----------------------------------
Costruisco un secondo form sempre con un control di tipo immagine...
Nella sezione delle dichiarazioni generali del fom dichiaro
Dim strTempFileName As String
Mentre all'interno dell'evento open  del form
Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrHandler
    Dim varRetVal As Long
    Dim intTries As Integer
    If Len(strTempFileName) > 0 Then
        Kill strTempFileName
        strTempFileName = ""
    End If
    strTempFileName = TempFile(False)
    If Len(strTempFileName) <= 0 Then
        MsgBox "Unable to obtain temporary file in Sub Form_Open", 
vbCritical, "Images in Access Example"
        Cancel = True
    Else
        strTempFileName = Left$(strTempFileName, Len(strTempFileName) - 3) & 
Me.RecordsetClone("estensione")
        If Len(Dir(strTempFileName)) > 0 Then
           Kill strTempFileName
        End If
        varRetVal = WriteBLOB(Me.RecordsetClone, "image", strTempFileName)
        If varRetVal <= 1 Then
            MsgBox "Unable to to write image to file in Sub Form_Open", 
vbCritical, "Images in Access Example"
        End If
        Me![image].Picture = strTempFileName
    End If
Exit_Sub:
    Exit Sub
ErrHandler:
    MsgBox "Error " & Err.Number & " : " & Err.Description & " in 
Form_Open", vbExclamation, "Images in Access Example"
    Cancel = True
  Resume Exit_Sub
End Sub
--------
Prova un pò e se va puoi utilizzare il form di prima, implementandolo con 
questo codice, anche per visualizzare l'immagine...
Ciao
Gaspare