Es gibt wohl kaum ein anderes Control, dass so flexibel und umfangreich ist, wie das sevText - Control. Wer dieses Control einmal ausprobiert hat, ärgert sich nur noch über eins: Dass man die ausgedienten VB-Standardcontrols nicht alle durch entsprechende sev-Komponenten entfernen kann... So ist es jedenfalls mir ergangen, nachdem ich mit dem sevText angefangen habe. Kein Formular mehr ohne sevText - und viele dynamsich generierte Formular könnte ich mir ohne sevText schon gar nicht mehr vorstellen. Aber alles hat seine Grenzen - so kann das sevText trotz des Funktionsumfangs eins natürlich nicht: Kontrollieren, ob eine grössere Eingabemaske auch korrekt ausgefüllt ist. Fügen Sie Ihrem Projekt zunächst ein neues Klassenmodul mit nachfolgendem Code hinzu. ' ============================================================================== ' Aufgabe dieser Klasse: ' Sie haben ein Formular mit diversen sevText Eingabecontrols. ' Einige davon sind Pflichtfelder - ander wiederum nicht. ' ' Mit dieser Klasse wird eine einfache Möglichkeit zur ' Formular-Validierung gegeben. ' ' Benutzung: ' Alle Pflichtfelder werden einer Instanz dieser Klasse über ' die .ADD Methode übergeben (alle sonstigen Controls NICHT !!!) ' ' Wenn die Funktion .ControlForm den Wert True liefert, ist das ' Formular korrekt ausgefüllt, ansonsten nicht !!! ' ' Besonderer Service: ' - alle falsch ausgefüllten sevTextbox-Controls werden mit der ' Farbe "BackColorError" ausgefüllt ' - Nur für das ERSTE Fehlerfeld wird eine Meldung ausgegeben, damit ' der User nicht 10 Fehlermeldungen bekommt.... ' - Der Focus wird auf das erste Fehlerfeld gesetzt Option Explicit ' Private Type's Private Type tpSevTxt sevTxt As sevTextBox.sevText MinWert As String MaxWert As String UserHinweis As String End Type Private Type tpObjDaten sevTxt() As tpSevTxt AnzTXT As Long BackColorError As Long BackColorOK As Long FirstErrorControl As Long MsgboxTitel As String End Type Private m As tpObjDaten Private Sub Class_Initialize() ' Vorgabewerte m.BackColorOK = vbWindowBackground m.BackColorError = RGB(255, 100, 100) ' ROT m.MsgboxTitel = "Es fehlen leider noch Angaben ..." End Sub ' Hintergrundfarbe für "Fehleingaben" Public Property Let BackColorError(wert As Long) m.BackColorError = wert End Property Public Property Get BackColorError() As Long BackColorError = m.BackColorError End Property ' Hintergrundfarbe für korrekte Eingaben Public Property Let BackColorOK(wert As Long) m.BackColorOK = wert End Property Public Property Get BackColorOK() As Long BackColorOK = m.BackColorOK End Property ' MsgBox-Titelzeile Public Property Get MsgboxTitel() As String MsgboxTitel = m.MsgboxTitel End Property Public Property Let MsgboxTitel(was As String) m.MsgboxTitel = was End Property ' Ein Control zur Validierung hinzufügen Public Sub Add(conSEV As sevText, _ Optional MinWert As Long, _ Optional MaxWert As Long, _ Optional Bemerkung As String) m.AnzTXT = m.AnzTXT + 1 ReDim Preserve m.sevTxt(m.AnzTXT) With m.sevTxt(m.AnzTXT) Set .sevTxt = conSEV .MaxWert = MaxWert .MinWert = MinWert .UserHinweis = Bemerkung End With End Sub ' Feldeingaben prüfen ' ' Rückgabewert: True = alles korrekt ausgefüllt ' False = mind. eine Falsch-/Fehleingabe Public Function ControlForm() As Boolean Dim ErrorAnz As Long ' damit nicht zu viel angemeckert wird ... Dim FirstErrorsevTXT As Control Dim i As Long, meld As String Dim bOK As Boolean ControlForm = True For i = 1 To m.AnzTXT With m.sevTxt(i) bOK = True If .sevTxt.Style = rsTextBox Then ' normale TextBox If Len(.sevTxt.Text) = 0 Then bOK = False ElseIf .MinWert <> 0 And .MaxWert <> 0 And _ (Val(.sevTxt.Text) < .MinWert Or Val(.sevTxt.Text) > .MaxWert) Then _ bOK = False End If ElseIf .sevTxt.Style = rsDropDownList Then ' DropDownListe If .sevTxt.ListIndex = -1 Then bOK = False End If End If ' Hintergrundfarbe setzen .sevTxt.BackColor = IIf(bOK, m.BackColorOK, m.BackColorError) If Not bOK Then If ErrorAnz = 0 Then m.FirstErrorControl = i ErrorAnz = ErrorAnz + 1 ControlForm = False End If End With Next i ' Falls ein Fehler "entdeckt" wurde, jetzt Hinweis anzeigen If ErrorAnz > 0 Then With m.sevTxt(m.FirstErrorControl) If .sevTxt.Style = rsTextBox Then If .MinWert = 0 And .MaxWert = 0 Then meld = "Bitte geben Sie noch etwas in das Feld '" & .sevTxt.Caption & "' ein." & _ vbCr & vbCr & .UserHinweis Else meld = "Im Feld '" & .sevTxt.Caption & "' sind nur Werte zwischen " & .MinWert & _ " und " & .MaxWert & " erlaubt." End If Else meld = "Bitte treffen Sie noch eine Auswahl für '" & .sevTxt.Caption & "'." & _ vbCr & vbCr & .UserHinweis End If If ErrorAnz > 1 Then meld = meld & vbCr & "Hinweis: Alle weiteren Felder, die nicht korrekt ausgefüllt sind, " & _ "wurden farblich hervorgehoben worden." End If MsgBox meld, vbInformation, m.MsgboxTitel .sevTxt.SetFocus End With End If End Function Ein kleines Beispiel: Option Explicit ' Klasse zur Eingabe-Validierung instanzieren Private sevPflicht As New clsSevTXTPflichtfelder Private Sub Form_Load() ' DropDownListe füllen With sevTextCBO .Style = rsDropDownList .AddItem "angestellt" .AddItem "selbständig" End With ' Pflichtfelder der Klasse hinzufügen und ' Eigenschaften übergeben With sevPflicht .Add sevText1 .Add sevText2 .Add sevText3, 100, 99999, _ "Sie wissen doch, wie PLZ auzusehen haben ..." .Add sevText4, 10, 80, _ "Haben Sie doch keine Hemmungen Ihr Alter anzugeben..." .Add sevTextCBO End With End Sub Private Sub btnPrüfen_Click() ' alle Pflichteingaben prüfen If sevPflicht.ControlForm = True Then MsgBox "Super, alle Pflichtfelder wurden beachtet ;-)", _ vbInformation, "sevText mit Pflichten" Else MsgBox "Dieses Formular ist leider noch nicht korrekt ausgefüllt ;-(", _ vbExclamation, "sevText mit Pflichten" End If End Sub Dieser Tipp wurde bereits 12.875 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |