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

Option Explicit

' ====== Customizable data ======

Const theLibrary = "Standard"

Const maxFields = 10   ' Increase if needed

' ====== End of Customizable data ======

' Registered field names and their dialog names.
Type FieldControl
  fName As String
  fDialogName As String
  fType As Integer
End Type

Dim FieldControls(1 To maxFields) As FieldControl
Dim iFieldIndex As Integer

' The dialog.
Dim oDlg As Object

' Important settings.
Dim keepMacros As Integer
Dim keepFields As Integer

' ====== Main Entry Point ======

' The OnLoad macro should be attached to the document trigger "Create Document".
' Use Tools > Customize > Events to attach it.
' This will cause the macro to be executed when a new document is created
' from the template.

Sub OnLoad
  DialogLibraries.LoadLibrary(theLibrary)
  iFieldIndex = 0

  ' ====== Customizable data ======

  ' keepMacros controls whether the macros and dialog are retained
  ' upon completion.
  keepMacros = 1   ' 1 = Set (Keep), 0 = Reset (Do not keep)

  ' keepFields controls whether ordinary fields are retained (as input
  ' fields), or removed (replaced with the actual contents).
  keepFields = 0   ' 1 = Set (Keep), 0 = Reset (Do not keep)

  ' Attach document properties to dialog fields.
  RegisterDocField("Title",    "DocTitle")
  RegisterDocField("Subject",  "DocSubject")
  RegisterDocField("Keywords", "DocKeywords")
  ' Field Comments doesn't work yet
  'RegisterDocField("Comments", "DocComments")

  ' Attach user info fields ("Info 1", "Info 2", "Info 3", and 
  ' "Info 4") to dialog fields.
  'RegisterInfoField(1, "DocInfo1")
  'RegisterInfoField(2, "DocInfo2")
  'RegisterInfoField(3, "DocInfo3")
  'RegisterInfoField(4, "DocInfo4")
  
  ' Attach ordinary user fields to dialog fields.
  'RegisterField("ufld01", "TextField1")
  'RegisterField("ufld02", "TextField2")
  
  ' ====== End of Customizable data ======
  
  ' Run the dialog.
  StartDialog()
End Sub

' ====== No Customizable data below this point ======

' ====== Dialog handling ======

Sub StartDialog
  ' Create dialog
  oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
  
  ' Center dialog on the screen
  CenterDialog(oDlg)

  ' Fill in current values
  FillDialogFields

  ' Execute dialog
  oDlg.execute()
  
  If keepMacros = 0 Then
    ' Remove the macros to make the resultant document harmless
    DialogLibraries.RemoveLibrary(theLibrary)
    BasicLibraries.RemoveLibrary(theLibrary)
  End If
  
  ' Dispose
  oDlg.dispose()

End Sub

Sub EndDialog
  oDlg.endExecute()
End Sub

Sub DialogOKPressed
  'Get new fields values from the dialog.
  FillFieldsFromDialog
    
  ' Update all fields.
  Thiscomponent.getTextFields().refresh()

  EndDialog()
End Sub

Sub DialogCancelPressed
  EndDialog()
End Sub

Sub CenterDialog(oDlog as Object)
  Dim CurPosSize As New com.sun.star.awt.Rectangle
  Dim FramePosSize, xWindowPeer
  Dim WindowHeight As Integer, WindowWidth As Integer
  Dim DialogHeight As Integer, DialogWidth As Integer
  Dim iXPos As Integer, iYPos As Integer
  
  ' Get dimensions of current frame.
  FramePosSize = ThisComponent.getCurrentController().Frame.getComponentWindow.PosSize
  WindowHeight = FramePosSize.Height
  WindowWidth = FramePosSize.Width

  ' Get dimensions of the dialog.
  xWindowPeer = oDlog.getPeer()
  CurPosSize = oDlog.getPosSize()
  DialogWidth = CurPosSize.Width
  DialogHeight = CurPosSize.Height
  
  ' Calculate new position.
  iXPos = ((WindowWidth/2) - (DialogWidth/2))
  iYPos = ((WindowHeight/2) - (DialogHeight/2))
  
  ' Update dialog properties.
  oDlog.setPosSize(iXPos, iYPos, DialogWidth, DialogHeight, com.sun.star.awt.PosSize.POS)
