In Anlehnung an den Tipp Auto-Indent für die (RTF)TextBox möchten wir Ihnen heute zeigen, wie sich eine AutoIndent-Funktion für die Standard-TextBoxen unter MS-Access realisieren lässt. Option Explicit ' In Anlehnung an: ' http://www.vbarchiv.net/archiv/tipp_1162.html ' von Jürgen Sorko ' abgeaendert für ACCESS, 2004-12-09 rimi Public Function autoIndent(oTextBox As Object) ' ********************************************************************* ' Rückt den Text ein bei ENTER (wie in der vorhergehenden Zeile) ' ********************************************************************* ' Die Eigenschaft "Eingabetastenverhalten" des Textfeldes ' steht auf "Neue Zeile im Feld" ' ------------------------------------------------------------ ' Beispiel für FunktionsAufruf im Formular-Code (Bei Taste) : ' ------------------------------------------------------------ ' Private Sub Test_Text_KeyPress(KeyAscii As Integer) ' If KeyAscii = vbKeyReturn Then ' ' Beim Drücken von Return, neuen Absatz autom. einrücken ' KeyAscii = 0 ' Call autoIndent(Screen.ActiveControl) ' End If ' End Sub ' ******************************************************************** Dim nSpaces As Long Dim OLD_START As Long With oTextBox OLD_START = .SelStart ' Anzahl Leerzeichen der aktuellen Zeile nSpaces = getLastSpaces(.Text, .SelStart) If OLD_START = Len(.Text) Then ' Sonderfall letzte zeile,ACCESS löscht Leerzeichen am Ende! ' Deshalb wird dieValue-Eigenschaft verwendet .Value = .Text & vbNewLine & Space$(nSpaces) Else ' Zeilenumbruch und Anzahl ermittelter Leerzeichen einfügen ' an die aktuelle Cursor-Position .SelStart = OLD_START Dim OLD_AFTER OLD_AFTER = .AfterUpdate ' merken Aktualisierung-Ereignis .AfterUpdate = "" ' Abblocken des Nach Aktualisierung-Ereignisses .SelText = vbNewLine & Space$(nSpaces) ' Löst aus ! .AfterUpdate = OLD_AFTER ' Wieder aktivieren End If ' Cursor positionieren .SelStart = OLD_START + nSpaces + 2 End With End Function Public Function getLastSpaces(ByVal sText As String, _ nCurPos As Long) As Long ' ************************************************************** ' Gibt die Anzahl der führenden Leerzeichen der ' aktuellen Zeile im TextFeld-Control aus ' ************************************************************** ' Fehlerbehanldung aktivieren (sicher ist sicher) On Error Resume Next Dim nPos As Long Dim nSpaces As Long ' position des 1. NewLine vor akt. pos. nPos = InStrRev(Left$(sText, nCurPos), vbNewLine) If nPos > 0 Then ' Newline gefunden nPos = nPos + 2 ' String,Start,Länge,Leerzeichen zählen While Mid$(sText, nPos, 1) = " " nSpaces = nSpaces + 1 nPos = nPos + 1 Wend ElseIf nPos = 0 Then ' kein Newline gefunden (=ErsteZeile) nPos = 1 ' String,Start,Länge,Leerzeichen zählen While Mid$(sText, nPos, 1) = " " nSpaces = nSpaces + 1 nPos = nPos + 1 Wend End If getLastSpaces = nSpaces End Function Dieser Tipp wurde bereits 13.884 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 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. 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. Neu! sevCoolbar 3.0 Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access |
||||||||||||||||
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. |