VB

Browser_Folder:
Direktroy_Listfeld:
Directory_+_Dateien_kopieren
Datei_erzeugen:
Text_anhängen:
Textfile_lesen:
Texfile_mit_notepad++_öffnen:
Zeilenende_definieren
Umgebungsvariable_setzen:
Programm_starten:
File_zeilenweise_in_ein_Array_schreiben
Zeile_durch_ein_angegebenes_Trennzeichen_in_ein_neues_Array_zerlegen
Deutsche_Zahlentrenner in Englische umwandeln und zurück

Formatierung:
ToolTip:
Farben
Label_Größe_ändern:
Label_Position:
Label_Margin:
Label_BorderStyle:
DataGridView:
Fehler_abfangen
Abfrage_auf_ein_Zeichen
Fehlermeldungen_abfangen:
Filename_abfragen_ob_existiert:
Zufalls-Zahlen_generieren
Collection:
RichTextBox:
Tasten_einschränken
Steuerelemente_als_Array:
Auto-Scroll:
Windows-Version_ermitteln:

31Projekt_veröffentlichen:

1. Browser Folder:

Um einen Browse Folder wie im Bild1 zu generieren ist folgendes notwendig:

-      Aus der Toolbox den Eintrag „FolderBrowserDialog“ auf das Formular ziehen

-      Doppel-Klick auf den Browse-Button des Formulars

-      Folgenden code eingeben:

Private Sub Browse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Browse.Click
        'Zeigt den List browser an
         FolderBrowserDialog1.SelectedPath = Me.EDA_container.Text
       
Dim result As DialogResult = FolderBrowserDialog1.ShowDialog()
       
If (result = DialogResult.OK) Then
            Me.EDA_container.Text = FolderBrowserDialog1.SelectedPath
            If ComboBox1.Text = "Job Name" Or ComboBox1.Text = "" Then
                Exit Sub
            End If
       
End If
   
End Sub

Wobei EDA_container das Textfeld links neben dem Browse-Button ist.

2. Direktroy Listfeld:

Um z.B. ein Dir-Listfeld zu bekommen, muß eine ComboBox (aus der Toolbox) in das Formular platziert werden. Damit die ComboBox beim Start des Formulars geladen wird, ist folgender Code notwendig:

Private Sub VCC_main_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim pathA As String = "C:\WINNT\system32"
        Dim dir1 As New DirectoryInfo(pathA) 
        Dim list1 = dir1.GetDirectories("*", SearchOption.TopDirectoryOnly)
        ComboBox1.Items.AddRange(list1) 
    End Sub
 

System.IO.DirectoryInfo und System.IO.SearchOption können durch die Imports Anweisung im Deklarationsabschnitt verkürzt werden:

Imports System
Imports System.IO 

dann ist wie im Code-Beispiel nur DirectoryInfo und SearchOption notwendig.

3. Directory + Dateien kopieren (einfach in ein Unterprogramm kopieren. Gehört in jedes Programm):

Imports System
Imports System.IO 

Public Class Callgemein
    Public Sub CopyDirector
y(ByVal SourceDirectory As String, ByVal TargetDirectory As String)
        Dim source As DirectoryInfo = New DirectoryInfo(SourceDirectory)
        Dim target As DirectoryInfo = New DirectoryInfo(TargetDirectory) 
        'Determine whether the source directory exists.
        If (source.Exists = False) Then
            Return
        End If
        If (target.Exists = False) Then
            target.Create()
        End If 

        'Copy files.
        Dim sourceFiles As FileInfo() = source.GetFiles()
        Dim i, j As Integer
        For i = 0 To sourceFiles.Length - 1
            File.Copy(sourceFiles(i).FullName, target.FullName + "\\" + sourceFiles(i).Name, True)
        Next

        'Copy directories.
        Dim sourceDirectories As DirectoryInfo() = source.GetDirectories()
        For j = 0 To sourceDirectories.Length - 1
            CopyDirectory(sourceDirectories(j).FullName, target.FullName + "\\" + sourceDirectories(j).Name)
        Next j
        source = Nothing
        target = Nothing
    End Sub 
End Class

4. Datei erzeugen:

        Dim reportFile As String = tmp_dir & "\" & ComboBox1.Text & ".rep"
        Dim fi As New FileInfo(reportFile)
            If fi.Exists Then
                fi.Delete()
            End If

            Dim sw As StreamWriter
            sw = fi.CreateText
            sw.WriteLine("reportFile = " & reportFile)
            sw.Flush()
           
