[МЕМО] Плавающие окна

Автор Рыбка Рио, 14 февраля 2011, 04:28

0 Пользователи и 1 гость просматривают эту тему.

Рыбка Рио

REM  *****  BASIC  *****

Dim floatingwindow As Object
Dim floatingframe As Object
Dim zToolkit As Object
Dim CW As Object
'Dim oL As Object

Sub Main
Doc=ThisComponent
CW=Doc.CurrentController.ComponentWindow
zToolkit=CW.getToolkit()

floatingframe = GetProcessServiceManager.createInstanceWithContext("com.sun.star.frame.Frame", GetDefaultContext)
floatingwindow = CreateWindow(zToolkit, MkRk(50,50,100,100))
floatingframe.initialize(floatingwindow)

ucc = CreateCtrWithProp( "Container", MkRk(50,50,90 ,90), Array(), Array())
ucc.createPeer( zToolkit, floatingwindow )
floatingframe.setComponent(ucc,Null)
oEdit1 = CreateCtrWithProp( "Edit", MkRk(5,5,90,40), Array("Text"), Array("Редактируй"))
ucc.addControl("Edit1",oEdit1)
'oButton1 = CreateCtrWithProp( "Button", MkRk(10,10,70,30), Array("Label"), Array("Кнопка"))
' ucc.addControl("Button1",oButton1)
' oL = CreateUnoListener("AL_", "com.sun.star.awt.XActionListener")
' oButton1.addActionListener(oL)
oLabel1 = CreateCtrWithProp( "FixedText", MkRk(10,50,85,30), Array(), Array())
oLabel1.Text="примечание "
ucc.addControl("Label1",oLabel1)
End Sub

'Sub AL_actionPerformed()
'msgbox "Action"
'End Sub

Function MkRk( nX As Long, nY As Long, nWidth As Long, nHeight As Long ) As com.sun.star.awt.Rectangle
   Dim Rk As Object
   Rk = createUnoStruct("com.sun.star.awt.Rectangle")
   With Rk
      .X = nX
      .Y = nY
      .Width = nWidth
      .Height = nHeight
   End With
   MkRk() = Rk
End Function

Function CreateWindow( oLocToolkit As Object, aLocRect As com.sun.star.awt.Rectangle ) As com.sun.star.awt.WindowDescriptor
Dim WDesc
WDesc = createUnoStruct("com.sun.star.awt.WindowDescriptor")
With WDesc
.Type = com.sun.star.awt.WindowClass.SIMPLE
.WindowServiceName = "floatingwindow"
.Parent = CW
.ParentIndex = -1
.Bounds = aLocRect
End With
With com.sun.star.awt.WindowAttribute
WDesc.WindowAttributes = .BORDER + .SHOW + .SIZEABLE + .MOVEABLE + .CLOSEABLE'WA_BORDER + WA_SHOW + WA_SIZEABLE + WA_MOVEABLE + WA_CLOSEABLE
End With
CreateWindow = oLocToolkit.createWindow(WDesc)
End Function

Function CreateCtrWithProp( CtrType, aPosSize, aPropNames, aPropValues )
Dim oCtr As Object, oCtrModel As Object
oCtr = createUnoService("com.sun.star.awt.UnoControl" & CtrType )
oCtrModel = createUnoService("com.sun.star.awt.UnoControl" & CtrType & "Model" )
oCtrModel.setPropertyValues( aPropNames, aPropValues )
With oCtr
.setModel(oCtrModel)
.setPosSize( aPosSize.X, aPosSize.Y, aPosSize.Width, aPosSize.Height, _
com.sun.star.awt.PosSize.POSSIZE )
End With
CreateCtrWithProp() = oCtr
End Function
ubuntu 12.04 + LibO3.6.0

Рыбка Рио

Выглядит вот так:

[вложение удалено Администратором]
ubuntu 12.04 + LibO3.6.0

convas

Это только для LibreOffice?

А то у меня на OOo pro 3.2.1 выдает ошибку.

[вложение удалено Администратором]

Рыбка Рио

Цитата: convas от 14 февраля 2011, 12:09
Это только для LibreOffice?

