Eingabe von Zeichen wie beim Mobiltelefon

Hallo zusammen!

Ich will mir eine Eingabe zusammenbaun, wie sie beim Handy genau so funktioniert. D.h. ich tipp auf die Nummern und bekommen dann Buchstaben, Zahlen …

Das Problem liegt darin dass man dieselbe Taste nicht für zwei verschiedene Buchstaben verwenden kann. Also „omo“ geht nicht schreiben. Ich komme nicht auf das zweite „m“. Er überschreibt mir das „o“ andauernd. Ich hoffe ihr könnt mir weiterhelfen und den Fehler finden. Hier der Code:

Dim intCount As Integer
Dim intOldIndex As Integer

Private Sub Command1_Click(Index As Integer)

Dim strChars As String
Dim strCharArr() As String

Select Case Index

Case 0: strChars = " ;0"
Case 1: strChars = „.;,;!;1“ 'usw
Case 2: strChars = „a;b;c;2“
Case 3: strChars = „d;e;f;3“
Case 4: strChars = „g;h;i;4“
Case 5: strChars = „j;k;l;5“
Case 6: strChars = „m;n;o;6“
Case 7: strChars = „p;q;r;s;7“
Case 8: strChars = „t;u;v;8“
Case 9: strChars = „w;x;y;z;9“

End Select

strCharArr = Split(strChars, „;“)

If intOldIndex Index Then
intCount = 0
intOldIndex = Index

Text1.SelStart = Len(Text1.Text)
Text1.SelText = strCharArr(intCount)
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1

Timer1.Enabled = False
Timer1.Enabled = True
Else
If intCount = UBound(strCharArr) Then
intCount = 0
Else
intCount = intCount + 1
End If

Text1.SelText = strCharArr(intCount)
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1

Timer1.Enabled = False
Timer1.Enabled = True
End If

End Sub

Private Sub Command2_Click()

If Len(Text1.Text) > 0 Then
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1
Text1.SelText = „“
End If

End Sub

Private Sub Form_Load()

Text1.RightMargin = Text1.Width - 500
Text1.HideSelection = False

End Sub

Private Sub Timer1_Timer() 'Interval 1500
Text1.SelStart = Len(Text1.Text)
intCount = 0
Timer1.Enabled = False
End Sub

10 Buttons werden benötigt (Command1 mit Index von 0 bis 9), einen Button (Command2) zum entfernen der Buchstaben (Backspace taste…)
Eine Textbox und einen Timer(Interval = 1500)

Vielen Dank im Voraus.

Grüße Franz

Hallo Franz,

ich habe zwei kleinigkeiten geändert, die mache ich mal fett …

Dim intCount As Integer
Dim intOldIndex As Integer

Private Sub Command1\_Click(Index As Integer)

Dim strChars As String
Dim strCharArr() As String

Select Case Index

Case 0: strChars = " ;0"
Case 1: strChars = ".;,;!;1" 'usw
Case 2: strChars = "a;b;c;2"
Case 3: strChars = "d;e;f;3"
Case 4: strChars = "g;h;i;4"
Case 5: strChars = "j;k;l;5"
Case 6: strChars = "m;n;o;6"
Case 7: strChars = "p;q;r;s;7"
Case 8: strChars = "t;u;v;8"
Case 9: strChars = "w;x;y;z;9"

End Select

strCharArr = Split(strChars, ";")

If intOldIndex Index Then
intCount = 0
intOldIndex = Index

Text1.SelStart = Len(Text1.Text)
Text1.SelText = strCharArr(intCount)
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1

Timer1.Enabled = False
Timer1.Enabled = True
Else
If intCount = UBound(strCharArr) Then
intCount = 0
Else
intCount = intCount + 1
End If

Text1.SelText = strCharArr(intCount)
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1
**End If 'Der Timer wird hiter End If bearbeitet  
  
Timer1.Enabled = False  
Timer1.Enabled = True  
  
End Sub**  
  

Private Sub Command2\_Click()

If Len(Text1.Text) \> 0 Then
Text1.SelStart = Len(Text1.Text) - 1
Text1.SelLength = 1
Text1.SelText = ""
End If

End Sub

Private Sub Form\_Load()

Text1.RightMargin = Text1.Width - 500
Text1.HideSelection = False

End Sub

Private Sub Timer1\_Timer() 'Interval 1500
Text1.SelStart = Len(Text1.Text)
intCount = 0
**intOldIndex = 99**
Timer1.Enabled = False
End Sub

Gruß, Rainer

Hi Rainer!

Es hat funktioniert. Wieder mal hast du mir geholfen! Vielen DANK!!

Mfg
Franz