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:
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.
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.
Imports
System
Imports
System.IO
Public
Class Callgemein
Public Sub
CopyDirectory(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 i
'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
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()
Dim sw As
StreamWriter
sw = fi.AppendText
sw.WriteLine("#------ (proc_lay2)
start")
sw.Flush()
sw.Close()
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
'ö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)
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
Environment.SetEnvironmentVariable("GENESIS_EDIR", "C:\Valor\Enterprise\e82")
Umgebungsvariable verwenden:
Dim MyENV As String = Environment.ExpandEnvironmentVariables("%VALOR_EDIR%/get/get")
Es gibt dazu 3 unterschiedliche Möglichkeiten:
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
Dim procID As Integer = Shell(“””C:\Program Files\display.exe”” –a –q”)
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.
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))
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)
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.
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.
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
label1.Size = New Size(115, 20)
label1.Location = New Point(115, 20)
label1.Margin = New Padding(0)
label1.BorderStyle = BorderStyle.None
Das DataGridView control hat ein paar Eigenheiten die hier beschrieben werden:
a. DataGridView1.CurrentCell.Style.BackColor = Color.White
b. DataGridView1.CurrentCell.Style.ForeColor = Color.Black
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
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
Dim
wert As String =
"#Test"
If
wert.IndexOf("#") = 0
Then
oder
If wert.IndexOfAny(New Char() {"@"c, "."c, ","c, "#"c}) > -1 Then
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
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
Dim
rand As New
Random
Dim job_swap
As String =
ComboBox1.Text & "."
& rand.Next(100000)
- 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
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
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 |
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
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
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)
Timer1.Interval = 150
End
If
End
If
End
Sub
'setze den Timer auf 10" um die ersten Zeilen ohne scrollen lesen zu können
Timer1.Interval = 10000
Timer1.Start()
End
Sub
If
Timer1.Enabled =
True
Then
Timer1.Stop()
Else
Timer1.Start()
End
If
End
Sub
If
Timer1.Enabled =
True
Then
Timer1.Stop()
Else
Timer1.Start()
End
If
End
Sub
Close()
End
Sub
End
Class
' 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)
Der Pfad für das Update lautet: http://milootz.de/Programme/Schriftensammlung_2013