End Sub

' ====== Fields registration ======

Sub RegisterField(sF As String, sDF As String)
  RegisterFieldHelper(sF, sDF, 0)
End Sub

Sub RegisterDocField(sF As String, sDF As String)
  RegisterFieldHelper(sF, sDF, 1)
End Sub

Sub RegisterInfoField(xF As Integer, sDF As String)
  RegisterFieldHelper(xF, sDF, 2)
End Sub

Sub RegisterFieldHelper(sF As String, sDF As String, iT as Integer)
  iFieldIndex = iFieldIndex + 1
  If iFieldIndex = maxFields Then
    MsgBox "Too many fields, increase maxFields", 16, "Error"
    Exit Sub
  End If
  With FieldControls(iFieldIndex)
    .fName = sF
    .fDialogName = sDF
    .fType = iT
  End With
End Sub

' ====== Getting / setting values from the dialog ======

Sub FillDialogFields
  Dim docInfo
  docInfo = thisComponent.getDocumentInfo()
  
  Dim i As Integer
  For i = 1 To iFieldIndex
    With FieldControls(i)
      Select Case .fType
      Case 0:
        oDlg.getControl(.fDialogName).setText(GetDocumentVariable(.fName))
      Case 1:
        If .fName = "Title" Then
          oDlg.getControl(.fDialogName).setText(docInfo.Title)
        ElseIf .fName = "Subject" Then
          oDlg.getControl(.fDialogName).setText(docInfo.Theme)
        ElseIf .fName = "Keywords" Then
          oDlg.getControl(.fDialogName).setText(docInfo.Keywords)
        ElseIf .fName = "Comments" Then
          MsgBox("Cannot handle Comments yet", 48, "Warning")
        Else
          MsgBox("Unhandled document property: " + .fName, 16, "Error")
        End If
      Case 2:
        Dim ix As Integer
        ix = CInt(.fName)
        If ix > 0 AND ix <= docInfo.getUserFieldCount() Then
          oDlg.getControl(.fDialogName).setText(docInfo.getUserFieldValue(ix-1))
        Else
          MsgBox("Unhandled document property: Info " + .fName, 16, "Error")
        End If
      End Select
    End With
  Next i

  ' Attach these if present.
  On Error Goto NoKeepMacros
  oDlg.getControl("KeepMacros").State = keepMacros
NoKeepMacros:
  On Error Goto NoKeepFields
  oDlg.getControl("KeepFields").State = keepFields
NoKeepFields:
  On Error Goto 0
End Sub

Sub FillFieldsFromDialog

  On Error Goto NoKeepMacros
  keepMacros = oDlg.getControl("KeepMacros").State
NoKeepMacros:
  On Error Goto NoKeepFields
  keepFields = oDlg.getControl("KeepFields").State
NoKeepFields:
  On Error Goto 0

  Dim bErr As Boolean
  bErr = False
  Dim docInfo
  docInfo = thisComponent.getDocumentInfo()
  
  Dim i As Integer
  For i = 1 To iFieldIndex
    With FieldControls(i)
      Select Case .fType
      Case 0:
        If SetDocumentVariable(.fName, oDlg.getControl(.fDialogName).text) Then
          FinishField(FieldControls(i))
        Else
          bErr = True
        End If
      Case 1:
        If .fName = "Title" Then
          docInfo.Title = oDlg.getControl(.fDialogName).text
        ElseIf .fName = "Subject" Then
          docInfo.Theme = oDlg.getControl(.fDialogName).text
        ElseIf .fName = "Keywords" Then
          docInfo.Keywords = oDlg.getControl(.fDialogName).text
        ElseIf .fName = "Comments" Then
          MsgBox("Cannot handle Comments yet", 48, "Warning")
        Else
          MsgBox("Unhandled document property: " + .fName, 16, "Error")
        End If
      Case 2:
        Dim ix As Integer
        ix = CInt(.fName)
        If ix > 0 AND ix <= docInfo.getUserFieldCount() Then
          docInfo.setUserFieldValue(ix-1, oDlg.getControl(.fDialogName).text)
        Else
          MsgBox("Unhandled document property: Info " + .fName, 16, "Error")
        End If
      End Select
    End With
  Next i
  If bErr Then
    MsgBox("Not all fields were handled", 16, "Error")
  End if
