Chip 2003 May/CHIPCD200305.iso/super/openofficecn/f_0110/Greeting.xba

Extensible Markup Language | 2001-06-08 | 8.1 KB | 241 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Greeting" script:language="StarBasic">REM  *****  BASIC  *****
' Todo: Identifizieren der Standardseitenvorlage über ihren programmatic Name
' Todo: Fertigstellen-Button muss disabled werden, wenn noch keine Grafik ausgewählt
'         ist und die Checkbox 'ChkPictureFirstPage' gewählt ist.
' Todo: Unter Umständen braucht die Tools Bibliothek nicht geladen werden
Dim oDocument as Object
Dim oDocText as Object
Dim oGraphic as Object
Dim oBookmarks as Object
Dim GalleryDir as String
Dim oTextShape as Object
Dim Greetingmode as Integer
Public Occasions(4,11,1) as String


Public Const SBEXTRAVAGANT = 0
Public Const SBCARDFOLD = 1
Public Const SBDUPLEX = 2


Sub StartExtravagantMacro()
    GreetingMode = SBEXTRAVAGANT
    DlgGreeting.Load
    DlgGreeting.OptRight.Enabled = False
    DlgGreeting.OptLeft.Value = True
    ShowGreetingDialog()
End Sub


Sub StartDuplexMacro()
    GreetingMode = SBDUPLEX
    DlgGreeting.Load
    DlgGreeting.OptRight.Value = True
    ShowGreetingDialog
End Sub


Sub StartCardFoldMacro()
    GreetingMode = SBCARDFOLD
    DlgGreeting.Load
    DlgGreeting.OptRight.Value = True
    ShowGreetingDialog
End Sub



Sub LoadLanguage()
    With DlgGreeting
        .FrmFirstPage.Caption = "Erste Seite"
        .ChkPictureFirstPage.Caption = "Bild auf 1. Seite"
        .ChkTextFirstPage.Caption = "Text auf 1. Seite"
        .TxtFirstPage.Text = "Alles Gute zum Thema"
        .CmdOwnPicture.Caption = "Bild wählen"
        .LblPictureFile.Caption = "<kein Bild gewählt>"

        .FrmInside.Caption = "Innenseite"
        .TxtInside.Text = "Alles Gute zum Thema"
        .OptLeft.Caption = "&Linke Innenseite"
        .OptRight.Caption = "&Rechte Innenseite"
        .OptNoText.Caption = "Kein &Text"

        .CmdCancel.Caption = "&Abbrechen"
        .CmdOk.Caption = "&Fertig stellen"
        .Caption = "Grußkarten-Assistent"
    End With
End Sub

Sub ShowGreetingDialog()
    LoadLanguage()
'  BasicLibraries.LoadLibrary("Tools")
    oDocument = StarDesktop.CurrentFrame.Controller.Model
    oDocText = oDocument.Text
    oBookmarks = oDocument.BookMarks

    oTextShape = oDocument.CreateInstance("com.sun.star.drawing.TextShape")
    oGraphic = oDocument.CreateInstance("com.sun.star.text.Graphic")
    GalleryDir = GetPathSettings("Gallery", False, 0)
    GalleryDir = ConvertToURL(GalleryDir)
    DlgGreeting.ChkPictureFirstPage.Value = True
    DlgGreeting.ChkTextFirstPage.Value = True
    DlgGreeting.Show
End Sub


Sub CloseDialog
    DlgGreeting.Unload
End Sub


Sub DisOrEnablePictureControls()
    DlgGreeting.CmdOwnPicture.Enabled = DlgGreeting.ChkPictureFirstPage.Value
    DlgGreeting.LblPictureFile.Enabled = DlgGreeting.ChkPictureFirstPage.Value
    DlgGreeting.TxtFirstPage.Enabled = DlgGreeting.ChkTextFirstPage.Value
End Sub


Sub DisOrEnableTextBox()
    DlgGreeting.TxtInside.Enabled = Not DlgGreeting.OptNoText.Value
End Sub


Sub EnableControls(bEnabled as Boolean)
    With DlgGreeting
        .FrmFirstPage.Enabled = bEnabled
        .ChkPictureFirstPage.Enabled = bEnabled
        .ChkTextFirstPage.Enabled = bEnabled
        .CmdOwnPicture.Enabled = bEnabled
        .LblPictureFile.Enabled = bEnabled
        .FrmInside.Enabled = bEnabled
        .TxtInside.Enabled = bEnabled
        .OptLeft.Enabled = bEnabled
        .OptRight.Enabled = bEnabled
        .OptNoText.Enabled = bEnabled
        .CmdOk.Enabled = bEnabled
    End With
End Sub


Sub InsertGreetingObjects()
Dim oStandardPageStyle as Object
Dim oPageStyles as Object
Dim oFrame as Object
Dim oCursor as Object
Dim WmfUrl as String
Dim aPoint As New com.sun.star.awt.Point
Dim aSize As New com.sun.star.awt.Size
Dim oBookmark as Object

