Список форумов Форум Libreoffice

Форум Libreoffice

Добро пожаловать на Форум Libreoffice!
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

English French German Italian Portuguese Russian Spanish
Работа с OCX - Microsoft Translate на MSINET.OCX

 
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic
Предыдущая тема :: Следующая тема  
Автор Сообщение
RFJ



Репутация: +1    

Зарегистрирован: 02.08.2011
Сообщения: 59

СообщениеДобавлено: Ср Ноя 16, 2011 8:40 am    Заголовок сообщения: Работа с OCX - Microsoft Translate на MSINET.OCX Ответить с цитатой

Возможность в Windows работать с элементами управления OCX можно показать на примере использования элемента управления Microsoft Internet Transfer Control, распространяемого в файле msinet.ocx. На этом элементе управления могут быть реализованы online-переводчики Microsoft Translate и Google Translate в документе Calc (как у covar).
Во-первых, нужно скачать сам файл msinet.ocx (в дистрибутив Windows он не входит).
Во-вторых, нужно зарегистрировать находящийся там элемент управления командой:
Код:
regsvr32.exe msinet.ocx

В-третьих, нужно знать ProgID этого элемента управления, который можно узнать из реестра Windows.
InetCtls.Inet.1 - это и есть ProgID элемента управления Microsoft Internet Transfer Control.




Теперь можно открывать документ Calc и вписывать код.

Microsoft Translate
Код:
Sub mst_msinet( )
Dim oleFactory
Dim Inet1

oDoc=ThisComponent
oSheet=oDoc.CurrentController.getActiveSheet()

'Получаем текст для перевода из выбранной ячейки
oCell1 = oDoc.CurrentSelection
ncol=oCell1.CellAddress.Column
nrow=oCell1.cellAddress.Row
TextEN=oCell1.getString()
 
oleFactory = createUnoService("com.sun.star.bridge.OleObjectFactory")
'oleFactory = createUnoService("com.sun.star.bridge.oleautomation.Factory")

Inet1 = oleFactory.createInstance("InetCtls.Inet.1")

lang1 = "en"
lang2 = "ru"

On Error GoTo ENDTR
rustr = Inet1.OpenURL("http://api.microsofttranslator.com/v2/Http.svc/Translate?appId=XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX&text=" & TextEN & "&from=" & lang1 & "&to=" & lang2)

lenrustr = Len(rustr)

rustr = Mid(rustr, 69, lenrustr - 77)

rustr = u2w(rustr)

'Перевод текста пишем в соседний столбец справа
oCell20=oSheet.getCellByposition(ncol+1,nrow)
oCell20.setString(rustr)
Exit Sub
ENDTR:
MsgBox "ERROR CONNECT"
End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - 40-значный ваш собственный appId, который нужно бесплатно получить здесь
https://ssl.bing.com/webmaster/Developers/CreateAppId

Google Translate
Код:
Sub gt_msinet( )
Dim oleFactory
Dim Inet1

oDoc=ThisComponent
oSheet=oDoc.CurrentController.getActiveSheet()

'Получаем текст для перевода из выбранной ячейки
oCell1 = oDoc.CurrentSelection
ncol=oCell1.CellAddress.Column
nrow=oCell1.cellAddress.Row
TextEN=oCell1.getString()
 
oleFactory = createUnoService("com.sun.star.bridge.OleObjectFactory")
'oleFactory = createUnoService("com.sun.star.bridge.oleautomation.Factory")

Inet1 = oleFactory.createInstance("InetCtls.Inet.1")
 
lang1 = "en"
lang2 = "ru"

On Error GoTo ENDTR
rustr = Inet1.OpenURL("http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & TextEN & "&langpair=" & lang1 & "|" & lang2)

lenrustr = Len(rustr)

rustr = Left(rustr, lenrustr - 50 - 1)
rustr = Right(rustr, Len(rustr) - 35 - 1)
rustr = u2w(rustr)

'Перевод текста пишем в соседний столбец справа
oCell20=oSheet.getCellByposition(ncol+1,nrow)
oCell20.setString(rustr)
Exit Sub
ENDTR:
MsgBox "ERROR CONNECT"
End Sub


Понадобится ещё декодер UTF-8.
Простенький декодер UTF-8 для русского языка:
Код:
Function u2w(u8)
Dim uu(1000)

lu8 = Len(u8)

rrr = ""
i = 0

S:
i = i + 1
If i > lu8 Then
GoTo E
End If

    uu(i) = Mid(u8, i, 1)
    If fcode(uu(i)) = 208 Or fcode(uu(i)) = 209 Then
        If fcode(uu(i)) = 208 Then
            aaa = 48
        End If
        If fcode(uu(i)) = 209 Then
            aaa = 112
        End If
        k = 2
        GoTo S
    Else
        If k = 2 Then
           If (aaa = 48 And fcode(uu(i)) = 129) Or (aaa = 112 And fcode(uu(i)) = 145) Then
              uu(i) = fchar(fcode(uu(i)) + 39)
           Else
              uu(i) = fchar(fcode(uu(i)) + aaa)
           End If
        Else
           uu(i) = fchar(fcode(uu(i)) + 0)
        End If
        rrr = rrr & uu(i)
        k = 1
        GoTo S
    End If
E:
u2w=rrr
End Function


И дополнительные функции:
Код:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fcode(u) As Integer
   FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
   fcode= FuncAcc.callFunction("CODE",array(u))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fchar(u)
   FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
   fchar= FuncAcc.callFunction("CHAR",array(u))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function funicode(u) As Integer
   FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
   funicode= FuncAcc.callFunction("UNICODE",array(u))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function funichar(u)
   FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
   funichar= FuncAcc.callFunction("UNICHAR",array(u))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Результат работы Microsoft Translate:

Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Форум Libreoffice -> Basic Часовой пояс: GMT
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group
Вы можете бесплатно создать форум на MyBB2.ru, RSS