sw.Close() 

5. Text anhängen:

            Dim sw As StreamWriter
            sw = fi.AppendText
            sw.WriteLine("#------ (proc_lay2) start")
            sw.Flush()
            sw.Close()
 

6. Textfile lesen:

            Dim attFile As String = (job_dir & "\" & ComboBox1.Text & "\misc\attrlist")
            Dim fi1 As New FileInfo(attFile)
            If fi1.Exists Then
                Dim zw1 As String, zw2 As Single
                Dim sr As StreamReader = fi1.OpenText()
                Do While sr.Peek() >= 0
                    zw1 = sr.ReadLine()
                    ..
                Loop
                sr.Close()
            End If 

7. Texfile mit notepad++ öffnen:

            'öffne den Report mit dem Text-Editor
            Dim MyprocID As Integer
            Dim report_file = tmp_dir & "\" & ComboBox1.Text & ".rep"
            Dim MyJob_start As String = """C:\Program Files\Notepad++\notepad++.exe""" & " " & report_file
            MyprocID = Shell(MyJob_start, AppWinStyle.NormalFocus)

8. Zeilenende definieren (hier nur das Unix-Zeilenende “Line feed” festlegen):

            Dim proc_lay As String = tmp_dir & "\proc_lay.tmp"
            Dim fj As New FileInfo(proc_lay)
            If fj.Exists Then
                fj.Delete()
            End If
            Dim sx As StreamWriter
            sx = fj.CreateText
            sx.NewLine = vbLf 

9. Umgebungsvariable setzen:

Environment.SetEnvironmentVariable("GENESIS_EDIR", "C:\Valor\Enterprise\e82")

Umgebungsvariable verwenden:

Dim MyENV As String = Environment.ExpandEnvironmentVariables("%VALOR_EDIR%/get/get")

10. Programm starten:

Es gibt dazu 3 unterschiedliche Möglichkeiten:

  1. startet das Programm und setzt die Programmausführung nach dem Beenden fort:

Imports System.Diagnostics

..

        Dim MyENV As String = Environment.ExpandEnvironmentVariables("%VALOR_EDIR%/get/get")
        Dim newProc As Process = New Process
        Dim prog_name As String = """" & MyENV & """"
        Dim prog_param As String = parameter
        newProc.StartInfo.FileName = prog_name
        newProc.StartInfo.Arguments = prog_param 
        newProc.Start() 

        While newProc.HasExited = False
            Application.DoEvents()
        End While 

        If newProc.ExitCode > 0 Then
            Valor_Fehler(newProc.ExitCode)
        End If 

  1. Programmstart via shell:

        Dim procID As Integer = Shell(“””C:\Program Files\display.exe”” –a –q”)

  1. Programmstart via shell mit Wartezeit in ms:

        Dim procID As Integer = Shell(“””C:\Program Files\display.exe”” –a –q”, , True, 100000)

Die doppelten Anführungszeichen sorgen dafür, dass die Leerzeichen im Pfad nicht als Trenner gedeutet werden.

11. File zeilenweise in ein Array schreiben und dann jede Zeile durch ein angegebenes Trennzeichen in ein neues Array zerlegen:

        Dim A() As String
        Dim line() As String = File.ReadAllLines(comps_file)
        For i = 0 To line.GetUpperBound(0)
            A = line(i).Split(CChar(vbTab))
 

12. Deutsche Zahlentrenner
("," für Nachkommastellen, "." für Tausender Trennung) mit englischer: ("." für Nachkommastellen und "," für Tausender Trennung) kombinieren:

Voraussetzung: Deutsches Zahlensystem in Windows eingestellt, aber die Zahlen im file liegen in englisch Format vor (z.B: 9.7654)

        Dim MyCultureInfo As CultureInfo = New CultureInfo("en-US")
        Dim zahl As String = 10.9507874
        Dim zw1 As Double
        zw1 = Double.Parse(zahl, MyCultureInfo) - 0.01
 

Um die ‘deutschen’ Zahl wieder in eine englische mit . als Trennzeichen umzuwandeln:

        zw1.ToString("G", MyCultureInfo)

13. Formatierung:

cell_type_des(i) = String.Format("{0,-40} {1,-15} {2,-10}", zw5, zw8, zw6)

    Public Shared Sub Main()
        Dim animal1 As String = "fox"
        Dim animal2 As String = "dog"
        Dim strTarget As String = [String].Format("The {0} jumped over the {1}.", animal1, animal2)
 
        Console.WriteLine("The original string is:{0}{1}{0}", Environment.NewLine, strTarget)
 
        Console.Write("Enter an adjective (or group of adjectives) to describe the {0}: ==> ", animal1)
        Dim adj1 As String = Console.ReadLine()
 
        Console.Write("Enter an adjective (or group of adjectives) to describe the {0}: ==> ", animal2)
        Dim adj2 As String = Console.ReadLine()
 
        adj1 = adj1.Trim() + " "
        adj2 = adj2.Trim() + " "
 
        strTarget = strTarget.Insert(strTarget.IndexOf(animal1), adj1)
        strTarget = strTarget.Insert(strTarget.IndexOf(animal2), adj2)
 
        Console.WriteLine("{0}The final string is:{0}{1}", Environment.NewLine, strTarget)
    End Sub 
End Class 
' Output from the example might appear as follows:
'       The original string is:
'       The fox jumped over the dog.
'       
'       Enter an adjective (or group of adjectives) to describe the fox: ==> bold
'       Enter an adjective (or group of adjectives) to describe the dog: ==> lazy
'       
'       The final string is:
'       The bold fox jumped over the lazy dog.

14. ToolTip:

Aus der Toolbox das ToolTip Control in das Formular ziehen. Das ToolTip Control hat diverse Eigenschaften die hier für alle ToolTip’s eingestellt werden:

AutomaticDelay: 500
AutoPopDelay: 5000 (ist auch der Maximal Wert von 5s)
InitialDelay: 300
ShowAlways: yes 

Wer längere Anzeige-Zeiten als 5s braucht, muss die show-Methode verwenden:

ToolTip1.Show(„Text, der angezeigt wird“, Me.Button1, 20000)

Die letzte Zahl gibt die Anzeigedauer in Millisekunden wieder. Entgegen der MS-Hilfe ist die Grenze 32767 ms, also nur eine Single Integer.

Auch ein ToolTip Title ist möglich:

ToolTip1.ToolTipTitle = „Überschrift“

Das ToolTip Control ist eine sehr unzuverlässige Funktion, was daran liegt, da es nur für Labels sinnvoll einsetzbar ist (sofern keine Ereignisse wie z.B. Prozeduren beim Verlassen des Feldes verwendet werden). Dies liegt daran, da der Timer für das ToolTip Control dann nicht mehr richtig arbeitet.

15. Farben (z.B. Vordergrund-/Hintergrund Farben):

Die Farb-Informationen können wie folgt in einer Variablen abgelegt und wieder gesetzt werden:

Dim farb_merk as String
farb_merk = Label1.ForeColor.Name 

Und zurück schreiben:

Label1.ForeColor = Color.FromName(farb_merk)

Achtung: Der Name der Fordergrundfarbe ist Standardmäßig abhängig vom Steuerelement:

Für Labels heißt sie: ControlText
Für TextBox: WindowText 

Und nicht schwarz. Entweder ändert man in der Form die Fordergrundfarbe in schwarz oder muss nach dem ControlText bzw. WindowText abfragen:

If <Steuerelementname>.ForeColor.Name = „ControlText“ Then
         <Steuerelementname>.ForeColor = Color.Red
End If 

16. Label Größe ändern:

label1.Size = New Size(115, 20)

17. Label Position:

label1.Location = New Point(115, 20)

18. Label Margin:

label1.Margin = New Padding(0)

19. Label BorderStyle:

label1.BorderStyle = BorderStyle.None

20. DataGridView:

Das DataGridView control hat ein paar Eigenheiten die hier beschrieben werden:

  1. Eine celle kann nur dann mit ReadOnly eingestellt werden, wenn vorher das ganze DataGridView control ReadOnly auf False steht
  2. Die Vorder- und Hintergrundfarbe wird wie folgt eingestellt:

a.  DataGridView1.CurrentCell.Style.BackColor = Color.White

b.  DataGridView1.CurrentCell.Style.ForeColor = Color.Black

  1. Die Vorder- und Hintergrundfarbe funktioniert nur dann, wenn die ReadOnly Eigenschaft des DataGridView1 controls danach geändert wird
  2. Die Vorder- und Hintergrundfarbe funktioniert nur in einer DataGridView1_CellEnter(….)-Sub
  3. Soll während der Dateneingabe einer Celle die KeyCodes eingeschränkt werden, so geht das nicht über KeyDown des DataGridView sondern über das Ereignis EditingControlShowing. Dazu sind folgende Programmzeilen notwendig:

    Private Sub DataGridView1_EditingControlShowing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewEditingControlShowingEventArgs) Handles DataGridView1.EditingControlShowing

        Dim txtedit As TextBox = DirectCast(e.Control, TextBox)
        AddHandler txtedit.KeyDown, AddressOf txtEdit_KeyDown

    End Sub 

    Private Sub txtEdit_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
        'Debug.Print(e.KeyValue)
        If (e.Alt = True Or e.Control = True Or e.Shift = True) Then
           