End Sub

' ====== Maintenance of user fields ======

Function SetDocumentVariable(ByVal strVarName As String, ByVal aValue As String) As Boolean 
  Dim bFound As Boolean
  Dim sName As String
  Dim sService As String
  Dim oActiveDocument
  Dim oTextMaster
  Dim xMaster

  On Error GoTo ErrorHandler 
  oActiveDocument = thisComponent 
  oTextmaster = oActiveDocument.getTextFieldMasters() 
  sService = "com.sun.star.text.FieldMaster.User" 
  sName = sService + "." + strVarName 
  bFound = oTextMaster.hasbyname(sName)  ' check if variable exists 
  if bFound Then
    xMaster = oTextMaster.getByName(sName) 
    'xMaster.Value = aValue    ' Numeric
    xMaster.Content = aValue   ' String
  Else        ' Document variable doesn't exist yet 
    xMaster = oActiveDocument.createInstance(sService)
    xMaster.Name = strVarName 
    xMaster.Content = aValue 
  End If 
  SetDocumentVariable = True      'Success 
  Exit Function 

ErrorHandler: 
  SetDocumentVariable = False 
End Function 

Function GetDocumentVariable(strVarName As String) As String
  Dim bFound As Boolean
  Dim sName As String
  Dim sService As String
  Dim oActiveDocument
  Dim oTextMaster
  Dim xMaster

  oActiveDocument = thisComponent 
  oTextmaster = oActiveDocument.getTextFieldMasters() 
  sService = "com.sun.star.text.FieldMaster.User" 
  sName = sService + "." + strVarName 
  bFound = oTextMaster.hasbyname(sName)  ' check if variable exists 
  if bFound Then 
    xMaster = oTextMaster.getByName(sName)          
    GetDocumentVariable = xMaster.Content 
  End If 
End Function

Sub FinishField(fCtl As FieldControl)
  Dim fName As String
  fName = fCtl.fName
  
  ' Get Text Field Masters.
  Dim xMasters
  xMasters = thisComponent.getTextFieldMasters()

  ' DO we have the requested field?
  If xMasters.hasByName("com.sun.star.text.FieldMaster.User." + fName) Then
    Dim xMaster, inpFields, inpField, i As Integer
    xMaster = xMasters.getByName("com.sun.star.text.FieldMaster.User." + fName)
    ' Get all dependent text fields, and iterate.
    inpFields = xMaster.DependentTextFields
    For i = LBound(inpFields) To UBound(inpFields)
      inpField = inpFields(i)
      ' Is it a "show only" variable field?
      If inpField.supportsService("com.sun.star.text.TextField.User") Then
        ' Get the value
        Dim sValue As String
        sValue = inpField.getPresentation(False)
        ' Get the location.
        Dim xAnchor
        xAnchor = inpField.getAnchor()
        ' Replace the field by its content.
        If keepFields = 0 Then
          ' And replace.
          thisComponent.Text.insertString(xAnchor, sValue, True)
          ' At this point we can get rid of the field
          inpField.dispose()
        Else
          ' Replace it with a new input field.
          Dim newField
          newField = thisComponent.createInstance("com.sun.star.text.TextField.InputUser")
          newField.Hint = oDlg.getControl(fCtl.fDialogNames).Model.HelpText
          newField.Content = fName
          thisComponent.Text.insertTextContent(xAnchor, newField, True)
        End If
      End If
    Next i
  End If
End Sub

