Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Bilder automatisch skalieren
zurück: Datumsformat Eingabe vs Ausgabe weiter: Erlauben das Werte nur einmal eingegeben werden Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Pirmin
Gast


Verfasst am:
16. Aug 2007, 17:00
Rufname:

Bilder automatisch skalieren - Bilder automatisch skalieren

Nach oben
       Version: Office 2003

Grüsse an die Access-Meister

Ich habe ein Formular, das mir ein Artikelspezifisches Foto anzeigt. Die Fotos sind ausserhalb der Datenbank abgelegt und bloss der Name des Fotos zu jedem Artikel in der Tabelle Hauptattribute gespeichert.
Zum praktischen auswählen des Bildes via FileDialog habe ich folgenden Code geschrieben/zusammenkopiert:
Code:
Sub getFileName()
' Zeigt das Dialogfeld "Datei öffnen" von Office an, in dem ein Foto für
' den aktuellen Artikel ausgewählt werden kann. Der Name der Bilddatei
' dann im Feld "Artikelfoto" in der Tabelle tbl_Hauptattribute gespeichert.
    Dim fileName As String
    Dim result As Integer
   
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Artikelbild wählen"
        .Filters.Add "Alle Dateien", "*.*"
        .Filters.Add "JPEG-Dateien", "*.jpg"
        .FilterIndex = 2
        .AllowMultiSelect = False
        If Not (IsNull(Me![Artikelnummer])) Then
            .InitialFileName = CurrentProject.Path & "\" & Me![Artikelnummer]
          Else
            .InitialFileName = CurrentProject.Path & "\"
        End If
        result = .Show
        If (result <> 0) Then
            fileName = Trim(.SelectedItems.Item(1))
            fileName = Mid(fileName, InStrRev(fileName, "\") + 1)
            Me.Artikelfoto = fileName
            End If
    End With
    RefreshPreview
End Sub
Damit Access beim Anzeigen des Formulares nicht allzu lange braucht um die Bilder zu laden, habe ich alle Bilder vorher in die Auflösung 640x480 gebracht (mit einem Thumbnail-Tool).

Gibt es nun eine Möglichkeit, dies von Access automatisch machen zu lassen?
D.h. es sollte überprüft werden, in welcher Auflösung das gewählte Bild ist und diese gegebenenfalls anpassen. Anschliessend sollte das neu erzeugte Bild den Namen des Originalbildes erhalten und im gleichen Ordner, in dem sich die Datenbank befindet, abgespeichert werden. Schliesslich soll das Originalbild noch gelöscht werden.

Es ist mir klar, dass dies eine grössere Angelegenheit ist. Ich bin um jegliche Gedankenanstösse froh...
Pirmin
Gast


Verfasst am:
17. Aug 2007, 14:01
Rufname:


AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

Salü zusammen

Nach einigem Suchen habe ich selbst eine Lösung gefunden.

Und zwar gibt es einen fleissigen VBA-Programmier, der ein Modul geschrieben hat, das die nötigen Prozeduren zur Grafikbearbeitung via GDIPlus beeinhaltet:

Zu finden hier: Bilder im Griff mit VBA und GDI+

Mit Hilfe dieses Moduls ist es dann ziemlich einfach und mein erweiterter Code sieht so aus:
Code:
Sub getFileName()
' Zeigt das Dialogfeld "Datei öffnen" von Office an, in dem ein Foto für
' den aktuellen Artikel ausgewählt werden kann. Der Name der Bilddatei
' dann im Feld "Artikelfoto" in der Tabelle tbl_Hauptattribute gespeichert.
' Wenn die Dimesionen des Fotos nicht 640x480 entsprechen, wird dies
' geändert und die Datei im Datenbank-Verzeichnis gespeichert.
    Dim FileName As String
    Dim result As Integer
    Dim picturePath As String
    Dim objPicture As StdPicture
    Dim Abmessungen As TSize
    Dim testPictureSave As Boolean
   
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Artikelbild wählen"
        .Filters.Add "Alle Dateien", "*.*"
        .Filters.Add "JPEG-Dateien", "*.jpg"
        .FilterIndex = 2
        .AllowMultiSelect = False
        If Not (IsNull(Me![Artikelnummer])) Then
            .InitialFileName = CurrentProject.Path + "\" + Me![Artikelnummer]
          Else
            .InitialFileName = CurrentProject.Path + "\"
        End If
        result = .Show
        If (result <> 0) Then
            FileName = Trim(.SelectedItems.Item(1))
            FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
            InitGDIP
            Set objPicture = LoadPictureGDIP(FileName)
            Abmessungen = GetDimensionsGDIP(objPicture)
            X = Abmessungen.X
            Y = Abmessungen.Y
            If (X / Y = 0.75) Then
                MsgBox "Das gewählte Bild ist im Hochformat. " & _
                       "Bitte wählen Sie ein Bild im Querformat (1:1.33)"
                Exit Sub
            End If
            If Not (X = 640 And Y = 480) Then
                Set objPicture = ResampleGDIP(objPicture, 640, 480)
                picturePath = CurrentProject.Path & "\" & FileName
                testPictureSave = SavePicGDIPlus(objPicture, picturePath, pictypeJPG)
            End If
            Me!Artikelfoto = FileName
            ShutDownGDIP
            End If
    End With
    RefreshPreview
End Sub
Für den Fall, dass mal jemand ein ähnliches Problem haben sollte...

Gruss
Pirmin
gioele
Gast


Verfasst am:
19. Jul 2009, 09:44
Rufname:

AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

hallo Pirmin,

habe auf dem Link geklickt aber keine Module gefunden. Oder muss man das Buch kaufen? eventuell könntst du das Modul posten?

gruß,
Gioele
jens05
Moderator


Verfasst am:
19. Jul 2009, 20:02
Rufname:
Wohnort: ~~~~~

AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

Hallo Gioele,
der Code wäre in bas Datei die du an 2 verschiedenen Stellen aus dem Link laden kannst einmal ganz unten, und dann noch ziemlich weit oben
Zitat:
Beispieldateien

mdlGDIPlus.bas

_________________
mfg jens05 Wink
gioele
Gast


Verfasst am:
20. Jul 2009, 00:53
Rufname:

AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

ah, danke schön, jetzt habe ich das Modul.

Ich bin aber wirklich anfänger mit access und grade kann ich mich nicht vorstellen wie ich das Module benutzten soll. Könnte mir jemand ein bißchen helfen?

Ich habe folgendes Code geschrieben, um ein Bild zu umbenennen und in einem Ordner zu kopieren und den Pfad in der Datenbank zu speichern. Ich möchte jetzt das Bild auch skalieren.
Hier mein Code. tbFile ist der Pfad des Bildes
Code:
Private Sub buttonSavePicture_Click()
On Error GoTo Err_buttonSavePicture_Click
    Dim strSQL    As String
    Dim pictureID As Integer
    Dim SourceFile As String
    Dim DestinationFile As String
   
    strSQL = "INSERT INTO picture ( control_id, path, title) " & _
             "VALUES (" & Me!txtID & ", '" & Me!tbFile & "' , " & _
                    "'" & Me!txtPictureTitle & "');"
    If IsNull(Me!tbFile) Or Me!tbFile = "" Then
        MsgBox "Please browse and select a valid file to open.", vbCritical, _
               "Invalid File"
      Else
        pictureID = DLookup("Max([id])", "[picture]")
        DoCmd.RunSQL strSQL
        SourceFile = Me!tbFile
        DestinationFile = "C:\DATA\picture\" & pictureID & ".jpg"
        FileCopy SourceFile, DestinationFile
        ' Textfelder werden initialisiert und die Liste aktualisiert
        Me!tbFile = Null
        Me!txtPictureTitle = Null
        Me!lstPicture3.Requery
    End If
Exit_buttonSavePicture_Click:
    Exit Sub
Err_buttonSavePicture_Click:
    MsgBox Err.Description
    Resume Exit_buttonSavePicture_Click
End Sub
jens05
Moderator


Verfasst am:
20. Jul 2009, 19:56
Rufname:
Wohnort: ~~~~~

AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

Hallo,
die genannten Funktionen legst du mal in einem Modul ab.
An der Stelle wo du derzeit den Dateinamen auswählst (Filedialog?) Kannst du die Prozedur von Pirmin verwenden.

_________________
mfg jens05 Wink
Gioele_
Gast


Verfasst am:
20. Jul 2009, 20:07
Rufname:


AW: Bilder automatisch skalieren - AW: Bilder automatisch skalieren

Nach oben
       Version: Office 2003

hallo Jens, danke dir für deine Hilfe!

ich habe sogar das code implementiert, so dass die Maße des Bildes erhalben bleiben und das Bild nicht nicht verzerrt wird. Wow! bin so zufrieden!
Hier meinen winzigen Beitrag Smile :
Code:
Private Sub buttonSavePicture_Click()
On Error GoTo Err_buttonSavePicture_Click
   
    Dim strSQL    As String
    Dim pictureID As Integer
    Dim SourceFile As String
    Dim vCount As Integer
    Dim objPicture As StdPicture
    Dim Abmessungen As TSize
    Dim testPictureSave As Boolean
    Dim x As Long
    Dim y As Long
    Dim picturePath As String
   
    strSQL = "INSERT INTO picture ( control_id, path, title) " & _
             "VALUES (" & Me!txtID & ", '" & Me!tbFile & "', " & _
                    "'" & Me!txtPictureTitle & "' ); "
    If Not IsNull(DLookup("max([id])", "picture")) Then
        pictureID = DLookup("max([id])", "picture") + 1
      Else
        pictureID = 1
    End If
'    If IsNull(Me!tbFile) Or Me!tbFile = "" Then
    If Nz(Me!tbFile, "") = "" Then
        MsgBox "Please browse and select a valid file to open.", vbCritical, _
               "Invalid File"
      Else
        DoCmd.RunSQL strSQL
        pictureID = DLookup("max([id])", "picture")
        SourceFile = Me!tbFile
        Set objPicture = LoadPictureGDIP(SourceFile)
        Abmessungen = GetDimensionsGDIP(objPicture)
        x = Abmessungen.x
        y = Abmessungen.y
        While x * y > 307200
            x = x * 0.8
            y = y * 0.8
        Wend
        Set objPicture = ResampleGDIP(objPicture, x, y)
        picturePath = "C:\DATA\picture\" & pictureID & ".jpg"
        testPictureSave = SavePicGDIPlus(objPicture, picturePath, pictypeJPG)
        Me!tbFile = Null
        Me!txtPictureTitle = Null
        DoCmd.Requery "lstPicture3"
    End If
Exit_buttonSavePicture_Click:
    Exit Sub
kleine Erklärung:
Code:
        While x * y > 307200
Diese Zahl entspricht ungefähr die Maße 640 x 480
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Access Tabellen & Abfragen: IDENT automatisch vergeben lassen 2 ? 784 31. Aug 2006, 14:23
Gast IDENT automatisch vergeben lassen
Keine neuen Beiträge Access Tabellen & Abfragen: Neue Tabellen aus anderem Tabellen erstellen automatisch 13 Elton#62 1001 28. Aug 2006, 13:01
Nouba Neue Tabellen aus anderem Tabellen erstellen automatisch
Keine neuen Beiträge Access Tabellen & Abfragen: Abfrage automatisch ordnen und Duplikate löschen 1 harald07 974 01. Aug 2006, 11:47
Gast Abfrage automatisch ordnen und Duplikate löschen
Keine neuen Beiträge Access Tabellen & Abfragen: Spalten automatisch erstellen lassen 1 Premium 899 04. Jul 2006, 19:21
rita2008 Spalten automatisch erstellen lassen
Keine neuen Beiträge Access Tabellen & Abfragen: Problem mit Abfrage 4 Maximiliane 675 03. Apr 2006, 10:09
Maximiliane Problem mit Abfrage
Keine neuen Beiträge Access Tabellen & Abfragen: Access rundet automatisch auf! 2 RazielX 4049 23. März 2006, 11:09
RazielX Access rundet automatisch auf!
Keine neuen Beiträge Access Tabellen & Abfragen: Datum automatisch einfügen 5 UPPsycho 898 09. März 2006, 20:58
jens05 Datum automatisch einfügen
Keine neuen Beiträge Access Tabellen & Abfragen: Felder automatisch ausfüllen 5 NVG 884 13. Sep 2005, 20:05
stpimi Felder automatisch ausfüllen
Keine neuen Beiträge Access Tabellen & Abfragen: Eurowert automatisch zu DM-Wert in anderer Zelle umrechnen 4 Peter2 3109 08. Sep 2005, 16:34
Peter2 Eurowert automatisch zu DM-Wert in anderer Zelle umrechnen
Keine neuen Beiträge Access Tabellen & Abfragen: Datensatz automatisch kopieren??? 0 Edelschnitt 701 11. Mai 2005, 19:41
Edelschnitt Datensatz automatisch kopieren???
Keine neuen Beiträge Access Tabellen & Abfragen: Automatisch nächste freie Nummer aus einem Nummerkreis? 4 derBovie 3325 08. Mai 2005, 20:03
'n Access User Automatisch nächste freie Nummer aus einem Nummerkreis?
Keine neuen Beiträge Access Tabellen & Abfragen: Abfragen im Formular aufrufen, automatisch bestätigen 3 Calvin22 1606 12. Apr 2005, 12:12
Willi Wipp Abfragen im Formular aufrufen, automatisch bestätigen
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Expression Web Forum