e.SuppressKeyPress = True
            'lasse CR, TAB, Entf, 4 Pfeil-Tasten zu
       
ElseIf (e.KeyValue = 13 Or e.KeyValue = 8 Or e.KeyValue = 46 Or e.KeyValue = 37 Or e.KeyValue = 38 Or e.KeyValue = 39 Or e.KeyValue = 40) Then
           
e.SuppressKeyPress = False
           
'lasse die Zeichen -., zu
        ElseIf (e.KeyValue = 189 Or e.KeyValue = 109 Or e.KeyValue = 190 Or e.KeyValue = 188 Or e.KeyValue = 110) Then
            e.SuppressKeyPress = False
        ElseIf (e.KeyValue < 48 Or (e.KeyValue > 57 And e.KeyValue < 96) Or e.KeyValue > 105) Then
            e.SuppressKeyPress = True
        End If
    End Sub
 

  1. Fehler abfangen, wenn einer Celle mit “Nothing” (od. IsNull) nichts zugewiesen wurde:

    Dim wert As String = DataGridView1.CurrentCell.Value

        Try
            If wert.Length > 2 Then
                If wert.Substring(0, 2) = "0," Then
                    Debug.Print(DataGridView1.CurrentCell.Value)
                    DataGridView1.CurrentCell.ReadOnly = False
                    DataGridView1.CurrentCell.Style.SelectionBackColor = Color.White
                    DataGridView1.CurrentCell.Style.SelectionForeColor = Color.Black
                    DataGridView1.CurrentCell.Style.BackColor = Color.White
                    DataGridView1.CurrentCell.Style.ForeColor = Color.Black
                    DataGridView1.ReadOnly = False
                End If
            End If

        Catch ex As NullReferenceException

            DataGridView1.CurrentCell.Value = ""

        End Try 

