Imports System.ComponentModel Imports System.Drawing Imports System.Globalization Imports System.Windows.Forms Public Class MyTextBox Inherits System.Windows.Forms.TextBox Implements INotifyPropertyChanged Property _numbersOnly As Boolean = False Property _numbersOnlyKommastellen As String = "" Property _numbersOnlyTrennzeichen As Boolean = True Property _ShortDateOnly As Boolean = False ' nicht mehr public , da fehler Property _ShortDateNew As Boolean = False Property _DateTimeOnly As Boolean = False Property _TimeOnly As Boolean = False Property _TimeOnly_Seconds As Boolean = False Property _Waehrung As Boolean = False Property _WaehrungZeichen As Boolean = True Property _Prozent As Boolean = False ' Property MaxLines As String = "" Property MaxLines_Warning As String = "" Property MaxLines_Warning_Label As Label = Nothing Property MaxLineLength As Integer = -1 Public Event ValueChanged() Public Sub New() If _Waehrung Then MyBase.TextAlign = HorizontalAlignment.Right ' Me.Focus() End Sub Private Sub MyTextBox_BindingContextChanged(sender As Object, e As EventArgs) Handles Me.BindingContextChanged ' If _ShortDateOnly Then 'If IsDate(sender.text) Then sender.text = CDate(sender.text).ToShortDateString ' End If ' If _Waehrung Then 'If IsNumeric(sender.text) Then sender.text = String.Format("{0:N2}", CDbl(sender.text)) 'End If ' If _ShortDateNew Then 'If IsDate(sender._value) Then 'sender._value = MyBase.Text ' End If ' End If End Sub Sub fillWithSQL(sql As String, Optional conn As String = "SDL") ' MsgBox((New SQL).getValueTxtBySql(sql, conn)) Me._value = (New SQL).getValueTxtBySql(sql, conn) ' MsgBox(Me._value) 'Me.Text = Me._value End Sub Private Sub MyTextBox_KeyDown(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress Exit Sub If False Then 'geht end If MaxLineLength > 0 And e.KeyChar <> Chr(13) Then Dim str() As String = Me.Text.Split(vbNewLine) For Each s In Me.Lines If s.Length > MaxLineLength Then s = s.Substring(0, MaxLineLength) End If Next End If End If If _numbersOnly Then If (Microsoft.VisualBasic.Asc(e.KeyChar) < 48) _ Or (Microsoft.VisualBasic.Asc(e.KeyChar) > 57) Then e.Handled = True End If If (Microsoft.VisualBasic.Asc(e.KeyChar) = 8) Then e.Handled = False End If End If End Sub Private Sub MyTextBox_Layout(sender As Object, e As LayoutEventArgs) Handles Me.Layout MyBase.CausesValidation = True If _ShortDateOnly Then MyBase.MaxLength = 10 If _ShortDateNew Then MyBase.MaxLength = 10 ': addPicToGueltigBis() If _DateTimeOnly Then MyBase.MaxLength = 16 ': addPicToGueltigBis() If _TimeOnly Then MyBase.MaxLength = 8 End Sub Sub initDatePicture() addNowBtnToDate() 'addPicToGueltigBis() End Sub Sub initDatePicture2() addNowBtnToDate2() 'addPicToGueltigBis() End Sub Sub initPINSHowPic() addNowBtnToPIN() 'addPicToGueltigBis() End Sub Public Sub addNowBtnToDate() Dim tb = Me Dim pb As New MyLinkPicBoxVALUE tb.Parent.Controls.Add(pb) pb.Tag = "Heute" pb.Left = tb.Left + tb.Width + 5 : pb.Top = tb.Top pb.Height = 18 : pb.Width = 20 pb.Anchor = tb.Anchor pb.SizeMode = PictureBoxSizeMode.Zoom pb.Cursor = Cursors.Hand pb.Image = My.Resources.today pb.linkedTextBox = tb ' ToolTip Text zuordnen Dim tooltip As New ToolTip ' tooltip.SetToolTip(pb, "Heute") AddHandler pb.Click, AddressOf linkclicked End Sub Public Sub addNowBtnToDate2() Dim tb = Me Dim pb As New MyLinkPicBoxVALUE tb.Parent.Controls.Add(pb) pb.Tag = "Heute" pb.Left = tb.Left + tb.Width - 11 : pb.Top = tb.Top + tb.Height - 11 pb.Height = 10 : pb.Width = 10 pb.Anchor = tb.Anchor pb.SizeMode = PictureBoxSizeMode.Zoom 'pb.Cursor = Cursors.Hand ' pb.Image = My.Resources.ok 'pb.BackColor = Color.Green pb.linkedTextBox = tb pb.BringToFront() ' ToolTip Text zuordnen 'Dim tooltip As New ToolTip ' 'tooltip.SetToolTip(pb, "Gül") pb.Image = Nothing If tb.Text.Length = 10 AndAlso IsDate(tb.Text) Then If CDate(tb.Text) >= Now.ToShortDateString Then pb.Image = My.Resources.ok Else pb.Image = My.Resources.del End If End If AddHandler tb.TextChanged, Sub(send As Object, ev As EventArgs) pb.Image = Nothing If send.text.length = 10 AndAlso IsDate(send.text) Then If CDate(send.text) >= Now.ToShortDateString Then pb.Image = My.Resources.ok Else pb.Image = My.Resources.del End If End If End Sub End Sub Public Sub addNowBtnToPIN() Dim tb = Me Dim pb As New MyLinkPicBoxVALUE tb.Parent.Controls.Add(pb) pb.Tag = "Feld bearbeiten" pb.Left = tb.Left + tb.Width + 5 : pb.Top = tb.Top pb.Height = 15 : pb.Width = 15 pb.Anchor = tb.Anchor pb.SizeMode = PictureBoxSizeMode.Zoom pb.Cursor = Cursors.Hand pb.Image = My.Resources.stift pb.linkedTextBox = tb ' ToolTip Text zuordnen Dim tooltip As New ToolTip ' tooltip.SetToolTip(pb, "Heute") AddHandler pb.Click, AddressOf linkclickedPIN 'AddHandler tb.EnabledChanged, Sub(send, ev) ' tb.ForeColor = Color.Black ' End Sub End Sub Sub linkclicked(sender As Object, e As EventArgs) 'Dim DateTimePicker1 As New DateTimePicker ' Me.Parent.Controls.Add(DateTimePicker1) Try Dim tb As TextBox = sender.linkedTextBox tb.Text = Now.ToShortDateString ' DateTimePicker1.Focus() ' SendKeys.Send("{F4}") Catch ex As Exception End Try End Sub Sub linkclickedPIN(sender As Object, e As EventArgs) 'Dim DateTimePicker1 As New DateTimePicker ' Me.Parent.Controls.Add(DateTimePicker1) Try Dim tb As TextBox = sender.linkedTextBox ' tb.Enabled = True tb.ReadOnly = False tb.BackColor = Color.White Catch ex As Exception End Try End Sub Public Sub addPicToGueltigBis() Dim tb = Me Dim pb As New MyLinkPicBoxVALUE tb.Parent.Controls.Add(pb) pb.Tag = "Gültig Bis" pb.Left = tb.Left + tb.Width + 5 : pb.Top = tb.Top pb.Height = 18 : pb.Width = 20 pb.SizeMode = PictureBoxSizeMode.Zoom pb.Name = "picGueltigBisUhr" ' pb = checkGueltigBis(pb, tb) pb.linkedTextBox = tb pb.linkedPictureBox = pb pb.Image = My.Resources.uhr_notime Dim tgb As New Label tb.Parent.Controls.Add(tgb) tgb.Name = "txtGueltigBisUhr" tgb.Left = tb.Left + tb.Width + pb.Width + 5 : tgb.Top = tb.Top ' tgb.Visible = False ' tgb.Text = "abgelaufen" tgb.ForeColor = Color.Red AddHandler tb.TextChanged, AddressOf checkGueltigBis checkGueltigBis(tb, New EventArgs) End Sub Sub checkGueltigBis(sender As Object, e As EventArgs) ' MsgBox("änderung") Try Dim tb As TextBox = sender Dim pb As MyLinkPicBoxVALUE = CType(tb.FindForm.Controls.Find("picGueltigBisUhr", True)(0), MyLinkPicBoxVALUE) Dim tgb As Label = CType(tb.FindForm.Controls.Find("txtGueltigBisUhr", True)(0), Label) ' MsgBox(tgb.Name) If tb.Text.Length = 10 And IsDate(tb.Text) Then If CDate(tb.Text) < Now Then pb.Image = My.Resources.uhr_red tgb.Text = "abgelaufen" tgb.Visible = True tgb.ForeColor = Color.Red ElseIf CDate(tb.Text) >= Now Then pb.Image = My.Resources.uhr_green tgb.Text = "gültig" 'tgb.Visible = False tgb.ForeColor = Color.Green End If Else pb.Image = My.Resources.uhr_notime ' tgb.Visible = False tgb.Text = "" End If Catch ex As Exception End Try Return End Sub Private Sub MyTextBox_Leave(sender As Object, e As EventArgs) Handles Me.Leave ' If _DateOnly AndAlso Not isShortDate(sender.text) Then sender.focus() Dim pruefungHandled = False If _numbersOnly Then 'If sender.text.ToString.StartsWith("21") Then ' For Each s In sender.text.ToString ' MsgBox(s & " - " & Convert.ToByte(s)) ' Next ' ' MsgBox(CInt(sender.text.ToString.Chars(3))) 'End If sender.text = sender.text.ToString.Replace(" ", "").Replace(Chr(160), "") ' 160: irgend ein Sonder-Leerzeichen pruefungHandled = True Try If Not _numbersOnlyTrennzeichen And IsNumeric(sender.text) Then Me._value = CInt(sender.text) ElseIf IsNumeric(_numbersOnlyKommastellen) And IsNumeric(sender.text) Then sender.text = CDbl(sender.text).ToString("N" & _numbersOnlyKommastellen) ' , CultureInfo.InvariantCulture) Me._value = CDbl(sender.text) ' Else ' sender.text = CDbl(sender.text) ElseIf IsNumeric(sender.text) Then Me._value = CDbl(sender.text) Else Me._value = "" End If Catch : sender.ForeColor = System.Drawing.Color.Red End Try End If If _Waehrung Then pruefungHandled = True Try ' sender.text = String.Format("{0:N2}", CDbl(sender.text)) If sender.text = "" Then Me._value = Nothing End If sender.text = CDbl(sender.text).ToString(If(_WaehrungZeichen, "C2", "N2")) ' String.Format("C2", CDbl(sender.text)) sender.ForeColor = System.Drawing.Color.Black Me._value = CDbl(sender.text) 'sender.text) Catch ex As Exception sender.ForeColor = System.Drawing.Color.Red End Try End If If _ShortDateOnly Then pruefungHandled = True Try 'wenn datetime wird es in shortdate umgewandelt If Me.Text <> "" Then sender.text = Convert.ToDateTime(sender.text).ToShortDateString Catch : Me.Text = "" : Me._value = Nothing 'Me.Focus() End Try If Not isShortDate(sender.text) Then sender.ForeColor = System.Drawing.Color.Red End If If _TimeOnly Then If Me.Text <> "" AndAlso IsNumeric(Me.Text) AndAlso CInt(Me.Text) >= 0 AndAlso CInt(Me.Text) < 24 Then pruefungHandled = True If _TimeOnly_Seconds Then Me.Text &= ":00:00" Else Me.Text &= ":00" End If OnPropertyChanged("_value") End If End If If _ShortDateNew Then pruefungHandled = True Me.ForeColor = Color.Black '------ falls Jahr zweistellig: Me.Text = Me.Text.Replace(",", ".") If Me.Text.Length = 8 Then Dim split = Me.Text.Split(".") If split.Count = 3 Then Me.Text = split(0) & "." & split(1) & ".20" & split(2) End If End If ' +2 = zwei Tage von heute weg If Me.Text <> "" AndAlso Not IsDate(Me.Text) AndAlso IsNumeric(Me.Text) Then Me.Text = Now.AddDays(Int(Me.Text)).ToShortDateString End If If (Me.Text.Length >= 6 And Me.Text.Length <= 10) AndAlso IsDate(Me.Text.Replace(",", ".")) AndAlso CDate(Me.Text) > CDate("01.01.1900") Then 'MsgBox(Me.Text) ''------ falls Jahr zweistellig: 'Dim split = Me.Text.Replace(",", ".").Split 'If split.Count = 3 Then ' Me.Text = split(0) & "." & split(1) & ".20" & split(2) 'End If 'MsgBox(Me.Text) '------ Me._value = CDate(Me.Text).ToShortDateString 'Nur wenns Passt Me.Text = CDate(Me.Text).ToShortDateString ElseIf Me.Text = "" Then Me._value = "" Else Me.ForeColor = Color.Red End If OnPropertyChanged("_value") End If If _DateTimeOnly Then pruefungHandled = True Me.ForeColor = Color.Black If Me.Text.Length > 16 Then Me.Text = Me.Text.Substring(0, 16) If (Me.Text.Length >= 6 And Me.Text.Length <= 16) AndAlso IsDate(Me.Text.Replace(",", ".")) AndAlso CDate(Me.Text) > CDate("01.01.1900") Then '------ falls Jahr zweistellig: Dim split = Me.Text.Replace(",", ".").Split If split.Count = 3 Then Me.Text = split(0) & "." & split(1) & ".20" & split(2) End If '------ Me._value = CDate(Me.Text).ToString("dd.MM.yyyy HH:mm") 'Nur wenns Passt Me.Text = CDate(Me.Text).ToString("dd.MM.yyyy HH:mm") ElseIf Me.Text = "" Then Me._value = "" Else Me.ForeColor = Color.Red End If OnPropertyChanged("_value") End If If _Prozent Then pruefungHandled = True Try If sender.text = "" Then Me._value = "" : Propvalue = "" Else Me._value = CDbl(sender.text.ToString.Replace("%", "")) / 100 End If Catch ex As Exception sender.ForeColor = System.Drawing.Color.Red Me._value = Propvalue End Try End If If MaxLineLength > 0 Then Dim str() As String = Me.Lines For i = 0 To Me.Lines.Count - 1 If str(i).Length > MaxLineLength Then str(i) = str(i).Substring(0, MaxLineLength) End If Next Me.Lines = str End If If Not pruefungHandled Then Me._value = Me.Text End If End Sub Private Sub MyTextBox_Textchanged(sender As Object, e As EventArgs) Handles Me.TextChanged sender.ForeColor = System.Drawing.Color.Black Dim pruefungHandled = False If _numbersOnly Then pruefungHandled = True If Not IsNumeric(sender.text) Then sender.ForeColor = System.Drawing.Color.Red End If If _TimeOnly Then pruefungHandled = True Dim regTime1 As New System.Text.RegularExpressions.Regex("^([0-1][0-9]|[2][0-3]):([0-5][0-9])$") Dim regTime2 As New System.Text.RegularExpressions.Regex("^([0-1][0-9]|[2][0-3]):([0-5][0-9]):([0-5][0-9])$") If Not regTime1.IsMatch(sender.Text) And Not regTime2.IsMatch(sender.Text) Then sender.ForeColor = System.Drawing.Color.Red End If End If If _Waehrung Then pruefungHandled = True End If If _Waehrung And False Then 'sonst bei jedem Zeichen kontrolle, zeiger hüpft pruefungHandled = True Try sender.text = CDbl(sender.text).ToString(If(_WaehrungZeichen, "C2", "N2")) ' String.Format("{0:N2}", CDbl(sender.text)) Me._value = CDbl(sender.text) Catch ex As Exception sender.ForeColor = System.Drawing.Color.Red End Try End If If _ShortDateNew Then pruefungHandled = True Me.ForeColor = Color.Black If Me.Text.Length = 10 AndAlso IsDate(Me.Text.Replace(",", ".")) AndAlso CDate(Me.Text) > CDate("01.01.1900") Then Try Me._value = CDate(Me.Text).ToShortDateString 'Nur wenns Passt Me.Text = CDate(Me.Text).ToShortDateString Catch ex As Exception sender.ForeColor = System.Drawing.Color.Red End Try ElseIf Me.Text = "" Then Me._value = "" Else Me.ForeColor = Color.Red End If OnPropertyChanged("_value") End If If _Prozent Then 'pruefungHandled = True 'Dim txt = sender.text 'If Not sender.text.ToString.Contains("%") Then txt = sender.text & " %" Me._value = sender.text End If If _DateTimeOnly Then pruefungHandled = True Me.ForeColor = Color.Black If Me.Text.Length = 16 AndAlso IsDate(Me.Text.Replace(",", ".")) AndAlso CDate(Me.Text) > CDate("01.01.1900 00:00") Then Me._value = CDate(Me.Text).ToString("dd.MM.yyyy HH:mm") 'Nur wenns Passt Me.Text = CDate(Me.Text).ToString("dd.MM.yyyy HH:mm") ElseIf Me.Text = "" Then Me._value = "" Else Me.ForeColor = Color.Red End If OnPropertyChanged("_value") End If ' If Me.Multiline And IsNumeric(MaxLines) Then 'If Me.Lines.Length > MaxLines Then 'Dim s() As String = Me.Text.Split(vbNewLine) ' If s.Count > 3 Then 'Me.Text = s(0) & vbNewLine & s(1) & vbNewLine & s(2) ' End If ' End If ' End If If Me.Multiline And IsNumeric(MaxLines_Warning) Then ' If Me.Lines.Length > MaxLines Then If MaxLines_Warning_Label IsNot Nothing Then MaxLines_Warning_Label.Visible = CBool(Me.Lines.Length > MaxLines_Warning) End If 'End If End If If Not pruefungHandled Then Me._value = Me.Text End If End Sub Function isShortDate(d) As Boolean Return CBool(IsDate(d) And d.length = 10) End Function Public Propvalue As String Public Property _value As String Get Return Propvalue End Get Set(v As String) ' MsgBox(v) If _Prozent Then If IsNumeric(v) Then Propvalue = v Me.Text = String.Format("{0:P2}", CDbl(v)) ' OnPropertyChanged("_value") ' MsgBox(String.Format("{0:P2}", CDbl(v))) End If ElseIf _ShortDateOnly Then If v Is Nothing Then Propvalue = "" Me.Text = "" Else Propvalue = v Me.Text = v End If ElseIf _Waehrung Then If v IsNot Nothing AndAlso IsNumeric(v) Then Propvalue = CDbl(v) Me.Text = CDbl(v).ToString(If(_WaehrungZeichen, "C2", "N2")) Else Propvalue = "" Me.Text = "" End If ElseIf _ShortDateNew Then If v Is Nothing Then Propvalue = "" Me.Text = "" Else Propvalue = v Me.Text = v End If ElseIf _DateTimeOnly Then If v Is Nothing Then Propvalue = "" Me.Text = "" Else If v.Length > 16 Then v = v.Substring(0, 16) Propvalue = v Me.Text = v End If ElseIf _numbersOnly Then If Not _numbersOnlyTrennzeichen And IsNumeric(v) Then Propvalue = CInt(v) Me.Text = v ElseIf IsNumeric(Me._numbersOnlyKommastellen) And IsNumeric(v) Then Propvalue = CDbl(v) Me.Text = CDbl(v).ToString("N" & Me._numbersOnlyKommastellen) ' , CultureInfo.InvariantCulture) ElseIf IsNumeric(v) Then Propvalue = CDbl(v) Me.Text = v Else Propvalue = "" Me.Text = "" End If Else If v IsNot Nothing AndAlso v.ToString.Length > Me.MaxLength Then Me.Text = v.Substring(0, Me.MaxLength) Propvalue = v.Substring(0, Me.MaxLength) Else Me.Text = v Propvalue = v End If End If RaiseEvent ValueChanged() End Set End Property Public Event PropertyChanged As PropertyChangedEventHandler _ Implements INotifyPropertyChanged.PropertyChanged Protected Sub OnPropertyChanged(ByVal name As String) ' MsgBox("AHAASO") RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs(name)) End Sub Private Sub MyTextBox_Validating(sender As Object, e As CancelEventArgs) Handles Me.Validating If sender.text = "" Then e.Cancel = False : Exit Sub 'wenn der Test leer ist, stimmt die Eingabe Dim errMessage As String = "Es ist ein Validierungsfehler aufgetreten:" & vbNewLine Dim errDescription As String = "Überprüfen Sie die Eingabe!" If _numbersOnly Then Try 'String.Format("{0:N2}", CDbl(sender.text)) If Not _numbersOnlyTrennzeichen And IsNumeric(sender.text) Then sender.text = CInt(sender.text) ElseIf IsNumeric(_numbersOnlyKommastellen) And IsNumeric(sender.text) Then sender.text = CDbl(sender.text).ToString("N" & _numbersOnlyKommastellen) ' , CultureInfo.InvariantCulture) Else sender.text = CDbl(sender.text) End If e.Cancel = False Catch ex As Exception errDescription = "Die Eingabe muss eine Zahl sein! (z.B. 123,45)" e.Cancel = True End Try End If If _Waehrung Then Try 'String.Format("{0:N2}", CDbl(sender.text)) CDbl(sender.text).ToString(If(_WaehrungZeichen, "C2", "N2")) e.Cancel = False Catch ex As Exception errDescription = "Die Eingabe muss eine Zahl sein! (z.B. 123,45)" e.Cancel = True End Try End If If _Prozent Then e.Cancel = False End If If _ShortDateOnly Then If isShortDate(sender.text) Then e.Cancel = False Else e.Cancel = True End If End If If _TimeOnly Then Me.Text = Me.Text.Replace(",", ":") Me.Text = Me.Text.Replace("-", ":") Me.Text = Me.Text.Replace(".", ":") Me.Text = Me.Text.Replace("/", ":") Dim regTime1 As New System.Text.RegularExpressions.Regex("^([0-1][0-9]|[2][0-3]):([0-5][0-9])$") Dim regTime2 As New System.Text.RegularExpressions.Regex("^([0-1][0-9]|[2][0-3]):([0-5][0-9]):([0-5][0-9])$") If _TimeOnly_Seconds Then If regTime1.IsMatch(sender.Text) Then Me.Text += ":00" End If If regTime2.IsMatch(sender.Text) Then e.Cancel = False Else e.Cancel = True End If Else If regTime1.IsMatch(sender.Text) Then e.Cancel = False Else e.Cancel = True End If End If End If If e.Cancel Then 'Try 'DirectCast(Me.FindForm, frmKundenblatt).setInfo("err", errMessage & errDescription, 3) ' Catch ex As Exception MsgBox(errMessage & errDescription) ' End Try End If End Sub Private Sub MyTextBox_Validated(sender As Object, e As EventArgs) Handles Me.Validated 'Wenns stimmt End Sub End Class