find here macros which open two dialogs in sequence to enter columns descriptions into split HSQL-DB's, others not testet.
For that start the macro "S_Create_Dialog_Table_Selection".
Code: Select all
global odlgTables
global oTables
Sub S_Create_Dialog_Table_Selection
Dim oWindow As Object
Dim oMod As Object
Dim i As Integer
oController = thisDatabasedocument.currentcontroller
if not oController.isconnected then oController.connect
oConnection = oController.activeConnection
oTables = oConnection.Tables
nTables = Ubound(oTables.ElementNames) + 1
ndlgHeight = 12*(nTables) + 20
REM ***** Initialisierung der Eigenschaften des Dialogs
odlgTablesModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
With odlgTablesModel
.setPropertyValue("PositionX", 320)
.setPropertyValue("PositionY", 111 )
'.setPropertyValue("FontName", Font)
.setPropertyValue("Width", 120)
.setPropertyValue("Height", ndlgHeight+3)
.setPropertyValue("Title", "SelectTable")
.setPropertyValue("Name", "DLGSelectTable")
'.setPropertyValue("DesktopAsParent", True )
End With
odlgTables = CreateUnoService("com.sun.star.awt.UnoControlDialog")
REM ********** Schaltflaechen erzeugen
for i = 0 to Ubound(oTables.ElementNames)
oMod = odlgTablesModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", oTables.ElementNames(i))
.setPropertyValue("Name", "CmdTable"+i)
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", 12*(i+1))
.setPropertyValue("Height", 12)
.setPropertyValue("Width", 100)
'.setPropertyValue("Tag", s_buttons(3,i))
.setPropertyValue("FontHeight",9)
.setPropertyValue("FocusOnClick",false)
.setPropertyValue("Tabstop",true)
End With
odlgTablesModel.insertByName("CmdTable"+i, oMod)
next i
odlgTables.setModel(odlgTablesModel)
REM ********** ActionListener erzeugen und Schaltflaechen zuordnen
ocmd_ActionListener = createUnoListener("cmd_ActionListener_", "com.sun.star.awt.XActionListener")
for i = 0 to Ubound(oTables.ElementNames)
oControl = odlgTables.getControl("CmdTable"+i)
oControl.model.Align = 0
oControl.addActionListener(ocmd_ActionListener)
next i
REM ********** Mittels des Modells den Dialog anzeigen
oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
odlgTables.createPeer(oWindow, null)
Dim oWindowsListener as Object
oTopWindowsListener = CreateUnoListener( "Top_Win_", "com.sun.star.awt.XTopWindowListener" )
odlgTables.addTopWindowListener(oTopWindowsListener)
odlgTables.setVisible(True)
End Sub
sub Set_columns_Description(sTableName)
Dim oWindow As Object
Dim oMod As Object
Dim i As Integer
oTable = oTables.getbyName(sTableName)
nColumns = Ubound(oTable.Columns.ElementNames) + 1
nTextFieldHeight = 104
ndlgHeight = 14*(nColumns+4)
REM ***** Initialisierung der Eigenschaften des Dialogs
odlgColumnsModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
With odlgColumnsModel
.setPropertyValue("PositionX", 320)
.setPropertyValue("PositionY", 111 )
'.setPropertyValue("FontName", Font)
.setPropertyValue("Width", 400)
.setPropertyValue("Height", ndlgHeight)
.setPropertyValue("Title", "enter Columns Descriptions")
.setPropertyValue("Name", "DLGDescriptions")
'.setPropertyValue("DesktopAsParent", True )
End With
odlgColumns = CreateUnoService("com.sun.star.awt.UnoControlDialog")
REM ********** Schaltflaechen erzeugen
for i = 0 to Ubound(oTable.Columns.ElementNames)
REM ********** Textlabel erzeugen
oMod = odlgColumnsModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", oTable.Columns.ElementNames(i))
.setPropertyValue("Name", "lblColumn"+i)
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", 14*(i+1))
.setPropertyValue("FontHeight",9)
.setPropertyValue("Height",12)
.setPropertyValue("Width", 60)
End With
odlgColumnsModel.insertByName("lblColumn"+i, oMod)
REM ********** Textfeld erzeugen
oMod = odlgColumnsModel.createInstance("com.sun.star.awt.UnoControlEditModel")
With oMod
.setPropertyValue("Name", "txtColumnDescription"+i)
.setPropertyValue("PositionX", 80)
.setPropertyValue("PositionY", 14*(i+1))
.setPropertyValue("Height",12)
.setPropertyValue("Width", 310)
.setPropertyValue("Border",2)
.setPropertyValue("VerticalAlign",0)' com.sun.star.style.VerticalAlignment
.setPropertyValue("MultiLine",TRUE)
.setPropertyValue("FontHeight",10)
.setPropertyValue("FontName","Courier New")
.setPropertyValue("Text",oTable.Columns(i).HelpText)
End With
odlgColumnsModel.insertByName("txtColumnDescription"+i, oMod)
next i
oMod = odlgColumnsModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", "OK")
.setPropertyValue("Name", "CmdOK")
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", 14*(i+2))
.setPropertyValue("Height", 12)
.setPropertyValue("Width", 380)
'.setPropertyValue("Tag", s_buttons(3,i))
.setPropertyValue("FontHeight",9)
.setPropertyValue("FocusOnClick",false)
.setPropertyValue("Tabstop",true)
.setPropertyValue("PushButtonType",com.sun.star.awt.PushButtonType.OK)
End With
odlgColumnsModel.insertByName("CmdColumn"+i, oMod)
odlgColumns.setModel(odlgColumnsModel)
REM ********** Mittels des Modells den Dialog anzeigen
oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
odlgColumns.createPeer(oWindow, null)
Dim oWindowsListener as Object
oTopWindowsListener = CreateUnoListener( "Top_Win_", "com.sun.star.awt.XTopWindowListener" )
odlgColumns.addTopWindowListener(oTopWindowsListener)
odlgColumns.setVisible(True)
if odlgColumns.execute = 1 then
for i = 0 to Ubound(oTable.Columns.ElementNames)
oTable.Columns(i).HelpText = odlgColumns.GetControl("txtColumnDescription"+i).Text
next i
endif
Thisdatabasedocument.store
msgbox ("Done, Columns descriptions where registered in Table """ & oTable.name &""" ✔ " & chr(13) & "The .odb file was saved!",64,"Descriptions were registered")
end sub
Sub cmd_ActionListener_actionPerformed(oEv)
odlgTables.setVisible(False)
Set_columns_Description(oEv.Source.model.Label)
end sub
Sub cmd_ActionListener_disposing(oEv)
End Sub
'Diese Routinen werden von dem XTopWindowListener benötigt
Sub Top_Win_windowClosing( oEvent ) 'Dialog schließen
oEvent.source.setVisible(False)
'odlgTables.dispose
End Sub
Sub Top_Win_disposing( )
End Sub
Sub Top_Win_windowOpened ( oEvent )
End sub
Sub Top_Win_windowClosed ( oEvent )
End sub
Sub Top_Win_windowMinimized ( oEvent )
End sub
Sub Top_Win_windowNormalized ( oEvent )
End sub
Sub Top_Win_windowActivated ( oEvent )
Top_Win_windowDeactivated = false
End sub
function Top_Win_windowDeactivated ( oEvent ) as boolean
Top_Win_windowDeactivated = true
End function