7.    TextBoxCell in ComboBoxCell umwandeln

z.B.

        Myorg_val1 = DataGridView3.CurrentCell.Value
        Dim CboCell As New DataGridViewComboBoxCell 
        'Bei der Umwandlung der TextBoxCell in eine ComboBoxCell muss die Tastaturabfrage über die TextBox ausgeschaltet sein
       
txtEdit2_allow = False 
        CboCell.Items.AddRange("No", "Reported", "All")
        DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex) = CboCell
        DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = Myorg_val1
        DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex).ReadOnly = False
 

Beschreibung:

- Mit ‚CboCell‘ wird eine „DataGridviewComboBoxCell“-Variable erstellt. Wird z.B. beim Ändern der 4. Spalte die Tastatureingabe mittels einer TextBox geprüft, so muss diese abgeschaltet werden (txtEdit2_allow = False) s. Nr. 5.
- CboCell.Items.AddRange(„…..“) füllt die ComboBox mit Werten
- Dann wird die DataGridComboBoxCell der gewünschten Celle zugeordnet.
- Da die neue ComboBoxCell leer ist, muss der vorherige Inhalt, der in Myorg_val1 steht, der ComboBox zugewiesen werden.
- Dann muss noch die ComboBox beschreibbar gemacht werden sonst kommt kein Auswahlfenster

Um aus der DataGridViewComboBoxCell wieder eine TextBoxCell zu machen:

        'Ändere die ComboBoxCell wieder zurück in eine TextBoxCell
       
Dim tt2 As String = DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex).Value
        Dim TCell As New DataGridViewTextBoxCell
        DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex) = TCell
        DataGridView3.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = tt2
 

