Compare commits

...

4 Commits
v0.8 ... master

Author SHA1 Message Date
6543 b2616664fd
add Tree png version 2019-10-25 18:40:53 +02:00
6543 3468188067
found a changelog 2019-10-25 16:55:22 +02:00
6543 f46deb1008 found as working on disk 2019-10-25 16:54:43 +02:00
6543 baa9b2695a v0.9 2019-10-25 16:52:34 +02:00
21 changed files with 397 additions and 361 deletions

0
SB-PictureTagger.sln Normal file → Executable file
View File

0
SB-PictureTagger/Class_Mark.vb Normal file → Executable file
View File

0
SB-PictureTagger/Class_MarkButton.vb Normal file → Executable file
View File

0
SB-PictureTagger/Class_Place.vb Normal file → Executable file
View File

0
SB-PictureTagger/Class_Rectangle.vb Normal file → Executable file
View File

0
SB-PictureTagger/Class_TaggedIMG.vb Normal file → Executable file
View File

0
SB-PictureTagger/F_SB_PictureTagger.Designer.vb generated Normal file → Executable file
View File

0
SB-PictureTagger/F_SB_PictureTagger.resx Normal file → Executable file
View File

4
SB-PictureTagger/F_SB_PictureTagger.vb Normal file → Executable file
View File

@ -15,7 +15,7 @@ Public Class SB_PictureTagger
Public Pub_nPfadeIndex As Long = 0 'IndexNR des aktuell Geladenen Photos aus pub_aPfade
Public Pub_aConfigForm(0) As String 'Array mit FormConfiguration
Public Pub_nOrdnerTiefe As Integer = 0 'Recursive Ordnertiefe beim Ordnereinlesen
Public Pub_aSupportedFiles() As String = {".jpg", ".bmp", ".gif", ".png", ".jp2", ".tif"} 'Speichert die Unterstützten Extentions
Public Pub_aSupportedFiles() As String = {".jpg", ".bmp", ".gif", ".png", ".jp2", ".tiff"} 'Speichert die Unterstützten Extentions

Private nCountMarks As Integer

@ -346,7 +346,7 @@ Public Class SB_PictureTagger
Mark_Description = ""

Next
nCountMarks = Mark_Index
nCountMarks = Mark_Index + 1
End If

End If

718
SB-PictureTagger/M_Tools.vb Normal file → Executable file
View File

@ -1,360 +1,360 @@
Namespace Tools
Namespace Filesystem
<HideModuleName()>
Module Filesystem

'######################################################################################
'################Function GetFilesFromDir(Pfad; Extention; RecursionsTiefe)############
Public Function GetFilesFromDir(ByVal Pfad As String, ByVal Extention() As String, Optional ByVal RecursionsTiefe As Integer = 0) As String()

If Extention.Length <= 0 Then ReDim Extention(0)
If Extention(0) = Nothing Then Extention(0) = ""

Dim aPathList(0) As String
Dim aPathList_Extention(0) As String

'Überprüfen auf Pfad Korektheit
If System.IO.Directory.Exists(Pfad) Then

'Auslesen der Ordner
_GetFilesFromDir(aPathList, Pfad, RecursionsTiefe)
If aPathList.Length <= 0 Then ReDim aPathList(0)

'Extention Rausfiltern
If Not (Array.IndexOf(Extention, "*") >= 0) Then
For Each EachFile In aPathList
If (Array.IndexOf(Extention, System.IO.Path.GetExtension(EachFile)) >= 0) Then
'Undimensionierte Arrays werden Dimensioniert
If aPathList_Extention.Length <= 0 Then ReDim aPathList_Extention(0)

'Wenn Letzter Wert Im Array nicht vergeben ist
If (aPathList_Extention(UBound(aPathList_Extention)) = Nothing) Or (aPathList_Extention(UBound(aPathList_Extention)) = "") Then
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
Else
'Wenn Letzter Wert Im Array ist vergeben!
ReDim Preserve aPathList_Extention(UBound(aPathList_Extention) + 1)
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
End If
End If
Next
Else
aPathList_Extention = aPathList
End If