А то у меня на OOo pro 3.2.1 выдает ошибку.
Нет, это для всех. Просто ради 3.2.1 лучше строчку где ошибка заменить на
CW=Doc.CurrentController.Frame.ComponentWindow
(т.к. видимо Doc.CurrentController.ComponentWindow - годится для 3.3, но не для 3.2.1)
ubuntu 12.04 + LibO3.6.0

Рыбка Рио

#4
А вот полезный макрос использующий плавающее окно, который преобразует выделенный фрагмент текста в BBcode:
REM  *****  BASIC  *****

Dim floatingwindow As Object
Dim floatingframe As Object
Dim zToolkit As Object
Dim CW As Object
Dim Doc As Object

Sub Main
Doc=ThisComponent
BBcodeString=Reload
CW=Doc.CurrentController.Frame.ComponentWindow
zToolkit=CW.getToolkit()

xsz=300
ysz=200

floatingframe = GetProcessServiceManager.createInstanceWithContext("com.sun.star.frame.Frame", GetDefaultContext)
floatingwindow = CreateWindow(zToolkit, MkRk(800,100,xsz,ysz))
floatingframe.initialize(floatingwindow)

ucc = CreateCtrWithProp( "Container", MkRk(0,0,xsz,ysz), Array(), Array())
ucc.createPeer( zToolkit, floatingwindow )
floatingframe.setComponent(ucc,Null)
oEdit1 = CreateCtrWithProp( "Edit", MkRk(0,0,xsz,ysz), Array("MultiLine","VScroll"), Array(true,true))
ucc.addControl("Edit1",oEdit1)
oEdit1.setText(BBcodeString)
End Sub

Function MkRk( nX As Long, nY As Long, nWidth As Long, nHeight As Long ) As com.sun.star.awt.Rectangle
  Dim Rk As Object
  Rk = createUnoStruct("com.sun.star.awt.Rectangle")
  With Rk
     .X = nX
     .Y = nY
     .Width = nWidth
     .Height = nHeight
  End With
  MkRk() = Rk
End Function

Function CreateWindow( oLocToolkit As Object, aLocRect As com.sun.star.awt.Rectangle ) As com.sun.star.awt.WindowDescriptor
Dim WDesc
WDesc = createUnoStruct("com.sun.star.awt.WindowDescriptor")
With WDesc
.Type = com.sun.star.awt.WindowClass.SIMPLE
.WindowServiceName = "floatingwindow"
.Parent = CW
.ParentIndex = -1
.Bounds = aLocRect
End With
With com.sun.star.awt.WindowAttribute
WDesc.WindowAttributes = .BORDER + .SHOW + .MOVEABLE + .CLOSEABLE
End With
CreateWindow = oLocToolkit.createWindow(WDesc)
End Function

Function CreateCtrWithProp( CtrType, aPosSize, aPropNames, aPropValues )
Dim oCtr As Object, oCtrModel As Object
oCtr = createUnoService("com.sun.star.awt.UnoControl" & CtrType )
oCtrModel = createUnoService("com.sun.star.awt.UnoControl" & CtrType & "Model" )
oCtrModel.setPropertyValues( aPropNames, aPropValues )
With oCtr
.setModel(oCtrModel)
.setPosSize( aPosSize.X, aPosSize.Y, aPosSize.Width, aPosSize.Height, _
com.sun.star.awt.PosSize.POSSIZE )
End With
CreateCtrWithProp() = oCtr
End Function

Function Reload As String
Dim Cx As Long
Dim Cy As Long
Dim ko As Long
Dim S As String
Dim NMx As String
Dim NMy As String
Dim k As Integer
Dim kk As Integer
Dim nSel As Integer
oSel = Doc.CurrentSelection
Dim Si(oSel.Count-1) As String
TG2()=Array("","[/COLOR]","[/B]","[/I]","[/U]","[/S]","[/URL]","[/SIZE]","[/SUB]","[/SUP]","[/FONT]") 'supported tags
Dim iTGo(3000,10) As Integer
Dim sTG(3000) As String
Dim sTGo(3000,10) As String
Dim ChBox1 As Boolean, ChBox2 As Boolean
ChBox1 = TRUE
ChBox2 = TRUE

