REM ***** BASIC ***** Dim Dlg As Object Dim mDatosV(150) as string Dim mDatosC(150) as string Dim mDatosCShort(150) as string Dim mDatosVShort(150) as string Dim ha_fet_intro as Boolean 'la ruta del membrete Public Const ruta as String = "file:///usr/share/lliurex-dgti-conf-membrete/membretes" Sub MacroCabecera 'Variables para el Dialogo Dim oControlCast As Object Dim oControlVal As Object Dim ocmdBoton As Object Dim opCast AS Integer Dim opVal AS Integer Dim EstadoCheckDer As Boolean,EstadoCheckInstituacional As Boolean,EstadoCheckLogoPeu As Boolean,EstadoCheckTextPeu As Boolean Dim textHeader '******************A partir de aqui manipulamos el dialogo**************************************** ' Cargamos las librerias Estandar DialogLibraries.LoadLibrary("mGVA") ' Cargamos nuestro dialogo "DialogoCabecera" en la variable Dlg Dlg = CreateUnoDialog(DialogLibraries.mGVA.DialogoCabecera) 'carrega la llibreria de macros tools que gastarem mes endavant If Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools") then GlobalScope.BasicLibraries.loadLibrary("Tools") Endif 'Hacemos dos Arrays con el texto en Castellano y en Valenciano que queramos que aparezca en los listbox ''''''''''''''''' if (LeerDepartamentos() = false) then exit sub endif '''''''''''''''''''''''''' oControlCast=Dlg.getControl("ListBox1") oControlVal=Dlg.getControl("ListBox2") 'Accedemos a la posicion donde esta insertado cada elemento del array oControlCast.getModel.StringItemList = mDatosCShort() oControlVal.getModel.StringItemList = mDatosVShort() ha_fet_intro=false ' Ejecutamos el Dialogo resul=Dlg.Execute() if ha_fet_intro=false then exit sub endif 'agafa els valors que hi ha seleccionats en el dialeg OpCast=oControlCast.SelectedItemPos OpVal=oControlVal.SelectedItemPos EstadoCheckDer=Dlg.getControl("CheckBox1").state EstadoCheckInstituacional=Dlg.getControl("CheckBox2").state EstadoCheckLogoPeu=Dlg.getControl("CheckLogoPeu").state EstadoCheckTextPeu=Dlg.getControl("CheckTextPeu").state 'allibera el dialeg Dlg.dispose() '********************** Depende de la posicion seleccionada en le listbox insertamos un texto o otro ****************************************** 'si insertem mes que els logos carreguem la cadena de text seleccionada If OpCast > -1 Then textHeader = mDatosC(OpCast) ElseIf OpVal > -1 Then textHeader = mDatosV(OpVal) else exit sub end if 'carreguem totes les dades a mostrar en les variables corresponents textHeaderTrencat=split(textHeader,";") if ubound(textHeaderTrencat) <> 5 then MsgBox "La linia: " & CHR$(13) & textHeader & CHR$(13) & "està mal configurada en el fitxer departamentos.txt", MB_ICONSTOP, "Problema de configuració" end end if nom_organisme=textHeaderTrencat(0) direccio=textHeaderTrencat(1) if textHeaderTrencat(2) <> "" then logo_izq=ruta & "/" & textHeaderTrencat(2) else logo_izq="" end if if textHeaderTrencat(3) <> "" then logo_der=ruta & "/" & textHeaderTrencat(3) else logo_der="" end if text_peu=textHeaderTrencat(4) if textHeaderTrencat(5) <> "" then logo_peu=ruta & "/" & textHeaderTrencat(5) else logo_peu="" end if if not EstadoCheckLogoPeu then logo_peu="" end if if not EstadoCheckTextPeu then text_peu="" end if 'Estilos de la cabecera oDoc = ThisComponent oStyles = oDoc.getStyleFamilies' En esta linea y las dos de abajo son para cargar el estilo de la hoja oPS = oStyles.getByName("PageStyles") Cursor_view=oDoc.CurrentController.getViewCursor Stan = oPS.getByName(Cursor_view.PageStyleName) Stan.HeaderIsOn = True 'Activamos la cabecera Stan.HeaderHeight = 2500 + Stan.HeaderBodyDistance ' Altura de la cabecera Cursor = Stan.HeaderText.createTextCursor() Cursor_view.gotoRange(Stan.HeaderText,false) 'Cursor to header. Cursor_view.paraAdjust = com.sun.star.style.ParagraphAdjust.BLOCK Cursor_view.ParaLastLineAdjust = 2 'inserta en logo de la esquerra anclat al paragraf per a solucionar el problema del 'text after pollastre' nom_imatge=logo_izq On Error GoTo ErrorOperaImatge tamanyImatge=GetGraphicSize(ConvertToUrl(nom_imatge)) EmbedGraphic(oDoc, Cursor, ConvertToUrl(nom_imatge),"al_paragraf",com.sun.star.text.HoriOrientation.NONE) On Error GoTo 0 'inserta el frame de l'esquerra per a que tot quede quadrat oFrame = ThisComponent.createInstance( "com.sun.star.text.TextFrame" ) oFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER aux_struct=oFrame.LeftBorder aux_struct.OuterLineWidth=0 aux_struct.LineWidth=0 oFrame.LeftBorder=aux_struct oFrame.RightBorder=aux_struct oFrame.TopBorder=aux_struct oFrame.BottomBorder=aux_struct oFrame.VertOrient = com.sun.star.text.VertOrientation.CENTER oFrame.SizeType=com.sun.star.text.SizeType.MIN oFrame.FrameWidthAbsolute = tamanyImatge.width-800 oFrame.FrameHeightAbsolute = tamanyImatge.height oFrame.TopMargin = 0 oFrame.BottomMargin = 0 oFrame.LeftMargin = 0 oFrame.RightMargin = 0 oFrame.BorderDistance = 0 Stan.HeaderText.insertTextContent( Cursor, oFrame, false ) 'inserta un espai abans del seguent frame Stan.HeaderText.insertString(Cursor," ", false) 'insertem el logo de la dreta o un frame buit per quadrar if EstadoCheckDer and logo_der <> "" then nom_imatge=logo_der On Error GoTo ErrorOperaImatge EmbedGraphic(oDoc, Cursor, ConvertToUrl(nom_imatge), "al_caracter",com.sun.star.text.HoriOrientation.NONE) On Error GoTo 0 else 'fica un frame buit a la dreta del mateix tamany que la imatge de l'esquerra (sense ontar el 800 que queden fora del marge) 'es fa aixi per cuadras el text central que el podria posar entre tots dos oFrame = ThisComponent.createInstance( "com.sun.star.text.TextFrame" ) oFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER aux_struct=oFrame.LeftBorder aux_struct.OuterLineWidth=0 aux_struct.LineWidth=0 oFrame.LeftBorder=aux_struct oFrame.RightBorder=aux_struct oFrame.TopBorder=aux_struct oFrame.BottomBorder=aux_struct oFrame.VertOrient = com.sun.star.text.VertOrientation.CENTER oFrame.SizeType=com.sun.star.text.SizeType.MIN oFrame.FrameWidthAbsolute = tamanyImatge.width-800 oFrame.FrameHeightAbsolute = tamanyImatge.height oFrame.TopMargin = 0 oFrame.BottomMargin = 0 oFrame.LeftMargin = 0 oFrame.RightMargin = 0 oFrame.BorderDistance = 0 Stan.HeaderText.insertTextContent( Cursor, oFrame, false ) endif 'inserim baix del logo de l'esquerre el nom del l'ormanisme seleccionat i la direccio 'si hem habilitat el text en el peu de pagina no es posen (cas especial per a organismes depenents) If nom_organisme <> "" and direccio <> "" and (not EstadoCheckTextPeu) Then 'inserta una nova linea per a que el text es fique baix del logo Stan.HeaderText.insertControlCharacter(Cursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False) 'establim format de paragraf i caracter Cursor.paraAdjust = com.sun.star.style.ParagraphAdjust.LEFT Cursor.CharFontName = "Gill Sans MT Condensed" Cursor.CharHeight = 9.3 ' Tamaño de la letra Cursor.CharColor = 3355443 'RGB(0,0,800) ' Color de la letra Cursor.CharWeight=com.sun.star.awt.FontWeight.BOLD Cursor.ParaBottomMargin=150 Cursor.ParaTopMargin=50 v = Cursor.ParaLineSpacing v.Mode = com.sun.star.style.LineSpacingMode.FIX v.Height=350 Cursor.ParaLineSpacing = v 'inserim el nom de l'organisme nomOrganisme=split(nom_organisme,"<br>") for i=0 to ubound(nomOrganisme) Stan.HeaderText.insertString(Cursor, nomOrganisme(i), False) if i<>ubound(nomOrganisme) then Stan.HeaderText.insertControlCharacter(Stan.HeaderText.getEnd(), com.sun.star.text.ControlCharacter.LINE_BREAK, False) end if next i 'inserta una nova linea per a que la direccio vaja en un paragraf nou Stan.HeaderText.insertControlCharacter(Stan.HeaderText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False) 'establim format de paragraf i caracter Cursor.CharWeight=com.sun.star.awt.FontWeight.NORMAL v = Cursor.ParaLineSpacing v.Mode = com.sun.star.style.LineSpacingMode.FIX v.Height=350 Cursor.ParaLineSpacing = v 'trenquem la direccio en les divereses linies que la componen i les anem inserint amb els corresponents bots de carro direccions=split(direccio,"<br>") for i=0 to ubound(direccions) Stan.HeaderText.insertString(Cursor, direccions(i), False) 'habilitar si no volem el bot de linia final 'if i<>ubound(direccions) then Stan.HeaderText.insertControlCharacter(Stan.HeaderText.getEnd(), com.sun.star.text.ControlCharacter.LINE_BREAK, False) 'end if next i end if 'gestionem si fiquem o no text i logos en el peu de pagina if (logo_peu <> "" or text_peu <> "") then Stan.FooterIsOn = True 'Activamos el peu de pagina Cursor = Stan.FooterText.createTextCursor() Cursor_view.gotoRange(Stan.FooterText,false) 'Cursor to footer. ' establim el justificat de paragraf per a que tots quede ben quadrat pels costats Cursor.paraAdjust = com.sun.star.style.ParagraphAdjust.BLOCK Cursor_view.ParaLastLineAdjust = 2 ' si hi ha un logo de peu definit fiquem un frame per l'esquerra del mateix tamany per a que el text central quede centrat if (logo_peu <> "") then tamanyImatge=GetGraphicSize(ConvertToUrl(logo_peu)) 'inserta el frame de la dreta per a que tot quede quadrat oFrameTamanyImatge = ThisComponent.createInstance( "com.sun.star.text.TextFrame" ) oFrameTamanyImatge.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER aux_struct=oFrameTamanyImatge.LeftBorder aux_struct.OuterLineWidth=0 aux_struct.LineWidth=0 oFrameTamanyImatge.LeftBorder=aux_struct oFrameTamanyImatge.RightBorder=aux_struct oFrameTamanyImatge.TopBorder=aux_struct oFrameTamanyImatge.BottomBorder=aux_struct oFrameTamanyImatge.VertOrient = com.sun.star.text.VertOrientation.CENTER oFrameTamanyImatge.SizeType=com.sun.star.text.SizeType.MIN oFrameTamanyImatge.FrameWidthAbsolute = tamanyImatge.width oFrameTamanyImatge.FrameHeightAbsolute = tamanyImatge.height oFrameTamanyImatge.TopMargin = 0 oFrameTamanyImatge.BottomMargin = 0 oFrameTamanyImatge.LeftMargin = 0 oFrameTamanyImatge.RightMargin = 0 oFrameTamanyImatge.BorderDistance = 0 Stan.FooterText.insertTextContent( Cursor, oFrameTamanyImatge, false ) end if Stan.FooterText.insertString(Cursor," ", false) 'si hi ha text central el fiquem dins del seu propi fram per a que poder-lo ficar amb bots de carro sense que 'interferisca amb el logo de la dreta if (text_peu <> "") then oFrameTextPeu = ThisComponent.createInstance( "com.sun.star.text.TextFrame" ) oFrameTextPeu.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER aux_struct=oFrameTextPeu.LeftBorder aux_struct.OuterLineWidth=0 aux_struct.LineWidth=0 oFrameTextPeu.LeftBorder=aux_struct oFrameTextPeu.RightBorder=aux_struct oFrameTextPeu.TopBorder=aux_struct oFrameTextPeu.BottomBorder=aux_struct oFrameTextPeu.VertOrient = com.sun.star.text.VertOrientation.CENTER oFrameTextPeu.SizeType=com.sun.star.text.SizeType.MIN oFrameTextPeu.FrameWidthPercent = 60 oFrameTextPeu.TopMargin = 0 oFrameTextPeu.BottomMargin = 0 oFrameTextPeu.LeftMargin = 0 oFrameTextPeu.RightMargin = 0 oFrameTextPeu.BorderDistance = 0 Stan.FooterText.insertTextContent( Stan.FooterText.getEnd(), oFrameTextPeu, false ) FrameCursor = oFrameTextPeu.createTextCursor() oText=FrameCursor.Text FrameCursor.CharFontName = "Gill Sans MT Condensed" FrameCursor.CharHeight = 9.3 ' Tamaño de la letra FrameCursor.CharColor = 3355443 'RGB(0,0,800) ' Color de la letra FrameCursor.CharWeight=com.sun.star.awt.FontWeight.NORMAL FrameCursor.paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER 'fiquem el text del peu de pagina trencant-lo en linies separades si esta configurat aixi peuPaginaTrencat=split(text_peu,"<br>") for i=0 to ubound(peuPaginaTrencat) oFrameTextPeu.insertString(oText.getEnd(), peuPaginaTrencat(i) , False) if i<>ubound(peuPaginaTrencat) then oFrameTextPeu.insertControlCharacter(oText.getEnd(), com.sun.star.text.ControlCharacter.LINE_BREAK, False) end if next i end if Stan.FooterText.insertString(Cursor," ", false) ' si hi ha un logo de peu definit fiquem el frame de la dreta per quadra aixi com el logo if (logo_peu <> "") then 'inserta el frame de la dreta per a que tot quede quadrat oFrameTamanyImatge = ThisComponent.createInstance( "com.sun.star.text.TextFrame" ) oFrameTamanyImatge.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER aux_struct=oFrameTamanyImatge.LeftBorder aux_struct.OuterLineWidth=0 aux_struct.LineWidth=0 oFrameTamanyImatge.LeftBorder=aux_struct oFrameTamanyImatge.RightBorder=aux_struct oFrameTamanyImatge.TopBorder=aux_struct oFrameTamanyImatge.BottomBorder=aux_struct oFrameTamanyImatge.VertOrient = com.sun.star.text.VertOrientation.CENTER oFrameTamanyImatge.SizeType=com.sun.star.text.SizeType.MIN oFrameTamanyImatge.FrameWidthAbsolute = tamanyImatge.width oFrameTamanyImatge.FrameHeightAbsolute = tamanyImatge.height oFrameTamanyImatge.TopMargin = 0 oFrameTamanyImatge.BottomMargin = 0 oFrameTamanyImatge.LeftMargin = 0 oFrameTamanyImatge.RightMargin = 0 oFrameTamanyImatge.BorderDistance = 0 Stan.FooterText.insertTextContent( Stan.FooterText.getEnd(), oFrameTamanyImatge, false ) nom_imatge=logo_peu On Error GoTo ErrorOperaImatge EmbedGraphic(oDoc, Stan.FooterText.getEnd(), ConvertToUrl(nom_imatge),"al_paragraf",com.sun.star.text.HoriOrientation.RIGHT) On Error GoTo 0 end if end if 'si s'ha seleccionat l'opcio d'aplicar els marges de pagina instituacionals els fiquem if EstadoCheckInstituacional then Cursor_view.gotoRange(oDoc.Text,false) oPageStyleName = Cursor_view.PageStyleName oPageStyles = oDoc.StyleFamilies.getByName("PageStyles") oStyle = oPageStyles.getByName(oPageStyleName) fromleft=2000 fromtop=1200 fromright=2000 frombottom=1200 oStyle.LeftMargin = fromleft oStyle.TopMargin = fromtop oStyle.RightMargin = fromright oStyle.BottomMargin = frombottom end if exit sub 'checking d'error que bota quan no es troba una imatge sobre la que anem a operar ErrorOperaImatge: MsgBox "Problema accedint a la imatge " & ConvertFromUrl(nom_imatge) & ", revise que la imatge existeix en el directori de configuració i que té permisos d'access sobre ella.", MB_ICONEXCLAMATION, "Error" exit sub End Sub 'handler del boto acceptar del dialeg Sub botonAceptar 'Asociamos esta macro con el boton aceptar del dialogo ha_fet_intro=true Dlg.EndExecute() End Sub Sub focusCastella 'lleva el focus del element de l'altre idioma Dlg.getControl("ListBox2").selectItemPos(Dlg.getControl("ListBox2").getSelectedItemPos(),false) End Sub Sub focusValencia 'lleva el focus del element de l'altre idioma Dlg.getControl("ListBox1").selectItemPos(Dlg.getControl("ListBox1").getSelectedItemPos(),false) End Sub 'funcio que llegeig i processa el fitxer departamentos.txt Function LeerDepartamentos as Boolean DIM lCas as boolean Dim LineaActual As String Dim Msg As String Dim nLinea 'si els noms ja estan carregats sortim 'if UBound(mDatosV)<150 then ' exit sub 'endif ' Define el nombre del archivo On Error GoTo ErrorLeerDepartamentos NombreArchivo = ruta & "/departamentos.txt" ' Create the SimpleFileAccess service. oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") 'Create the Specialized stream. oTextStream = CreateUnoService("com.sun.star.io.TextInputStream") ' Abre el archivo (modo de lectura) NumArchivo = oSFA.openFileRead(ConvertToURL(NombreArchivo)) oTextStream.SetInputStream(NumArchivo) oTextStream.setEncoding("ISO-8859-15") ' Verifica cuando se ha alcanzado el final del archivo Do While not oTextStream.isEOF() ' Lee una línea i lleva els bots de carro per si estem en linux LineaActual=Replace(oTextStream.readline(),chr(10),"") If len(LineaActual)<>0 Then if LineaActual = "Castellano" then lCas = True nLinea=0 goto seguir endif if LineaActual = "Valenciano" then lCas = False nLinea=0 goto seguir endif posSep=InStr(LineaActual,";") elShort=DeleteStr(Left(LineaActual, posSep-1),"<br>") if lCas then mDatosC(nLinea)=LineaActual mDatosCShort(nLinea)=elShort endif if not LCas then mDatosV(nLinea)=LineaActual mDatosVShort(nLinea)=elShort endif nLinea=nLinea+1 endif Seguir: Loop 'redimensiona els arrays de dades per a que tinguen el tamnay utilitzat ReDim Preserve mDatosV(nLinea-1) ReDim Preserve mDatosC(nLinea-1) ReDim Preserve mDatosVShort(nLinea-1) ReDim Preserve mDatosCShort(nLinea-1) ' Cierra el archivo oTextStream.closeInput() GoTo FinErrorLeerDepartamentos ErrorLeerDepartamentos: LeerDepartamentos=False ' Informar sobre el error MsgBox "Problema llegint el fitxer de departaments, és possible que la macro estiga mal configurada o que el format del fitxer siga incorrecte.", MB_ICONEXCLAMATION, "Error" ' Terminar la ejecución de la macro End FinErrorLeerDepartamentos: ' Desactivar tratamiento de errores On Error GoTo 0 LeerDepartamentos=True End Function 'funcio aixiliar que extrau el tamany d'un objecte imatge Function RecommendGraphSize(oGraph) Dim oSize Dim lMaxW As Double ' Maximum width in 100th mm Dim lMaxH As Double ' Maximum height in 100th mm lMaxW = 6.75 * 2540 ' 6.75 inches lMaxH = 9.5 * 2540 ' 9.5 inches If IsNull(oGraph) OR IsEmpty(oGraph) Then Exit Function End If oSize = oGraph.Size100thMM If oSize.Height = 0 OR oSize.Width = 0 Then ' 2540 is 25.40 mm in an inch, but I need 100th mm. ' There are 1440 twips in an inch oSize.Height = oGraph.SizePixel.Height * 2540.0 * TwipsPerPixelY() / 1440 oSize.Width = oGraph.SizePixel.Width * 2540.0 * TwipsPerPixelX() / 1440 End If If oSize.Height = 0 OR oSize.Width = 0 Then 'oSize.Height = 2540 'oSize.Width = 2540 Exit Function End If If oSize.Width > lMaxW Then oSize.Height = oSize.Height * lMaxW / oSize.Width oSize.Width = lMaxW End If If oSize.Height > lMaxH Then oSize.Width = oSize.Width * lMaxH / oSize.Height oSize.Height = lMaxH End If RecommendGraphSize = oSize End Function 'funcio que incrusta una imatge en una ubicacio cursor dterminad d'un document Sub EmbedGraphic(oDoc, oCurs, sURL$, anclatge, horientacio) Dim oShape Dim oGraph 'The graphic object is text content. Dim oProvider 'GraphicProvider service. Dim oText Dim oProps(0) as new com.sun.star.beans.PropertyValue Dim oSize100thMM Dim lHeight As Long Dim lWidth As Long oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape") oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject") oProvider = createUnoService("com.sun.star.graphic.GraphicProvider") oProps(0).Name = "URL" oProps(0).Value = sURL REM Save the original size. oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps)) If NOT IsNull(oSize100thMM) AND NOT IsEmpty(oSize100thMM) Then lHeight = oSize100thMM.Height lWidth = oSize100thMM.Width End If oDoc.getDrawPage().add(oShape) oShape.Graphic = oProvider.queryGraphic(oProps()) oGraph.graphicurl = oShape.graphicurl if anclatge = "al_paragraf" then oGraph.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH if horientacio = com.sun.star.text.HoriOrientation.NONE then oGraph.setPropertyValue("HoriOrient", com.sun.star.text.HoriOrientation.NONE) oGraph.setPropertyValue("HoriOrientPosition", -800) else oGraph.setPropertyValue("HoriOrient", com.sun.star.text.HoriOrientation.RIGHT) end if else oGraph.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER end if oGraph.VertOrient=2 oText= oCurs.getText() oText.insertTextContent(oCurs, oGraph, false) oDoc.getDrawPage().remove(oShape) If lHeight > 0 AND lWidth > 0 Then Dim oSize oSize = oGraph.Size oSize.Height = lHeight oSize.Width = lWidth oGraph.Size = oSize End If ' Set the paragraph style if it is in the document. 'Dim oStyles 'oStyles = oDoc.StyleFamilies.getByName("ParagraphStyles") 'If oStyles.hasByName(sParStyle) Then ' oCurs.ParaStyleName = sParStyle 'End If End sub ' funcio que ens torna el tamany d'una imatge a partir de la seua url function GetGraphicSize(sURL$) Dim oSize as new com.sun.star.awt.Size REM Save the original size. Dim oSize100thMM Dim lHeight As Long Dim lWidth As Long Dim oProps(0) as new com.sun.star.beans.PropertyValue oProps(0).Name = "URL" oProps(0).Value = sURL oProvider = createUnoService("com.sun.star.graphic.GraphicProvider") oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps)) If NOT IsNull(oSize100thMM) AND NOT IsEmpty(oSize100thMM) Then lHeight = oSize100thMM.Height lWidth = oSize100thMM.Width End If If lHeight > 0 AND lWidth > 0 Then oSize.Height = lHeight oSize.Width = lWidth End If GetGraphicSize=oSize End function