hard03 » 27.12.2006 (Ср) 12:58
Вот такое получилось
Option Explicit
Private Sub Buttom_Click()
Dim str As String
str = Text.Text
Dim strArray As Variant
' Создаем строковый массив из строки
strArray = Split(str)
Dim ser As String
Dim i As Integer
' Проверяем условие от 2 до 10
If UBound(strArray) >= 2 And UBound(strArray) <= 10 Then
For i = 0 To UBound(strArray)
ser = strArray(i)
Call Forma.Find(ser, str)
Next i
Label.Caption = str
Call Forma.Sort(strArray)
Else
Label.Caption = "Неверный диапазон срок !"
End If
End Sub
Public Sub Find(ByRef ser, ByRef str)
' Ищем в строке слово полученное из массива и заменяем на преобразованное
str = Replace(str, ser, Alf(ser))
End Sub
Public Function Alf(ByVal ser)
Dim ito_eto As String
Dim check As Boolean
check = True
Dim A As String * 1
Dim b As String * 1
A = Mid(ser, 1, 1)
Dim j As Integer
' Запускаем цикл для проверки наличия в слове русских и английских символов
' Если таковые есть, то - check = False
For j = 2 To Len(ser)
b = Mid(ser, j, 1)
If Values(A) <> Values(b) Then
check = False
Exit For
End If
Next j
If check = True Then
If 65 <= Asc(A) And Asc(A) <= 90 Or 97 <= Asc(A) And Asc(A) <= 122 Then
' Переводим первую букву (англиского слова) в верхний регистр
Alf = UCase(A) + Right(ser, Len(ser) - 1)
End If
If 128 <= Asc(A) And Asc(A) <= 175 Or 224 <= Asc(A) And Asc(A) <= 243 Then
' Переводим первую букву (русского слова) в нижний регистр
Alf = LCase(ser)
End If
Else
Dim g As Integer
' Переводим регистры русских и английских символов в нужный регистр
For g = 1 To Len(ser)
b = Mid(ser, g, 1)
If 65 <= Asc(b) And Asc(b) <= 90 Or 97 <= Asc(b) And Asc(b) <= 122 Then
ito_eto = ito_eto + UCase(b)
End If
If 128 <= Asc(b) And Asc(b) <= 175 Or 224 <= Asc(b) And Asc(b) <= 243 Then
ito_eto = ito_eto + LCase(b)
End If
Next g
Alf = ito_eto
End If
End Function
Public Function Values(ch)
Dim check As Boolean
' Проверяем все символы
If 65 <= Asc(ch) And Asc(ch) <= 90 Or 97 <= Asc(ch) And Asc(ch) <= 122 Then
check = True
End If
If 128 <= Asc(ch) And Asc(ch) <= 175 Or 224 <= Asc(ch) And Asc(ch) <= 243 Then
check = False
End If
Values = check
End Function
Public Sub Sort(ByRef strArray)
Dim i As Integer
Dim j As Integer
Dim n As String
' Изменяем размерность сортированной части массива
For i = 0 To UBound(strArray) - 1
' Сравниваем поочередно i - тый лемент несортированной части массива со всеми i +1 до конца
For j = i + 1 To UBound(strArray)
' Если элемент больше, чем i меняем местами
If StrComp(strArray(i), strArray(j)) = -1 Then
n = strArray(i)
strArray(i) = strArray(j)
strArray(j) = n
End If
Next j
Next i
Label1.Caption = Join(strArray, " ")
End Sub
Private Sub Text_Change()
End Sub
Только, где-то теряется преобразованный массив и происходит обращение к исходному тексту при сортировке. Не пойму в чем трабл? Может что-то с пространством имен?