added menu items

trip up down menu options write to temp or docs
OlimilO1402 · Apr 30, 2022 · 7267f9b · 7267f9b
1 parent dc90154
commit 7267f9b
Show file tree

Hide file tree

Showing 5 changed files with 174 additions and 69 deletions.
diff --git a/Forms/Form1.frm → Forms/FMain.frm b/Forms/Form1.frm → Forms/FMain.frm
@@ -1,12 +1,12 @@
 VERSION 5.00
 Begin VB.Form FMain 
-   Caption         =   "Form1"
+   Caption         =   "FMain"
    ClientHeight    =   5895
    ClientLeft      =   3240
-   ClientTop       =   3030
+   ClientTop       =   3330
    ClientWidth     =   12255
-   Icon            =   "Form1.frx":0000
-   LinkTopic       =   "Form1"
+   Icon            =   "FMain.frx":0000
+   LinkTopic       =   "FMain"
    ScaleHeight     =   5895
    ScaleWidth      =   12255
    Begin VB.ListBox LBTrip 
@@ -43,7 +43,7 @@ Begin VB.Form FMain
    End
    Begin VB.Label Label1 
       AutoSize        =   -1  'True
-      Caption         =   "Geo-Positions of Your Famous Places:"
+      Caption         =   "Geo-positions of your famous places:"
       Height          =   195
       Left            =   60
       TabIndex        =   4
@@ -59,9 +59,8 @@ Begin VB.Form FMain
       Top             =   0
       Width           =   855
    End
-   Begin VB.Menu mnuPopup1 
-      Caption         =   "mnuPopup1"
-      Visible         =   0   'False
+   Begin VB.Menu mnuPopGPS 
+      Caption         =   "mnuPopGPS"
       Begin VB.Menu mnuStartKoUmre 
          Caption         =   "Start Koordinaten-Umrechner.de"
       End
@@ -77,19 +76,40 @@ Begin VB.Form FMain
       Begin VB.Menu mnuAddToTrip 
          Caption         =   "Add To Trip"
       End
-      Begin VB.Menu mnuOpenTempDir 
-         Caption         =   "Open Temp-Folder"
-      End
    End
-   Begin VB.Menu mnuPopup2 
-      Caption         =   "mnuPopup2"
-      Visible         =   0   'False
-      Begin VB.Menu mnuTripRemovePlace 
-         Caption         =   "Remove From Trip"
-      End
+   Begin VB.Menu mnuPopTrip 
+      Caption         =   "mnuPopTrip"
       Begin VB.Menu mnuTripStartGEarth 
          Caption         =   "Show Trip in Google Earth"
       End
+      Begin VB.Menu mnuTripMoveUp 
+         Caption         =   "Move ^_up_^"
+      End
+      Begin VB.Menu mnuTripMoveDown 
+         Caption         =   "Move v_down_v"
+      End
+      Begin VB.Menu mnuTripRemovePlace 
+         Caption         =   "Remove Item"
+      End
+      Begin VB.Menu mnuTripClear 
+         Caption         =   "Clear Trip"
+      End
+   End
+   Begin VB.Menu mnuPopOptions 
+      Caption         =   "mnuPopOptions"
+      Begin VB.Menu mnuOptFolder 
+         Caption         =   "Write kml-file to Folder"
+         Begin VB.Menu mnuOptFolderTemp 
+            Caption         =   "Temp"
+            Checked         =   -1  'True
+         End
+         Begin VB.Menu mnuOptFolderDocs 
+            Caption         =   "Documents"
+         End
+      End
+      Begin VB.Menu mnuOptFolderOpen 
+         Caption         =   "Open Folder: Temp"
+      End
    End
 End
 Attribute VB_Name = "FMain"
@@ -100,33 +120,40 @@ Attribute VB_Exposed = False
 Option Explicit
 'https://www.koordinaten-umrechner.de/decimal/51.000000,10.000000?karte=OpenStreetMap&zoom=8
 Private m_FamousPlaces As Collection 'Of GeoPos
-Private m_Trip         As Collection
-Private m_pfnTmp       As String
-Private m_pfnDoc       As String
+Private m_Trip         As Collection 'Of GeoPos
+Private m_pfnKml       As String 'pathfilename of kml-file
 'https://earth.google.com/web
 
-'Wünsche:
-' * List-funktionen bei Trip
-'   - Entries rauf/runter schieben
-' * Strings verketten mit class Stringbuilder
-' * Datei Operationen mit class PathFileName
-' * rausfinden wie man kml-Datei an webbasierten Google-Earth sendet
+'Wishes:
+' * do file operations with class PathFileName get the
+'   chance to call the default program for html-files
+' * check how to send kml-file to Google-Earth Web
 '   https://www.youtube.com/watch?v=-wXcH5Uzsos
