Исправление регистра, раскладки

Два исходных кода, каждый из которых может пригодится как самостоятельное приложение. Одно из них меняет регистр символов на заданный для определенных ключевых слов. Другое меняет раскладку выделенного текста в стороннем приложении. Более подробно возможности и использование в этой ветке форума.

Платформа: Windows
Автор: Somerick

Изменение регистра:

Использование :

1. Скопировать какой-то код, например эти две строки:
# define i iF 1 =( a - hIwORd(b )- 8)* cAsT( LONG,c) tHen d stRPtR( " cAsT( LONG,e)")
declare function x( y AS any PTR) as ZSTRING

2. Запустить программу. Готово, теперь в буфере будет что-то вроде этого:
#Define i If 1=(a-HiWord(b)-8)*Cast(Long,c) Then d StrPtr(" cAsT( LONG,e)")
Declare Function x(y As Any Ptr) As ZString

Маленькое всплывающее окошко показывает что программа сработала, если буфер с нетекстовым форматом или пуст выдаёт "В буфере нет текста!", через 2 секунды программа завершается.

#INCLUDE Once"windows.bi"

'копирует текст из Src в Dst без лишних пробелов
Declare Sub CorrectCode(Src As Zstring Ptr,Dst As Zstring Ptr)
'ищет в тексте s все слова sWord и меняет их регистр
Declare Sub CorrectWordRegistr(s As Zstring Ptr,sWord As Zstring Ptr)
'окошко уведомления, s текст col цвет текста
Declare Sub WndView(s As Zstring Ptr,col As Long)

#DEFINE Words !"As Is If IIf EndIf Then Else Asm Sub Function End Return Select Case Do Loop While Wend Exit GoTo For Next To HiWord LoWord "_
!"Long ULong Short UShort Byte UByte Double LongInt ULongInt ZString String StrPtr Ptr Dim Var Any Static Shared Cast "_
!"Shr Shl And Or Not Xor Poke Peek "_
!"Declare Enum Define Undef Ifdef Include Once Inclib "_
!"SendMessage "

'1-буквы и цифры, 0-знаки препинания и пр.
Dim Shared Word_tbl(256)As UByte={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,_
1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,_
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}

'таблица нижнего регистра
Dim Shared Cmpi_tbl(256)As UByte={0,1,2,3,4,5,6,7,8,32,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,_
29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,97,98,99,_
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,91,92,93,94,95,96,97,98,99,_
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,_
130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,156,158,159,_
160,161,162,163,164,165,166,167,184,169,170,171,172,173,173,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,_
190,191,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,_
252,253,254,255,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,_
250,251,252,253,254,255}

Sub main Cdecl Alias"main"()'Точка входа. Программа начинает выполняться здесь.
    If IsClipboardFormatAvailable(CF_TEXT)=0 Then
        WndView "В буфере нет текста!",7679
        Exit Sub
    Endif
    OpenClipboard 0
    Var cl=GetClipboardData(CF_TEXT)
    Var m=GlobalLock(cl)'Данные из буфера
    Var cl2=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,lstrlen(m)+2)
    Var m2=GlobalLock(cl2)'Память для нового буфера

    CorrectCode m,m2'm-исходный текст m2-скопированный без лишних пробелов

    Dim As Long c=Any
    Dim As ZString*2000 S=Any
    Dim As Zstring Ptr pS=@S,pWords=@Words

    Do
        c=Peek(pWords)
        pWords+=1
        If c=32 Then'конец слова из Words
            Poke pS,0
            pS=@s
            CorrectWordRegistr m2,pS'поиск слова s и исправление регистра

            While Peek(pWords)=32
                pWords+=1
            Wend
        Else
            Poke pS,c
            pS+=1
        Endif
    Loop While c

    GlobalUnlock m
    GlobalUnlock m2
    EmptyClipboard
    SetClipboardData CF_TEXT,cl2'Задать текст

    cl=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,5)
    m=GlobalLock(cl)
    Poke dword,m,959721521'1049
    Poke m+4,0
    GlobalUnlock m
    SetClipboardData CF_LOCALE,cl'Задать локаль
    CloseClipboard

    WndView !"Готово!\r\nОбработан текст в буфере.",55808
End Sub