'Array Sortieren
Array.Sort(aPathList_Extention)

Else
aPathList_Extention(0) = Nothing
End If
GetFilesFromDir = aPathList_Extention
End Function

Private Sub _GetFilesFromDir(ByRef aAim As String(), ByVal Pfad As String, ByVal RecursionsTiefe As Integer)
Try 'Um das Zugrifsrecht Problem zu Beseitigen
If RecursionsTiefe > 0 Then
Dim aDirs As String() = System.IO.Directory.GetDirectories(Pfad)
For Each EachDir In aDirs
_GetFilesFromDir(aAim, EachDir, (RecursionsTiefe - 1))
Next
End If
Dim aFiles As String() = System.IO.Directory.GetFiles(Pfad)

For Each EachFile In aFiles
If aAim.Length <= 0 Then ReDim aAim(0)
If (aAim(UBound(aAim)) = Nothing) Or (aAim(UBound(aAim)) = "") Then
aAim(UBound(aAim)) = EachFile
Else
ReDim Preserve aAim(UBound(aAim) + 1)
aAim(UBound(aAim)) = EachFile
End If
Next
Catch err As System.UnauthorizedAccessException
End Try
End Sub 'Teil von Finction GetFilesFromDir
'######################################################################################
'######################################################################################

'### 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 'FileExists Vor VBA AND VB without .Net

'### 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 'DirExists Vor VBA AND VB without .Net
'######################################################################################
'######################################################################################

End Module
End Namespace 'Filesystem
Namespace Dialoge
<HideModuleName()>
Module Dialoge

