home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 2003 August
/
VPR0308.ISO
/
OPENOFFICE
/
install
/
f_0114
/
Greeting.xba
< prev
next >
Wrap
Extensible Markup Language
|
2001-06-08
|
8KB
|
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>