Sub WndView(s As Zstring Ptr,col As Long)
    Static As Long rccol
    Dim As Long x=Any,a=240
    Dim As HWND h=CreateWindowEx(&h000800AC,"#32770",s,&hD0000000,GetSystemMetrics(0)Shr 1-100,GetSystemMetrics(1)Shr 1-60,200,100,0,0,0,0)
    Dim As HBRUSH Brush=CreateSolidBrush(723467)
    Dim As RECT rr=Type(0,25,200,100)

    For x=0 To 30
        SetLayeredWindowAttributes h,0,a,LWA_ALPHA
        a-=10
        If col=55808 Then
            If a<60 Then Exit For
        Else
            If a<180 Then a=250
        Endif

        Dim As HDC dc=GetDC(h)
        rccol+=758630
        Dim As HPEN pen=CreatePen(0,5,rccol)
        SelectObject dc,Pen
        SelectObject dc,Brush
        Rectangle dc,0,0,200,100'рамка
        DeleteObject Pen
        SetTextColor dc,col
        SetBkMode dc,TRANSPARENT
        DrawText dc,s,-1,@rr,2309'текст
        ReleaseDC h,dc
        Sleep_ 70'Sleep WinApi
    Next

    DestroyWindow h'удаление окна и кисти
    DeleteObject Brush

    ExitProcess 0 'добавлено, завершение программы
End Sub

Sub CorrectWordRegistr naked(s As Zstring Ptr,sWord As Zstring Ptr)
    Asm
        mov eax,[esp+4]
        mov edx,[esp+8]
        push ebx
        push esi
        movzx ecx,Byte Ptr[edx]'

        test cl,cl
        jz ex0
        mov bl,Byte Ptr[ecx+Cmpi_tbl]'первый символ sWord в нижнем регистре

        dec eax
        NowSymvol:'цикл поиска в s первого символа
        inc eax
        NowSymvolStart:
        movzx ecx,Byte Ptr[eax]'

        cmp cl,34
        je Short Skip34'исключение слов в кавычках
        test cl,cl
        jz Short ex0'конец строки, выход
        cmp bl,Byte Ptr[ecx+Cmpi_tbl]
        jne Short NowSymvol'новая итерация

        cmp eax,[esp+12]'s
        je Short Ok1'символ первый в строке
        movzx ecx,Byte Ptr[eax-1]
        cmp Byte Ptr[ecx+Word_tbl],1'проверка на начало слова
        je Short NowSymvol
        Ok1:

        Xor esi,esi
        NowCmp:'цикл сравнения слова
        inc esi
        movzx ecx,Byte Ptr[edx+esi]
        test cl,cl
        jz Short WordOk'конец слова
        mov bh,Byte Ptr[ecx+Cmpi_tbl]
        movzx ecx,Byte Ptr[eax+esi]
        cmp bh,Byte Ptr[ecx+Cmpi_tbl]
        je Short NowCmp
        jmp Short NowSymvol

        WordOk:
        movzx ecx,Byte Ptr[eax+esi]
        cmp Byte Ptr[ecx+Word_tbl],1
        je Short NowSymvol'слово не завершено

        Xor esi,esi
        NowCopy:'цикл замены найденного слова
        mov cl,Byte Ptr[edx+esi]
        test cl,cl
        jz NowSymvolStart
        mov [eax],cl
        inc eax
        inc esi
        jmp Short NowCopy

        Skip34:'пропуск фразы в кавычках
        cmp eax,[esp+12]'s
        je Short Ok134
        cmp Byte Ptr[eax-1],33
        jne Short Ok134

        Ok234:'цикл пропуска фразы в !""
        inc eax
        mov cx,[eax]'

        cmp cl,34
        je Short NowSymvol
        cmp cl,13
        je Short NowSymvol
        test cl,cl
        jz Short ex0
        cmp cx,8796'\"
        jne Short Ok234
        inc eax
        jmp Short Ok234

        Ok134:'цикл пропуска фразы в ""
        inc eax
        mov cl,[eax]'

        cmp cl,34
        je Short NowSymvol
        cmp cl,13
        je Short NowSymvol
        test cl,cl
        jnz Short Ok134

        ex0:
        pop esi
        pop ebx
        ret 8
    End Asm
End Sub

