VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmOpslaan BorderStyle = 1 'Fixed Single Caption = "Opslaan" ClientHeight = 2895 ClientLeft = 45 ClientTop = 435 ClientWidth = 11265 ClipControls = 0 'False ControlBox = 0 'False Icon = "frmOpslaan.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2895 ScaleWidth = 11265 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton cmdStop Caption = "Stop" Height = 495 Left = 8040 TabIndex = 9 Top = 2280 Width = 3135 End Begin VB.CommandButton cmdTerug Caption = "Ga terug naar het Edit-scherm" Height = 495 Left = 120 TabIndex = 8 Top = 2280 Width = 3255 End Begin VB.CommandButton cmdOpslaan Caption = "Opslaan" Height = 495 Left = 4800 TabIndex = 7 Top = 2280 Width = 3135 End Begin VB.Frame Frame2 Caption = "Selecteer de doelbestanden:" Height = 2055 Left = 120 TabIndex = 0 Top = 120 Width = 11055 Begin VB.CommandButton cmdLocatieLogFile Caption = "..." Height = 375 Left = 10440 TabIndex = 6 Top = 1440 Width = 495 End Begin VB.CommandButton cmdLocatieSurfacelines Caption = "..." Height = 375 Left = 10440 TabIndex = 5 Top = 720 Width = 495 End Begin VB.TextBox txtLogBestand Height = 285 Left = 120 TabIndex = 4 Text = "Text1" Top = 1440 Width = 10095 End Begin VB.TextBox txtProfielen Height = 285 Left = 120 TabIndex = 1 Text = "output_profiel.csv" Top = 720 Width = 10095 End Begin VB.Label Label4 Caption = "Naam logbestand:" Height = 255 Left = 120 TabIndex = 3 Top = 1200 Width = 5535 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Naam doelbestand aangepaste profielen (input voor DAM Edit Design):" Height = 195 Left = 120 TabIndex = 2 Top = 360 Width = 5010 End End Begin MSComDlg.CommonDialog openBestand Left = 3840 Top = 2280 _ExtentX = 847 _ExtentY = 847 _Version = 393216 FileName = "c" End End Attribute VB_Name = "frmOpslaan" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Function openBestanden(ByVal titleOpenDialog As String, voorstelFilename As String) As String 'Sets the Dialog Title to Open File openBestand.DialogTitle = titleOpenDialog 'Definieer setting file dialog venster 'Sets the File List box to csv files openBestand.Filter = "DAM Ditch Output bestand (*.csv)|*.csv" 'Set the default files type to csv files openBestand.FilterIndex = 1 openBestand.FileName = voorstelFilename 'Sets the flags - File must exist and Hide Read only openBestand.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 'Set dialog box so an error occurs if the dialogbox is cancelled openBestand.CancelError = True ' Enables error handling to catch cancel error On Error Resume Next ' display the dialog box openBestand.ShowSave If Err Then ' This code runs if the dialog was cancelled MsgBox "Geen bestandsnaam geselecteerd" Exit Function End If 'Bewaar de bestandsnaam in de functie variabele openBestanden = openBestand.FileName End Function Private Sub cmdLocatieLogFile_Click() 'Sets the Dialog Title to Open File titleMenu = "Save DAM Edit logbestand" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "output_DAM_Edit_log.csv") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtLogBestand.Text = inputBestand End If End Sub Private Sub cmdLocatieSurfacelines_Click() 'Declareer locale variabele Dim myString As String 'Sets the Dialog Title to Open File titleMenu = "Save DAM Edit profiellijnenbestand" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtProfielen.Text = inputBestand myString = inputBestand pathInvoerbestand = (Mid$(myString, 1, InStrRev(myString, "\"))) txtLogBestand.Text = pathInvoerbestand & "output_DAM_Ditch_log.csv" End If End Sub Private Sub cmdOpslaan_Click() 'Declareer locale variabelen Dim tellerEen, tellerTwee, tellerDrie, tellerVier, aantalPuntenRegel As Long Dim directoryPathPL, directoryPathProfiel, directoryPathLogBestand, outputProfiel, outputPL, tempVarPL, tempVarProfiel, outputLogBestand Dim xOld, yOld, xNew, yNew As Double Dim i As Integer 'Set trap On Error GoTo errorHandler 'Bewaar de geselecteerde bestandsnaam outputProfiel = txtProfielen.Text outputLogBestand = txtLogBestand.Text directoryPathProfiel = outputProfiel directoryPathLogBestand = outputLogBestand 'Tijdelijke code om resultaat in bestand te laten zien Open directoryPathProfiel For Output As #1 'Set de initialisatie waarde tellerDrie = 2 'schrijf header weg Print #1, "CODE;SUBCODE;X;Y;Z;PROFIELNAAM" For tellerEen = 1 To aantalProfielen 'Controleer of het profiel verwijderd moet worden bij het opslaan If arrayProcessLog(tellerEen, 8) = "FALSE" Then 'Schrijf profielregel weg For tellerTwee = 2 To totaalAantalKolommen - 2 If arrayProfielen(tellerEen, tellerTwee) = "" Then Exit For tempVar = arrayPuntCode(tellerEen, tellerDrie) & ";" & arrayPuntCode(tellerEen, tellerDrie + 1) & ";" & arrayProfielen(tellerEen, tellerTwee) & ";" & arrayProfielen(tellerEen, tellerTwee + 1) & ";" & arrayProfielen(tellerEen, tellerTwee + 2) & ";" & arrayProfielen(tellerEen, 1) Print #1, tempVar 'Verhoog de tellers om weer op de juiste locatie terug te keren tellerDrie = tellerDrie + 2 tellerTwee = tellerTwee + 2 Next tellerTwee 'Set de initialisatie waarde tellerDrie = 2 End If Next tellerEen 'Schrijf de process log weg Open directoryPathLogBestand For Output As #3 Print #3, "profielnaam;sloot_aanwezig;aantal_insteekpunten_sloot;taludhellingen_aangepast;sloot_aangemaakt;Boezem_aanwezig;Damwand_aanwezig;Profielverwijderd;Profiel_bewerkt;Opmerkingen" For tellerEen = 1 To aantalProfielen For tellerTwee = 1 To aantalKolommenArrayProcessLog If tellerTwee = 1 Then tempVar = arrayProcessLog(tellerEen, tellerTwee) Else tempVar = tempVar & ";" & arrayProcessLog(tellerEen, tellerTwee) End If Next tellerTwee Print #3, tempVar Next tellerEen Close #3 'Sluit de bestanden Close #1 'Geef aan dat het opslaan gelukt is i = MsgBox("Bestanden zijn opgeslagen.", vbOKOnly, "Bestand opgeslagen") 'Activeer de stopknop cmdStop.Enabled = True 'Voorkom dat onnodig de errorHanlder wordt uitgevoerd Exit Sub 'Trap errorHandler: 'Toon waarschuwing i = MsgBox("Fout bij het opslaan, controleer bestandsnaam", vbCritical, "Fout!") 'sluit bestanden Close #1 End Sub Private Sub cmdStop_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u wilt stoppen?", vbYesNo, "Let op!") If i = vbYes Then 'Stop het programma End End If End Sub Private Sub cmdTerug_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u naar het Edit scherm wilt?", vbYesNo, "Let op!") If i = vbYes Then 'Sluit het huidige scherm en open het scherm opslaan frmOpslaan.Show frmPL.Show End If End Sub Private Sub Form_Load() Dim lengtebestandsnaam As Long lengtebestandsnaam = Len(kadeTraject) 'Toon voorstel voor de bestandsnamen txtProfielen.Text = inputBestand txtLogBestand.Text = inputBestand 'Als het aantalverwijderde profielen groter is dan 0, dan kan het log bestan dopgeslagen worden If aantalVerwijderdeProfielen > 0 Then txtLogBestand.Enabled = True End If End Sub