textbox - skal slette det der ikke er synligt i textboxen

Spændende, er med på en lytter

her sletter den så der kun er 1 linie

Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
    Const EM_GETLINECOUNT = 186

Private Sub Text1_Change()
  If SendMessageAsLong(Text1.hWnd, EM_GETLINECOUNT, 0, 0) > 1 Then
  SendKeys "^+{home}"
  SendKeys "{DEL}"
  End If
End Sub

info:

http://www.developerfusion.co.uk/show/1607/

Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
    Const EM_GETLINECOUNT = 186
    Dim Linie(4) As String
    Dim L1 As Boolean
    Dim L2 As Boolean
    Dim L3 As Boolean
    Dim L4 As Boolean

Private Sub Text1_Change()

  If SendMessageAsLong(Text1.hWnd, EM_GETLINECOUNT, 0, 0) = 6 Then
    SendKeys "^{home}"
    SendKeys "{DOWN}"
    SendKeys "^+{home}"
    SendKeys "{DEL}"
  End If
    Text1.SelStart = Len(Text1.Text)
End Sub

her sletter den den første, når du starter på 6 linie

Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
    Const EM_GETLINECOUNT = 186
    Dim Linie(4) As String
    Dim L1 As Boolean
    Dim L2 As Boolean
    Dim L3 As Boolean
    Dim L4 As Boolean

Private Sub Text1_Change()

  If SendMessageAsLong(Text1.hWnd, EM_GETLINECOUNT, 0, 0) = 6 Then
    SendKeys "^{home}"
    SendKeys "{DOWN}"
    SendKeys "^+{home}"
    SendKeys "{DEL}"
    Text1.SelStart = Len(Text1.Text)
  End If
    End Sub

flyttede lige en linie

Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
    Const EM_GETLINECOUNT = 186

Private Sub Text1_Change()

  If SendMessageAsLong(Text1.hWnd, EM_GETLINECOUNT, 0, 0) = 6 Then
    SendKeys "^{home}"
    SendKeys "{DOWN}"
    SendKeys "^+{home}"
    SendKeys "{DEL}"
    Text1.SelStart = Len(Text1.Text)
  End If
    End Sub

slettede lige nogle gamle variabler

hvis det ikke er godt nok det som kabbak har lavet til dig, så kan du prøve den her.. Den viser altid kun SHOW_LINES og tager ikke højde for ENTER (vbCrLf)

Så kan du skrive din tekst i en lang linje.. når din tekst boks så knæger en linje så bliver det talt som en linje..

' ------------------------------- Form1 -------------------------------
Option Explicit

Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const SHOW_LINES As Long = 5 '<- Vis max antal linjer.

Private Sub Text1_Change() ' <- TextBox
  With Text1 ' <- TextBox
      If SendMessageAsLong(.hWnd, EM_GETLINECOUNT, 0, 0) > SHOW_LINES Then
        Do While SendMessageAsLong(.hWnd, EM_GETLINECOUNT, 0, 0) > SHOW_LINES
          .Text = Mid$(.Text, 2)
        Loop
        If Left$(.Text, 1) = vbLf Then
          .Text = Mid$(.Text, 2)
        End If
        .SelStart = Len(.Text)
      End If
  End With
End Sub
' ------------------------------- Form1 -------------------------------

Checker det imorgen, på forhånd tak

Det ser ud som om begge koder virker, dog kunne jeg bedst lide den fra sjh. så jeg har tænkt mig at fordele points således kabbak 50 sjh: 150, men kunne i ikke lige forklare mig hvordan functionen virker?

P.S er der en måde hvorpå man kan sætte textboxen cursoren til altid at blive bagefter sidste del af teksten istedet for at bruge "SelStart = Len(.Text)" da den for cursoren til at hoppe fra start til slut hele tiden?

Når den skal slette den øverste linie, er cursoren nødt til at gå derop, for at gøre det, derfor sætter koden den tilbage igen efter sletning.

Jeg mener ikke at det kan undgås.

ellers prøv sådan..


Private Declare Function SendMessageAsLong Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
   
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const SHOW_LINES As Long = 5 '<- Vis max antal linjer.

Private Sub Text1_Change() ' <- TextBox
Dim mLen As Long
Dim mStart As Long
  With Text1 ' <- TextBox
      If SendMessageAsLong(.hWnd, EM_GETLINECOUNT, 0, 0) > SHOW_LINES Then
        mLen = Len(.Text)
        mStart = .SelStart
        Do While SendMessageAsLong(.hWnd, EM_GETLINECOUNT, 0, 0) > SHOW_LINES
          .Text = Mid$(.Text, 2)
        Loop
        If Left$(.Text, 1) = vbLf Then
          .Text = Mid$(.Text, 2)
        End If
        mStart = (mStart - (mLen - Len(.Text)))
        If mStart > 0 Then
          .SelStart = mStart
        End If
      End If
  End With
End Sub

sjh: hvad skulle forskellen være?

I skal under alle omstændigheder have tak begge to.

forskellen er at du kan skrive midt i teksten.. uden at cursor flyttes til enden af teksten..

sjh: ok, tak