Die Umstellung darf nur im CellClick event passieren, nicht im CellEnter, CellLeave oder CellValidated, sonst bricht der Vorgang mit folgender Fehlermeldung ab: „System.InvalidOperationException“:

    Private Sub DataGridView1_CellClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellClick
        If DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).GetType.ToString = "System.Windows.Forms.DataGridViewComboBoxCell" Then
            Exit Sub
        End If

        If cell_wechsel = True Then
            Dim TxtCell As New DataGridViewTextBoxCell
            Dim merk As String = DataGridView1.Rows(ze).Cells(sp).Value
            DataGridView1.Rows(ze).Cells(sp) = TxtCell
            DataGridView1.Rows(ze).Cells(sp).Value = merk
            cell_wechsel = False
        End If

        'Debug.Print(DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).GetType.ToString)

        Dim CboCell As New DataGridViewComboBoxCell
        CboCell.Items.Clear()
        CboCell.Items.Add("Yes")
        CboCell.Items.Add("No")
        CboCell.Items.Add("None")
        'Debug.Print("Zeile " & e.RowIndex & "         Spalte " & e.ColumnIndex)
        If e.RowIndex = 0 And e.ColumnIndex = 0 Then
        Else
            Dim r As Int32 = e.RowIndex
            Dim c As Int32 = e.ColumnIndex
            DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).ReadOnly = True
            Dim merk As String = DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value
            DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex) = CboCell
            DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).ReadOnly = False
            DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = merk
        End If
    End Sub 

    Private Sub DataGridView1_CellLeave(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellLeave

        If DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).GetType.ToString = "System.Windows.Forms.DataGridViewTextBoxCell" Then
            Exit Sub
        End If
        ze = e.RowIndex
        sp = e.ColumnIndex
        cell_wechsel = True

    End Sub

21. Abfrage auf ein Zeichen (oder Zeichenfolge):

Dim wert As String = "#Test"
If wert.IndexOf("#") = 0 Then

oder

If wert.IndexOfAny(New Char() {"@"c, "."c, ","c, "#"c}) > -1 Then

22. Fehlermeldungen abfangen:

Dim outfile As String = "C:\valor_local_db\outputs\tmp\out5.txt"

        Try
            Dim line() As String = File.ReadAllLines(outfile)
       
Catch ex As FileNotFoundException
            Debug.Print("Datei nicht gefunden: " & ex.FileName)
        End Try
 

Als “Catch ex As FileNotFoundException“ können auch andere Fehler abgefangen warden:

Try
    ' Add code for your I/O task here. 
Catch dirNotFound As System.IO.DirectoryNotFoundException
    Throw dirNotFound
Catch fileNotFound As System.IO.FileNotFoundException
    Throw fileNotFound
Catch pathTooLong As System.IO.PathTooLongException
    Throw pathTooLong
Catch ioEx As System.IO.IOException
    Throw ioEx
Catch security As System.Security.SecurityException
    Throw security
Catch ex As Exception
    Throw ex
Finally
    ' Dispose of any resources you used or opened in the Try block. 
End Try

23. Filename abfragen ob existiert:

Dim outfile As String = "C:\valor_local_db\outputs\tmp\out5.txt"
        If File.Exists(outfile) Then
            Dim line() As String = File.ReadAllLines(outfile)
       
End If 

24. Zufalls-Zahlen generieren (z.B. um Filenamen zu unterscheiden):

Dim rand As New Random
        Dim job_swap As String = ComboBox1.Text & "."
& rand.Next(100000)

25. Collection:

-      Definieren: 1. Neue Klasse anlegen:

Imports System
Imports System.IO 

Public Class Cerfpath

    'schreibe den Inhalt der erf-files + die zugehörigen Nodes in die Collection
   
Private _node1 As Integer
    Private _node2 As Integer
    Private _node3 As Integer
    Private _node4 As Integer
    Private _erfpath As FileInfo
    Private _erfcaption As String
    Private _changed As Boolean 

    Public Sub New(ByVal node1 As Integer, ByVal node2 As Integer, ByVal node3 As Integer, ByVal node4 As Integer, ByVal erfpath As FileInfo, ByVal erfcaption As String, ByVal changed As Boolean)

        _node1 = node1
        _node2 = node2
        _node3 = node3
       