Public Function FolderBrowserDialog(Optional ByVal sStartPath As String = "C:\", Optional ByVal ShowNewFolderButton As Boolean = True, Optional ByRef CheckError As Boolean = False) As String
'Verändert die übergebene variable,
'wenn der benutzer durch "OK" den neuen Pfad bestätigt
FolderBrowserDialog = ""
Using FolderBrowserD As New FolderBrowserDialog
With FolderBrowserD
' Ordnervorschlag
.SelectedPath = sStartPath

.Description = "Bitte einen Ordner auswählen."

'#Button "Neuen Ordner erstellen" anzeigen
.ShowNewFolderButton = ShowNewFolderButton

'#ruft Dialog auf, weitere Ausführung nur bei Resultat "OK"
If .ShowDialog = Windows.Forms.DialogResult.OK Then
FolderBrowserDialog = .SelectedPath
Else
CheckError = True '#Ausführung bei Abruch
End If
End With 'FolderBrowserD
End Using
End Function 'FolderBrowserDialog

'###################################################################################################################
'############### OpenFileDialog ####################################################################################
'###################################################################################################################

'Private Sub Button1_Click(ByVal sender As Object, ByVal e As _
' EventArgs) Handles Button1.Click
' ' ### OpenFileDialog ###
' Dim txt As String = ""
' Using ofd As New OpenFileDialog

' With ofd
' ' Ordnervorschlag
' .InitialDirectory = Pfad
' .Title = "Wähle Datei zum öffnen"
' ' Dateivorschlag (falls sinnvoll)
' ' .FileName = "Datei.gif"

' ' Filter
' .Filter = TextBox2.Text
' ' boolsche Abfrage ob Mehrfachauswahl zulässig
' .Multiselect = Not ChkEinzel.Checked

' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
' ' Resultat OK:
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
' If ChkEinzel.Checked = True Then
' ' Bei Einzelauswahl wertet man .FileName aus
' txt = .FileName & vbNewLine

' Else
' ' Bei möglicher Multiselektion wertet man
' ' das Array .FileNames aus
' For Each filename As String In .FileNames
' txt &= filename & vbNewLine
' Next
' End If
' ' Welcher Filter wurde verwendet?
' Dim idx As Integer = .FilterIndex
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
' idx) & vbNewLine
' txt &= "Multiselect: " & .Multiselect.ToString
' Else
' txt = "Abbruch durch Benutzer"
' End If
' End With
' End Using
' TextBox1.Text = txt
'End Sub 'OpenFileDialog

'###################################################################################################################
'############### SaveFileDialog ####################################################################################
'###################################################################################################################

'Private Sub Button2_Click(ByVal sender As Object, ByVal e As _
' EventArgs) Handles Button2.Click
' ' ### SaveFileDialog ###
' Dim txt As String
' Using sfd As New SaveFileDialog

' With sfd
' ' Ordnervorschlag
' .InitialDirectory = Pfad
' .Title = "Eingabe Datei zum speichern (Es wird hier nicht "_
' "wirklich überschrieben)"
' ' Dateivorschlag
' .FileName = "Datei.gif"
' ' Filter
' .Filter = TextBox2.Text

' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
' ' Resultat OK:
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
' txt = .FileName & vbNewLine

' ' Welcher Filter wurde verwendet?
' Dim idx As Integer = .FilterIndex
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
' idx)
' Else
' txt = "Abbruch durch Benutzer"
' End If
' End With
' End Using
' TextBox1.Text = txt
'End Sub 'SaveFileDialog

'###################################################################################################################
'############### xxxxxxxxxxxxxxxxxxxxxxx ###########################################################################
'###################################################################################################################

'Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As _
' Object, ByVal e As EventArgs) _
' Handles ComboBox1.SelectedIndexChanged
' Dim strFilter As String
' Select Case ComboBox1.SelectedIndex
' Case 0
' ' Einfacher Filter
' strFilter = "Gif Bilddateien|*.gif"
' Case 1
' ' Erweiterter Filter
' strFilter = "JPEG Bilddateien|*.jpg|Gif Bilddateien|*.gif|Alle Dateien|*.*"
' Case Else
' ' Mehrere Dateierweiterungen in einer Auswahl
' strFilter = "Alle Bilddateien|*.jpg; *.jpeg; *.bmp; *.gif, *.tif|Alle Dateien|*.*"
' End Select

' TextBox2.Text = strFilter
'End Sub 'ComboBox1_SelectedIndexChanged

'Private Function FilterDescription(ByVal Filter As String, _
' ByVal Index As Integer) As String
' ' erstellt aus dem Filterstring die Bezeichnung
' Dim strArr() As String = Split(Filter, "|"), _
' MyList As New List(Of String)
' For i As Integer = 0 To strArr.GetUpperBound(0)
' If (i Mod 2 = 0) Then MyList.Add(strArr(i))
' Next
' Return MyList(Index - 1)
'End Function 'FilterDescription

End Module
End Namespace 'Dialoge (Ordner Öffnen, Datei Öffnen, Datei Speichern, Ja/Nein, ...
Namespace Convert
Namespace Numeral_System
'Gehört noch Proggramiert (Hex - Dezi - Dual - Römisch - ...)
End Namespace 'Numeral_System (Hex - Dezi - Dual - Römisch - ...) in work
Namespace Coding
<HideModuleName()>
Module Coding
'######################################################################################
'##################################Ascii AND Base64####################################
'Ascii to Base64
Public Function Ascii_To_Base64(ByVal AsciiString As String) As String
If AsciiString = Nothing Then AsciiString = ""
Dim raw As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(AsciiString)
Ascii_To_Base64 = System.Convert.ToBase64String(raw)
End Function
'Base64 to Ascii
Public Function Base64_To_Ascii(ByVal Base64String As String) As String
Try
Dim raw As Byte() = System.Convert.FromBase64String(Base64String)
Base64_To_Ascii = System.Text.ASCIIEncoding.ASCII.GetString(raw)
Catch ex As Exception
Base64_To_Ascii = ""
End Try
End Function
'######################################################################################
'######################################################################################
End Module 'Coding
End Namespace 'Coding (Ascii, Base64, Dual<-in work, ...)
Namespace Koordinaten
<HideModuleName()>
Module Koordinaten
'Soll anhand der GPS Koordinaten GoogleMaps öfnen
'URL ansteuerung: https://developers.google.com/maps/documentation/staticmaps/
' String = "52.520817 13.40945"
'
'Umrechnung von Geo-Koordinaten: http://rechneronline.de/geo-koordinaten/
' ___________________________________________________________________________________________________
'| Grad, Minuten, Sekunden | Dezimalgrad | Grad, Dezimalminuten |
'| z.B. N52° 31' 14.941" E13° 24' 34.020" | z.B. 52.520817 13.40945 | z.B. N52° 31.249 E13° 24.567 |
' ---------------------------------------------------------------------------------------------------
' URL= "http://maps.google.com/maps?q=" & String
'In Projekt SB-PictureTagger: Set a LincLable ;)
End Module 'Koordinaten
End Namespace 'Koordinaten (GPS einheiten, MapsURLs,...)
End Namespace 'Convert
Namespace Prog_Org
<HideModuleName()>
Module Prog_Org
'######################################################################################
'############################## PORTABLE MODE TOOLS ###################################
'Festlegung ob Portable oder nicht, ...
Public Function PortableModeTrue(ByVal ConfigFileName As String) As Boolean
If System.IO.File.Exists(".\" & ConfigFileName) Then
PortableModeTrue = True
Else
PortableModeTrue = False
End If

End Function 'PortableModeTrue
'PortableMode:
'Übergabe: ConfigFile [WorkDir] [AppName] Return: (PortableMode=True/False)
'ConfigFile Nahme und Extendion - Wird Indirekt Geändert zu KonfigPfad
'WorkDir Pfad des Arbeitsverzeichnises - Wird Indirekt Geändert
'AppName Erstellt einen Neuern Ordner mit Diesen Nahme, wenn Nicht Portabler Mode
Public Function PortableMode(ByRef ConfigFile As String, Optional ByRef WorkDir As String = "-default-", Optional ByVal AppName As String = "-default-") As Boolean
If AppName = ("-default-" Or "") Then
AppName = Application.ProductName
End If
If Not System.IO.Directory.Exists(WorkDir) Then WorkDir = "-default-"
If WorkDir = ("-default-" Or "") Then
WorkDir = Application.StartupPath
End If

If System.IO.File.Exists(System.IO.Path.Combine(WorkDir, ConfigFile)) Then
PortableMode = True
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
Else
PortableMode = False
WorkDir = Environment.GetEnvironmentVariable("APPDATA") & "\" & AppName
If Not System.IO.Directory.Exists(WorkDir) Then System.IO.Directory.CreateDirectory(WorkDir)
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
If Not System.IO.File.Exists(ConfigFile) Then System.IO.File.Create(ConfigFile)
End If

End Function 'PortableMode
'######################################################################################
'######################################################################################
End Module
End Namespace 'Prog_Org
Namespace Data
Namespace DB
'Verschiedenen DBs mit ihren Befehlen
End Namespace 'DBs (SQLite, SQL, MySQL, ...)
Namespace File
<HideModuleName()>
Module File
'Declaration für INI:
Private Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Int32, ByVal lpFileName As String) As Int32
Private Declare Ansi Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32

Public Function INI_ReadValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, Optional ByVal sDefault As String = "") As String
Dim strTemp As String = Space(1024), lLength As Integer
lLength = GetPrivateProfileString(sSection, sKey, sDefault, strTemp, strTemp.Length, sFilePath)
Return (strTemp.Substring(0, lLength))
End Function 'Read a INI
Public Function INI_WriteValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, ByVal sValue As String) As Boolean
Return (Not (WritePrivateProfileString(sSection, sKey, sValue, sFilePath) = 0))
End Function 'Write a INI