-' * Falls alte Desktop version von Google-Earth-Pro vorhanden
-'        Option anbieten ob neuer oder webbasierter verwendet werden soll
-'   Sonst das Webbasierte Google-Earth verwenden
-'
+' * if desktop version Google-Earth-Pro exists
+'        offer option for usigng old (pro) or new (web)
+'   else use google earth web
 
 Private Sub Form_Load()
-    Me.Caption = "Angle,WGS84,UTM32 v" & App.Major & "." & App.Minor & "." & App.Revision
+
+    Me.Caption = "Angle, GeoPos(gps)WGS84,UTM32 v" & App.Major & "." & App.Minor & "." & App.Revision
     AddPlaces
     Set m_Trip = New Collection
-    m_pfnTmp = Environ("Temp") & "\" & "AngleWGS84UTM32GoogleEarth.kml"
-    m_pfnDoc = Environ("Homedrive") & Environ("Homepath") & "\Documents\" & "AngleWGS84UTM32GoogleEarth.kml"
+
+    m_pfnKml = pathTemp & "\" & fnKml
+
+    mnuPopGPS.Visible = False
+    mnuPopTrip.Visible = False
+    mnuPopOptions.Visible = False
+End Sub
+
+Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+    If Button = MouseButtonConstants.vbRightButton Then
+        PopupMenu mnuPopOptions
+    End If
 End Sub
 
 Private Sub Form_Unload(Cancel As Integer)
-    If FileExists(m_pfn) Then Kill m_pfn
+    If FileExists(m_pfnKml) Then Kill m_pfnKml
 End Sub
 
 Private Sub Form_Resize()
@@ -185,13 +212,27 @@ End Sub
 
 Private Sub LBFamousPlaces_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = MouseButtonConstants.vbRightButton Then
-        PopupMenu mnuPopup1
+        PopupMenu mnuPopGPS
     End If
 End Sub
 
+Private Sub LBTrip_Click()
+    If LBTrip.ListCount = 1 Then
+        mnuTripMoveUp.Enabled = False
+        mnuTripMoveDown.Enabled = False
+        Exit Sub
+    End If
+    mnuTripMoveUp.Enabled = True
+    mnuTripMoveDown.Enabled = True
+    Select Case LBTrip.ListIndex
+    Case 0:                    mnuTripMoveUp.Enabled = False
+    Case LBTrip.ListCount - 1: mnuTripMoveDown.Enabled = False
+    End Select
+End Sub
+
 Private Sub LBTrip_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = MouseButtonConstants.vbRightButton Then
-        PopupMenu mnuPopup2
+        PopupMenu mnuPopTrip
     End If
 End Sub
 
@@ -248,24 +289,24 @@ Private Function GetGeoPos(s As String) As GeoPos
     Next
 End Function
 
-' ----------~~~~~~~~~~==========########## '     Menu handler     ' ##########==========~~~~~~~~~~---------- '
+' ----------~~~~~~~~~~==========########## '     Menu handler    ' ##########==========~~~~~~~~~~---------- '
+' ----------~~~~~~~~~~==========########## '      mnuPopGPS      ' ##########==========~~~~~~~~~~---------- '
 Private Sub mnuStartKoUmre_Click()
     Dim s As String: s = LBFamousPlaces.Text
     If Len(s) = 0 Then MsgBox "Select item first": Exit Sub
     Dim gps As GeoPos: Set gps = MNew.GeoPosS(s)
-    'maybe here edit the path to your preferred internet browser
-    Dim cmd As String: cmd = """" & "C:\Program Files\Mozilla Firefox\firefox.exe" & """" & " " & """" & gps.ToKoUmrLink & """"
+    Dim cmd As String: cmd = """" & pfnFF & """" & " " & """" & gps.ToKoUmrLink & """"
     Shell cmd, vbNormalFocus
 End Sub
 
 Private Sub mnuStartGEarth_Click()
     Dim s As String: s = LBFamousPlaces.Text
     If Len(s) = 0 Then MsgBox "Select item first": Exit Sub
     Dim gps As GeoPos: Set gps = MNew.GeoPosS(s)
-    If FileExists(m_pfn) Then Kill m_pfn
-    If SaveFile(m_pfn, gps.ToStrKml) Then
+    If FileExists(m_pfnKml) Then Kill m_pfnKml
+    If SaveFile(m_pfnKml, gps.ToStrKml) Then
         'maybe here edit the path to your Google Earth installation
