354 lines
15 KiB
VB.net
354 lines
15 KiB
VB.net
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
|