_node4 = node4
        _erfpath = erfpath
        _erfcaption = erfcaption
       
_changed = changed

    End Sub 

    Public Property node1() As Integer
        Get
            Return _node1
        End Get
        Set(ByVal value As Integer)
            _node1 = value
        End Set
    End Property 

    Public Property node2() As Integer
        Get
            Return _node2
        End Get
        Set(ByVal value As Integer)
            _node2 = value
        End Set
    End Property 

    Public Property node3() As Integer
        Get
            Return _node3
        End Get
        Set(ByVal value As Integer)
            _node3 = value
        End Set
    End Property 

    Public Property node4() As Integer
        Get
            Return _node4
        End Get
        Set(ByVal value As Integer)
            _node4 = value
        End Set
    End Property 

    Public Property erfpath() As FileInfo
        Get
            Return _erfpath
        End Get
        Set(ByVal value As FileInfo)
            _erfpath = value
        End Set
    End Property 

    Public Property erfcaption() As String
        Get
            Return _erfcaption
        End Get
        Set(ByVal value As String)
            _erfcaption = value
        End Set
    End Property 

    Public Property changed() As Boolean
        Get
            Return _changed
        End Get
        Set(ByVal value As Boolean)
            _changed = value
        End Set
    End Property 
End Class 

-      Globale Variable definieren:

Public Myerfpath As New List(Of Cerfpath)

-      Werte hinzufügen:

            For Each li In werte3
                Dim erfval As New Cerfvalue(node1, node2, node3, node4, li)
                Myerfval.Add(erfval)
            Next 

-      Bereich löschen:

o   1. Index des 1. Vorkommens ermitteln

            Dim ndx As Integer = Myerfval.FindIndex(AddressOf MyFindIndex)

o   Letzten Index des letzten Vorkommens ermittel

            Dim ndx2 As Integer = Myerfval.FindLastIndex(AddressOf MyFindIndex)

o   Löschen:

            Myerfval.RemoveRange(ndx, ndx2 - ndx + 1)

    Private Function MyFindIndex(ByVal bk As Cerfvalue) As Boolean
        If bk.node1 = node1_akt And bk.node2 = node2_akt And bk.node3 = node3_akt And bk.node4 = node4_akt Then
            Return True
        Else
            Return False
        End If
   
End Function

-      Inhalt ändern:

            For Each ks As Cerfpath In Myerfpath
                If node1_akt = ks.node1 And node2_akt = ks.node2 And node3_akt = ks.node3 And node4_akt = ks.node4 Then
                    ks.changed = True
                End If
            Next

26. RichTextBox:

Muster in einer RichTextBox suchen und dann die ganze Zeile rot darstellen:

            'indexToText gibt die gefundene Position im RichText zurück
            Dim indexToText As Integer
            'linenr1 liefert die Zeilen# von indexToText
            Dim linenr1 As Integer
            'char_nr1 gibt die Position des 1. Zeichens von linenr1 zurück
            Dim char_nr1 As Integer
            'char_nr2 gibt die Postion des 1. zeichens von linenr1 + 1 zurück
            Dim char_nr2 As Integer
            'laenge = Anzahl der Zeichen in linenr1
            Dim laenge As Integer 

            For s = 0 To Gfilter.GetUpperBound(0)
                If chk_box(s) = True And Gfilter(s) <> "" Then
                    Dim h As Integer = 0
                    Do While h < RichTextBox1.TextLength
                        indexToText = RichTextBox1.Find(Gfilter(s), h, RichTextBoxFinds.MatchCase)
                        If indexToText >= 0 Then
                            linenr1 = RichTextBox1.GetLineFromCharIndex(indexToText)
                            char_nr1 = RichTextBox1.GetFirstCharIndexOfCurrentLine
                            char_nr2 = RichTextBox1.GetFirstCharIndexFromLine(linenr1 + 1)
                            laenge = char_nr2 - char_nr1 - 1
                            RichTextBox1.Select(char_nr1, laenge)
                            RichTextBox1.SelectionColor = Color.Red
                            h = char_nr2
                        Else
                            Exit Do
                        End If
                    Loop
                End If
            Next 

Schneller geht es aber, den Text im array zu suchen:

            'lines enthält den Inhalt der Text-Box
           
Dim lines(0) As String
            Dim i As Integer = 0
           
