PictureTagger/SB-PictureTagger/Modul_SB-PictureTagger.vb

Option Explicit On
Imports System.IO

Module Modul_SB_PictureTagger
    Structure Mark
        Dim PositionX As Long
        Dim PositionY As Long
        Dim ID As Long
        Dim Radius As Long
        Dim Description As String
    End Structure 'Mark
    Structure Place
        Dim Title As String
        Dim Adresse As String
        Dim Description As String
        Dim GPS As String
        Public Sub Clear()
            Me.Adresse = Nothing
            Me.Description = Nothing
            Me.GPS = Nothing
        End Sub
    End Structure
    Structure TaggedIMG
        Dim ID As String
        Dim Title As String
        Dim Description As String
        Dim Time As String
        Dim Markierung() As Mark
        Dim Image As Image
        Dim Ort As Place
        Dim Path As String
        Public Sub Create_NewMark(ByVal ID As Long, ByVal PositionX As Long, ByVal PositionY As Long, Optional ByVal Radius As Long = 10, Optional ByVal Description As String = "")
            'Dim Index As Integer
            'If Array.IndexOf(Me.Mark, ) Then Index = 1 + UBound(Me.Mark)
            'ReDim Me.Mark(Index)
            'Me.Mark(Index).ID = ID
            'Me.Mark(Index).PositionX = PositionX
            'Me.Mark(Index).PositionY = PositionY
            'Me.Mark(Index).Radius = Radius
            'Me.Mark(Index).Description = Description
            
        End Sub

        Public Sub Clear()
            Me.ID = Nothing
            Me.Image = Nothing
            Me.Title = Nothing
            Me.Description = Nothing
            Me.Time = Nothing
            Me.Path = Nothing
            Me.Ort.Clear()
            ReDim Me.Markierung(0)
            Me.Markierung(0).Description = Nothing
            Me.Markierung(0).PositionX = Nothing
            Me.Markierung(0).PositionY = Nothing
            Me.Markierung(0).ID = Nothing
            Me.Markierung(0).Radius = Nothing
        End Sub

    End Structure 'TaggedIMG



    'Methoden Index:
    '1.LoadPicture
    '   Parameter: "-SupportedFormats-" -> Array of Supported Formats;
    '   Parameter: File Pfad -> Picture ##in Work!##
    '2.DirReadPhotos
    '   Parameter: Ordner Pfad; Return: Array von Pfaden der Bilddateien des Ordners
    '3.Load_Taggs
    '   Parameter: TaggedIMG-Objekt, DB_Locate -> Indirekte änderung des TaggedIMG-Objekts
    '4.Save_Taggs
    '   Parameter: TaggedIMG-Objekt, DB_Locate







    '###################################################################################################################
    '############### 1.LoadPicture #####################################################################################
    '###################################################################################################################

    Public Function LoadPicture(ByVal sPath As String) As Object
        'Deklariere
        Dim aPhotoFormats(0) As String 'Array Enthält die Unsterstützten Photoformate
        '###Statische Einstellungen###
        'Die Untestützten Formate einstellen
        ReDim Preserve aPhotoFormats(5)
        aPhotoFormats(0) = ".jpg"
        aPhotoFormats(1) = ".bmp"
        aPhotoFormats(2) = ".gif"
        aPhotoFormats(3) = ".png"
        aPhotoFormats(4) = ".jp2"
        aPhotoFormats(5) = ".tif"

        'Entscheide ob Rückgabe des Arrays für die FormatUnterstützung
        'Oder das Laden des Bildes aus der angegebenen Quelle
        If sPath = "-SupportedFormats-" Then
            LoadPicture = aPhotoFormats
        ElseIf (File.Exists(sPath) = True) Then
            'BildLadeFunktion
            'Main Work###############################################
            Dim iPicture As New TaggedIMG
            Dim iPicture_Verz As String

            'Testen ob Vormat unterstüzt!
            If (Array.IndexOf(aPhotoFormats, IO.Path.GetExtension(sPath))) >= 0 Then
                iPicture_Verz = IO.Path.GetDirectoryName(sPath)
                iPicture.Path = sPath
                iPicture.Image = Image.FromFile(sPath)
                iPicture.ID = IO.Path.GetFileName(sPath)

                'Wen Forhanden Exif infos lesen und eintragen (werden von DB überschrieben, wenn dor ein Wert vorhanden ist)

                'Wird hier mit Tagg Bestückt!
                '   iPicture_Verz wird zum localisieren der INI benötigt
                Load_Taggs(iPicture, iPicture_Verz)


                LoadPicture = iPicture
            Else
                MsgBox("Unsupported Format!")
                LoadPicture = ""
            End If
            'Main Work Ende##########################################
        Else
            MsgBox("Can't load Picture")
            LoadPicture = ""
        End If
    End Function 'LoadPicture

    '###################################################################################################################
    '############### 2.DirReadPhotos ###################################################################################
    '###################################################################################################################

    Public Function DirReadPhotos(ByVal sPath As String) As Object
        'Parameter: Ordner Pfad
        'Return: Array von Pfaden der Bilddateien des Ordners


        Dim aPhotos(0) As String
        Dim i As Long
        Dim sPhotoFormat As String
        Dim aPhotoFormats(0) As String 'Array Enthält die Unsterstützten Photoformate

        'Lade Unterstüzte Formate:
        aPhotoFormats = LoadPicture("-SupportedFormats-")

        Try
            'Deklarieren
            Dim aFiles As String() = Directory.GetFiles(sPath) ' Try verwenden!!                <----




            'Überprüfen auf existenz des Ordners
            'Ja: Weiter
            'Nein: MsgBox("Error: Der Pfad existiert Nicht!")
            If Directory.Exists(sPath) = True Then


                'Speichere Pfad in Array aPhotos
                'Wenn das File die Dateiendungen aus Array aPhotoFormats besitzt

                Dim nCount As Long = 0
                If aFiles(0) <> "" Then
                    aPhotos(0) = ""
                    For i = 0 To UBound(aFiles)
                        For Each sPhotoFormat In aPhotoFormats
                            If IO.Path.GetExtension(aFiles(i)) = sPhotoFormat Then
                                If nCount > UBound(aPhotos) Then ReDim Preserve aPhotos(nCount)
                            aPhotos(nCount) = aFiles(i)
                            nCount = nCount + 1
                            End If
                        Next sPhotoFormat
                    Next i
                Else
                    aPhotos(0) = ""
                End If

                'Array Nach Dateinahmen Sortieren
                Array.Sort(aPhotos)


            Else
                MsgBox("Error: Der Pfad existiert Nicht!")
                aPhotos(0) = ""
            End If
            DirReadPhotos = aPhotos
        Catch ex As Exception
            MsgBox(ex.Message)
            aPhotos(0) = ""
            DirReadPhotos = aPhotos
        End Try
    End Function 'DirReadPhotos


    '###################################################################################################################
    '############### 3.Load_Taggs ###################################################################################
    '###################################################################################################################


    'Taggs auslesen (jezt noch aus INI - später aus DB)
    Private Sub Load_Taggs(ByRef iPicture As TaggedIMG, ByVal DB_Locate As String)
        'Grund Vars Deklarieren
        Dim ID As String = iPicture.ID
        Dim sDB As String = "Tagg.ini"
        Dim i As Long


        sDB = Path.Combine(DB_Locate, sDB)
        If File.Exists(sDB) And ID <> "" Then
            'Dekalriere
            Dim Mark_ID As String
            Dim Mark_PositionX As Long
            Dim Mark_PositionY As Long
            Dim Mark_Radius As Long
            Dim Mark_Description As String
            Dim Mark_Index As String

            'Titel
            iPicture.Title = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Title", Nothing)
            'Kurzbeschreibung
            '##############################################################
            'ReFormate Description Text from "Description"
            iPicture.Description = Modul_Tools.Base64_To_Ascii(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Description", Nothing))
            '##############################################################

            'Zeitangabe
            iPicture.Time = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Time", Nothing)
            'Ortsangabe-Title
            iPicture.Ort.Title = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Place_Title", Nothing)
            'Ortsangabe-Adresse
            iPicture.Ort.Adresse = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Place_Adresse", Nothing)
            'Ortsangabe-Kurzbeschreibung
            '##############################################################
            'ReFormate Description Text from "Place.Description"
            iPicture.Ort.Description = Modul_Tools.Base64_To_Ascii(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Place_Description", Nothing))
            '##############################################################

            'Ortsangabe-GPS Koordinaten
            iPicture.Ort.GPS = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Place_GPS", Nothing)


            'Load Marks
            'sMark_Index = Modul_Tools.Config_INI_ReadValue(sDB, ID, "Title")
            i = 0
            Do While i <= 200
                Mark_Index = ("Mark" & Convert.ToString(i) & "_ID")
                Mark_ID = Modul_Tools.Config_INI_ReadValue(sDB, ID, Mark_Index)
                If Mark_ID <> "" Then
                    i += 1

                    Mark_PositionX = Convert.ToDouble(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Mark" & Convert.ToString(i) & "_PositionX", "0"))
                    Mark_PositionY = Convert.ToInt32(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Mark" & Convert.ToString(i) & "_PositionY", "0"))
                    Mark_Radius = Convert.ToInt32(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Mark" & Convert.ToString(i) & "_Radius", "0"))
                    '##############################################################
                    'ReFormate Description Text from "Mark_Description"
                    Mark_Description = Modul_Tools.Base64_To_Ascii(Modul_Tools.Config_INI_ReadValue(sDB, ID, "Mark" & Convert.ToString(i) & "_Description", Nothing))
                    '##############################################################

                    'Erstellen eines Neuen Marks
                    iPicture.Create_NewMark(Mark_ID, Mark_PositionX, Mark_PositionY, Mark_Radius, Mark_Description)
                Else
                    'Verlasse Schleife
                    Exit Do
                End If
            Loop
            i = 0
        End If
    End Sub

    '###################################################################################################################
    '############### 4.Save_Taggs ###################################################################################
    '###################################################################################################################
    Public Sub Save_Taggs(ByVal iPicture As TaggedIMG, ByVal DB_Locate As String)
        'Grund Vars Deklarieren
        Dim ID As String = iPicture.ID
        Dim sDB As String = "Tagg.ini"
        Dim i As Long

        sDB = Path.Combine(DB_Locate, sDB)
        If (ID <> "") And (Not File.Exists(sDB)) Then
            File.Create(sDB)

            'Titel
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Title", iPicture.Title)

            'Kurzbeschreibung
            '##############################################################
            'Formate Description Text from "Description"
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Description", Modul_Tools.Ascii_To_Base64(iPicture.Description))
            '##############################################################

            'Zeitangabe
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Time", iPicture.Time)
            'Ortsangabe-Title
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Place_Title", iPicture.Ort.Title)
            'Ortsangabe-Adresse
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Place_Adresse", iPicture.Ort.Adresse)

            'Ortsangabe-Kurzbeschreibung
            '##############################################################
            'Formate Description Text from "iPicture.Place.Description"
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Place_Description", Modul_Tools.Ascii_To_Base64(iPicture.Ort.Description))
            '##############################################################

            'Ortsangabe-GPS Koordinaten
            Modul_Tools.Config_INI_WriteValue(sDB, ID, "Place_GPS", iPicture.Ort.GPS)


            'Save Marks                  
            i = 0
            If iPicture.Markierung(0).ID <> "" Then
                For i = 0 To UBound(iPicture.Markierung)
                    Modul_Tools.Config_INI_WriteValue(sDB, ID, "Mark" & i & "_ID", Convert.ToString(i))
                    Modul_Tools.Config_INI_WriteValue(sDB, ID, "Mark" & i & "_PositionX", Convert.ToString(iPicture.Markierung(i).PositionX))
                    Modul_Tools.Config_INI_WriteValue(sDB, ID, "Mark" & i & "_PositionY", Convert.ToString(iPicture.Markierung(i).PositionY))
                    Modul_Tools.Config_INI_WriteValue(sDB, ID, "Mark" & i & "_Radius", Convert.ToString(iPicture.Markierung(i).Radius))
                    Modul_Tools.Config_INI_WriteValue(sDB, ID, "Mark" & i & "_Description", Modul_Tools.Ascii_To_Base64(iPicture.Markierung(i).Description))
                Next i
            End If
            i = 0
        End If


    End Sub








    'Vor VBA AND VB without .Net

    '### with .Net: Imports System.IO; Directory.Exists(Path)####
    'Private Function FileExists(ByVal FileName As String) As Boolean
    '    On Error Resume Next
    '    FileExists = Not CBool(GetAttr(FileName) And (vbDirectory Or vbVolume))
    '    On Error GoTo 0
    'End Function

    '### with .Net: Imports System.IO; File.Exists(Path)####
    'Private Function DirExists(ByVal DirectoryName As String) As Boolean
    '    On Error Resume Next
    '    DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
    '    On Error GoTo 0
    'End Function
End Module