FreeBasic
Главная
Вход
Регистрация
Среда, 09.10.2024, 09:18Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Программа - ТРАНСЛИТ
ПавелДата: Понедельник, 24.12.2012, 10:48 | Сообщение # 1
Сержант
Группа: Пользователи
Сообщений: 21
Репутация: 0
Статус: Offline


translit.rc:

Код
    #define IDD_DLG1 1000
     #define IDC_RED1 1001
     #define IDC_RED2 1002
     #define IDC_BTN1 1003
     #define IDC_BTN2 1004
       
     IDD_DLG1 DIALOGEX 6,5,402,138
     CAPTION "Транлит"
     FONT 8,"MS Sans Serif",400,0,0
     STYLE 0x10CE0800
     BEGIN
     CONTROL "Введите текст для транслитерации",IDC_RED1,"RichEdit20A",0x50010000,3,3,204,105,0x00000200
     CONTROL "",IDC_RED2,"RichEdit20A",0x50010000,210,3,189,105,0x00000200
     CONTROL "Транслит",IDC_BTN1,"Button",0x50010000,168,117,81,18
     CONTROL "Копировать",IDC_BTN2,"Button",0x50010000,345,117,48,15
     END


translit.bi:


Код
    #define IDD_DLG1 1000
     #define IDC_RED1 1001
     #define IDC_RED2 1002
     #define IDC_BTN1 1003
     #define IDC_BTN2 1004
       
     Dim Shared hInstance As HMODULE


translit.bas:

Код
#Include Once "windows.bi"
   
#Include "Транслит.bi"
   
Dim Shared rus(...) As String*1 = { _
"А","Б","В","Г","Д","Е","Ё","Ж","З","И",_
"Й","К","Л","М","Н","О","П","Р","С","Т","У",_
"Ф","Х","Ц","Ч","Ш","Щ","Ь","Ы","Ъ","Э","Ю","Я",_
"а","б","в","г","д","е","ё","ж","з","и",_
"й","к","л","м","н","о","п","р","с","т","у",_
"ф","х","ц","ч","ш","щ","ь","ы","ъ","э","ю","я"}
Dim Shared Transl(...)As String*2 = { _
"A","B","V","G","D","E","Jo","Zh","Z","I",_
"J","K","L","M","N","O","P","R","S","T","U",_
"F","H","C","Ch","Sh","W","''","Y","##","Je","Ju","Ja",_
"a","b","v","g","d","e","jo","zh","z","i",_
"j","k","l","m","n","o","p","r","s","t","u",_
"f","h","c","ch","sh","w","'","y","#","je","ju","ja"}
   
   
Function TRANSLIT(DANNIE As String) As String
Dim a As Integer, b As Integer,c As Integer, VIHODNAYA_STROKA As String
For b = 1 To Len(DANNIE)
For a = 0 To UBound(rus)
If rus(a) = Mid(DANNIE,b,1) Then
VIHODNAYA_STROKA += Transl(a)
c = 1
Exit For
EndIf
Next
If c = 0 Then VIHODNAYA_STROKA += Mid(DANNIE,b,1)
c = 0
Next
TRANSLIT = VIHODNAYA_STROKA
End Function
   
Declare Function DlgProc(ByVal hWin As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
hInstance=GetModuleHandle(NULL)
Var hRichEdDLL = LoadLibrary ("RICHED20.DLL")
DialogBoxParam(hInstance, Cast(ZString Ptr,IDD_DLG1), NULL, @DlgProc, NULL)
FreeLibrary(hRichEdDLL)
ExitProcess(0)
End
   
Function DlgProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Integer
Dim As Long id, Event, x, y
Dim hBtn As HWND
Dim rect As RECT
Dim TEXT As String*512
Dim TEXT2 As String
Select Case uMsg
Case WM_INITDIALOG
Case WM_CLOSE
EndDialog(hWin, 0) '
Case WM_COMMAND
id=LoWord(wParam)
Event=HiWord(wParam)
Select Case id
Case IDC_BTN1
SendDlgItemMessage(hWin,IDC_RED1,WM_GETTEXT,512,@TEXT)
If Len(TEXT)>0 Then
TEXT2 = TRANSLIT(TEXT)
SendDlgItemMessage(hWin,IDC_RED2,WM_SETTEXT,0,SAdd(TEXT2))
EndIf
Case IDC_BTN2
Var EDIT2 = GetDlgItem(hwin,IDC_RED2)
SetFocus(EDIT2)
SendMessage(EDIT2, EM_SETSEL,0 ,-1)
SendDlgItemMessage(hWin,IDC_RED2,WM_COPY,0,0)
End Select '
Case Else
Return FALSE
End Select
Return TRUE
   
End Function


сайт программы: http://ya-freebasic.narod.ru/
Прикрепления: 1833172.png (24.8 Kb)
 
  • Страница 1 из 1
  • 1
Поиск: