VBNet - Форум - Change Case (регистр букв)

Вопрос: Change Case (регистр букв) Добавлено: 05.02.09 09:01

Автор вопроса: Dropper

Вот есть в ворде очень удобная штука -- выделяешь текст и жмешь Shift+F3. При каждом нажатии изменяется регистр. Хотел бы использовать эту штуку и в других программах. Поясню подробней чтоб было понятно -- в тех программах где я хочу такое же, функция перевода регистра конечно есть, но она либо в виде окна, либо в виде отдельных функций для каждого случая, типа: аа>AA, AA>aa, aA>Aa и т.п. А хочется чтоб это было в одной функции и вызывалось по одному аккорду. Сначала я бросился делать проверки, типа: если "нечто выделенное" в таком регистре, то делаем так. Но то ли в результате недостаточного знания функций бейсика, то ли еще по какой-то причине, но понял что это гемор. Слишком много проверок. Гораздо логичней сразу переводить по порядку "аа>AA, AA>aa, aA>aa". Единственная загвоздка -- как сохранить информацию что например аа>AA уже произошло? Некий флажок, с какого места запускать функцию?
Причем такая штука сохранение информации уже после выполнения кода, была бы полезна и для других случаев.

Надеюсь объяснил понятно.
Ответить

Ответы Всего ответов: 10

Номер ответа: 1 Автор ответа: AngryBadger Вопросов: 33 Ответов: 245	Профиль \| \| #1	Добавлено: 05.02.09 09:18
	аа>AA, AA>aa, aA>aa - а что в итоге ты хочешь получить? АА>AA? Ответить

Номер ответа: 2 Автор ответа: Dropper Вопросов: 11 Ответов: 19	Профиль \| \| #2	Добавлено: 05.02.09 09:24
	В итоге я хочу получить то что имеется в ворде при нажатии Shift+F3. При записи макроса появляется wdNextCase. Мне нужно осуществить этот "NextCase" в других программах посредством VBA либо VBS Ответить

Номер ответа: 3 Автор ответа: mc-black ICQ: 308-534-060 Вопросов: 20 Ответов: 1860	Web-сайт: mc-black.narod.ru/dzp.htm Профиль \| \| #3	Добавлено: 05.02.09 09:44
	Ну дык глобальная переменная имеющая всего три значения и меняющая эти значения в цикле по кругу, что еще здесь нужно объяснять? Ответить

Номер ответа: 4 Автор ответа: Dropper Вопросов: 11 Ответов: 19	Профиль \| \| #4	Добавлено: 05.02.09 10:05
	mc-black А для VBS? Ответить

Номер ответа: 5 Автор ответа: mc-black ICQ: 308-534-060 Вопросов: 20 Ответов: 1860	Web-сайт: mc-black.narod.ru/dzp.htm Профиль \| \| #5	Добавлено: 05.02.09 13:03
	А для VBScript то же самое. Dim lState As Long ... ... lState = 0 ... if lState = 2 then lState = 0 else lState = lState + 1 end if Ответить

Номер ответа: 6 Автор ответа: Kardinal ICQ: 360041513 Вопросов: 1 Ответов: 164	Web-сайт: kg7.ru Профиль \| \| #6	Добавлено: 05.02.09 13:12
	Ты хочешь перевод регистра и в других программах? допустим shift-F3 горячая клавиша которая вызывает выполнение кода, самым сложным является перехват текста из поля, можно через буфер обмена: после комбинации посылается комбинация клавиш на копирование в активное приложение->преобразование->комбинация на вставку... Ответить