-        Dim cmd As String: cmd = """" & "C:\Program Files\Google\Google Earth Pro\client\googleearth.exe" & """" & " " & """" & m_pfn & """"
+        Dim cmd As String: cmd = """" & pfnGE & """" & " " & """" & m_pfnKml & """"
         Shell cmd, vbNormalFocus
     End If
 End Sub
@@ -287,8 +328,6 @@ Private Sub mnuEditGeoPos_Click()
     If ns = vbNullString Then Exit Sub 'Cancel
     gps.Parse ns
     LBFamousPlaces.List(LBFamousPlaces.ListIndex) = gps.ToStr
-    'UpdateView
-    'UpdateTripLengthView
 End Sub
 
 Private Sub mnuAddToTrip_Click()
@@ -301,18 +340,7 @@ Private Sub mnuAddToTrip_Click()
     UpdateTripLengthView
 End Sub
 
-Private Sub mnuOpenTempDir_Click()
-    Dim cmd As String: cmd = "explorer.exe " & Environ("Temp") & "\"
-    Shell cmd, vbNormalFocus
-End Sub
-
-Private Sub mnuTripRemovePlace_Click()
-    Dim i As Long: i = LBTrip.ListIndex
-    If i < 0 Then MsgBox "Select item first": Exit Sub
-    m_Trip.Remove i + 1
-    LBTrip.RemoveItem i
-    UpdateTripLengthView
-End Sub
+' ----------~~~~~~~~~~==========########## '      mnuPopTrip      ' ##########==========~~~~~~~~~~---------- '
 
 Private Sub mnuTripStartGEarth_Click()
     If m_Trip.Count < 2 Then MsgBox "Minimum 2 Places in a trip!": Exit Sub
@@ -363,17 +391,78 @@ Private Sub mnuTripStartGEarth_Click()
             "    </Placemark>" & vbCrLf & _
             "</Document>" & vbCrLf & _
             "</kml>"
-    Dim pfn As String
-    pfn = m_pfnDoc
-    If FileExists(pfn) Then Kill pfn
-    If SaveFile(pfn, s) Then
+    If FileExists(m_pfnKml) Then Kill m_pfnKml
+    If SaveFile(m_pfnKml, s) Then
         'maybe here edit the path to your Google Earth installation
-        Dim pfn_GE As String: pfn_GE = "C:\Program Files\Google\Google Earth Pro\client\googleearth.exe"
-        If FileExists(pfn_GE) Then
-            Dim cmd As String: cmd = """" & pfn_GE & """" & " " & """" & pfn & """"
+        If FileExists(pfnGE) Then
+            Dim cmd As String: cmd = """" & pfnGE & """" & " " & """" & m_pfnKml & """"
             Shell cmd, vbNormalFocus
         Else
             'trying to load the kml-file to Google-Earth-Web
+            MsgBox "Please install desktop-version Google Earth Pro"
         End If
     End If
 End Sub
+
+Private Sub mnuTripMoveUp_Click()
+    Dim i As Long: i = LBTrip.ListIndex
+    If i < 0 Then MsgBox "Select item first": Exit Sub
+    'View aktualisieren
+    Dim tmp As String
+    tmp = LBTrip.List(i)
+    LBTrip.List(i) = LBTrip.List(i - 1)
+    LBTrip.List(i - 1) = tmp
+    LBTrip.ListIndex = i - 1
+    i = i + 1  'collection is 1-based
+    Dim gps As GeoPos: Set gps = m_Trip.Item(i)
+    m_Trip.Remove i
+    m_Trip.Add gps, , i - 1
+End Sub
+
+Private Sub mnuTripMoveDown_Click()
+    Dim i As Long: i = LBTrip.ListIndex
+    If i < 0 Then MsgBox "Select item first": Exit Sub
+    Dim tmp As String
+    tmp = LBTrip.List(i)
+    LBTrip.List(i) = LBTrip.List(i + 1)
+    LBTrip.List(i + 1) = tmp
+    LBTrip.ListIndex = i + 1
+    i = i + 1 'collection is 1-based
+    Dim gps As GeoPos: Set gps = m_Trip.Item(i)
+    m_Trip.Remove i
+    m_Trip.Add gps, , , i '- 1
+End Sub
+
+Private Sub mnuTripRemovePlace_Click()
+    Dim i As Long: i = LBTrip.ListIndex
+    If i < 0 Then MsgBox "Select item first": Exit Sub
+    m_Trip.Remove i + 1
+    LBTrip.RemoveItem i
+    UpdateTripLengthView
+End Sub
+
+Private Sub mnuTripClear_Click()
+    LBTrip.Clear
+    Set m_Trip = New Collection
+End Sub
+
+' ----------~~~~~~~~~~==========########## '      mnuPopOpt      ' ##########==========~~~~~~~~~~---------- '
+Private Sub mnuOptFolderDocs_Click()
+    mnuOptFolderDocs.Checked = True
+    mnuOptFolderTemp.Checked = False
+    mnuOptFolderOpen.Caption = "Open Folder: Documents"
+    m_pfnKml = pathDocs & "\" & fnKml
+End Sub
+
+Private Sub mnuOptFolderTemp_Click()
+    mnuOptFolderDocs.Checked = False
+    mnuOptFolderTemp.Checked = True
+    mnuOptFolderOpen.Caption = "Open Folder: Temp"
+    m_pfnKml = pathTemp & "\" & fnKml
+End Sub
+
+Private Sub mnuOptFolderOpen_Click()
+    Dim cmd As String
+    cmd = "explorer.exe " & IIf(mnuOptFolderTemp.Checked, pathTemp, pathDocs)
+    Shell cmd, vbNormalFocus
+End Sub
diff --git a/Forms/Form1.frx → Forms/FMain.frx b/Forms/Form1.frx → Forms/FMain.frx
diff --git a/Modules/MMain.bas b/Modules/MMain.bas
@@ -1,7 +1,23 @@
 Attribute VB_Name = "MMain"
 Option Explicit