'zaeler_anfang enthält die Anzahl der Zeichen bis zur untersuchenden Zeile
            Dim zaehler_anfang As Integer = 0
            'zaehler_ende enthält die Anzahl der Zeichen bis zum Ende der zu untersuchenden Zeile
            Dim zaehler_ende As Integer 
            'Die RichText Box kann nicht nach Regex suchen
            'daher erfolgt der Umweg über die Variable
           
For Each li In TextBox1.Lines
                If i = 0 Then
                    lines(i) = li
                    i = i + 1
                Else
                    ReDim Preserve lines(i)
                    lines(i) = li
                    i = i + 1
                End If
            Next 

            For i = 0 To lines.GetUpperBound(0)
                If i > 0 Then
                   
zaehler_anfang = zaehler_anfang + lines(i - 1).Length + 1
               
End If
               
zaehler_ende = zaehler_anfang + lines(i).Length
               
Dim zeile_filter As Boolean = False 

                For s = 0 To Gfilter.GetUpperBound(0)
                    If chk_box(s) = True And Gfilter(s) <> "" Then
                        If Filter.RadioButton1.Checked = True Then
                            If lines(i).IndexOf(Gfilter(s)) > -1 Then
                                zeile_filter = True
                                Exit For
                            End If
                        Else
                            Dim _reg As Regex = New Regex(Gfilter(s))
                            Dim m As Match = _reg.Match(lines(i))
                            If (m.Success) Then
                                zeile_filter = True
                                Exit For
                            End If
                        End If
                    End If
                Next
                If zeile_filter = True Then
                   
RichTextBox1.Select(zaehler_anfang, zaehler_ende - zaehler_anfang)
                   
RichTextBox1.SelectionColor = Color.Red
                End If
           
Next 

Inhalt der TextBox in ein Array schreiben:

            'lines enthält den Inhalt der Text-Box
            Dim lines(0) As String
 

            For Each li In TextBox1.Lines
                If i = 0 Then
                    lines(i) = "#" & li
                    i = i + 1
                Else
                    ReDim Preserve lines(i)
                    lines(i) = "#" & li
                    i = i + 1
                End If
            Next

27. Tasten einschränken

    Private Sub TextBox1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown

        If e.Alt = True Then
            e.SuppressKeyPress = True
            'lasse 4 Pfeil-Tasten zu
        ElseIf (e.KeyValue = 37 Or e.KeyValue = 38 Or e.KeyValue = 39 Or e.KeyValue = 40) Then
            e.SuppressKeyPress = False
            'CTRL-c zulassen für copy
        ElseIf ((e.Control = True) And (e.KeyValue = 67)) Then
            e.SuppressKeyPress = False
            'Bild up und down zulassen
        ElseIf e.Control = True And (e.KeyValue = 33 Or e.KeyValue = 34) Then
            e.SuppressKeyPress = False
        Else
            e.SuppressKeyPress = True
        End If 

    End Sub

Zeichen

:

Code

+

:

187

-

:

189

.

:

190

CR

:

13

löschen

:

8

:

37

:

39

:

38

:

40

0-9

:

48-57

0-9 kpd

:

96-105

Pos1

:

36

Ende

:

35

TAB

:

9

28. Steuerelemente als Array:

        Dim boxlist As New List(Of TextBox)
        boxlist.AddRange(New TextBox() {TextBox1, TextBox2, TextBox3, TextBox4, TextBox5, TextBox6, TextBox7, TextBox8, TextBox9, TextBox10, TextBox11, TextBox12, TextBox13, TextBox14, TextBox15, TextBox16, TextBox17, TextBox18, TextBox19, TextBox20, TextBox21, TextBox22, TextBox23, TextBox24, TextBox25})
        Dim checklist As New List(Of CheckBox)
        checklist.AddRange(New CheckBox() {CheckBox1, CheckBox2, CheckBox3, CheckBox4, CheckBox5, CheckBox6, CheckBox7, CheckBox8, CheckBox9, CheckBox10, CheckBox11, CheckBox12, CheckBox13, CheckBox14, CheckBox15, CheckBox16, CheckBox17, CheckBox18, CheckBox19, CheckBox20, CheckBox21, CheckBox22, CheckBox23, CheckBox24, CheckBox25}) 

        If zeile >= 2 And zeile < 25 Then
            boxlist(zeile).Text = boxlist(zeile + 1).Text
            checklist(zeile).Checked = checklist(zeile + 1).Checked
       