Sub CorrectCode naked(Src As Zstring Ptr,Dst As Zstring Ptr)
    Asm
        mov eax,[esp+4]
        mov edx,[esp+8]
        jmp Short skip0131

        skip:'цикл пропуска всех пробелов
        inc eax
        mov cl,[eax]'

        cmp cl,32
        je Short skip
        cmp cl,9
        je Short skip
        inc edx
        mov [edx],cl
        jmp Short tspp'в основной цикл

        skip13:
        cmp Byte Ptr[eax+1],10'проверка завершения строки
        jne Short skip10
        inc eax

        skip10:'цикл RТrim строки
        dec edx
        cmp edx,[esp+8]
        jl Short scxx13
        cmp Byte Ptr[edx],32
        je Short skip10
        cmp Byte Ptr[edx],9
        je Short skip10
        scxx13:
        inc edx
        mov word Ptr[edx],2573'13 10
        inc edx

        'началась новая строка
        skip013:'цикл копирования пробелов в начале строки
        inc eax
        inc edx
        skip0131:
        mov cl,[eax]'

        mov [edx],cl
        cmp cl,32
        je Short skip013
        cmp cl,9
        je Short skip013
        jmp tspp'переход вниз в основной цикл

        NxtSymv:
        inc eax
        inc edx
        mov cl,[eax]'

        mov [edx],cl
        tspp:
        test cl,cl
        jz Short exit0
        cmp cl,94
        jg Short NxtSymv
        cmp cl,91'[
        jg Short skip1
        je Short skip
        cmp cl,62
        jg Short NxtSymv

        cmp cl,32
        je Short skip
        cmp cl,9
        je Short skip

        cmp cl,13'CR
        je Short skip13
        cmp cl,10'LF
        je Short skip10

        cmp cl,57'<=>
        jg Short skip1

        cmp cl,45',
        jg Short NxtSymv
        cmp cl,41')*
        jg Short skip1

        cmp cl,34
        jne Short ffno34

        cmp eax,[esp+4]
        jle Short skipcopy34
        cmp Byte Ptr[eax-1],33'!
        jne Short skipcopy34

        skipcopy34x:'цикл копирования текста в !""
        inc eax
        inc edx
        mov cl,[eax]'

        mov [edx],cl
        test cl,cl
        jz Short exit0
        cmp cl,34
        jne skipcopy34x
        cmp Byte Ptr[eax-1],92
        je Short skipcopy34x
        jmp Short NxtSymv

        skipcopy34:'цикл копирования текста в ""
        inc eax
        inc edx
        mov cl,[eax]'

        mov [edx],cl
        test cl,cl
        jz Short exit0
        cmp cl,34
        jne Short skipcopy34
        jmp Short NxtSymv

        ffno34:
        cmp cl,35'#
        je Short skip1
        cmp cl,40'{
        je Short skip
        cmp cl,41')
        je Short skip1b
        jmp Short NxtSymv

        skip1:'исключение пробелов до и после символа
        dec edx
        cmp edx,[esp+8]
        jl Short scxx
        cmp Byte Ptr[edx],32
        je Short skip1
        cmp Byte Ptr[edx],9
        je Short skip1
        scxx:
        inc edx
        mov [edx],cl
        jmp skip

        skip1b:'исключение пробелов до
        dec edx
        cmp edx,[esp+8]
        jl Short scxx1
        cmp Byte Ptr[edx],32
        je Short skip1b
        cmp Byte Ptr[edx],9
        je Short skip1b
        scxx1:
        inc edx
        mov [edx],cl
        jmp NxtSymv

        exit0:
        dec edx
        cmp edx,[esp+8]
        jl Short scxx11
        cmp Byte Ptr[edx],32
        je Short scxx110
        cmp Byte Ptr[edx],9
        je Short scxx110
        inc edx
        scxx110:
        mov [edx],cl
        scxx11:
        ret 8
    End Asm
End Sub

Изменение раскладки:

Использование:

Скомпилировать. Создать ярлык программы на рабочем столе. В свойствах ярлыка задать клавишу или сочетание быстрого вызова.
Например F7
Теперь открываем блокнот. Набираем там в русской раскладке например: Руддщ цщкдв
Выделяем весь этот набранный текст, курсор должен быть над полем ввода, нажимаем F7 и продолжаем печатать нормально.

#INCLUDE Once"windows.bi"