End Module
End Namespace 'File (INI, XML, ...)
End Namespace 'Data = Manage Infos (DBs, Files, ...)
Namespace Tools
Namespace Filesystem
<HideModuleName()>
Module Filesystem

'######################################################################################
'################Function GetFilesFromDir(Pfad; Extention; RecursionsTiefe)############
Public Function GetFilesFromDir(ByVal Pfad As String, ByVal Extention() As String, Optional ByVal RecursionsTiefe As Integer = 0) As String()

If Extention.Length <= 0 Then ReDim Extention(0)
If Extention(0) = Nothing Then Extention(0) = ""

Dim aPathList(0) As String
Dim aPathList_Extention(0) As String

'Überprüfen auf Pfad Korektheit
If System.IO.Directory.Exists(Pfad) Then

'Auslesen der Ordner
_GetFilesFromDir(aPathList, Pfad, RecursionsTiefe)
If aPathList.Length <= 0 Then ReDim aPathList(0)

'Extention Rausfiltern
If Not (Array.IndexOf(Extention, "*") >= 0) Then
For Each EachFile In aPathList
If (Array.IndexOf(Extention, System.IO.Path.GetExtension(EachFile)) >= 0) Then
'Undimensionierte Arrays werden Dimensioniert
If aPathList_Extention.Length <= 0 Then ReDim aPathList_Extention(0)