Номер ответа: 7 Автор ответа: GDK Вопросов: 13 Ответов: 348	Профиль \| \| #7	Добавлено: 05.02.09 13:17
	Строчные и прописные буквы имеют разные ASCII коды, которые можно узнать (i=ASC("A"). Есть функция Len("FAa" она возвращает длину строки, которая указана в её единственном параметре. Есть цикл, в котором можно будет проверять символы от начала строки до её конца. Ну и есть таблица ASCII, которую не трудно найти. Причём если подумать, не придётся выполнять кучу проверок. Дело в том, что в этой таблице ASC("A"-ASC("a" будет равно ASC("B"-ASC("b". Перевести ASCII код в символ - CHR(). В скобки надо ввести число, которому соответствует ваш символ. Ответить

Номер ответа: 8 Автор ответа: AngryBadger Вопросов: 33 Ответов: 245	Профиль \| \| #8	Добавлено: 05.02.09 14:15
	Знаю, что Жесть, но делал в оставшиеся от обеда 10 минут. Может половина - лишняя. С большим объемом текста будет работать ППЦ, как долго. Private Declare Function IsCharAlpha _ Lib "user32.dll" Alias "IsCharAlphaA" ( _ ByVal cChar As Byte) As Long Private Declare Function IsCharLower _ Lib "user32.dll" Alias "IsCharLowerA" ( _ ByVal cChar As Byte) As Long '........................................................ Sub aToA() Dim strA As String Dim strB As String Dim MyArrA() As Variant Dim MyArrB As Variant Dim i As Integer Dim i1 As Integer Dim i2 As Integer Dim item As Variant strA = "Ass>Asfghsdg,asd" strB = strA For i = 0 To Len(strB) - 1 ReDim Preserve MyArrA(i) MyArrA(i) = Mid(strB, i + 1, 1) If IsCharAlpha(Asc(MyArrA(i))) = 0 Then MyArrA(i) = " " End If Next strB = Join(MyArrA, "" MyArrB = Split(strB) i = 0 i1 = 0 i2 = 0 For Each item In MyArrB If IsCharLower(Asc(Mid(item, 1, 1))) <> 0 Then i1 = i1 + 1 End If If item = UCase(item) Then i2 = i2 + 1 End If i = i + 1 Next i = 0 For Each item In MyArrB If i2 = UBound(MyArrB) + 1 Then MyArrB(i) = LCase(item) i = i + 1 End If Next If i2 = UBound(MyArrB) + 1 Then GoTo LastLine i = 0 For Each item In MyArrB If i1 > 0 Then MyArrB(i) = UCase(Mid(item, 1, 1)) + Right(item, Len(item) - 1) Else MyArrB(i) = UCase(item) End If i = i + 1 Next LastLine: strB = Join(MyArrB, " " ReDim MyArrB(Len(strB)) For i = 0 To Len(strB) - 1 MyArrB(i) = Mid(strB, i + 1, 1) MyArrA(i) = Mid(strA, i + 1, 1) Next i = 0 For Each item In MyArrB On Error Resume Next If StrComp(MyArrB(i), MyArrA(i), vbTextCompare) <> 0 Then MyArrB(i) = MyArrA(i) End If i = i + 1 Next strA = Join(MyArrB, "" Debug.Print strA End Sub Ответить

Номер ответа: 9 Автор ответа: Dropper Вопросов: 11 Ответов: 19	Профиль \| \| #9	Добавлено: 05.02.09 15:53
	Вобщем такая ситуация. Для VBA действительно можно использовать глобальную переменную. Я признаться об этом не подумал. mc-black напомнил. Однако не подумал я по причине того что VBA не для всех программ. Ну для Корела там или Автокада можно юзать, но некоторые понимают либо VBS либо exe-скрипты. Для VBS порывшись на msdn.microsoft.com написал такой черновой тест-код: main Function main() Dim s s = Selection.Contents Selection.Contents = CH_CS(s) End function '____________________________________________________________________________________________ Function CH_CS(s) Dim objFSO 'As FileSystemObject dim oTS dim sText Dim objTextFile 'As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set oTS = objFSO.OpenTextFile("\varCH_CS.txt") sText = oTS.ReadAll oTS.close set oTS = nothing Set objFSO = nothing Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.CreateTextFile("\varCH_CS.txt", True) Select Case sText Case 1 CH_CS = LCase(s) objTextFile.Write (2) ' Write a line. Case 2 CH_CS = UCase(s) objTextFile.Write (1) ' Write a line. End Select objTextFile.Close End Function Короче говоря переменную заношу в файл, и читаю из него. Работает. Ответы № 5-8 пока толком не смотрел, нет времени. Но обязательно посмотрю, когда буду писать чистовой код. Ответить

Номер ответа: 10 Автор ответа: AngryBadger Вопросов: 33 Ответов: 245	Профиль \| \| #10	Добавлено: 05.02.09 17:48
	Первый вариант неправильно работал - переделал Private Declare Function IsCharAlpha _ Lib "user32.dll" Alias "IsCharAlphaA" ( _ ByVal cChar As Byte) As Long Option Explicit Sub a_to_A() Dim text1 As String Dim text2 As String Dim i As Integer Dim i1 As Integer Dim i2 As Integer Dim MyArrA As Variant Dim MyArrB() As Variant Dim item As Variant i = 0 i1 = 0 i2 = 0 text1 = " " + CStr(ActiveCell.Value) If text1 = UCase(text1) Then text1 = LCase(text1) GoTo lastline End If ReDim MyArrA(Len(text1) - 1) For i = 0 To Len(text1) - 1 MyArrA(i) = Mid(text1, i + 1, 1) If IsCharAlpha(Asc(MyArrA(i))) = 0 Then ReDim Preserve MyArrB(i1) MyArrB(i1) = i i1 = i1 + 1 End If Next For Each item In MyArrB On Error Resume Next If Asc(MyArrA(CInt(item) + 1)) >= 97 And Asc(MyArrA(CInt(item) + 1)) <= 122 Then i2 = i2 + 1 MyArrA(CInt(item) + 1) = UCase(MyArrA(CInt(item) + 1)) End If Next item text2 = Join(MyArrA, "" If text2 = text1 Then text1 = UCase(text1) Else text1 = text2 End If lastline: ActiveCell.Value = Mid(text1, 2) End Sub Ответить

Страница: 1 |