'    oDocument.LockControllers
    WmfUrl = GalleryDir & "/clipart/car.wmf"
    EnableControls(False)
    oBookMark = oBookmarks.GetbyName("TitlePage")
    oCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
    oCursor.GoRight(1,True)
    oGraphic.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
'    oGraphic.Backtransparent = False
    oGraphic.GraphicURL = WmfUrl
    Select Case GreetingMode
        Case SBDUPLEX
            ' Zweiseitig, einfach gefaltet
            ' Spiegele die Grafik
            ' Der Text wird in eine Zeile unter der Grafik geschrieben.
            oCursor.Text.InsertTextContent(oCursor,oGraphic,True)
        Case SBCARDFOLD
            oFrame = oDocument.TextFrames.GetByName("Picture and Title")
            oCursor.Text.InsertTextContent(oCursor,oTextShape,True)
            AdjustTextShape(oFrame)
            oTextShape.SetString(DlgGreeting.TxtFirstPage.Text)
            oCursor.CollapseToEnd()
            oCursor.Text.InsertTextContent(oCursor,oGraphic,False)

            oGraphic.VertMirrored = True
            oTextShape.RotateAngle = 18000
            ' Die Breite muss so groß sein, dass die Textshape oberhalb der Grafik steht.

        Case SBSBEXTRAVAGANT
            oFrame = oDocument.TextFrames.GetByName("Picture")
            oCursor.Text.InsertTextContent(oCursor,oGraphic,True)
            ChangeSizeofGraphic(oFrame, oGraphic)
            If DlgGreeting.ChkTextFirstPage.Value Then
                ' Insert Text in the frame "Title"
                oFrame = oDocument.TextFrames.GetByName("Title")
                oCursor = oFrame.CreateTextCursor
                oCursor.SetString(DlgGreeting.TxtFirstPage.Text)
            End If
    End Select

    If Not DlgGreeting.OptNoText.Value Then
        If DlgGreeting.OptLeft.Value Then
            InsertTextToPlaceholder("LeftPage", DlgGreeting.TxtInside.Text)
            InsertTextToPlaceholder("RightPage", "")
        ElseIf DlgGreeting.OptRight.Value Then
            InsertTextToPlaceholder("LeftPage", "")
            InsertTextToPlaceholder("RightPage", DlgGreeting.TxtInside.Text)
        End If
    End If
    DlgGreeting.Unload
'    oDocument.UnlockControllers
End Sub


Sub InsertTextToPlaceHolder(sPosition as String, sCaption as String)
Dim oBookMark as Object
Dim oBookmarkCursor as Object
    oBookMark = oBookmarks.GetbyName(sPosition)
    oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
    oBookMarkCursor.GoRight(1,True)
    oBookMarkCursor.SetString(sCaption)
End Sub


Sub ChangeSizeofGraphic(oFrame as Object, oGraphic as Object)
Dim NewGraphWidth as Long
Dim NewGraphHeight as Long
Dim OldGraphWidth as Long
Dim OldGraphHeight as Long
Dim PageWidth as Long
Dim RightPageBorder as Long
Dim TopPageBorder as Long
Dim aSize As New com.sun.star.awt.Size

    OldGraphWidth = oGraphic.Size.Width
    OldGraphHeight = oGraphic.Size.Height
    PageWidth = GetPageWidth()
    RightPageBorder = PageWidth - oFrame.HoriOrientPosition - oFrame.Size.Width
    TopPageBorder = oFrame.VertOrientPosition
    NewGraphWidth = CInt(((PageWidth/2 - TopPageBorder - RightPageBorder) * OldGraphWidth) /( OldGraphWidth + OldGraphHeight))
    NewGraphHeight = CInt(((PageWidth/2 - TopPageBorder - RightPageBorder) * OldGraphHeight) /( OldGraphWidth + OldGraphHeight))
    aSize.Width = NewGraphWidth
    aSize.Height = NewGraphHeight
    oGraphic.Size = aSize
End Sub


Function GetPageWidth()
Dim oPageStyles as Object
Dim oPageStyle as Object
    oPageStyles = oDocument.StyleFamilies.GetbyName("PageStyles")
' Todo: Call template by Programmatic name
    oPageStyle = oPageStyles.GetByName("Standard")
    GetPageWidth = oPageStyle.Size.Width
End Function


Sub ChooseGreetingGraphic()
    ' Todo: attach Call of Dialog
    Msgbox("Jetzt soll eine Grafik ausgewählt und die Caption des Controls" & chr(13) & _
            "'LblPictureFile' entsprechend aktualisiert werden", 16, "StarOffice 6.0")
End Sub


Sub AdjustTextShape(oFrame as Object)
Dim aSize As New com.sun.star.awt.Size
Dim FrameWidth as Long
    oTextShape.TextAutoGrowWidth = True
    oTextShape.TextMaximumFrameWidth = oFrame.Size.Width
    oTextShape.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
End Sub
</script:module>