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