'Wenn Letzter Wert Im Array nicht vergeben ist
If (aPathList_Extention(UBound(aPathList_Extention)) = Nothing) Or (aPathList_Extention(UBound(aPathList_Extention)) = "") Then
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
Else
'Wenn Letzter Wert Im Array ist vergeben!
ReDim Preserve aPathList_Extention(UBound(aPathList_Extention) + 1)
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
End If
End If
Next
Else
aPathList_Extention = aPathList
End If

'Array Sortieren
Array.Sort(aPathList_Extention)

Else
aPathList_Extention(0) = Nothing
End If
GetFilesFromDir = aPathList_Extention
End Function

Private Sub _GetFilesFromDir(ByRef aAim As String(), ByVal Pfad As String, ByVal RecursionsTiefe As Integer)
Try 'Um das Zugrifsrecht Problem zu Beseitigen
If RecursionsTiefe > 0 Then
Dim aDirs As String() = System.IO.Directory.GetDirectories(Pfad)
For Each EachDir In aDirs
_GetFilesFromDir(aAim, EachDir, (RecursionsTiefe - 1))
Next
End If
Dim aFiles As String() = System.IO.Directory.GetFiles(Pfad)

For Each EachFile In aFiles
If aAim.Length <= 0 Then ReDim aAim(0)
If (aAim(UBound(aAim)) = Nothing) Or (aAim(UBound(aAim)) = "") Then
aAim(UBound(aAim)) = EachFile
Else
ReDim Preserve aAim(UBound(aAim) + 1)
aAim(UBound(aAim)) = EachFile
End If
Next
Catch err As System.UnauthorizedAccessException
End Try
End Sub 'Teil von Finction GetFilesFromDir
'######################################################################################
'######################################################################################

'### 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 'FileExists Vor VBA AND VB without .Net

'### 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 'DirExists Vor VBA AND VB without .Net
'######################################################################################
'######################################################################################

End Module
End Namespace 'Filesystem
Namespace Dialoge
<HideModuleName()>
Module Dialoge