+Public pathTemp  As String 'path to tmp directory
+Public pathDocs  As String 'path to documents directory
+Public pathProgs As String 'path to program files directory
+Public pfnGE     As String 'pathfilename to google earth pro (or link to google earth web)
+Public pfnFF     As String 'pathfilename to firefox
+Public fnKml     As String 'default filename of kml file
 
 Sub Main()
+
+    pathTemp = Environ("Temp")
+    pathDocs = Environ("Homedrive") & Environ("Homepath") & "\Documents\"
+    pathProgs = Environ("ProgramW6432")
+
+    'maybe here edit the path to your default or preferred internet browser
+    pfnFF = pathProgs & "\Mozilla Firefox\firefox.exe"
+    pfnGE = pathProgs & "\Google\Google Earth Pro\client\googleearth.exe"
+    fnKml = "AngleWGS84UTM32GoogleEarth.kml"
+
     MMath.Init
     MUTM.Init
     FMain.Show

diff --git a/PAngleWGS84UTM32.vbp b/PAngleWGS84UTM32.vbp
@@ -1,14 +1,14 @@
 Type=Exe
 Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation
-Form=Forms\Form1.frm
+Form=Forms\FMain.frm
+Form=Forms\FTestAngle.frm
+Module=MMain; Modules\MMain.bas
 Module=MNew; Modules\MNew.bas
+Module=MMath; Modules\MMath.bas
 Module=MUTM; Modules\MUTM.bas
 Class=Angle; Classes\Angle.cls
 Class=GeoPos; Classes\GeoPos.cls
 Class=UTM32; Classes\UTM32.cls
-Form=Forms\FTestAngle.frm
-Module=MMain; Modules\MMain.bas
-Module=MMath; Modules\MMath.bas
 ResFile32="Resources\MyRes.res"
 IconForm="FMain"
 Startup="Sub Main"
@@ -21,7 +21,7 @@ HelpContextID="0"
 CompatibleMode="0"
 MajorVer=1
 MinorVer=0
-RevisionVer=23
+RevisionVer=26
 AutoIncrementVer=1
 ServerSupportFiles=0
 CompilationType=0

diff --git a/README.md b/README.md
@@ -3,7 +3,7 @@
 
 [![GitHub](https://img.shields.io/github/license/OlimilO1402/Math_AngleWGS84UTM32?style=plastic)](https://github.com/OlimilO1402/Math_AngleWGS84UTM32/blob/master/LICENSE) 
 [![GitHub release (latest by date)](https://img.shields.io/github/v/release/OlimilO1402/Math_AngleWGS84UTM32?style=plastic)](https://github.com/OlimilO1402/Math_AngleWGS84UTM32/releases/latest)
-[![Github All Releases](https://img.shields.io/github/downloads/OlimilO1402/Math_AngleWGS84UTM32/total.svg)](https://github.com/OlimilO1402/Math_AngleWGS84UTM32/releases/download/v1.0.22/AngleWGS84UTM32_v1.0.22.zip)
+[![Github All Releases](https://img.shields.io/github/downloads/OlimilO1402/Math_AngleWGS84UTM32/total.svg)](https://github.com/OlimilO1402/Math_AngleWGS84UTM32/releases/download/v1.0.25/AngleWGS84UTM32_v1.0.25.zip)
 [![Follow](https://img.shields.io/github/followers/OlimilO1402.svg?style=social&label=Follow&maxAge=2592000)](https://github.com/OlimilO1402/Math_AngleWGS84UTM32/watchers)
 
 Project started in march 2022.