Sub ReplaceAllFields()
  Dim xFields, xMaster, inpFieldEnum

  ' Get Text Fields, and iterate.
  xFields = thisComponent.getTextFields()
  inpFieldEnum = xFields.createEnumeration()
  While inpFieldEnum.hasMoreElements()
    Dim inpField, xAnchor, sValue As String
    inpField = inpFieldEnum.nextElement()
    If inpField.supportsService("com.sun.star.text.TextField.User") Then
      xMaster = inpField.getTextFieldMaster()
      ' Get the value
      sValue = inpField.getPresentation(False)
      ' Get the location.
      xAnchor = inpField.getAnchor()
      ' And replace.
      thisComponent.Text.insertString(xAnchor, sValue, True)
      ' At this point we can get rid of the field
      inpField.dispose()
    End If

  Wend
End Sub

' ====== Bonus: For entertainment (and debugging) ======

Sub ShowInputFields
  Dim NL As String
  NL = chr$(13)

  Dim xFields, xMasters, xMaster

  ' Get Text Fields and Masters.
  xFields = thisComponent.getTextFields()
  xMasters = thisComponent.getTextFieldMasters()

  ' Enumerate fields.
  Dim inpFieldEnum
  inpFieldEnum = xFields.createEnumeration()
  While inpFieldEnum.hasMoreElements()
    Dim inpField
    inpField = inpFieldEnum.nextElement()
    Dim fName As String
    Dim msg As String
    Dim sValue As String
    
    ' services = inpField.getSupportedServiceNames()

    ' InputUser fields have an Input dialog, and a variable associated.
    If inpField.supportsService("com.sun.star.text.TextField.InputUser") Then
      fName = inpField.Content
      msg = "Input Field: " + fName + NL + "Hint: " + inpField.Hint
      ' Hmm. xMaster is a TextMaster, but not with complete info?
      'xMaster = inpField.getTextFieldMaster()
      'If Not isNull(xMaster) Then
      '  msg = msg + NL + "Master: " + xMaster.dbg_properties
      'End If
      If xMasters.hasByName("com.sun.star.text.FieldMaster.User." & fName) Then
        xMaster = xMasters.getByName("com.sun.star.text.FieldMaster.User." & fName)
        'msg = msg + NL + "Master: " + xMaster.dbg_properties
        msg = msg + NL + "Value: " + xMaster.Content
      EndIf
      MsgBox msg, 0, "Input Field: " + fName
    End If

    ' Input fields have an Input dialog, but no variable associated.
    If inpField.supportsService("com.sun.star.text.TextField.Input") Then
      msg = "InputUser Field: <NoName>" + NL + "Hint: " + inpField.Hint + NL + "Value: " + inpField.Content
      MsgBox msg, 0, "InputUser Field"
    End If

    ' User fields have no dialog, only a variable associated.
    If inpField.supportsService("com.sun.star.text.TextField.User") Then
      'On Error Goto UErr
      xMaster = inpField.getTextFieldMaster()
      fName = xMaster.Name
      sValue = inpField.getPresentation(False)
      msg = "User Field: " + fName + NL + "Value: " + sValue
      MsgBox msg, 0, "User Field: " + fName
      If False Then
      UErr:
        MsgBox "User Field: <ERROR>", 0, "User Field"
      End If
    End If
    If False Then
      Dim xAnchor
      xAnchor = inpField.getAnchor()
      inpField.dispose()
      inpField = thisComponent.createInstance("com.sun.star.text.TextField.InputUser")
      inpField.Hint = "Hello!"
      inpField.Content = sValue
      'inpField.attachTextFieldMaster(xMaster)
      inpField.attach(xAnchor)
    End If

  Wend
End Sub

' Copyright 2004 Squirrel Consultancy. All rights reserved.
' This work is licensed under a Creative Commons Attribution-ShareAlike License.
' Parts of this software is derived from freely available sources
' on the internet, in particular Andrew Pitonyak's book "Useful
' Macro Information For OpenOffice".

' $Id: InitialDialog.bas,v 1.2 2004/08/02 18:27:32 jv Exp $