Public Function FolderBrowserDialog(Optional ByVal sStartPath As String = "C:\", Optional ByVal ShowNewFolderButton As Boolean = True, Optional ByRef CheckError As Boolean = False) As String
'Verändert die übergebene variable,
'wenn der benutzer durch "OK" den neuen Pfad bestätigt
FolderBrowserDialog = ""
Using FolderBrowserD As New FolderBrowserDialog
With FolderBrowserD
' Ordnervorschlag
.SelectedPath = sStartPath

.Description = "Bitte einen Ordner auswählen."

'#Button "Neuen Ordner erstellen" anzeigen
.ShowNewFolderButton = ShowNewFolderButton

'#ruft Dialog auf, weitere Ausführung nur bei Resultat "OK"
If .ShowDialog = Windows.Forms.DialogResult.OK Then
FolderBrowserDialog = .SelectedPath
Else
CheckError = True '#Ausführung bei Abruch
End If
End With 'FolderBrowserD
End Using
End Function 'FolderBrowserDialog

'###################################################################################################################
'############### OpenFileDialog ####################################################################################
'###################################################################################################################

'Private Sub Button1_Click(ByVal sender As Object, ByVal e As _
' EventArgs) Handles Button1.Click
' ' ### OpenFileDialog ###
' Dim txt As String = ""
' Using ofd As New OpenFileDialog

' With ofd
' ' Ordnervorschlag
' .InitialDirectory = Pfad
' .Title = "Wähle Datei zum öffnen"
' ' Dateivorschlag (falls sinnvoll)
' ' .FileName = "Datei.gif"

' ' Filter
' .Filter = TextBox2.Text
' ' boolsche Abfrage ob Mehrfachauswahl zulässig
' .Multiselect = Not ChkEinzel.Checked

' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
' ' Resultat OK:
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
' If ChkEinzel.Checked = True Then
' ' Bei Einzelauswahl wertet man .FileName aus
' txt = .FileName & vbNewLine

' Else
' ' Bei möglicher Multiselektion wertet man
' ' das Array .FileNames aus
' For Each filename As String In .FileNames
' txt &= filename & vbNewLine
' Next
' End If
' ' Welcher Filter wurde verwendet?
' Dim idx As Integer = .FilterIndex
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
' idx) & vbNewLine
' txt &= "Multiselect: " & .Multiselect.ToString
' Else
' txt = "Abbruch durch Benutzer"
' End If
' End With
' End Using
' TextBox1.Text = txt
'End Sub 'OpenFileDialog

'###################################################################################################################
'############### SaveFileDialog ####################################################################################
'###################################################################################################################

'Private Sub Button2_Click(ByVal sender As Object, ByVal e As _
' EventArgs) Handles Button2.Click
' ' ### SaveFileDialog ###
' Dim txt As String
' Using sfd As New SaveFileDialog

' With sfd
' ' Ordnervorschlag
' .InitialDirectory = Pfad
' .Title = "Eingabe Datei zum speichern (Es wird hier nicht "_
' "wirklich überschrieben)"
' ' Dateivorschlag
' .FileName = "Datei.gif"
' ' Filter
' .Filter = TextBox2.Text

' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
' ' Resultat OK:
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
' txt = .FileName & vbNewLine

' ' Welcher Filter wurde verwendet?
' Dim idx As Integer = .FilterIndex
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
' idx)
' Else
' txt = "Abbruch durch Benutzer"
' End If
' End With
' End Using
' TextBox1.Text = txt
'End Sub 'SaveFileDialog

'###################################################################################################################
'############### xxxxxxxxxxxxxxxxxxxxxxx ###########################################################################
'###################################################################################################################

'Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As _
' Object, ByVal e As EventArgs) _
' Handles ComboBox1.SelectedIndexChanged
' Dim strFilter As String
' Select Case ComboBox1.SelectedIndex
' Case 0
' ' Einfacher Filter
' strFilter = "Gif Bilddateien|*.gif"
' Case 1
' ' Erweiterter Filter
' strFilter = "JPEG Bilddateien|*.jpg|Gif Bilddateien|*.gif|Alle Dateien|*.*"
' Case Else
' ' Mehrere Dateierweiterungen in einer Auswahl
' strFilter = "Alle Bilddateien|*.jpg; *.jpeg; *.bmp; *.gif, *.tif|Alle Dateien|*.*"
' End Select

' TextBox2.Text = strFilter
'End Sub 'ComboBox1_SelectedIndexChanged

'Private Function FilterDescription(ByVal Filter As String, _
' ByVal Index As Integer) As String
' ' erstellt aus dem Filterstring die Bezeichnung
' Dim strArr() As String = Split(Filter, "|"), _
' MyList As New List(Of String)
' For i As Integer = 0 To strArr.GetUpperBound(0)
' If (i Mod 2 = 0) Then MyList.Add(strArr(i))
' Next
' Return MyList(Index - 1)
'End Function 'FilterDescription

End Module
End Namespace 'Dialoge (Ordner Öffnen, Datei Öffnen, Datei Speichern, Ja/Nein, ...
Namespace Convert
Namespace Numeral_System
'Gehört noch Proggramiert (Hex - Dezi - Dual - Römisch - ...)
End Namespace 'Numeral_System (Hex - Dezi - Dual - Römisch - ...) in work
Namespace Coding
<HideModuleName()>
Module Coding
'######################################################################################
'##################################Ascii AND Base64####################################
'Ascii to Base64
Public Function Ascii_To_Base64(ByVal AsciiString As String) As String
If AsciiString = Nothing Then AsciiString = ""
Dim raw As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(AsciiString)
Ascii_To_Base64 = System.Convert.ToBase64String(raw)
End Function
'Base64 to Ascii
Public Function Base64_To_Ascii(ByVal Base64String As String) As String
Try
Dim raw As Byte() = System.Convert.FromBase64String(Base64String)
Base64_To_Ascii = System.Text.ASCIIEncoding.ASCII.GetString(raw)
Catch ex As Exception
Base64_To_Ascii = ""
End Try
End Function
'######################################################################################
'######################################################################################
End Module 'Coding
End Namespace 'Coding (Ascii, Base64, Dual<-in work, ...)
Namespace Koordinaten
<HideModuleName()>
Module Koordinaten
'Soll anhand der GPS Koordinaten GoogleMaps öfnen
'URL ansteuerung: https://developers.google.com/maps/documentation/staticmaps/
' String = "52.520817 13.40945"
'
'Umrechnung von Geo-Koordinaten: http://rechneronline.de/geo-koordinaten/
' ___________________________________________________________________________________________________
'| Grad, Minuten, Sekunden | Dezimalgrad | Grad, Dezimalminuten |
'| z.B. N52° 31' 14.941" E13° 24' 34.020" | z.B. 52.520817 13.40945 | z.B. N52° 31.249 E13° 24.567 |
' ---------------------------------------------------------------------------------------------------
' URL= "http://maps.google.com/maps?q=" & String
'In Projekt SB-PictureTagger: Set a LincLable ;)
End Module 'Koordinaten
End Namespace 'Koordinaten (GPS einheiten, MapsURLs,...)
End Namespace 'Convert
Namespace Prog_Org
<HideModuleName()>
Module Prog_Org
'######################################################################################
'############################## PORTABLE MODE TOOLS ###################################
'Festlegung ob Portable oder nicht, ...
Public Function PortableModeTrue(ByVal ConfigFileName As String) As Boolean
If System.IO.File.Exists(".\" & ConfigFileName) Then
PortableModeTrue = True
Else
PortableModeTrue = False
End If

End Function 'PortableModeTrue
'PortableMode:
'Übergabe: ConfigFile [WorkDir] [AppName] Return: (PortableMode=True/False)
'ConfigFile Nahme und Extendion - Wird Indirekt Geändert zu KonfigPfad
'WorkDir Pfad des Arbeitsverzeichnises - Wird Indirekt Geändert
'AppName Erstellt einen Neuern Ordner mit Diesen Nahme, wenn Nicht Portabler Mode
Public Function PortableMode(ByRef ConfigFile As String, Optional ByRef WorkDir As String = "-default-", Optional ByVal AppName As String = "-default-") As Boolean
If AppName = ("-default-" Or "") Then
AppName = Application.ProductName
End If
If Not System.IO.Directory.Exists(WorkDir) Then WorkDir = "-default-"
If WorkDir = ("-default-" Or "") Then
WorkDir = Application.StartupPath
End If

If System.IO.File.Exists(System.IO.Path.Combine(WorkDir, ConfigFile)) Then
PortableMode = True
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
Else
PortableMode = False
WorkDir = Environment.GetEnvironmentVariable("APPDATA") & "\" & AppName
If Not System.IO.Directory.Exists(WorkDir) Then System.IO.Directory.CreateDirectory(WorkDir)
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
If Not System.IO.File.Exists(ConfigFile) Then System.IO.File.Create(ConfigFile)
End If

End Function 'PortableMode
'######################################################################################
'######################################################################################
End Module
End Namespace 'Prog_Org
Namespace Data
Namespace DB
'Verschiedenen DBs mit ihren Befehlen
End Namespace 'DBs (SQLite, SQL, MySQL, ...)
Namespace File
<HideModuleName()>
Module File
'Declaration für INI:
Private Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Int32, ByVal lpFileName As String) As Int32
Private Declare Ansi Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32

Public Function INI_ReadValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, Optional ByVal sDefault As String = "") As String
Dim strTemp As String = Space(1024), lLength As Integer
lLength = GetPrivateProfileString(sSection, sKey, sDefault, strTemp, strTemp.Length, sFilePath)
Return (strTemp.Substring(0, lLength))
End Function 'Read a INI
Public Function INI_WriteValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, ByVal sValue As String) As Boolean
Return (Not (WritePrivateProfileString(sSection, sKey, sValue, sFilePath) = 0))
End Function 'Write a INI