End If 

Private Sub ClickButton(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click, Button2.Click, Button3.Enter

        Dim btn As Button
        btn =
CType(sender, Button)
        MsgBox(btn.Text)

End Sub

In the above example ClickButton procedure is handling the click event of Button1 and Button2, whereas Enter event of the Button3. In order to check the control that is pressed, you need to convert the sender to the respective type. The CType function converts it into a button type, so that you can access the attributes of the event raised by the control.

'Create the button

        Dim btn As New Button()

'Specify the location and the size

        btn.Location = New System.Drawing.Point(200, 30)
        btn.Size =
New System.Drawing.Size(100, 20)
        btn.Text =
"New Button"

'Add it to the forms control collection

               Me.Controls.Add(btn)

'Link the event to the event handler

        AddHandler btn.Click, AddressOf Me.ClickButton

29. Auto-Scroll:

Um ein Text-Feld automatisch nach oben scrollen zu lassen, muss etwas getrixt werden. Benötig werden dazu:

-  ein Panel (aus der Toolbox)
- eine Text- oder RichText Box
- Timer

In einem Formular wird zu erst das Panel platziert:

Darin kommt die TextBox:

Diese TextBox ist nach unten viel größer als das Panel-Fenster. Die X/Y-Koordianten für die location müssen manuell auf 0,0 gesetzt werden

Anschließend kommt der Timer aus der Toolbox ins Formular und der folgende Code. wobei "Über" das Formular ist:

Public Class Über
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        'schiebt die TextBox1, die eingebettet in einem Panel ist, schrittweise nach oben. Dadurch erscheint der Text innerhalb der TextBox1, als ob er nach oben scrollt
        'TextBox1.Locaation.Y >= -100 legt das Ende des scrollens fest; bei = -250 wird die TextBox2 weiter nach oben gesschoben
        If TextBox1.Location.Y >= -100 Then
            'Schiebe die TextBox1 punktweise innerhalb des Panels nach oben
            TextBox1.Location = New Point(0, TextBox1.Location.Y - 1)
             'Setze den Timer auf 150 ms, falls die 10" abgelaufen sind
            If Timer1.Interval = 10000 Then
                            Timer1.Interval = 150
            End If
        End If
  End Sub 
    Private Sub Über_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        'setze den Timer auf 10" um die ersten Zeilen ohne scrollen lesen zu können
        Timer1.Interval = 10000
        Timer1.Start()
    End Sub
 
    Private Sub Über_Click(sender As Object, e As EventArgs) Handles MyBase.Click
        If Timer1.Enabled = True Then
                     Timer1.Stop()
        Else
                     Timer1.Start()
        End If
    End Sub
 
    Private Sub TextBox1_Click(sender As Object, e As EventArgs) Handles TextBox1.Click
        If Timer1.Enabled = True Then
                     Timer1.Stop()
        Else
                     Timer1.Start()
        End If
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Close()
 
End Sub
End Class

30. Windows-Version ermitteln:

 ' Ermittelt die Windows-Version per WMI
' Optional: sVersion - exakte Windows-Versionsnummer
' Bsp.: 6.2.9200
Public Function OSVersionWMI(Optional ByRef sVersion As String = "") As String
Dim oWMI As Object
Dim oSystem As Object
Dim SQL As String

On Error GoTo ErrHandler

' Abfrage
SQL = "SELECT * FROM Win32_OperatingSystem"

' WMI-Objekt erstellen und Abfrage ausführen
oWMI = GetObject("winmgmts:").ExecQuery(SQL)
For Each oSystem In oWMI
OSVersionWMI = Trim$(oSystem.Caption) ' Windows-Version im Klartext
sVersion = Trim$(oSystem.Version) ' exakte Version-Nr.
Exit For
Next

oSystem = Nothing
oWMI = Nothing
On Error GoTo 0
Exit Function

ErrHandler:
oSystem = Nothing
oWMI = Nothing
End Function

Der Aufruf kann wie folgt erfolgen:

Dim sVersion As String = "Windows7"
Dim sWinVersion As String

sWinVersion = OSVersionWMI(sVersion)

31Projekt veröffentlichen

Der Pfad für das Update lautet: http://milootz.de/Programme/Schriftensammlung_2013

Zurück