Bilder resizen in Access 03 VBA und älter

[Janchu88]

Hi,

habe das ganze jetzt schon auf eigene Faust gelöst, aber da ich weit und breit im Netz nicht viel zum Thema fand, werde ich es hier mal eben niederschreiben und evtl stößt irgendwer mit dem selben Problem auch mal darauf und es hilft demjenigen weiter... falls hier im Forum jemand eine elegante Lösung einfällt, bin ich gerne dafür offen

Problem:

In VBA ist nicht wie bei VB.net ein brauchbares Bordmittel ala GDI+ mitgeliefert um Bilder zu verkleinern. Habe eine DB, die sich Bilder in ein bestimmtes Verzeichnis zieht und dann passend zu Artikeln darstellt. Wenn allerdings das Eingangspic mit der Auflösung des Zorns von 5000x5000 oder so vorliegt (10MP+ kommt ja in Mode) dann verbraucht das a nutzlos speicher und b werden die DB Formulare lahm, da sie bei jeder Darstellung das Bild erstmal auf Anzeigegröße resizen. Da wie bereits gesagt VBA hierfür keine Bordmittel mitbringt muss man sich anders helfen

In diesem Fall hab ich mir unter VB.Net einfach ein super simples Kommandozeilentool geschrieben, welches aus VBA heraus aufgerufen werden kann. Dieses hat nichts an Bord was es nicht können muss, ist sage und schreibe 16kb "fett" und erledigt seine Arbeit bestens... Was kann es? Es nimmt ein Bild und verkleinert es unter Angabe der Zielbreite der längsten Seite (daher längste Seite max 640px bspw)

Ist ein Bild kleiner als die Zielgröße, wird es nicht angerührt

Aufruf erfolgt über resize.exe <Pfad des Bildes> <Pixel längste Seite Zielbild>

die Exe ist im Anhang beigefügt...

Daher, nun hat man 2 Möglichkeiten

1. Resize.exe im selben Verzeichnis oder wo auch immer ablegen
2. Resize.exe binär in der DB speichern und bei bedarf temporär auslesen, erstellen und nach benutzung wieder löschen (bei den paar kb ist das quasi instant erledigt und das ganze ist richtig ins Projekt integriert). Dafür ließe sich dann auch eine eigene Funktion definieren, welche das alles automatisch macht und nur noch ein Bild und eine Größe als Parameter erwartet

Wie auch immer man es lösen will, der Aufruf erfolgt nun aus VBA mit Hilfe des Shell Funktion, mit welcher sich direkt Kommandozeilenbefehle ausführen lassen, also bspw

shell("c:\resize.exe c:\test.jpg 800", vbhide)

vbhide sorgt dafür, dass der Nutzer auch keine Commandshell zu gesicht bekommt. Noch ein Hinweis: Die Shell Routine wird asynchron ausgeführt, daher der nachfolgende VBA Code wird ausgeführt egal ob der Befehl in der Kommandozeile schon beendet ist. Ist in diesem Fall relevant, falls man direkt danach mit dem verkleinerten Bild arbeiten will im Code, dann stürzt das Programm ab. Aber auch hierfür gibt es eine Lösung. In diesem Fall wird dies über API´s gelöst und nennt sie sich ShellandWait, welche eine Shell synchronisiert ausführt, daher abwartet bis sie beendet wurde (Quelle ShellandWait: Warten bis eine andere Anwendung beendet wurde Office-Loesung.de)

Private Declare Function OpenProcess Lib "kernel32.dll" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long

Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE As Long = &HFFFFFFFF

Public Sub ShellAndWait(Shellcommand As String)
   Dim lngTaskID As Long, lngProcID As Long, lngExitCode As Long
   lngTaskID = Shell(Shellcommand, vbHide)
   lngProcID = OpenProcess(SYNCHRONIZE + PROCESS_QUERY_INFORMATION, 0&, lngTaskID)
   Call WaitForSingleObject(lngProcID, INFINITE)
   Call CloseHandle(lngProcID)
End Sub

hier btw die VB.net sources vom resizer, falls es wen interessiert:

Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging

Module Module1

    Sub Main()

        Dim args As String()
        args = Environment.GetCommandLineArgs()

        Dim pfad As String
        Dim zielbreite As Integer

        pfad = args(1)
        zielbreite = Convert.ToInt32(args(2))

        Dim bild As Bitmap
        Using Bmp As New Bitmap(pfad)
            bild = New Bitmap(Bmp)
        End Using

        Call PicResize(bild, zielbreite, pfad)

    End Sub

    Public Sub PicResize(ByVal quellbild As Image, ByVal breitesteseite As Integer, ByVal pfad As String)

        If quellbild.Width > breitesteseite Or quellbild.Height > breitesteseite Then

            Dim skalierfaktor As Double

            If quellbild.Width > quellbild.Height Then

                skalierfaktor = breitesteseite / quellbild.Width

            ElseIf quellbild.Height > quellbild.Width Then

                skalierfaktor = breitesteseite / quellbild.Height

            Else

                skalierfaktor = breitesteseite / quellbild.Width

            End If

            Dim neuehöhe As Integer
            Dim neuebreite As Integer
            neuehöhe = skalierfaktor * quellbild.Height
            neuebreite = skalierfaktor * quellbild.Width
            Dim neuesbild As New Bitmap(neuebreite, neuehöhe)
            Using G As Graphics = Graphics.FromImage(neuesbild)

                G.InterpolationMode = InterpolationMode.HighQualityBicubic
                G.DrawImage(quellbild, New Rectangle(0, 0, neuebreite, neuehöhe))

            End Using

            neuesbild.Save(pfad, Imaging.ImageFormat.Jpeg)

        Else

        End If

    End Sub

End Module

Evtl. kann ich irgendwem da draussen in irgendeiner Art und Weise mit helfen und wenn nicht dann eben nicht

mfG Janchu88