End Module
End Namespace 'File (INI, XML, ...)
End Namespace 'Data = Manage Infos (DBs, Files, ...)
End Namespace 'Tools

0
SB-PictureTagger/My Project/Application.Designer.vb generated Normal file → Executable file
View File

0
SB-PictureTagger/My Project/Application.myapp Normal file → Executable file
View File

0
SB-PictureTagger/My Project/AssemblyInfo.vb Normal file → Executable file
View File

0
SB-PictureTagger/My Project/Resources.Designer.vb generated Normal file → Executable file
View File

0
SB-PictureTagger/My Project/Resources.resx Normal file → Executable file
View File

0
SB-PictureTagger/My Project/Settings.Designer.vb generated Normal file → Executable file
View File

0
SB-PictureTagger/My Project/Settings.settings Normal file → Executable file
View File

0
SB-PictureTagger/Resorcen/Tree.ico Normal file → Executable file
View File

Before

Width:  |  Height:  |  Size: 170 KiB

After

Width:  |  Height:  |  Size: 170 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.7 KiB

0
SB-PictureTagger/SB-PictureTagger.vbproj Normal file → Executable file
View File

36
doc/cangeloog.txt Executable file
View File

@ -0,0 +1,36 @@
0.1
Ordner einlesen und Bilder in Array
Ausgeben in Strucktur
Lesen Von Informationen aus INI
Für und Zurück der Bilder


0.2
Versuch von ausbau an Strucktur TaggedIMG Gescheitert
Veralgemeinern Gescheitert
-Funktions Unfähig-

0.3
Erfolgreiches umsetzen der Strucktur TaggedIMG zu Classe
Umstruckturieren der Funcktionen und Rotienen verteilungen in den einzelnen Bereichen
Ausbau der Tools - Library
Ordner Tiefen Funktio Hinzugefügt, auf Drei Unterordner Begrenzt

0.4
Entbuggen von Grafierenden Fehlern
-Speicherrotine
-Laderotiene
-Erkennung von Änderungen
-Bild wird wieder in PictureBox Geladen
-Ordner wird bei Ordner Tiefen Änderung neu Geladen
Veralgemeinerung der Funktionen (Schnelles Umrüsten auf DB, XML, etc. als Tagg-Source möglich)

0.5
Speicher rotiene feinschlif (AutoSave Checkbox funktioniert wieder)
-Halbstadion (Auser Markierungen Funktioniert Alles)-



Geplante Funktionen:
-Markierungen Erstellen/Bearbeiten/Löschen/Laden/Speichern
-Merken der Einstellungen (Portable - Normal Mode)