Dim Shared T(256)As UByte={0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,_
29,30,31,32,33,64,185,59,37,63,253,40,41,42,43,63,45,47,124,48,49,50,51,52,53,54,55,56,57,94,36,193,61,_
222,38,34,212,200,209,194,211,192,207,208,216,206,203,196,220,210,217,199,201,202,219,197,195,204,214,_
215,205,223,245,92,250,58,95,184,244,232,241,226,243,224,239,240,248,238,235,228,252,242,249,231,233,_
234,251,229,227,236,246,247,237,255,213,47,218,168,127,128,129,130,131,132,133,134,135,136,137,138,139,_
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,_
166,167,126,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,96,35,186,187,188,189,190,191,70,_
60,68,85,76,84,58,80,66,81,82,75,86,89,74,71,72,67,78,69,65,123,87,88,73,79,125,83,77,34,62,90,102,44,100,_
117,108,116,59,112,98,113,114,107,118,121,106,103,104,99,110,101,97,91,119,120,105,111,93,115,109,39,46,122}

Sub main Cdecl Alias"main"
Dim As zString*10 s=Any
Dim As Point cp=Any
GetCursorPos @cp
Var h=WindowFromPoint(cp)'узнаём окно под курсором

'Эти две строки только для того чтоб работало в FbEdit
GetClassName h,s,8
If lstrcmp(s,"RAEditC")=0 Then h=GetParent(h)

Var hkl=IIf(Loword(GetKeyboardLayout(GetWindowThreadProcessId(h,0)))=1033,1049,1033)'локаль в окне, 1049 ru 1033 en
OpenClipboard 0
EmptyClipboard
CloseClipboard
SendMessage h,WM_COPY,0,0

If IsClipboardFormatAvailable(CF_TEXT)Then
OpenClipboard 0
'указание локали
Var cl=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,5)
Var m=GlobalLock(cl)
Poke dword,m,959721521
Poke m+4,0
GlobalUnlock m
SetClipboardData CF_LOCALE,cl
cl=GetClipboardData(CF_TEXT)
m=GlobalLock(cl)
Dim As Zstring Ptr p=m
Dim As Long c=Any

If hkl=1033 Then
Do'Перекодировка по таблице
c=Peek(p)
Poke p,T(c)
p+=1
Loop While c
Else'чтоб не делать вторую таблицу. Одной в одном цикле не обойтись, так как некоторые знаки препинания не совпадают
Do
    c=Peek(p)
    Select Case c
        Case 34:c=221
        Case 44:c=225
        Case 46:c=254
        Case 58:c=198
        Case 59:c=230
        Case 63:c=44
        Case Else:c=T(c)
    End Select
    Poke p,c
    p+=1
Loop While c
Endif

SendMessage h,EM_REPLACESEL,0,m
GlobalUnlock m
CloseClipboard
Endif

SendMessage HWND_BROADCAST,WM_INPUTLANGCHANGEREQUEST,1,hkl'задать глобально раскладку.

SetForegroundWindow h'возврат фокуса

ExitProcess 0
End Sub

BAT файл для компиляции любого из вышеописанных исходных кодов:

@echo off
SET FBPATH=C:\FreeBASIC-1.05.0-win32

%~d1
cd %~p1
SET File=%~n1
SET LIBS=-lkernel32 -luser32 -lgdi32 -lmsimg32 -lshell32 -lComdlg32 -lole32 -ladvapi32.dll -luuid -loleaut32 -limm32 -lwinmm -lcomctl32.dll -lfb -lgcc -lmingw32 -lmingwex -lmoldname -lsupc++ -lgcc_eh -lmsvcrt

If Not Exist %File%.rc Goto norc
echo compiling resource..
SET RES="%File%.res.obj"
%FBPATH%\bin\win32\gorc /ni /nw /o /fo %RES% "%File%.rc"
:norc
echo compiling..
%FBPATH%\fbc.exe -w 3 %1 -r -lib
If ErrorLevel 1 echo # Compile error! # && Goto Exit
echo assembling..
%FBPATH%\bin\win32\as.exe --32 --strip-local-absolute %File%.asm -o %File%.o
If ErrorLevel 1 echo # Asm error! # && Goto Exit
echo linking..
%FBPATH%\bin\win32\ld.exe -e _main -subsystem windows "%FBPATH%\lib\win32\fbextra.x" -s --stack 102400,102400 -L %FBPATH%\lib\win32 -L "./" "%File%.o" %RES% -o "%File%.exe" -( %LIBS% -)
If ErrorLevel 1 echo # Link error! # && Goto Exit
echo # No errors ! #
:Exit
pause

FreeBasic

Исправление регистра, раскладки