| Вопрос: Нужен совет | Добавлено: 14.11.04 10:42 |
Автор вопроса:  Mihalыch | ICQ: 373-509-101 |
| Ответы | Всего ответов: 21 |
|
Номер ответа: 16 Автор ответа:  Mihalыch ICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #16 | Добавлено: 15.11.04 02:22 |
|
А вариант у меня получился такой, прошу строго не судить:
Option Explicit Public Enum MarkView Rus = 44 Us = 46 End Enum Public Enum ShowErrMsg No = 0 Yes = 1 End Enum  im CurPos As Long
im strAfterCheck As String
Public Sub CheckEnter(ByRef CheckObj As Object, ByVal MinValue As Double, ByVal MaxValue As Double, Optional ByVal NumDigitsAfterDecimal As Byte = 0, Optional ByVal MarkView As MarkView = 44, Optional ByVal ShowErrMsg As ShowErrMsg = No) im i As Integer
im IsErr As Boolean
im strCheckLine As String
im MarkPos As Integer
im strCheckSimbol As String
If strAfterCheck = CheckObj.Text Or CheckObj.Text = "" Then CheckObj.SelStart = CurPos Exit Sub Else strAfterCheck = "" End If strCheckLine = CheckObj.Text MarkPos = 0 CurPos = CheckObj.SelStart For i = 1 To Len(strCheckLine) 'после выхода из цикла в строке остаются: 'только числовые символы, первый найденый знак разделителя ("." или ","  ,
'и если находится перед первым числовым символом строки один "-" strCheckSimbol = Left(strCheckLine, 1) 'отрезаем первый символ для проверки strCheckLine = Right(strCheckLine, Len(strCheckLine) - 1) 'укорачиваем строку на один символ слева If (Asc(strCheckSimbol) >= 48 And Asc(strCheckSimbol) <= 57) Or _  Len(strAfterCheck) = 0 And Asc(strCheckSimbol) = 45) Or _
(Asc(strCheckSimbol) = 44 Or Asc(strCheckSimbol) = 46) And MarkPos = 0) Then
If Asc(strCheckSimbol) = 44 Or Asc(strCheckSimbol) = 46 Then If NumDigitsAfterDecimal > 0 Then MarkPos = Len(strAfterCheck) + 1 strCheckSimbol = Chr(44) 'ставим запятую чеб ф-я FormatNumber не парилась Else CurPos = CurPos - 1 'корректируем позицию курсора Exit For End If End If strAfterCheck = strAfterCheck & strCheckSimbol Else 'если найден "плохой" символ If CurPos > 0 Then CurPos = CurPos - 1 'корректируем позицию курсора IsErr = True End If End If Next i If Len(strAfterCheck) > MarkPos + NumDigitsAfterDecimal And MarkPos <> 0 Then strAfterCheck = FormatNumber(strAfterCheck, NumDigitsAfterDecimal) 'устанавливаем необходимое количество знаков после запятой End If If strAfterCheck = "" Then IsErr = True ElseIf strAfterCheck < MinValue Then 'если значение меньше минимального... strAfterCheck = MinValue IsErr = True ElseIf strAfterCheck > MaxValue Then 'если значение больше максимального... strAfterCheck = MaxValue IsErr = True End If If Len(strAfterCheck) >= MarkPos And MarkPos <> 0 Then Mid(strAfterCheck, MarkPos, 1) = Chr(MarkView) 'если знак разделителя остался, заменяем его на указанный 'вообще замену знака разделителя можно убрать, но вдруг будет необходимо 'производить вычисления с полученным значением CheckObj.Text = strAfterCheck If ShowErrMsg = Yes And IsErr = True Then MsgBox "Разрешен ввод только числовых значений больших либо равных " & MinValue & " и меньших либо равных " & MaxValue & "!", vbCritical, "Внимание!" End If End Sub |
||
|
Номер ответа: 17 Автор ответа: cresta Вопросов: 117 Ответов: 1538 |
Профиль | | #17 | Добавлено: 15.11.04 03:51 |
|
Mihalыch
Ну, без бутылки я тут не разберусь  ))))
Ведь есть такие штуки как Copy/Paste Эти штуки обходятся на раз..
Например, ко всему что я написал, ещё и Copy/Paste блокируется, итого имеем: а)только числа б)разделители точка и запятая в)разделитель только один в)знак "-" только спереди г)Copy/Paste блокируется для мыши и для клавиатуры д)ограничение диапазона вводимых чисел Dim St As String
Private Sub TxtCount_Change() On Error GoTo err If CDbl((TxtCount.Text)) < -299.01 Or CDbl((TxtCount.Text)) > 24999.99 Then MsgBox "From -299.01 To 24999.99" TxtCount = Left$(TxtCount, Len(TxtCount) - 1) TxtCount.SelStart = Len(TxtCount) End If err: End Sub Private Sub TxtCount_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 16 Then St = TxtCount.Text End Sub Private Sub TxtCount_KeyPress(KeyAscii As Integer) If KeyAscii = 46 Or KeyAscii = 44 Then If InStr(1, TxtCount.Text, "," Then
KeyAscii = 0 Else KeyAscii = 44 End If End If If KeyAscii = 45 And Len(TxtCount) <> 0 Then KeyAscii = 0 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 44 Then KeyAscii = 0 End If End Sub Private Sub TxtCount_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = 45 Then TxtCount.Text = St End Sub Private Sub TxtCount_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then St = TxtCount.Text End Sub Private Sub TxtCount_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then TxtCount.Text = St TxtCount.SelStart = Len(TxtCount) End If End Sub Дёшево и сердито )) Пусть попытается кто вставить, хоть мышью, хоть с клавиатуры (Shift-Insert)
Что ещё можно придумать по поводу функциональности ? |
||
|
Номер ответа: 18 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #18 | Добавлено: 15.11.04 08:28 |
|
Жуть какую вы понаписали....
Private Sub Text1_Validate(Cancel As Boolean) If IsNumeric(Text1.Text) = False Then MsgBox "Not number" Cancel = True ElseIf Text1.Text > 24999.99 Or Text1.Text < 299.01 Then MsgBox "Out of Range" Cancel = True Else Text1.Text = Int(Text1.Text) End If End Sub Все. |
||
|
Номер ответа: 19 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #19 | Добавлено: 15.11.04 09:11 |
|
LamerOnLine
Я думал про Validate, вот только один момент мне не понравился, и я отказался от него Сам момент: только когда наберешь в текстбоксе всё и потом будешь использовать уже набранный текст, только тогда выскочит msgbox, а до этого никакой реакции, и действия юзера происходят впустую, надо потом опять очищать текстбокс и начинать всё сначала. А это очень раздражает (то, что сразу не индицируется ошибка, а только после всего ввода) |
||
|
Номер ответа: 20 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #20 | Добавлено: 15.11.04 12:33 |
| А ещё бы предусмотреть ситуацию ввода точки или запятой в начале строки: или ноль в начале добавлять, или запретить или ещё чего. Я тоже с подобным примером невесть сколько провозился, но универсальным кодом это не назвать.. Вроде простая задача на первый взгляд, но если писать по принципу максимальной защиты от дураков, какие-нибудь кривости да выходят. | ||
|
Номер ответа: 21 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #21 | Добавлено: 15.11.04 14:37 |
|
Вообще-то я делал так, только в конкретном случае пропустил это, т.к. Mihalыch такой задачи не ставил
А если надо, то вот ещё раз код. Даже Виндовый калькулятор не может так ))
а)только числа б)разделители точка и запятая в)разделитель только один в)знак "-" только спереди и только один г)Copy/Paste блокируется для мыши и для клавиатуры д)ограничение диапазона вводимых чисел е)если разделитель в начале - автоматом вставляется ноль спереди и если со знаком, то ноль вставляется после знака ж)код на голом VB, что является несомненным плюсом для посетителей сайта
Dim St As String
Private Sub Txt1_Change() On Error GoTo err If CDbl((Txt1.Text)) < -299.01 Or CDbl((Txt1.Text)) > 24999.99 Then MsgBox "From -299.01 To 24999.99" Txt1 = Left$(Txt1, Len(Txt1) - 1) Txt1.SelStart = Len(Txt1) End If err: End Sub Private Sub Txt1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 16 Then St = Txt1.Text End Sub Private Sub Txt1_KeyPress(KeyAscii As Integer) If KeyAscii = 45 Then If Len(Txt1) = 0 Then Txt1.Text = "-" End If KeyAscii = 0 Txt1.SelStart = Len(Txt1) End If If KeyAscii = 46 Or KeyAscii = 44 Then If InStr(1, Txt1.Text, "," Then
KeyAscii = 0 Else KeyAscii = 44 End If End If If KeyAscii = 44 And Len(Txt1) = 0 Then Txt1.Text = "0,": KeyAscii = 0: Txt1.SelStart = Len(Txt1) ElseIf KeyAscii = 44 And Left$(Txt1.Text, 1) = "-" And Len(Txt1.Text) = 1 Then Txt1.Text = "-0,": KeyAscii = 0: Txt1.SelStart = Len(Txt1) End If If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 44 Then KeyAscii = 0 End If End Sub Private Sub Txt1_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = 45 Then Txt1.Text = St End Sub Private Sub Txt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then St = Txt1.Text End Sub Private Sub Txt1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then Txt1.Text = St Txt1.SelStart = Len(Txt1) End If End Sub mc-black, я не знаю, какой ещё функциональности можно добавить этому несчастному текстбоксу. По-моему предостаточно |
||