nSel=oSel.Count-1

For i=0 to nSel
bPx=True
iiE=0
L=len(oSel(i).String)
TC3 = Doc.Text.createTextCursorByRange(oSel(i).End)
If L<1 then goto Nexti
Doc.CurrentController.StatusIndicator.reset
If nSel=0 then
Doc.CurrentController.StatusIndicator.start("B B C o d e . . . ", L)
Else
Doc.CurrentController.StatusIndicator.start("B B C o d e . . . : "+cStr(i)+"/"+cStr(nSel), L)
Endif
S=""
TC1 = Doc.Text.createTextCursorByRange(oSel(i).Start)
TC2 = Doc.Text.createTextCursorByRange(oSel(i).Start)
TC1.goRight(1, True)
TC2.goRight(1, False)

j=0
ko=0
k=0
kk=0
Do
With TC1
Cx=.CharColor
Bx=.CharWeight
Ix=.CharPosture
Ux=.CharUnderline
Sx=.CharStrikeout
Hx=.HyperLinkURL
CHx=.CharHeight
CEx=.CharEscapement
CFx=.CharFontName
NMx=.NumberingStyleName
End With

TC2.goRight(1, True)
With TC2
Cy=.CharColor
By=.CharWeight
Iy=.CharPosture
Uy=.CharUnderline
Sy=.CharStrikeout
Hy=.HyperLinkURL
CHy=.CharHeight
CEy=.CharEscapement
CFy=.CharFontName
NMy=.NumberingStyleName
End With

If Doc.Text.compareRegionEnds(TC1,TC3)=0 then iiE=1 : goto M1
If TC1.isStartOfParagraph then goto M1
If CHx<>CHy then
k=1
If CFx<>CFy then kk=1
goto M1
Elseif CFx<>CFy then
kk=1
If CHx<>CHy then k=1
goto M1
Endif
If Hx+Hy="" then
If abs(Cx-Cy)>1 or Ux<>Uy then goto M1
Endif
If (Bx<>By or Ix<>Iy or Sx<>Sy or Hx<>Hy or CEx<>CEy or NMx<>NMy) then goto M1
goto Nextj
M1:
sTG(ko)=TC1.String
TC1.collapseToEnd()

If Cx<>0 and Cx<>-1 then sTGo(ko,1)= "[COLOR=#"+StrHEX(Cx)+"]"
If Bx=150 then sTGo(ko,2)="[B]"
If Ix=com.sun.star.awt.FontSlant.ITALIC then sTGo(ko,3)="[I]"
If Ux=1 then sTGo(ko,4)="[U]"
If Sx=1 then sTGo(ko,5)="[S]"
If Hx<>"" then
sTGo(ko,6)="[URL="+Hx+"]"
sTGo(ko,4)=""
sTGo(ko,1)=""
Endif
If ChBox2=FALSE then
If k=1 then sTGo(ko,7)="[SIZE="+CHx+"pt]"
Endif
If ChBox1=FALSE then
If kk=1 then sTGo(ko,10)="[FONT="+CFx+"]"
Endif
If CEx>0 then sTGo(ko,9)="[SUP]"
If CEx<0 then sTGo(ko,8)="[SUB]"
If NMx<>"" and bPx=True then sTGo(ko,0)="[*]"

sTG1=""
sTG2=""

For jj=0 to 10
If sTGo(ko,jj)<>"" and sTGo(ko,jj)<>"[SIZE=pt]" and sTGo(ko,jj)<>"[FONT=]" and sTGo(ko,jj)<>"[URL=]" then
sTG1=sTG1+sTGo(ko,jj)
sTGo(ko,jj)=""
sTG2=TG2(jj)+sTG2
Endif
Next
If Ubound(Split(sTG(ko)," "))+Ubound(Split(sTG(ko),chr(9)))=len(sTG(ko)) then
S=S+sTG(ko)
Elseif sTG(ko)<>"" then
S=S+sTG1+sTG(ko)+sTG2
Endif
ko=ko+1
bPx=TC1.isStartOfParagraph
goto Nextj
Nextj:
j=j+1
TC1.goRight(1, True)
TC2.collapseToEnd()
Doc.CurrentController.StatusIndicator.setValue(j)
Loop until iiE=1

Replace1()=Array("[/B][B]","[/I][I]","[/U][U]","[/S][S]","[/SUB][SUB]","[/SUP][SUP]")
For ij=0 to 5
S=Join(Split(S,Replace1(ij)),"")
Next
If ChBox2=TRUE then S="[SIZE="+TC3.CharHeight+"pt]"+S+"[/SIZE]"
If ChBox1=TRUE then S="[FONT="+TC3.CharFontName+"]"+S+"[/FONT]"
Si(i)=S
Doc.CurrentController.StatusIndicator.end
Nexti:
Next
Reload=Join(Si(),"[HR]"+chr(13))
End Function

Function StrHEX(N As Long) As String
Ary()=Array("00","0","")
sA()=Array(cStr(HEX(Red(N))), cStr(HEX(Green(N))), cStr(HEX(Blue(N))))
StrHEX=sA(0)+Ary(len(sA(0)))+sA(1)+Ary(len(sA(1)))+sA(2)+Ary(len(sA(2)))
End Function


PS.
ChBox1 = TRUE 'измените на False если хотите чтобы отслеживалось изменение гарнитуры шрифта
ChBox2 = TRUE 'измените на False если хотите чтобы отслеживалось изменение размера шрифта

[вложение удалено Администратором]
ubuntu 12.04 + LibO3.6.0

convas

Здесь ошибка
Цитироватьthen sTGo(ko,1)= "[COLOR=#"+StrHEX(Cx)+"]"
Наверное, нужно
Цитироватьthen sTGo(ko,1)= "[COLOR=#"+Str(HEX(Cx))+"]"

Рыбка Рио

Цитата: convas от 14 февраля 2011, 14:51
Здесь ошибка
Цитироватьthen sTGo(ko,1)= "[COLOR=#"+StrHEX(Cx)+"]"
Наверное, нужно
Цитироватьthen sTGo(ko,1)= "[COLOR=#"+Str(HEX(Cx))+"]"
Нет, извините, нужно добавить функцию в конец
Function StrHEX(N As Long) As String
Ary()=Array("00","0","")
sA()=Array(cStr(HEX(Red(N))), cStr(HEX(Green(N))), cStr(HEX(Blue(N))))
StrHEX=sA(0)+Ary(len(sA(0)))+sA(1)+Ary(len(sA(1)))+sA(2)+Ary(len(sA(2)))
End Function

(в предыдущем сообщении уже исправлено)
ubuntu 12.04 + LibO3.6.0

Рыбка Рио

#7
Вот готовое расширение на основе того что выше (меню Writer - Сервис/Дополнения/BBcode):

[вложение удалено Администратором]
ubuntu 12.04 + LibO3.6.0

ape

Цитата: Клио от 14 февраля 2011, 12:51
Нет, это для всех. Просто ради 3.2.1 лучше строчку где ошибка заменить на
CW=Doc.CurrentController.Frame.ComponentWindow
(т.к. видимо Doc.CurrentController.ComponentWindow - годится для 3.3, но не для 3.2.1)
OOo-3.3.0; Win_x86: png. (Без "Frame." - аналогично).

[вложение удалено Администратором]

dr.Faust

Я Пастернака не читал макрос не запускал, но вроде должно работать. Очень странно - свойства вроде взяты верно...
Свобода информации - свобода личности!

Рыбка Рио

Цитата: ape от 14 февраля 2011, 17:11
Цитата: Клио от 14 февраля 2011, 12:51
Нет, это для всех. Просто ради 3.2.1 лучше строчку где ошибка заменить на
CW=Doc.CurrentController.Frame.ComponentWindow
(т.к. видимо Doc.CurrentController.ComponentWindow - годится для 3.3, но не для 3.2.1)
OOo-3.3.0; Win_x86: png. (Без "Frame." - аналогично).
А у вас Writer открыт? (Вы откуда макрос запускаете?) Он наверное контроллер не может найти, а не потому что что свойства нет. Если окрыт только Basic IDE то может поэтому и не работает.
ubuntu 12.04 + LibO3.6.0

ape

Не был: сразу из soffice.exe. После запуска ТП - ОК.