update
This commit is contained in:
Jane
@@ -0,0 +1,347 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DBMeta" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
|
||||
Public iCommandTypes() as Integer
|
||||
Public CurCommandType as Integer
|
||||
Public oDataSource as Object
|
||||
Public bEnableBinaryOptionGroup as Boolean
|
||||
'Public bSelectContent as Boolean
|
||||
|
||||
|
||||
Function GetDatabaseNames(baddFirstListItem as Boolean)
|
||||
Dim sDatabaseList()
|
||||
If oDBContext.HasElements Then
|
||||
Dim LocDBList() as String
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
LocDBList = oDBContext.ElementNames()
|
||||
MaxIndex = Ubound(LocDBList())
|
||||
If baddfirstListItem Then
|
||||
ReDim Preserve sDatabaseList(MaxIndex + 1)
|
||||
sDatabaseList(0) = sSelectDatasource
|
||||
a = 1
|
||||
Else
|
||||
ReDim Preserve sDatabaseList(MaxIndex)
|
||||
a = 0
|
||||
End If
|
||||
For i = 0 To MaxIndex
|
||||
sDatabaseList(a) = oDBContext.ElementNames(i)
|
||||
a = a + 1
|
||||
Next i
|
||||
End If
|
||||
GetDatabaseNames() = sDatabaseList()
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetSelectedDBMetaData(sDBName as String)
|
||||
Dim OldsDBname as String
|
||||
Dim DBIndex as Integer
|
||||
Dim LocList() as String
|
||||
' If bStartUp Then
|
||||
' bStartUp = false
|
||||
' Exit Sub
|
||||
' End Sub
|
||||
ToggleDatabasePage(False)
|
||||
With DialogModel
|
||||
If GetConnection(sDBName) Then
|
||||
If GetDBMetaData() Then
|
||||
LocList() = AddListToList(Array(sSelectDBTable), TableNames())
|
||||
.lstTables.StringItemList() = AddListToList(LocList(), QueryNames())
|
||||
' bSelectContent = True
|
||||
.lstTables.SelectedItems() = Array(0)
|
||||
iCommandTypes() = CreateCommandTypeList()
|
||||
EmptyFieldsListboxes()
|
||||
End If
|
||||
End If
|
||||
bEnableBinaryOptionGroup = False
|
||||
.lstTables.Enabled = True
|
||||
.lblTables.Enabled = True
|
||||
' Else
|
||||
' DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
|
||||
' EmptyFieldsListboxes()
|
||||
' End If
|
||||
ToggleDatabasePage(True)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetConnection(sDBName as String)
|
||||
Dim oInteractionHandler as Object
|
||||
Dim bExitLoop as Boolean
|
||||
Dim bGetConnection as Boolean
|
||||
Dim iMsg as Integer
|
||||
Dim Nulllist()
|
||||
If Not IsNull(oDBConnection) Then
|
||||
oDBConnection.Dispose()
|
||||
End If
|
||||
oDataSource = oDBContext.GetByName(sDBName)
|
||||
' If Not oDBContext.hasbyName(sDBName) Then
|
||||
' GetConnection() = False
|
||||
' Exit Function
|
||||
' End If
|
||||
If Not oDataSource.IsPasswordRequired Then
|
||||
oDBConnection = oDBContext.GetByName(sDBName).GetConnection("","")
|
||||
GetConnection() = True
|
||||
Else
|
||||
oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler")
|
||||
oDataSource = oDBContext.GetByName(sDBName)
|
||||
On Local Error Goto NOCONNECTION
|
||||
Do
|
||||
bExitLoop = True
|
||||
oDBConnection = oDataSource.ConnectWithCompletion(oInteractionHandler)
|
||||
NOCONNECTION:
|
||||
bGetConnection = Err = 0
|
||||
If bGetConnection Then
|
||||
bGetConnection = Not IsNull(oDBConnection)
|
||||
If Not bGetConnection Then
|
||||
Exit Do
|
||||
End If
|
||||
End If
|
||||
If Not bGetConnection Then
|
||||
iMsg = Msgbox (sMsgNoConnection,32 + 2, sMsgWizardName)
|
||||
bExitLoop = iMsg = SBCANCEL
|
||||
Resume CLERROR
|
||||
CLERROR:
|
||||
End If
|
||||
Loop Until bExitLoop
|
||||
On Local Error Goto 0
|
||||
If Not bGetConnection Then
|
||||
DialogModel.lstTables.StringItemList() = Array(sSelectDBTable)
|
||||
DialogModel.lstFields.StringItemList() = NullList()
|
||||
DialogModel.lstSelFields.StringItemList() = NullList()
|
||||
End If
|
||||
GetConnection() = bGetConnection
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function GetDBMetaData()
|
||||
If oDBContext.HasElements Then
|
||||
Tablenames() = oDBConnection.Tables.ElementNames()
|
||||
Querynames() = oDBConnection.Queries.ElementNames()
|
||||
GetDBMetaData = True
|
||||
Else
|
||||
MsgBox(sMsgErrNoDatabase, 64, sMsgWizardName)
|
||||
GetDBMetaData = False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetTableMetaData()
|
||||
Dim iType as Long
|
||||
Dim m as Integer
|
||||
Dim Found as Boolean
|
||||
Dim i as Integer
|
||||
Dim sFieldName as String
|
||||
Dim n as Integer
|
||||
Dim WidthIndex as Integer
|
||||
Dim oField as Object
|
||||
MaxIndex = Ubound(DialogModel.lstSelFields.StringItemList())
|
||||
Dim ColumnMap(MaxIndex)as Integer
|
||||
FieldNames() = DialogModel.lstSelFields.StringItemList()
|
||||
' Build a structure which maps the position of a selected field (within the selection) to the column position within
|
||||
' the table. So we ensure that the controls are placed in the same order the according fields are selected.
|
||||
For i = 0 To Ubound(FieldNames())
|
||||
sFieldName = FieldNames(i)
|
||||
Found = False
|
||||
n = 0
|
||||
While (n< MaxIndex And (Not Found))
|
||||
If (FieldNames(n) = sFieldName) Then
|
||||
Found = True
|
||||
ColumnMap(n) = i
|
||||
End If
|
||||
n = n + 1
|
||||
Wend
|
||||
Next i
|
||||
For n = 0 to MaxIndex
|
||||
sFieldname = FieldNames(n)
|
||||
oField = oColumns.GetByName(sFieldName)
|
||||
iType = oField.Type
|
||||
FieldMetaValues(n,0) = oField.Type
|
||||
FieldMetaValues(n,1) = AssignFieldLength(oField.Precision)
|
||||
FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),1, WidthIndex)
|
||||
FieldMetaValues(n,3) = WidthList(WidthIndex,3)
|
||||
FieldMetaValues(n,4) = oField.FormatKey
|
||||
FieldMetaValues(n,5) = oField.DefaultValue
|
||||
FieldMetaValues(n,6) = oField.IsCurrency
|
||||
FieldMetaValues(n,7) = oField.Scale
|
||||
' If oField.Description <> "" Then
|
||||
'' Todo: What's wrong with this line?
|
||||
' Msgbox oField.Helptext
|
||||
' End If
|
||||
FieldMetaValues(n,8) = oField.Description
|
||||
Next
|
||||
ReDim oDBShapeList(MaxIndex) as Object
|
||||
ReDim oTCShapeList(MaxIndex) as Object
|
||||
ReDim oDBModelList(MaxIndex) as Object
|
||||
ReDim oGroupShapeList(MaxIndex) as Object
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetSpecificFieldNames() as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim s as Integer
|
||||
Dim iType as Integer
|
||||
Dim oField as Object
|
||||
Dim MaxIndex as Integer
|
||||
Dim EmptyList()
|
||||
If Ubound(DialogModel.lstTables.StringItemList()) > -1 Then
|
||||
FieldNames() = oColumns.GetElementNames()
|
||||
MaxIndex = Ubound(FieldNames())
|
||||
If MaxIndex <> -1 Then
|
||||
Dim ResultFieldNames(MaxIndex)
|
||||
ReDim ImgFieldNames(MaxIndex)
|
||||
m = 0
|
||||
For n = 0 To MaxIndex
|
||||
oField = oColumns.GetByName(FieldNames(n))
|
||||
iType = oField.Type
|
||||
If GetIndexInMultiArray(WidthList(), iType, 0) <> -1 Then
|
||||
ResultFieldNames(m) = FieldNames(n)
|
||||
m = m + 1
|
||||
End If
|
||||
If GetIndexInMultiArray(ImgWidthList(), iType, 0) <> -1 Then
|
||||
ImgFieldNames(s) = FieldNames(n)
|
||||
s = s + 1
|
||||
End If
|
||||
Next n
|
||||
If s <> 0 Then
|
||||
Redim Preserve ImgFieldNames(s-1)
|
||||
bEnableBinaryOptionGroup = True
|
||||
Else
|
||||
bEnableBinaryOptionGroup = False
|
||||
End If
|
||||
If (DialogModel.optBinariesasGraphics.State = 1) And (s <> 0) Then
|
||||
ResultFieldNames() = AddListToList(ResultFieldNames(), ImgFieldNames())
|
||||
Else
|
||||
Redim Preserve ResultFieldNames(m-1)
|
||||
End If
|
||||
FieldNames() = ResultFieldNames()
|
||||
DialogModel.lstFields.StringItemList = FieldNames()
|
||||
InitializeListboxProcedures(DialogModel, DialogModel.lstFields, DialogModel.lstSelFields)
|
||||
End If
|
||||
GetSpecificFieldNames = MaxIndex
|
||||
Else
|
||||
GetSpecificFieldNames = -1
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub CreateDBForm()
|
||||
If oDrawPage.Forms.Count = 0 Then
|
||||
oDBForm = oDocument.CreateInstance("com.sun.star.form.component.Form")
|
||||
oDrawpage.Forms.InsertByIndex (0, oDBForm)
|
||||
Else
|
||||
oDBForm = oDrawPage.Forms.GetByIndex(0)
|
||||
End If
|
||||
oDBForm.Name = "Standard"
|
||||
oDBForm.DataSourceName = sDBName
|
||||
oDBForm.Command = TableName
|
||||
oDBForm.CommandType = CurCommandType
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddOrRemoveBinaryFieldsToWidthList()
|
||||
Dim LocWidthList()
|
||||
Dim MaxIndex as Integer
|
||||
Dim OldMaxIndex as Integer
|
||||
Dim s as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
If DialogModel.optBinariesasGraphics.State = 1 Then
|
||||
OldMaxIndex = Ubound(WidthList(),1)
|
||||
If OldMaxIndex = 15 Then
|
||||
MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1
|
||||
ReDim Preserve WidthList(MaxIndex,4)
|
||||
s = 0
|
||||
For n = OldMaxIndex + 1 To MaxIndex
|
||||
For m = 0 To 3
|
||||
WidthList(n,m) = ImgWidthList(s,m)
|
||||
Next m
|
||||
s = s + 1
|
||||
Next n
|
||||
MergeList(DialogModel.lstFields, ImgFieldNames())
|
||||
End If
|
||||
Else
|
||||
ReDim Preserve WidthList(15, 4)
|
||||
RemoveListItems(DialogModel.lstFields(), DialogModel.lstSelFields(), ImgFieldNames())
|
||||
End If
|
||||
DialogModel.lstSelFields.Tag = True
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function CreateCommandTypeList()
|
||||
Dim MaxTableIndex as Integer
|
||||
Dim MaxQueryIndex as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
MaxTableIndex = Ubound(TableNames())
|
||||
MaxQueryIndex = Ubound(QueryNames())
|
||||
MaxIndex = MaxTableIndex + MaxQueryIndex + 1
|
||||
If MaxIndex > -1 Then
|
||||
Dim LocCommandTypes(MaxIndex) as Integer
|
||||
For i = 0 To MaxTableIndex
|
||||
LocCommandTypes(i) = com.sun.star.sdb.CommandType.TABLE
|
||||
Next i
|
||||
a = i
|
||||
For i = 0 To MaxQueryIndex
|
||||
LocCommandTypes(a) = com.sun.star.sdb.CommandType.QUERY
|
||||
a = a + 1
|
||||
Next i
|
||||
End If
|
||||
CreateCommandTypeList() = LocCommandTypes()
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetCurrentMetaValues(Index as Integer)
|
||||
CurFieldType = FieldMetaValues(Index,0)
|
||||
CurFieldLength = FieldMetaValues(Index,1)
|
||||
CurControlType = FieldMetaValues(Index,2)
|
||||
CurControlName = FieldMetaValues(Index,3)
|
||||
CurFormatKey = FieldMetaValues(Index,4)
|
||||
CurDefaultValue = FieldMetaValues(Index,5)
|
||||
CurIsCurrency = FieldMetaValues(Index,6)
|
||||
CurScale = FieldMetaValues(Index,7)
|
||||
CurHelpText = FieldMetaValues(Index,8)
|
||||
CurFieldName = FieldNames(Index)
|
||||
End Sub
|
||||
|
||||
|
||||
Function AssignFieldLength(FieldLength as Long) as Integer
|
||||
If FieldLength >= 65535 Then
|
||||
AssignFieldLength() = -1
|
||||
Else
|
||||
AssignFieldLength() = FieldLength
|
||||
End If
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,111 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DlgFormDB" dlg:left="96" dlg:top="28" dlg:width="270" dlg:height="210" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_DIALOG" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblSelFields" dlg:tab-index="10" dlg:left="154" dlg:top="70" dlg:width="110" dlg:height="8" dlg:page="1" dlg:value="lblSelFields"/>
|
||||
<dlg:menulist dlg:id="lstTables" dlg:tab-index="3" dlg:left="6" dlg:top="51" dlg:width="110" dlg:height="12" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_MASTER_LBTABLES" dlg:spin="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.FormGetFields?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-mousedown" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.DeleteFirstTableListBoxEntry?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:img dlg:id="imgTheme" dlg:tab-index="1" dlg:left="6" dlg:top="6" dlg:width="258" dlg:height="26" dlg:scale-image="false"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="33" dlg:left="6" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:34401" dlg:value="cmdCancel" dlg:button-type="cancel"/>
|
||||
<dlg:button dlg:id="cmdHelp" dlg:tab-index="34" dlg:left="63" dlg:top="190" dlg:width="53" dlg:height="14" dlg:tag="34400" dlg:value="cmdHelp" dlg:button-type="help"/>
|
||||
<dlg:button dlg:id="cmdBack" dlg:tab-index="35" dlg:left="155" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CMDPREV" dlg:value="cmdBack">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.PreviousStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="36" dlg:left="211" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CMDNEXT" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.NextStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="lblTables" dlg:tab-index="2" dlg:left="6" dlg:top="40" dlg:width="72" dlg:height="8" dlg:page="1" dlg:value="lblTables"/>
|
||||
<dlg:text dlg:id="lblFields" dlg:tab-index="4" dlg:left="6" dlg:top="70" dlg:width="109" dlg:height="8" dlg:page="1" dlg:value="lblFields"/>
|
||||
<dlg:button dlg:id="cmdMoveSelected" dlg:tab-index="6" dlg:left="122" dlg:top="84" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_OPTONEXISTINGRELATION" dlg:value="->">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdMoveAll" dlg:tab-index="7" dlg:left="122" dlg:top="101" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_OPTSELECTMANUALLY" dlg:value="=>>">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveAll?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdRemoveSelected" dlg:tab-index="8" dlg:left="122" dlg:top="118" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_lstRELATIONS" dlg:value="<-">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdRemoveAll" dlg:tab-index="9" dlg:left="122" dlg:top="135" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:34425" dlg:value="<<=">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveAll?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optIgnoreBinaries" dlg:tab-index="14" dlg:left="122" dlg:top="169" dlg:width="104" dlg:height="10" dlg:page="1" dlg:help-url="HID:34427" dlg:value="optIgnoreBinaries" dlg:checked="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.DBMeta.AddOrRemoveBinaryFieldsToWidthList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBinariesasGraphics" dlg:tab-index="13" dlg:left="12" dlg:top="169" dlg:width="104" dlg:height="10" dlg:page="1" dlg:help-url="HID:34426" dlg:value="optBinariesasGraphics">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.DBMeta.AddOrRemoveBinaryFieldsToWidthList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:menulist dlg:id="lstFields" dlg:tab-index="5" dlg:left="6" dlg:top="81" dlg:width="110" dlg:height="70" dlg:page="1" dlg:help-url="HID:34420" dlg:multiselection="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:menulist dlg:id="lstSelFields" dlg:tab-index="11" dlg:left="154" dlg:top="81" dlg:width="110" dlg:height="70" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CHKCREATESUBFORM" dlg:multiselection="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:text dlg:id="lblStyles" dlg:tab-index="25" dlg:left="150" dlg:top="39" dlg:width="114" dlg:height="8" dlg:page="2" dlg:value="lblStyles"/>
|
||||
<dlg:button dlg:id="cmdArrange1" dlg:tab-index="16" dlg:left="12" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_LBTABLES">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange2" dlg:tab-index="17" dlg:left="39" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_FIELDSAVAILABLE">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange3" dlg:tab-index="18" dlg:left="66" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="3" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVESELECTED">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange4" dlg:tab-index="19" dlg:left="93" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="4" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEALL">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange5" dlg:tab-index="20" dlg:left="120" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="5" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDREMOVESELECTED">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:menulist dlg:id="lstStyles" dlg:tab-index="26" dlg:left="150" dlg:top="50" dlg:width="114" dlg:height="86" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTSLAVELINK2">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:FormWizard.tools.ImportStyles?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optBorder0" dlg:tab-index="22" dlg:left="12" dlg:top="95" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEUP" dlg:value="optBorder0">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBorder1" dlg:tab-index="23" dlg:left="12" dlg:top="109" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEDOWN" dlg:value="optBorder1">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBorder2" dlg:tab-index="24" dlg:left="12" dlg:top="123" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:34440" dlg:value="optBorder2">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:fixedline dlg:id="hlnBinaries" dlg:tab-index="12" dlg:left="6" dlg:top="158" dlg:width="258" dlg:height="8" dlg:page="1" dlg:value="hlnBinaries"/>
|
||||
<dlg:fixedline dlg:id="hlnBackground" dlg:tab-index="30" dlg:left="150" dlg:top="143" dlg:width="114" dlg:height="8" dlg:page="2" dlg:value="hlnBackground"/>
|
||||
<dlg:fixedline dlg:id="hlnAlign" dlg:tab-index="27" dlg:left="6" dlg:top="143" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnAlign"/>
|
||||
<dlg:fixedline dlg:id="hlnBorderLayout" dlg:tab-index="21" dlg:left="6" dlg:top="83" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnBorderLayout"/>
|
||||
<dlg:fixedline dlg:id="hlnArrangements" dlg:tab-index="15" dlg:left="6" dlg:top="39" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnArrangements"/>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optAlign0" dlg:tab-index="28" dlg:left="12" dlg:top="154" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTSLAVELINK1" dlg:value="optAlign0">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeLabelAlignments?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optAlign2" dlg:tab-index="29" dlg:left="12" dlg:top="168" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTMASTERLINK1" dlg:value="optAlign2">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeLabelAlignments?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:fixedline dlg:id="FixedLine1" dlg:tab-index="0" dlg:left="6" dlg:top="180" dlg:width="258" dlg:height="6"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,440 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FormWizard" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public DocumentName as String
|
||||
Public FormPath as String
|
||||
Public WizardPath as String
|
||||
Public WorkPath as String
|
||||
Public TempPath as String
|
||||
Public TexturePath as String
|
||||
Public sQueryName as String
|
||||
Public oDBConnection as Object
|
||||
Public bWithBackGraphic as Boolean
|
||||
Public bNeedFieldRefresh as Boolean
|
||||
Public oDBForm as Object
|
||||
Public oColumns() as Object
|
||||
Public sDatabaseList() as String
|
||||
Public TableNames() as String
|
||||
Public QueryNames() as String
|
||||
Public FieldNames() as String
|
||||
Public ImgFieldNames() as String
|
||||
Public oDBContext as Object
|
||||
Public oUcb as Object
|
||||
Public oDocInfo as Object
|
||||
Public WidthList(15,3)
|
||||
Public ImgWidthList(3,3)
|
||||
Public sDBName as String
|
||||
Public Tablename as String
|
||||
Public Const SBSIZETEXT = "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog."
|
||||
Public bDisposeDoc as Boolean
|
||||
Public bDebug as Boolean
|
||||
'Public bStartUp as Boolean
|
||||
Public bConnectionIsovergiven as Boolean
|
||||
Public FormName As String
|
||||
Public sFormUrl as String
|
||||
Public oFormDocuments
|
||||
|
||||
|
||||
' The macro can be called in 4 possible scenarios:
|
||||
' Scenario 1. No parameters at given
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
' Scenario 3: a data source and a connection are given
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
|
||||
Sub Main()
|
||||
Dim oLocDBContext as Object
|
||||
Dim oLocConnection as Object
|
||||
|
||||
' Scenario 1. No parameters at given
|
||||
MainWithDefault()
|
||||
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
' MainWithDefault("Bibliography")
|
||||
|
||||
' Scenario 3: a data source and a connection are given
|
||||
' oLocDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
' oLocConnection = oLocDBContext.GetByName("Bibliography").GetConnection("","")
|
||||
' MainWithDefault("Bibliography", oLocConnection)
|
||||
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
' oLocDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
' oLocConnection = oLocDBContext.GetByName("Bibliography").GetConnection("","")
|
||||
' MainWithDefault("Bibliography", oLocConnection, com.sun.star.sdb.CommandType.TABLE, "biblio")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MainWithDefault(Optional DatasourceName as String, Optional oConnection as Object, Optional CommandType as Integer, Optional sContent as String)
|
||||
Dim i as Integer
|
||||
Dim SelCount as Integer
|
||||
Dim RetValue as Integer
|
||||
Dim SelList(0) as Integer
|
||||
Dim LocList() as String
|
||||
SelList(0) = 0
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
bDebug = False
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
OpenFormDocument()
|
||||
CurArrangement = 0
|
||||
bControlsareCreated = False
|
||||
bEnableBinaryOptionGroup = False
|
||||
bDisposeDoc = True
|
||||
MaxIndex = -1
|
||||
If Not InitResources("Formwizard") Then
|
||||
Exit Sub
|
||||
End If
|
||||
oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
If GetFormWizardPaths() = False Then
|
||||
Exit Sub
|
||||
End If
|
||||
oDocument.GetCurrentController().Frame.ComponentWindow.Enable = False
|
||||
oProgressBar.Value = 10
|
||||
LoadLanguage()
|
||||
oProgressBar.Value = 20
|
||||
InitializeWidthList()
|
||||
oProgressBar.Value = 30
|
||||
Styles() = getListBoxArrays(oUcb, "/stl")
|
||||
CurIndex = GetCurIndex(DialogModel, Styles(), 2)
|
||||
oProgressBar.Value = 40
|
||||
ConfigurePageStyle()
|
||||
oProgressBar.Value = 50
|
||||
InitializeLabelValues()
|
||||
bNeedFieldRefresh = True
|
||||
SetDialogLanguage()
|
||||
' bStartUp = true
|
||||
With DialogModel
|
||||
.cmdBack.Enabled = False
|
||||
.cmdGoOn.Enabled = False
|
||||
.lblTables.Enabled = False
|
||||
.lstSelFields.Tag = False
|
||||
.Step = 1
|
||||
End With
|
||||
oProgressBar.Value = 60
|
||||
bConnectionIsovergiven = Not IsMissing(oConnection)
|
||||
If Not IsMissing(DataSourceName) Then
|
||||
sDBName = DataSourceName
|
||||
If Not IsMissing(oConnection) Then
|
||||
' Scenario 3: a data source and a connection are given
|
||||
Set oDBConnection = oConnection
|
||||
oDataSource = oDBContext.GetByName(DataSourceName)
|
||||
DialogModel.lstTables.Enabled = True
|
||||
DialogModel.lblTables.Enabled = True
|
||||
If GetDBMetaData() Then
|
||||
LocList() = AddListToList(TableNames(), QueryNames())
|
||||
iCommandTypes = CreateCommandTypeList()
|
||||
If Not IsMissing(sContent) Then
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
DialogModel.lstTables.StringItemList() = LocList()
|
||||
iCommandTypes() = CreateCommandTypeList()
|
||||
SelCount = CountItemsInArray(DialogModel.lstTables.StringItemList(), sContent)
|
||||
If SelCount = 1 Then
|
||||
DlgFormDB.GetControl("lstTables").SelectItem(sContent, True)
|
||||
Else
|
||||
If CommandType = com.sun.star.sdb.CommandType.QUERY Then
|
||||
SelIndex = IndexInArray(sContent, QueryNames())
|
||||
DlgFormDB.GetControl("lstTables").SelectItemPos(SelIndex, True)
|
||||
ElseIf CommandType = com.sun.star.sdb.CommandType.TABLE Then
|
||||
SelIndex = IndexInArray(sContent, TableNames())
|
||||
DlgFormDB.GetControl("lstTables").SelectItemPos(Ubound(QueryNames()+1 + SelIndex, True))
|
||||
End If
|
||||
End If
|
||||
CurCommandType = CommandType
|
||||
FillUpFieldsListbox(False)
|
||||
Else
|
||||
LocList() = AddListToList(Array(sSelectDBTable), LocList())
|
||||
DialogModel.lstTables.StringItemList() = LocList()
|
||||
' bSelectContent = True
|
||||
DialogModel.lstTables.SelectedItems() = Array(0)
|
||||
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
GetSelectedDBMetaData(sDBName)
|
||||
End If
|
||||
Else
|
||||
' Scenario 1: No parameters are given
|
||||
ToggleListboxControls(DialogModel, False)
|
||||
End If
|
||||
oProgressBar.Value = 80
|
||||
bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, Styles(CurIndex, 8), Styles(), TexturePath)
|
||||
DlgFormDB.Title = WizardTitle(1)
|
||||
DialogModel.lstStyles.StringItemList() = ArrayfromMultiArray(Styles, 1)
|
||||
DialogModel.lstStyles.SelectedItems() = SelList()
|
||||
ControlCaptionsToStandardLayout()
|
||||
oDocument.GetCurrentController().Frame.ComponentWindow.Enable = True
|
||||
oProgressBar.Value = 90
|
||||
DialogModel.imgTheme.ImageURL = FormPath & "FormWizard_1.png"
|
||||
DialogModel.imgTheme.BackGroundColor = RGB(0,60,126)
|
||||
ToggleDatabasePage(True)
|
||||
oProgressBar.Value = 100
|
||||
DlgFormDB.GetControl("lstTables").SetFocus()
|
||||
oProgressbar.End
|
||||
RetValue = DlgFormDB.Execute()
|
||||
DlgFormDB.Dispose()
|
||||
If bDisposeDoc Then
|
||||
Dim aPropertyValues(2) as new com.sun.star.beans.PropertyValue
|
||||
oFormDocuments = oDataSource.getFormDocuments()
|
||||
DlgFormDB.Dispose()
|
||||
oDocument.dispose()
|
||||
Dim bLinkExists as Boolean
|
||||
i = 1
|
||||
Dim FormBaseName as String
|
||||
FormBaseName = FormName
|
||||
Do
|
||||
bLinkExists = oFormDocuments.HasbyHierarchicalName(FormName)
|
||||
If bLinkExists Then
|
||||
i = i + 1
|
||||
FormName = FormBaseName & "_" & i
|
||||
End If
|
||||
Loop Until Not bLinkExists
|
||||
aPropertyValues(0).Name = "Name"
|
||||
aPropertyValues(0).Value = FormName
|
||||
aPropertyValues(1).Name = "Parent"
|
||||
aPropertyValues(1).Value = oFormDocuments()
|
||||
aPropertyValues(2).Name = "URL"
|
||||
aPropertyValues(2).Value = sFormUrl
|
||||
Dim oDBDocument
|
||||
oDBDocument = oFormDocuments.createInstanceWithArguments("com.sun.star.sdb.DocumentDefinition", aPropertyValues())
|
||||
oFormDocuments.insertbyName(FormName, oDBDocument)
|
||||
ElseIf RetValue = 0 Then
|
||||
RemoveNirwanaShapes()
|
||||
End If
|
||||
If ((Not IsNull(oDBConnection)) And (Not bConnectionIsovergiven)) Then
|
||||
oDBConnection.Dispose()
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormGetFields()
|
||||
Dim i as Integer
|
||||
' If bSelectContent Then
|
||||
' bSelectContent = False
|
||||
' Exit Sub
|
||||
' End If
|
||||
DeleteFirstListBoxEntry("lstTables", sSelectDBTable)
|
||||
ToggleDatabasePage(False)
|
||||
FillUpFieldsListbox(True)
|
||||
ToggleDatabasePage(True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillUpFieldsListbox(bGetCommandType as Boolean)
|
||||
Dim SelIndex as Integer
|
||||
Dim QueryIndex as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo NOFIELDS
|
||||
End If
|
||||
SelIndex = DlgFormDB.GetControl("lstTables").getSelectedItemPos() '.SelectedItems())
|
||||
If SelIndex > -1 Then
|
||||
If bGetCommandType Then
|
||||
CurCommandType = iCommandTypes(SelIndex)
|
||||
End If
|
||||
If CurCommandType = com.sun.star.sdb.CommandType.QUERY Then
|
||||
QueryIndex = SelIndex - Ubound(Tablenames()) - 1
|
||||
Tablename = QueryNames(QueryIndex)
|
||||
oColumns = oDBConnection.Queries.GetByName(TableName).Columns
|
||||
Else
|
||||
Tablename = Tablenames(SelIndex)
|
||||
oColumns = oDBConnection.Tables.GetByName(Tablename).Columns
|
||||
End If
|
||||
If GetSpecificFieldNames() <> -1 Then
|
||||
ToggleListboxControls(DialogModel, True)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
EmptyFieldsListboxes()
|
||||
NOFIELDS:
|
||||
If Err <> 0 Then
|
||||
MsgBox sMsgErrCouldNotOpenObject, 16, sMsgWizardName
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub PreviousStep()
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
With DialogModel
|
||||
.Step = 1
|
||||
.cmdBack.Enabled = False
|
||||
.cmdGoOn.Enabled = True
|
||||
.lstSelFields.Tag = Not bControlsareCreated
|
||||
.cmdGoOn.Label = sGoOn
|
||||
.imgTheme.ImageUrl = FormPath & "FormWizard_1.png"
|
||||
End With
|
||||
FormSetMoveRights()
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub NextStep()
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
Select Case DialogModel.Step
|
||||
Case 1
|
||||
bControlsAreCreated = Not (cBool(DialogModel.lstSelFields.Tag))
|
||||
If Not bControlsAreCreated Then
|
||||
GetTableMetaData()
|
||||
CreateDBForm()
|
||||
RemoveShapes()
|
||||
InitializeLayoutSettings()
|
||||
oDBForm.Load
|
||||
End If
|
||||
DialogModel.cmdGoOn.Label = sReady
|
||||
DialogModel.cmdBack.Enabled = True
|
||||
DialogModel.Step = 2
|
||||
bDisposeDoc = False
|
||||
Case 2
|
||||
StoreForm()
|
||||
DlgFormDB.EndExecute()
|
||||
exit Sub
|
||||
End Select
|
||||
DialogModel.imgTheme.ImageUrl = FormPath & "FormWizard_" & DialogModel.Step & ".png"
|
||||
DlgFormDB.Title = WizardTitle(DialogModel.Step)
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeLayoutSettings()
|
||||
SwitchArrangementButtons(cTabled)
|
||||
SwitchAlignMode(SBALIGNLEFT)
|
||||
SwitchBorderMode(SB3DBORDER)
|
||||
ToggleBorderGroup(bControlsAreCreated)
|
||||
ToggleAlignGroup(bControlsAreCreated)
|
||||
ArrangeControls()
|
||||
If OldAlignMode <> 0 Then
|
||||
DlgFormDB.GetControl("optAlign2").Model.State = 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleDatabasePage(bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
.cmdBack.Enabled = False
|
||||
.cmdHelp.Enabled = bDoEnable
|
||||
.cmdGoOn.Enabled = Ubound(DialogModel.lstSelFields.StringItemList()) <> -1
|
||||
.hlnBinaries.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
.optIgnoreBinaries.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
.optBinariesasGraphics.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
' This Sub is called from the Procedure "StoreDocument" in the "Tools" Library
|
||||
Sub CommitLastDocumentChanges(sTargetPath as String)
|
||||
Dim i as Integer
|
||||
Dim sBookmarkName as String
|
||||
Dim oDBBookmarks as Object
|
||||
Dim bLinkExists as Boolean
|
||||
Dim sBaseBookmarkName as String
|
||||
sBookmarkName = GetFileNamewithoutExtension(FileNameoutofPath(sTargetPath))
|
||||
sBaseBookmarkName = sBookmarkName
|
||||
oDBBookmarks = oDataSource.GetBookmarks()
|
||||
i = 1
|
||||
Do
|
||||
bLinkExists = oDBBookmarks.HasbyName(sBookmarkName)
|
||||
If bLinkExists Then
|
||||
i = i + 1
|
||||
sBookmarkName = sBaseBookmarkName & "_" & i
|
||||
Else
|
||||
oDBBookmarks.insertByName(sBookmarkName, sTargetPath)
|
||||
End If
|
||||
Loop Until Not bLinkExists
|
||||
bDisposeDoc = False
|
||||
GroupShapesTogether()
|
||||
ToggleDesignMode(oDocument)
|
||||
oDBForm.Reload()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StoreFormInDatabase()
|
||||
Dim NoArgs() as new com.sun.star.beans.PropertyValue
|
||||
FormName = "Form_" & sDBName & "_" & TableName & ".sxw"
|
||||
sFormUrl = TempPath & "/" & FormName
|
||||
oDocument.StoreAsUrl(sFormUrl, NoArgs())
|
||||
bdisposeDoc = true
|
||||
DlgFormDB.Endexecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StoreForm()
|
||||
Dim sTargetPath as String
|
||||
Dim TypeNames(0,2) as String
|
||||
Dim oMasterKey as Object
|
||||
Dim oTypes() as Object
|
||||
oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types/")
|
||||
oTypes() = oMasterKey.Types
|
||||
TypeNames(0,0) = GetFilterName("StarOffice XML (Writer)")
|
||||
TypeNames(0,1) = "*.sxw"
|
||||
TypeNames(0,2) = ""
|
||||
StoreFormInDatabase()
|
||||
' sTargetPath = StoreDocument(oDocument, TypeNames(), "Form_" & sDBName & "_" & TableName & ".sxw", WorkPath, 1)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EmptyFieldsListboxes()
|
||||
Dim NullList() as String
|
||||
ToggleListboxControls(DialogModel, False)
|
||||
DialogModel.lstFields.StringItemList() = NullList()
|
||||
DialogModel.lstSelFields.StringItemList() = NullList()
|
||||
bEnableBinaryOptionGroup = False
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DeleteFirstTableListBoxEntry()
|
||||
DeleteFirstListBoxEntry("lstTables", sSelectDBTable)
|
||||
End Sub
|
||||
|
||||
Sub DeleteFirstListboxEntry(ListBoxName as String, DelEntryName as String)
|
||||
Dim oListbox as Object
|
||||
Dim sFirstItem as String
|
||||
dim iSelPos as Integer
|
||||
oListBox = DlgFormDB.getControl(ListBoxName)
|
||||
sFirstItem = oListBox.getItem(0)
|
||||
If sFirstItem = DelEntryName Then
|
||||
iSelPos = oListBox.getSelectedItemPos()
|
||||
oListBox.removeItems(0, 1)
|
||||
If iSelPos > 0 Then
|
||||
oListBox.selectItemPos(iSelPos-1, True)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,297 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit
|
||||
|
||||
|
||||
Public Const SBCANCEL = 2
|
||||
Public Const SBREPEAT = 4
|
||||
Public LabelDiffHeight as Long
|
||||
Public BasicLabelDiffHeight as Long
|
||||
|
||||
Public WizardTitle(1 To 3) as String
|
||||
Public DlgFormDB as Object
|
||||
Public DialogModel as Object
|
||||
|
||||
Dim sMsgWizardName as String
|
||||
Dim sMsgErrMsg as String
|
||||
Dim sMsgErrNoDatabase as String
|
||||
Dim sMsgErrNoTableInDatabase as String
|
||||
Dim sMsgErrTitleSuggestedExist as String
|
||||
Dim sMsgErrTitleSyntaxError as String
|
||||
Dim sMsgErrTitleAsTableExist as String
|
||||
Dim sMsgProgressText as String
|
||||
Dim sMsgCreatedForm as String
|
||||
Dim sMsgErrCouldNotOpenObject as String
|
||||
Dim sMsgErrNameToLong as String
|
||||
Dim sTimeAppendix as String
|
||||
Dim sDateAppendix as String
|
||||
Public sGoOn as String
|
||||
Public sReady as String
|
||||
Public sMsgNoConnection as String
|
||||
Public XPixelFactor as Long
|
||||
Public YPixelFactor as Long
|
||||
Public sSelectDatasource as String
|
||||
Public sSelectDBTable as String
|
||||
|
||||
|
||||
|
||||
Sub LoadLanguage ()
|
||||
sMsgWizardName = GetResText("RID_FORM_0")
|
||||
sMsgErrMsg = GetResText("RID_DB_COMMON_6")
|
||||
sMsgErrNoDatabase = GetResText("RID_DB_COMMON_8")
|
||||
sMsgErrNoTableInDatabase = GetResText("RID_DB_COMMON_9")
|
||||
sMsgErrTitleSuggestedExist = GetResText("RID_DB_COMMON_10")
|
||||
sMsgErrTitleAsTableExist = GetResText("RID_DB_COMMON_10")
|
||||
sMsgErrTitleSyntaxError = GetResText("RID_DB_COMMON_11")
|
||||
sMsgNoConnection = GetResText("RID_DB_COMMON_14")
|
||||
sMsgProgressText = GetResText("RID_FORM_2")
|
||||
sMsgCreatedForm = GetResText("RID_FORM_26")
|
||||
sMsgErrNameToLong = GetResText("RID_FORM_27")
|
||||
sMsgErrCouldNotOpenObject = GetResText("RID_DB_COMMON_13")
|
||||
|
||||
' Internal Logic
|
||||
sDateAppendix = GetResText("RID_FORM_4")
|
||||
sTimeAppendix = GetResText("RID_FORM_5")
|
||||
|
||||
sReady = GetResText("RID_DB_COMMON_0")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetDialogLanguage ()
|
||||
Dim i as Integer
|
||||
Dim ButtonHelpText as String
|
||||
Dim CmdButton as Object
|
||||
Dim IDArray as Variant
|
||||
Dim FNameAddOn as String
|
||||
Dim slblSelFields as String
|
||||
Dim slblFields as String
|
||||
|
||||
DlgFormDB = LoadDialog("FormWizard", "DlgFormDB")
|
||||
DialogModel = DlgFormDB.Model
|
||||
|
||||
With DialogModel
|
||||
.cmdCancel.Label = GetResText("RID_DB_COMMON_1")
|
||||
.cmdBack.Label = GetResText("RID_DB_COMMON_2")
|
||||
.cmdHelp.Label = GetResText("RID_DB_COMMON_20")
|
||||
sGoOn = GetResText("RID_DB_COMMON_3")
|
||||
.cmdGoOn.Label = sGoOn
|
||||
.lblTables.Label = GetResText("RID_FORM_6")
|
||||
|
||||
slblFields = GetResText("RID_FORM_12")
|
||||
slblSelFields = GetResText("RID_FORM_13")
|
||||
.lblFields.Label = slblFields
|
||||
.lblSelFields.Label = slblSelFields
|
||||
|
||||
.lblStyles.Label = GetResText("RID_FORM_21")
|
||||
.hlnBorderLayout.Label = GetResText("RID_FORM_28")
|
||||
.hlnAlign.Label = GetResText("RID_FORM_32")
|
||||
.hlnArrangements.Label = GetResText("RID_FORM_35")
|
||||
|
||||
WizardTitle(1) = sMsgWizardName & " - " & GetResText("RID_FORM_45")
|
||||
WizardTitle(2) = sMsgWizardName & " - " & GetResText("RID_FORM_46")
|
||||
WizardTitle(3) = sMsgWizardName & " - " & GetResText("RID_FORM_47")
|
||||
|
||||
.hlnBinaries.Label = GetResText("RID_FORM_50")
|
||||
.optIgnoreBinaries.Label = GetResText("RID_FORM_51")
|
||||
.optBinariesasGraphics.Label = GetResText("RID_FORM_52")
|
||||
|
||||
.hlnBackground.Label = GetResText("RID_FORM_55")
|
||||
.optTiled.Label = GetResText("RID_FORM_56")
|
||||
.optArea.Label = GetResText("RID_FORM_57")
|
||||
|
||||
.optBorder0.Label = GetResText("RID_FORM_29")
|
||||
.optBorder1.Label = GetResText("RID_FORM_30")
|
||||
.optBorder2.Label = GetResText("RID_FORM_31")
|
||||
.optBorder1.State = 1
|
||||
|
||||
.optAlign0.Label = GetResText("RID_FORM_33")
|
||||
.optAlign2.Label = GetResText("RID_FORM_34")
|
||||
.optAlign0.State = 1
|
||||
|
||||
REM//FIXME: Remove this unused FNameAddOn through the file
|
||||
FNameAddOn = ""
|
||||
|
||||
IDArray = Array("RID_FORM_36", "RID_FORM_37", "RID_FORM_40", "RID_FORM_38", "RID_FORM_39")
|
||||
For i = 1 To 5
|
||||
ButtonHelpText = GetResText(IDArray(i-1))
|
||||
cmdButton = DlgFormDB.getControl("cmdArrange" & i)
|
||||
cmdButton.Model.ImageURL = FormPath & "Arrange_" & i & FNameAddOn & ".gif"
|
||||
cmdButton.Model.HelpText = ButtonHelpText
|
||||
cmdButton.getPeer().setProperty("AccessibleName", ButtonHelpText)
|
||||
Next i
|
||||
' .cmdArrange1.ImageURL = FormPath & "Arrange_1" & FNameAddOn & ".gif"
|
||||
' .cmdArrange1.HelpText = GetResText("RID_FORM_36")
|
||||
'
|
||||
' .cmdArrange2.ImageURL = FormPath & "Arrange_2" & FNameAddOn & ".gif"
|
||||
' .cmdArrange2.HelpText = GetResText("RID_FORM_37")
|
||||
'
|
||||
' .cmdArrange3.ImageURL = FormPath & "Arrange_3" & FNameAddOn & ".gif"
|
||||
' .cmdArrange3.HelpText = GetResText("RID_FORM_40")
|
||||
'
|
||||
' .cmdArrange4.ImageURL = FormPath & "Arrange_4" & FNameAddOn & ".gif"
|
||||
' .cmdArrange4.HelpText = GetResText("RID_FORM_38")
|
||||
'
|
||||
' .cmdArrange5.ImageURL = FormPath & "Arrange_5" & FNameAddOn & ".gif"
|
||||
' .cmdArrange5.HelpText = GetResText("RID_FORM_39")
|
||||
End With
|
||||
DlgFormDB.GetControl("cmdMoveSelected").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_39"))
|
||||
DlgFormDB.GetControl("cmdRemoveSelected").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_40"))
|
||||
DlgFormDB.GetControl("cmdMoveAll").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_41"))
|
||||
DlgFormDB.GetControl("cmdRemoveAll").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_42"))
|
||||
DlgFormDB.getControl("lstFields").getPeer().setProperty("AccessibleName", DeleteStr(slblFields, "~"))
|
||||
DlgFormDB.getControl("lstSelFields").getPeer().setProperty("AccessibleName", DeleteStr(slblSelFields, "~"))
|
||||
|
||||
sSelectDatasource = GetResText("RID_DB_COMMON_37")
|
||||
sSelectDBTable = GetResText("RID_DB_COMMON_38")
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub InitializeWidthList()
|
||||
|
||||
If Ubound(WidthList(),1) > 16 Then
|
||||
ReDim WidthList(16,4)
|
||||
End If
|
||||
|
||||
WidthList(0,0) = com.sun.star.sdbc.DataType.BIT ' = -7;
|
||||
WidthList(0,1) = cCheckbox
|
||||
WidthList(0,2) = False
|
||||
WidthList(0,3) = "CheckBox"
|
||||
|
||||
WidthList(1,0) = com.sun.star.sdbc.DataType.TINYINT ' = -6;
|
||||
WidthList(1,1) = cNumericBox
|
||||
WidthList(1,2) = False
|
||||
WidthList(1,3) = "FormattedField"
|
||||
|
||||
WidthList(2,0) = com.sun.star.sdbc.DataType.SMALLINT ' = 5;
|
||||
WidthList(2,1) = cNumericBox
|
||||
WidthList(2,2) = False
|
||||
WidthList(2,3) = "FormattedField"
|
||||
|
||||
WidthList(3,0) = com.sun.star.sdbc.DataType.INTEGER ' = 4;
|
||||
WidthList(3,1) = cNumericBox
|
||||
WidthList(3,2) = False
|
||||
WidthList(3,3) = "FormattedField"
|
||||
|
||||
WidthList(4,0) = com.sun.star.sdbc.DataType.BIGINT ' = -5;
|
||||
WidthList(4,1) = cNumericBox
|
||||
WidthList(4,2) = False
|
||||
WidthList(4,3) = "FormattedField"
|
||||
|
||||
WidthList(5,0) = com.sun.star.sdbc.DataType.FLOAT ' = 6;
|
||||
WidthList(5,1) = cNumericBox
|
||||
WidthList(5,2) = False
|
||||
WidthList(5,3) = "FormattedField"
|
||||
|
||||
WidthList(6,0) = com.sun.star.sdbc.DataType.REAL ' = 7;
|
||||
WidthList(6,1) = cNumericBox
|
||||
WidthList(6,2) = False
|
||||
WidthList(6,3) = "FormattedField"
|
||||
|
||||
WidthList(7,0) = com.sun.star.sdbc.DataType.DOUBLE ' = 8;
|
||||
WidthList(7,1) = cNumericBox
|
||||
WidthList(7,2) = False
|
||||
WidthList(7,3) = "FormattedField"
|
||||
|
||||
WidthList(8,0) = com.sun.star.sdbc.DataType.NUMERIC ' = 2;
|
||||
WidthList(8,1) = cNumericBox
|
||||
WidthList(8,2) = False
|
||||
WidthList(8,3) = "FormattedField"
|
||||
|
||||
WidthList(9,0) = com.sun.star.sdbc.DataType.DECIMAL ' = 3; (including decimal places)
|
||||
WidthList(9,1) = cNumericBox
|
||||
WidthList(9,2) = False
|
||||
WidthList(9,3) = "FormattedField"
|
||||
|
||||
WidthList(10,0) = com.sun.star.sdbc.DataType.CHAR ' = 1;
|
||||
WidthList(10,1) = cTextBox
|
||||
WidthList(10,2) = False
|
||||
WidthList(10,3) = "TextField"
|
||||
|
||||
WidthList(11,0) = com.sun.star.sdbc.DataType.VARCHAR ' = 12;
|
||||
WidthList(11,1) = cTextBox
|
||||
WidthList(11,2) = True
|
||||
WidthList(11,3) = "TextField"
|
||||
|
||||
WidthList(12,0) = com.sun.star.sdbc.DataType.LONGVARCHAR ' = -1;
|
||||
WidthList(12,1) = cTextBox
|
||||
WidthList(12,2) = True
|
||||
WidthList(12,3) = "TextField"
|
||||
|
||||
WidthList(13,0) = com.sun.star.sdbc.DataType.DATE ' = 91;
|
||||
WidthList(13,1) = cDateBox
|
||||
WidthList(13,2) = False
|
||||
WidthList(13,3) = "DateField"
|
||||
|
||||
WidthList(14,0) = com.sun.star.sdbc.DataType.TIME ' = 92;
|
||||
WidthList(14,1) = cTimeBox
|
||||
WidthList(14,2) = False
|
||||
WidthList(14,3) = "TimeField"
|
||||
|
||||
WidthList(15,0) = com.sun.star.sdbc.DataType.TIMESTAMP ' = 93;
|
||||
WidthList(15,1) = cDateBox
|
||||
WidthList(15,2) = False
|
||||
WidthList(15,3) = "DateField"
|
||||
|
||||
WidthList(16,0) = com.sun.star.sdbc.DataType.BOOLEAN ' = 16;
|
||||
WidthList(16,1) = cCheckbox
|
||||
WidthList(16,2) = False
|
||||
WidthList(16,3) = "CheckBox"
|
||||
|
||||
ImgWidthList(0,0) = com.sun.star.sdbc.DataType.BINARY ' = -2;
|
||||
ImgWidthList(0,1) = cImageControl
|
||||
ImgWidthList(0,2) = False
|
||||
ImgWidthList(0,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(1,0) = com.sun.star.sdbc.DataType.VARBINARY ' = -3;
|
||||
ImgWidthList(1,1) = cImageControl
|
||||
ImgWidthList(1,2) = False
|
||||
ImgWidthList(1,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(2,0) = com.sun.star.sdbc.DataType.LONGVARBINARY ' = -4;
|
||||
ImgWidthList(2,1) = cImageControl
|
||||
ImgWidthList(2,2) = False
|
||||
ImgWidthList(2,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(3,0) = com.sun.star.sdbc.DataType.BLOB ' = 2004;
|
||||
ImgWidthList(3,1) = cImageControl
|
||||
ImgWidthList(3,2) = False
|
||||
ImgWidthList(3,3) = "ImageControl"
|
||||
|
||||
' Note: the following Fieldtypes are ignored
|
||||
'ExcludeList(0) = com.sun.star.sdbc.DataType.SQLNULL
|
||||
'ExcludeList(1) = com.sun.star.sdbc.DataType.OTHER
|
||||
'ExcludeList(2) = com.sun.star.sdbc.DataType.OBJECT
|
||||
'ExcludeList(3) = com.sun.star.sdbc.DataType.DISTINCT
|
||||
'ExcludeList(4) = com.sun.star.sdbc.DataType.STRUCT
|
||||
'ExcludeList(5) = com.sun.star.sdbc.DataType.ARRAY
|
||||
'ExcludeList(6) = com.sun.star.sdbc.DataType.CLOB
|
||||
'ExcludeList(7) = com.sun.star.sdbc.DataType.REF
|
||||
|
||||
oModelService(cLabel) = "com.sun.star.form.component.FixedText"
|
||||
oModelService(cTextBox) = "com.sun.star.form.component.TextField"
|
||||
oModelService(cCheckBox) = "com.sun.star.form.component.CheckBox"
|
||||
oModelService(cDateBox) = "com.sun.star.form.component.DateField"
|
||||
oModelService(cTimeBox) = "com.sun.star.form.component.TimeField"
|
||||
oModelService(cNumericBox) = "com.sun.star.form.component.FormattedField"
|
||||
oModelService(cGridControl) = "com.sun.star.form.component.GridControl"
|
||||
oModelService(cImageControl) = "com.sun.star.form.component.DatabaseImageControl"
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,397 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Layouter" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public oProgressbar as Object
|
||||
Public ProgressValue as Integer
|
||||
Public oDocument as Object
|
||||
Public oController as Object
|
||||
Public oForm as Object
|
||||
Public oDrawPage as Object
|
||||
Public oPageStyle as Object
|
||||
|
||||
Public nMaxColRightX as Long
|
||||
Public nMaxTCWidth as Long
|
||||
Public nMaxRowRightX as Long
|
||||
Public nMaxRowY as Long
|
||||
Public nSecMaxRowY as Long
|
||||
Public MaxIndex as Integer
|
||||
Public CurIndex as Integer
|
||||
|
||||
Public Const cVertDistance = 200
|
||||
Public Const cHoriDistance = 300
|
||||
|
||||
Public nPageWidth as Long
|
||||
Public nPageHeight as Long
|
||||
Public nFormWidth as Long
|
||||
Public nFormHeight as Long
|
||||
Public nMaxHoriPos as Long
|
||||
Public nMaxVertPos as Long
|
||||
|
||||
Public CONST SBALIGNLEFT = 0
|
||||
Public CONST SBALIGNRIGHT = 2
|
||||
|
||||
Public Const SBNOBORDER = 0
|
||||
Public Const SB3DBORDER = 1
|
||||
Public Const SBSIMPLEBORDER = 2
|
||||
|
||||
Public CurArrangement as Integer
|
||||
Public CurBorderType as Integer
|
||||
Public CurAlignmode as Integer
|
||||
|
||||
Public OldAlignMode as Integer
|
||||
Public OldBorderType as Integer
|
||||
Public OldArrangement as Integer
|
||||
|
||||
Public Const cColumnarLeft = 1
|
||||
Public Const cColumnarTop = 2
|
||||
Public Const cTabled = 3
|
||||
Public Const cLeftJustified = 4
|
||||
Public Const cTopJustified = 5
|
||||
|
||||
Public Const cXOffset = 1000
|
||||
Public Const cYOffset = 700
|
||||
' This is the viewed space that we lose because of the symbol bars
|
||||
Public Const cSymbolMargin = 2000
|
||||
Public Const MaxFieldIndex = 200
|
||||
|
||||
Public Const cControlCollectionCount = 9
|
||||
Public Const cLabel = 1
|
||||
Public Const cTextBox = 2
|
||||
Public Const cCheckBox = 3
|
||||
Public Const cDateBox = 4
|
||||
Public Const cTimeBox = 5
|
||||
Public Const cNumericBox = 6
|
||||
Public Const cCurrencyBox = 7
|
||||
Public Const cGridControl = 8
|
||||
Public Const cImageControl = 9
|
||||
|
||||
Public Styles(100, 8) as String
|
||||
|
||||
Public CurControlType as Integer
|
||||
Public CurFieldlength as Double
|
||||
Public CurFieldType as Integer
|
||||
Public CurFieldName as String
|
||||
Public CurControlName as String
|
||||
Public CurFormatKey as Long
|
||||
Public CurDefaultValue
|
||||
Public CurIsCurrency as Boolean
|
||||
Public CurScale as Integer
|
||||
Public CurHelpText as String
|
||||
|
||||
Public FieldMetaValues(MaxFieldIndex, 8)
|
||||
' Description of this List:
|
||||
' CurFieldType = FieldMetaValues(Index,0)
|
||||
' CurFieldLength = FieldMetaValues(Index,1)
|
||||
' CurControlType = FieldMetaValues(Index,2) (ControlType, e.g., cLabel, cTextbox, etc.)
|
||||
' CurControlName = FieldMetaValues(Index,3)
|
||||
' CurFormatKey = FieldMetaValues(Index,4)
|
||||
' CurDefaultValue = FieldMetaValues(Index,5)
|
||||
' CurIsCurrency = FieldMetaValues(Index,6)
|
||||
' CurScale = FieldMetaValues(Index,7)
|
||||
' CurHelpText = FieldMetaValues(Index,8)
|
||||
|
||||
Public FieldNames(MaxFieldIndex) as string
|
||||
Public oModelService(cControlCollectionCount) as String
|
||||
Public oGridModel as Object
|
||||
|
||||
|
||||
Function InsertControl(oContainer as Object, oControlObject as object, aPoint as Object, aSize as Object)
|
||||
Dim oShape as object
|
||||
oShape = oDocument.CreateInstance ("com.sun.star.drawing.ControlShape")
|
||||
oShape.Size = aSize
|
||||
oShape.Position = aPoint
|
||||
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
|
||||
oShape.control = oControlObject
|
||||
oContainer.Add(oShape)
|
||||
InsertControl() = oShape
|
||||
End Function
|
||||
|
||||
|
||||
Function ArrangeControls()
|
||||
Dim oShape as Object
|
||||
Dim i as Integer
|
||||
oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
|
||||
oProgressbar.Start("", MaxIndex)
|
||||
If oDBForm.HasbyName("Grid1") Then
|
||||
RemoveShapes()
|
||||
End If
|
||||
ToggleLayoutPage(False)
|
||||
Select Case CurArrangement
|
||||
Case cTabled
|
||||
PositionGridControl(MaxIndex)
|
||||
Case Else
|
||||
PositionControls(MaxIndex)
|
||||
End Select
|
||||
ToggleLayoutPage(True)
|
||||
oProgressbar.End
|
||||
End Function
|
||||
|
||||
|
||||
Sub OpenFormDocument()
|
||||
Dim NoArgs() as new com.sun.star.beans.PropertyValue
|
||||
Dim oViewSettings as Object
|
||||
oDocument = CreateNewDocument("swriter")
|
||||
oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
|
||||
oProgressbar.Start("", 100)
|
||||
oDocument.ApplyFormDesignMode = False
|
||||
oController = oDocument.GetCurrentController
|
||||
oViewSettings = oDocument.CurrentController.ViewSettings
|
||||
oViewSettings.ShowTableBoundaries = False
|
||||
oViewSettings.ShowOnlineLayout = True
|
||||
oDrawPage = oDocument.DrawPage
|
||||
oPageStyle = oDocument.StyleFamilies.GetByName("PageStyles").GetByName("Standard")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeLabelValues()
|
||||
Dim oLabelModel as Object
|
||||
Dim oTBModel as Object
|
||||
Dim oLabelShape as Object
|
||||
Dim oTBShape as Object
|
||||
Dim aTBSize As New com.sun.star.awt.Size
|
||||
Dim aLabelSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim oLocControl as Object
|
||||
Dim oLocPeer as Object
|
||||
oLabelModel = CreateUnoService("com.sun.star.form.component.FixedText")
|
||||
oTBModel = CreateUnoService("com.sun.star.form.component.TextField")
|
||||
|
||||
Set oLabelShape = InsertControl(oDrawPage, oLabelModel, aPoint, aLabelSize)
|
||||
Set oTBShape = InsertControl(oDrawPage, oTBModel, aPoint, aSize)
|
||||
|
||||
oLocPeer = oController.GetControl(oLabelModel).Peer
|
||||
XPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterX
|
||||
YPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterY
|
||||
aLabelSize = GetPeerSize(oLabelModel, oLocControl, "The quick brown fox...")
|
||||
nTCHeight = (aLabelSize.Height+1) * YPixelFactor
|
||||
aTBSize = GetPeerSize(oTBModel, oLocControl, "The quick brown fox...")
|
||||
nDBRefHeight = (aTBSize.Height+1) * YPixelFactor
|
||||
BasicLabelDiffHeight = Clng((nDBRefHeight - nTCHeight)/2)
|
||||
oDrawPage.Remove(oLabelShape)
|
||||
oDrawPage.Remove(oTBShape)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConfigurePageStyle()
|
||||
Dim aPageSize As New com.sun.star.awt.Size
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
oPageStyle.IsLandscape = True
|
||||
aPageSize = oPageStyle.Size
|
||||
nPageWidth = aPageSize.Width
|
||||
nPageHeight = aPageSize.Height
|
||||
aSize.Width = nPageHeight
|
||||
aSize.Height = nPageWidth
|
||||
oPageStyle.Size = aSize
|
||||
nPageWidth = nPageHeight
|
||||
nPageHeight = oPageStyle.Size.Height
|
||||
nFormWidth = nPageWidth - oPageStyle.RightMargin - oPageStyle.LeftMargin - 2 * cXOffset
|
||||
nFormHeight = nPageHeight - oPageStyle.TopMargin - oPageStyle.BottomMargin - 2 * cYOffset - cSymbolMargin
|
||||
End Sub
|
||||
|
||||
|
||||
' Modify the Borders of the Controls
|
||||
Sub ChangeBorderLayouts(oEvent as Object)
|
||||
Dim oModel as Object
|
||||
Dim i as Integer
|
||||
Dim oCurModel as Object
|
||||
Dim sLocText as String
|
||||
Dim oGroupShape as Object
|
||||
Dim s as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchBorderMode(Val(Right(oModel.Name,1)))
|
||||
ToggleLayoutPage(False)
|
||||
If CurArrangement = cTabled Then
|
||||
oGridModel.Border = CurBorderType
|
||||
Else
|
||||
If OldBorderType <> CurBorderType Then
|
||||
For i = 0 To MaxIndex
|
||||
If oDBShapeList(i).SupportsService("com.sun.star.drawing.GroupShape") Then
|
||||
oGroupShape = oDBShapeList(i)
|
||||
For s = 0 To oGroupShape.Count-1
|
||||
oGroupShape(s).Control.Border = CurBorderType
|
||||
Next s
|
||||
Else
|
||||
If oDBModelList(i).PropertySetInfo.HasPropertyByName("Border") Then
|
||||
oDBModelList(i).Border = CurBorderType
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
ToggleLayoutPage(True)
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
DlgFormDB.Dispose()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChangeLabelAlignments(oEvent as Object)
|
||||
Dim i as Integer
|
||||
Dim oSize as New com.sun.star.awt.Size
|
||||
Dim oModel as Object
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchAlignMode(Val(Right(oModel.Name,1)))
|
||||
ToggleLayoutPage(False)
|
||||
If OldAlignMode <> CurAlignMode Then
|
||||
For i = 0 To MaxIndex
|
||||
oTCShapeList(i).GetControl.Align = CurAlignmode
|
||||
Next i
|
||||
End If
|
||||
If CurAlignmode = com.sun.star.awt.TextAlign.RIGHT Then
|
||||
For i = 0 To Ubound(oTCShapeList())
|
||||
oSize = oTCShapeList(i).Size
|
||||
oSize.Width = oDBShapeList(i).Position.X - oTCShapeList(i).Position.X - cHoriDistance
|
||||
oTCShapeList(i).Size = oSize
|
||||
Next i
|
||||
End If
|
||||
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
ToggleLayoutPage(True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChangeArrangemode(oEvent as Object)
|
||||
Dim oModel as Object
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchArrangementButtons(Val(Right(oModel.Name,1)))
|
||||
oModel.State = 1
|
||||
DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0
|
||||
If CurArrangement <> OldArrangement Then
|
||||
ArrangeControls()
|
||||
Select Case CurArrangement
|
||||
Case cTabled
|
||||
ToggleBorderGroup(False)
|
||||
ToggleAlignGroup(False)
|
||||
Case Else ' cColumnarTop,cLeftJustified, cTopJustified
|
||||
ToggleAlignGroup(CurArrangement = cColumnarLeft)
|
||||
If CurArrangement = cColumnarTop Then
|
||||
If CurAlignMode = com.sun.star.awt.TextAlign.RIGHT Then
|
||||
DialogModel.optAlign0.State = 1
|
||||
CurAlignMode = com.sun.star.awt.TextAlign.LEFT
|
||||
OldAlignMode = com.sun.star.awt.TextAlign.RIGHT
|
||||
End If
|
||||
End If
|
||||
ControlCaptionstoStandardLayout()
|
||||
oDBForm.Load
|
||||
End Select
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleBorderGroup(bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
.hlnBorderLayout.Enabled = bDoEnable
|
||||
.optBorder0.Enabled = bDoEnable ' 0: No border
|
||||
.optBorder1.Enabled = bDoEnable ' 1: 3D border
|
||||
.optBorder2.Enabled = bDoEnable ' 2: simple border
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleAlignGroup(ByVal bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
If bDoEnable Then
|
||||
bDoEnable = CurArrangement = cColumnarLeft
|
||||
End If
|
||||
.hlnAlign.Enabled = bDoEnable
|
||||
.optAlign0.Enabled = bDoEnable
|
||||
.optAlign2.Enabled = bDoEnable
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleLayoutPage(bDoEnable as Boolean, Optional FocusControlName as String)
|
||||
DialogModel.Enabled = bDoEnable
|
||||
If bDoEnable Then
|
||||
If Not bDebug Then
|
||||
oDocument.UnlockControllers()
|
||||
End If
|
||||
ToggleOptionButtons(DialogModel,(bWithBackGraphic = True))
|
||||
ToggleAlignGroup(bDoEnable)
|
||||
ToggleBorderGroup(bDoEnable)
|
||||
Else
|
||||
If Not bDebug Then
|
||||
oDocument.LockControllers()
|
||||
End If
|
||||
End If
|
||||
If Not IsMissing(FocusControlName) Then
|
||||
DlgFormDB.GetControl(FocusControlName).SetFocus()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DestroyControlShapes(oDrawPage as Object)
|
||||
Dim i as Integer
|
||||
Dim oShape as Object
|
||||
For i = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage.GetByIndex(i)
|
||||
If oShape.ShapeType = "com.sun.star.drawing.ControlShape" Then
|
||||
oShape.Dispose()
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchArrangementButtons(ByVal LocArrangement as Integer)
|
||||
OldArrangement = CurArrangement
|
||||
CurArrangement = LocArrangement
|
||||
If OldArrangement <> 0 Then
|
||||
DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0
|
||||
End If
|
||||
DlgFormDB.GetControl("cmdArrange" & CurArrangement).Model.State = 1
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchBorderMode(ByVal LocBorderType as Integer)
|
||||
OldBorderType = CurBorderType
|
||||
CurBorderType = LocBorderType
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchAlignMode(ByVal LocAlignMode as Integer)
|
||||
OldAlignMode = CurAlignMode
|
||||
CurAlignMode = LocAlignMode
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,550 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="develop" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
Public oDBShapeList() as Object
|
||||
Public oTCShapeList() as Object
|
||||
Public oDBModelList() as Object
|
||||
Public oGroupShapeList() as Object
|
||||
|
||||
Public oGridShape as Object
|
||||
Public a as Integer
|
||||
Public StartA as Integer
|
||||
Public bIsFirstRun as Boolean
|
||||
Public bIsVeryFirstRun as Boolean
|
||||
Public bControlsareCreated as Boolean
|
||||
Public nDBRefHeight as Long
|
||||
Public nXTCPos&, nYTCPos&, nXDBPos&, nYDBPos&, nTCHeight&, nTCWidth&, nDBHeight&, nDBWidth&
|
||||
|
||||
Dim iReduceWidth as Integer
|
||||
|
||||
Function PositionControls(Maxindex as Integer)
|
||||
Dim oTCModel as Object
|
||||
Dim oDBModel as Object
|
||||
Dim i as Integer
|
||||
InitializePosSizes()
|
||||
bIsFirstRun = True
|
||||
bIsVeryFirstRun = True
|
||||
a = 0
|
||||
StartA = 0
|
||||
nMaxRowY = 0
|
||||
nSecMaxRowY = 0
|
||||
If CurArrangement = cLeftJustified Or cTopJustified Then
|
||||
DialogModel.optAlign0.State = 1
|
||||
End If
|
||||
For i = 0 To MaxIndex
|
||||
GetCurrentMetaValues(i)
|
||||
oTCModel = InsertTextControl(i)
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
|
||||
InsertTimeStampShape(i)
|
||||
Else
|
||||
InsertDBControl(i)
|
||||
bIsVeryFirstRun = False
|
||||
oDBModelList(i).LabelControl = oTCModel
|
||||
End If
|
||||
GetLabelDiffHeight(i+1)
|
||||
ResetPosSizes(i)
|
||||
oProgressbar.Value = i
|
||||
Next i
|
||||
ControlCaptionstoStandardLayout()
|
||||
bControlsareCreated = True
|
||||
End Function
|
||||
|
||||
|
||||
Sub ResetPosSizes(LastIndex as Integer)
|
||||
Select Case CurArrangement
|
||||
Case cColumnarLeft
|
||||
nYDBPos = nYDBPos + nDBHeight + cVertDistance
|
||||
If (nYDBPos > cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then
|
||||
RepositionColumnarLeftControls(LastIndex)
|
||||
nXTCPos = nMaxColRightX + 2 * cHoriDistance
|
||||
nXDBPos = nXTCPos + cHoriDistance + nMaxTCWidth
|
||||
nYDBPos = cYOffset
|
||||
bIsFirstRun = True
|
||||
StartA = LastIndex + 1
|
||||
a = 0
|
||||
Else
|
||||
a = a + 1
|
||||
End If
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
Case cColumnarTop
|
||||
nYTCPos = nYDBPos + nDBHeight + cVertDistance
|
||||
If nYTCPos > cYOffset + nFormHeight Then
|
||||
nXDBPos = nMaxColRightX + cHoriDistance
|
||||
nXTCPos = nXDBPos
|
||||
nYDBPos = cYOffset + nTCHeight + cVertDistance
|
||||
nYTCPos = cYOffset
|
||||
bIsFirstRun = True
|
||||
StartA = LastIndex + 1
|
||||
a = 0
|
||||
Else
|
||||
a = a + 1
|
||||
End If
|
||||
Case cLeftJustified,cTopJustified
|
||||
If nMaxColRightX > cXOffset + nFormWidth Then
|
||||
Dim nOldYTCPos as Long
|
||||
nOldYTCPos = nYTCPos
|
||||
CheckJustifiedPosition()
|
||||
Else
|
||||
nXTCPos = nMaxColRightX + CHoriDistance
|
||||
If CurArrangement = cLeftJustified Then
|
||||
nYTCPos = nYDBPos + LabelDiffHeight
|
||||
End If
|
||||
End If
|
||||
a = a + 1
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RepositionColumnarLeftControls(LastIndex as Integer)
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim i as Integer
|
||||
aSize = GetSize(nMaxTCWidth, nTCHeight)
|
||||
bIsFirstRun = True
|
||||
For i = StartA To LastIndex
|
||||
If i = StartA Then
|
||||
nXTCPos = oTCShapeList(i).Position.X
|
||||
nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance
|
||||
End If
|
||||
ResetDBShape(oDBShapeList(i), nXDBPos)
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ResetDBShape(oLocDBShape as Object, iXPos as Long)
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
nYDBPos = oLocDBShape.Position.Y
|
||||
nDBWidth = oLocDBShape.Size.Width
|
||||
nDBHeight = oLocDBShape.Size.Height
|
||||
aPoint = GetPoint(iXPos,nYDBPos)
|
||||
oLocDBShape.SetPosition(aPoint)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializePosSizes()
|
||||
nXTCPos = cXOffset
|
||||
nTCWidth = 2000
|
||||
nDBWidth = 2000
|
||||
nDBHeight = nDBRefHeight
|
||||
iReduceWidth = 0
|
||||
Select Case CurArrangement
|
||||
Case cColumnarLeft, cLeftJustified
|
||||
GetLabelDiffHeight(0)
|
||||
nYTCPos = cYOffset + LABELDIFFHEIGHT
|
||||
nXDBPos = cXOffset + 3050
|
||||
nYDBPos = cYOffset
|
||||
Case cColumnarTop, cTopJustified
|
||||
nXDBPos = cXOffset
|
||||
nYTCPos = cYOffset
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Function InsertTextControl(i as Integer) as Object
|
||||
Dim oShape as Object
|
||||
Dim oModel as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
If bControlsareCreated Then
|
||||
Set oShape = oTCShapeList(i)
|
||||
Set oModel = oShape.GetControl
|
||||
If CurArrangement = cLeftJustified Then
|
||||
nTCWidth = GetPreferredWidth(oModel, True, CurFieldname)
|
||||
Else
|
||||
nTCWidth = oShape.Size.Width
|
||||
End If
|
||||
oShape.Position = GetPoint(nXTCPos, nYTCPos)
|
||||
If CurArrangement = cColumnarTop Then
|
||||
oModel.Align = com.sun.star.awt.TextAlign.LEFT
|
||||
End If
|
||||
Else
|
||||
oModel = CreateUnoService(oModelService(cLabel))
|
||||
aPoint = GetPoint(nXTCPos, nYTCPos)
|
||||
aSize = GetSize(nTCWidth,nTCHeight)
|
||||
Set oShape = InsertControl(oDrawPage, oModel, aPoint, aSize)
|
||||
Set oTCShapeList(i)= oShape
|
||||
If bIsVeryFirstRun Then
|
||||
If CurArrangement = cColumnarTop Then
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
End If
|
||||
End If
|
||||
nTCWidth = GetPreferredWidth(oModel, True, CurFieldName)
|
||||
End If
|
||||
If CurArrangement = cColumnarLeft Then
|
||||
' Note This If Sequence must be called before retrieving the outer Points
|
||||
If bIsFirstRun Then
|
||||
nMaxTCWidth = nTCWidth
|
||||
bIsFirstRun = False
|
||||
ElseIf nTCWidth > nMaxTCWidth Then
|
||||
nMaxTCWidth = nTCWidth
|
||||
End If
|
||||
End If
|
||||
CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight, False)
|
||||
Select Case CurArrangement
|
||||
Case cLeftJustified
|
||||
nXDBPos = nMaxColRightX
|
||||
Case cColumnarTop,cTopJustified
|
||||
oModel.Align = com.sun.star.awt.TextAlign.LEFT
|
||||
nXDBPos = nXTCPos
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
If CurFieldLength = 20 And nDBWidth > 2 * nTCWidth Then
|
||||
iReduceWidth = iReduceWidth + 1
|
||||
End If
|
||||
End Select
|
||||
oShape.SetSize(GetSize(nTCWidth,nTCHeight))
|
||||
If CurHelpText <> "" Then
|
||||
oModel.HelpText = CurHelptext
|
||||
End If
|
||||
InsertTextControl = oModel
|
||||
End Function
|
||||
|
||||
|
||||
Sub InsertDBControl(i as Integer)
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim oControl as Object
|
||||
Dim iColRightX as Long
|
||||
|
||||
aPoint = GetPoint(nXDBPos, nYDBPos)
|
||||
If bControlsAreCreated Then
|
||||
oDBShapeList(i).Position = aPoint
|
||||
Else
|
||||
oDBModelList(i) = CreateUnoService(oModelService(CurControlType))
|
||||
oDBShapeList(i) = InsertControl(oDrawPage, oDBModelList(i), aPoint, aSize)
|
||||
SetNumerics(oDBModelList(i), CurFieldType)
|
||||
If CurControlType = cCheckBox Then
|
||||
oDBModelList(i).Label = ""
|
||||
End If
|
||||
oDBModelList(i).DataField = CurFieldName
|
||||
End If
|
||||
nDBHeight = GetDBHeight(oDBModelList(i))
|
||||
nDBWidth = GetPreferredWidth(oDBModelList(i),True)
|
||||
aSize = GetSize(nDBWidth,nDBHeight)
|
||||
oDBShapeList(i).SetSize(aSize)
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
End Sub
|
||||
|
||||
|
||||
Function InsertTimeStampShape(i as Integer) as Object
|
||||
Dim oDateModel as Object
|
||||
Dim oTimeModel as Object
|
||||
Dim oDateShape as Object
|
||||
Dim oTimeShape as Object
|
||||
Dim oDateTimeShape as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize as New com.sun.star.awt.Size
|
||||
Dim nDateWidth as Long
|
||||
Dim nTimeWidth as Long
|
||||
Dim oGroupShape as Object
|
||||
aPoint = GetPoint(nXDBPos, nYDBPos)
|
||||
If bControlsAreCreated Then
|
||||
oDBShapeList(i).Position = aPoint
|
||||
nDBWidth = oDBShapeList(i).Size.Width
|
||||
nDBHeight = oDBShapeList(i).Size.Height
|
||||
Else
|
||||
oGroupShape = oDocument.CreateInstance("com.sun.star.drawing.GroupShape")
|
||||
oGroupShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
|
||||
oDrawPage.Add(oGroupShape)
|
||||
CurFieldType = com.sun.star.sdbc.DataType.DATE
|
||||
oDateModel = CreateUnoService("com.sun.star.form.component.DateField")
|
||||
oDateModel.DataField = CurFieldName
|
||||
oDateShape = InsertControl(oGroupShape, oDateModel, aPoint, aSize)
|
||||
SetNumerics(oDateModel, CurFieldType)
|
||||
nDBHeight = GetDBHeight(oDateModel)
|
||||
nDateWidth = GetPreferredWidth(oDateModel,True)
|
||||
aSize = GetSize(nDateWidth,nDBHeight)
|
||||
oDateShape.SetSize(aSize)
|
||||
|
||||
CurFieldType = com.sun.star.sdbc.DataType.TIME
|
||||
oTimeModel = CreateUnoService("com.sun.star.form.component.TimeField")
|
||||
oTimeModel.DataField = CurFieldName
|
||||
oTimeShape = InsertControl(oGroupShape, oTimeModel, aPoint, aSize)
|
||||
oTimeShape.Position = GetPoint(nXDBPos + 10 + nDateWidth,nYDBPos)
|
||||
nTimeWidth = GetPreferredWidth(oTimeModel)
|
||||
aSize = GetSize(nTimeWidth,nDBHeight)
|
||||
oTimeShape.SetSize(aSize)
|
||||
nDBWidth = nDateWidth + nTimeWidth + 10
|
||||
oGroupShape.Position = aPoint
|
||||
oGroupShape.Size = GetSize(nDBWidth, nDBHeight)
|
||||
Set oDBShapeList(i)= oGroupShape
|
||||
End If
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
InsertTimeStampShape() = oDBShapeList(i)
|
||||
End Function
|
||||
|
||||
|
||||
' Note: on all Controls except for the checkbox the Label has to be set
|
||||
' a bit under the DBControl because its Height is also smaller
|
||||
Sub GetLabelDiffHeight(Index as Integer)
|
||||
If (CurArrangement = cLeftJustified) Or (CurArrangement = cColumnarLeft) Then
|
||||
If Index <= Ubound(FieldMetaValues()) Then
|
||||
If FieldMetaValues(Index,2) = cCheckBox Then
|
||||
LabelDiffHeight = 0
|
||||
Else
|
||||
LabelDiffHeight = BasicLabelDiffHeight
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckJustifiedPosition()
|
||||
Dim nLeftDist as Long
|
||||
Dim nRightDist as Long
|
||||
Dim oLocDBShape as Object
|
||||
Dim oLocTextShape as Object
|
||||
Dim nBaseWidth as Long
|
||||
nBaseWidth = nFormWidth + cXOffset
|
||||
nLeftDist = nMaxColRightX - nBaseWidth
|
||||
nRightDist = nBaseWidth - nXTCPos + cHoriDistance
|
||||
If nLeftDist < 0.5 * nRightDist and iReduceWidth > 2 Then
|
||||
' Fieldwidths in the line can be made smaller
|
||||
AdjustLineWidth(StartA, a, nLeftDist, - 1)
|
||||
If CurArrangement = cLeftjustified Then
|
||||
nYDBPos = nMaxRowY + cVertDistance
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
nXTCPos = cXOffset
|
||||
Else
|
||||
nYTCPos = nMaxRowY + cVertDistance
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
nXTCPos = cXOffset
|
||||
nXDBPos = cXOffset
|
||||
End If
|
||||
bIsFirstRun = True
|
||||
StartA = a + 1
|
||||
Else
|
||||
Set oLocDBShape = oDBShapeList(a)
|
||||
Set oLocTextShape = oTCShapeList(a)
|
||||
If CurArrangement = cLeftJustified Then
|
||||
If nYDBPos + nDBHeight = nMaxRowY Then
|
||||
' The last Control was the highest in the row
|
||||
nYDBPos = nSecMaxRowY + cVertDistance
|
||||
Else
|
||||
nYDBPos = nMaxRowY + cVertDistance
|
||||
End If
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
nXDBPos = cXOffset + nTCWidth
|
||||
oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
|
||||
oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos)
|
||||
' PosSizes for the next two Controls
|
||||
nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
|
||||
bIsFirstRun = True
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
nXDBPos = nMaxColRightX + cHoriDistance
|
||||
Else ' cTopJustified
|
||||
If nYDBPos + nDBHeight = nMaxRowY Then
|
||||
' The last Control was the highest in the row
|
||||
nYTCPos = nSecMaxRowY + cVertDistance
|
||||
Else
|
||||
nYTCPos = nMaxRowY + cVertDistance
|
||||
End If
|
||||
nYDBPos = nYTCPOS + nTCHeight
|
||||
nXDBPos = cXOffset
|
||||
nXTCPos = cXOffset
|
||||
oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
|
||||
oLocDBShape.Position = GetPoint(cXOffset, nYDBPos)
|
||||
bIsFirstRun = True
|
||||
If nDBWidth > nTCWidth Then
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
Else
|
||||
CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight, True)
|
||||
End If
|
||||
nXTCPos = nMaxColRightX + cHoriDistance
|
||||
nXDBPos = nXTCPos
|
||||
End If
|
||||
AdjustLineWidth(StartA, a-1, nRightDist, 1)
|
||||
StartA = a
|
||||
End If
|
||||
iReduceWidth = 0
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function GetCorrWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) as Integer
|
||||
Dim ShapeCount as Integer
|
||||
If WidthFactor > 0 Then
|
||||
ShapeCount = EndIndex-StartIndex + 1
|
||||
Else
|
||||
ShapeCount = iReduceWidth
|
||||
End If
|
||||
GetCorrWidth() = (nDist)/ShapeCount
|
||||
End Function
|
||||
|
||||
|
||||
Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer)
|
||||
Dim i as Integer
|
||||
Dim oLocDBShape as Object
|
||||
Dim oLocTCShape as Object
|
||||
Dim CorrWidth as Integer
|
||||
Dim bAdjustPos as Boolean
|
||||
Dim iLocTCPosX as Long
|
||||
Dim iLocDBPosX as Long
|
||||
CorrWidth = GetCorrWidth(StartIndex, EndIndex, nDist, Widthfactor)
|
||||
bAdjustPos = False
|
||||
iLocTCPosX = cXOffset
|
||||
For i = StartIndex To EndIndex
|
||||
Set oLocDBShape = oDBShapeList(i)
|
||||
Set oLocTCShape = oTCShapeList(i)
|
||||
If bAdjustPos Then
|
||||
oLocTCShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y)
|
||||
If CurArrangement = cLeftJustified Then
|
||||
iLocDBPosX = oLocTCShape.Position.X + oLocTCShape.Size.Width
|
||||
oLocDBShape.Position = GetPoint(iLocDBPosX, oLocDBShape.Position.Y)
|
||||
Else
|
||||
oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight)
|
||||
End If
|
||||
Else
|
||||
bAdjustPos = True
|
||||
End If
|
||||
If CDbl(FieldMetaValues(i,1)) > 20 or WidthFactor > 0 Then
|
||||
If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width > oLocDBShape.Size.Width) Then
|
||||
oLocDBShape.Size = GetSize(oLocTCShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
|
||||
Else
|
||||
oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
|
||||
End If
|
||||
End If
|
||||
iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
|
||||
If CurArrangement = cTopJustified Then
|
||||
If oLocTCShape.Size.Width > oLocDBShape.Size.Width Then
|
||||
iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean)
|
||||
Dim nColRightX as Long
|
||||
Dim nRowY as Long
|
||||
Dim nOldMaxRowY as Long
|
||||
If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then
|
||||
If bIsDBField Then
|
||||
' Only at DBControls you can measure the Value of nMaxRowY
|
||||
If bIsFirstRun Then
|
||||
nMaxRowY = nYPos + nHeight
|
||||
nSecMaxRowY = nMaxRowY
|
||||
Else
|
||||
nRowY = nYPos + nHeight
|
||||
If nRowY >= nMaxRowY Then
|
||||
nOldMaxRowY = nMaxRowY
|
||||
nSecMaxRowY = nOldMaxRowY
|
||||
nMaxRowY = nRowY
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
' Find the outer right point
|
||||
If bIsFirstRun Then
|
||||
nMaxColRightX = nXPos + nWidth
|
||||
bIsFirstRun = False
|
||||
Else
|
||||
nColRightX = nXPos + nWidth
|
||||
If nColRightX > nMaxColRightX Then
|
||||
nMaxColRightX = nColRightX
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function PositionGridControl(MaxIndex as Integer)
|
||||
Dim oControl as Object
|
||||
Dim n as Integer
|
||||
Dim oColumn as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize as New com.sun.star.awt.Size
|
||||
If bControlsareCreated Then
|
||||
ShapesToNirwana()
|
||||
End If
|
||||
oGridModel = CreateUnoService(oModelService(cGridControl))
|
||||
oGridModel.Name = "Grid1"
|
||||
aPoint = GetPoint(cXOffset, cYOffset)
|
||||
aSize = GetSize(nFormWidth, nFormHeight)
|
||||
oDBForm.InsertByName (oGridModel.Name, oGridModel)
|
||||
oGridShape = InsertControl(oDrawPage, oGridModel, aPoint, aSize)
|
||||
For n = 0 to MaxIndex
|
||||
GetCurrentMetaValues(n)
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
|
||||
oColumn = SetupGridColumn(oGridModel,"DateField", False, com.sun.star.sdbc.DataType.DATE, CurFieldName & " " & sDateAppendix)
|
||||
oColumn = SetupGridColumn(oGridModel,"TimeField", False, com.sun.star.sdbc.DataType.TIME, CurFieldName & " " & sTimeAppendix)
|
||||
Else
|
||||
If CurControlType = cImageControl Then
|
||||
oColumn = SetupGridColumn(oGridModel,"TextField", True, CurFieldType, CurFieldName)
|
||||
Else
|
||||
oColumn = SetupGridColumn(oGridModel, CurControlName, False, CurFieldType, CurFieldName)
|
||||
End If
|
||||
End If
|
||||
oProgressbar.Value = n
|
||||
next n
|
||||
End Function
|
||||
|
||||
|
||||
Function SetupGridColumn(oGridModel as Object, ControlName as String, bHidden as Boolean, iLocFieldType as Integer, ColName as String) as Object
|
||||
Dim oColumn as Object
|
||||
CurControlName = ControlName
|
||||
oColumn = oGridModel.CreateColumn(CurControlName)
|
||||
oColumn.Name = CalcUniqueContentName(oGridModel, CurControlName)
|
||||
oColumn.Hidden = bHidden
|
||||
SetNumerics(oColumn, iLocFieldType)
|
||||
oColumn.DataField = CurFieldName
|
||||
oColumn.Label = ColName
|
||||
oColumn.Width = 0 ' Width of column is adjusted to Columname
|
||||
oGridModel.insertByName(oColumn.Name, oColumn)
|
||||
End Function
|
||||
|
||||
|
||||
Sub ControlCaptionstoStandardLayout()
|
||||
Dim i as Integer
|
||||
Dim iBorderType as Integer
|
||||
Dim oCurModel as Object
|
||||
Dim oStyle as Object
|
||||
Dim iStandardColor as Long
|
||||
If CurArrangement <> cTabled Then
|
||||
oStyle = oDocument.StyleFamilies.GetByName("ParagraphStyles").GetByName("Standard")
|
||||
iStandardColor = oStyle.CharColor
|
||||
For i = 0 To MaxIndex
|
||||
oCurModel = oTCShapeList(i).GetControl
|
||||
If i = 0 Then
|
||||
If oCurModel.TextColor = iStandardColor Then
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
oCurModel.TextColor = iStandardColor
|
||||
Next i
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GroupShapesTogether()
|
||||
Dim i as Integer
|
||||
If CurArrangement <> cTabled Then
|
||||
For i = 0 To MaxIndex
|
||||
oGroupShapeList(i) = CreateUnoService("com.sun.star.drawing.ShapeCollection")
|
||||
oGroupShapeList(i).Add(oTCShapeList(i))
|
||||
oGroupShapeList(i).Add(oDBShapeList(i))
|
||||
oDrawPage.Group(oGroupShapeList(i))
|
||||
Next i
|
||||
Else
|
||||
RemoveNirwanaShapes()
|
||||
End If
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,5 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="FormWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="DlgFormDB"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,10 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="FormWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="FormWizard"/>
|
||||
<library:element library:name="Layouter"/>
|
||||
<library:element library:name="Language"/>
|
||||
<library:element library:name="DBMeta"/>
|
||||
<library:element library:name="tools"/>
|
||||
<library:element library:name="develop"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,363 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
Public Const SBMAXTEXTSIZE = 50
|
||||
|
||||
|
||||
Function SetProgressValue(iValue as Integer)
|
||||
If iValue = 0 Then
|
||||
oProgressbar.End
|
||||
End If
|
||||
ProgressValue = iValue
|
||||
oProgressbar.Value = iValue
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim nWidth as Integer
|
||||
Dim oControl as Object
|
||||
If Not IsMissing(LocText) Then
|
||||
' Label
|
||||
aPeerSize = GetPeerSize(oModel, oControl, LocText)
|
||||
ElseIf CurControlType = cImageControl Then
|
||||
GetPreferredWidth() = 2000
|
||||
Exit Function
|
||||
Else
|
||||
aPeerSize = GetPeerSize(oModel, oControl)
|
||||
End If
|
||||
nWidth = aPeerSize.Width
|
||||
' We increase the preferred Width a bit so that the control does not become too small
|
||||
' when we change the border from "3D" to "Flat"
|
||||
GetPreferredWidth = (nWidth + 10) * XPixelFactor ' PixelTo100thmm(nWidth)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPreferredHeight(oModel as Object, Optional LocText)
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim nHeight as Integer
|
||||
Dim oControl as Object
|
||||
If Not IsMissing(LocText) Then
|
||||
' Label
|
||||
aPeerSize = GetPeerSize(oModel, oControl, LocText)
|
||||
ElseIf CurControlType = cImageControl Then
|
||||
GetPreferredHeight() = 2000
|
||||
Exit Function
|
||||
Else
|
||||
aPeerSize = GetPeerSize(oModel, oControl)
|
||||
End If
|
||||
nHeight = aPeerSize.Height
|
||||
' We increase the preferred Height a bit so that the control does not become too small
|
||||
' when we change the border from "3D" to "Flat"
|
||||
GetPreferredHeight = (nHeight+1) * YPixelFactor ' PixelTo100thmm(nHeight)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
|
||||
Dim oPeer as Object
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim NullValue
|
||||
oControl = oController.GetControl(oModel)
|
||||
oPeer = oControl.GetPeer()
|
||||
If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
|
||||
If oControl.Model.EffectiveMax = 0 Then
|
||||
' This is relevant for decimal fields
|
||||
oControl.Model.EffectiveValue = 999.9999
|
||||
Else
|
||||
oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
|
||||
End If
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Model.EffectiveValue = NullValue
|
||||
ElseIf Not IsMissing(LocText) Then
|
||||
oControl.Text = LocText
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
|
||||
oControl.Model.Date = Date
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Model.Date = NullValue
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
|
||||
oControl.Time = Time
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Time = NullValue
|
||||
Else
|
||||
If oControl.MaxTextLen > SBMAXTEXTSIZE Then
|
||||
oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
|
||||
Else
|
||||
oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
|
||||
End If
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Text = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function TwipToCM(ByVal nValue as long) as String
|
||||
TwipToCM = trim(str(nValue / 567)) + "cm"
|
||||
End function
|
||||
|
||||
|
||||
Function TwipTo100telMM(ByVal nValue as long) as long
|
||||
TwipTo100telMM = nValue / 0.567
|
||||
End function
|
||||
|
||||
|
||||
Function TwipToPixel(ByVal nValue as long) as long ' not an exact calculation
|
||||
TwipToPixel = nValue / 15
|
||||
End function
|
||||
|
||||
|
||||
Function PixelTo100thMMX(oControl as Object) as long
|
||||
oPeer = oControl.GetPeer()
|
||||
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
|
||||
|
||||
' PixelTo100thMM = nValue * 28 ' not an exact calculation
|
||||
End function
|
||||
|
||||
|
||||
Function PixelTo100thMMY(oControl as Object) as long
|
||||
oPeer = oControl.GetPeer()
|
||||
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
|
||||
|
||||
' PixelTo100thMM = nValue * 28 ' not an exact calculation
|
||||
End function
|
||||
|
||||
|
||||
Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
aPoint.X = xPos
|
||||
aPoint.Y = yPos
|
||||
GetPoint() = aPoint
|
||||
End Function
|
||||
|
||||
|
||||
Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
aSize.Width = iWidth
|
||||
aSize.Height = iHeight
|
||||
GetSize() = aSize
|
||||
End Function
|
||||
|
||||
|
||||
Sub ImportStyles()
|
||||
Dim OldIndex as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
OldIndex = CurIndex
|
||||
CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
|
||||
If CurIndex <> OldIndex Then
|
||||
ToggleLayoutPage(False)
|
||||
Dim sImportPath as String
|
||||
sImportPath = Styles(CurIndex, 8)
|
||||
bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
|
||||
ControlCaptionsToStandardLayout()
|
||||
ToggleLayoutPage(True, "lstStyles")
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
|
||||
If CurControlType = cNumericBox Then
|
||||
oLocObject.TreatAsNumber = True
|
||||
Select Case iLocFieldType
|
||||
Case com.sun.star.sdbc.DataType.BIGINT
|
||||
oLocObject.EffectiveMax = 2147483647 * 2147483647
|
||||
oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
|
||||
' oLocObject.DecimalAccuracy = 0
|
||||
Case com.sun.star.sdbc.DataType.INTEGER
|
||||
oLocObject.EffectiveMax = 2147483647
|
||||
oLocObject.EffectiveMin = -2147483648
|
||||
Case com.sun.star.sdbc.DataType.SMALLINT
|
||||
oLocObject.EffectiveMax = 32767
|
||||
oLocObject.EffectiveMin = -32768
|
||||
Case com.sun.star.sdbc.DataType.TINYINT
|
||||
oLocObject.EffectiveMax = 127
|
||||
oLocObject.EffectiveMin = -128
|
||||
Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
|
||||
'Todo: oLocObject.DecimalAccuracy = ...
|
||||
oLocObject.EffectiveDefault = CurDefaultValue
|
||||
' Todo: HelpText???
|
||||
End Select
|
||||
If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width
|
||||
oLocObject.Width = CurFieldLength + CurScale + 1
|
||||
End If
|
||||
If CurIsCurrency Then
|
||||
'Todo: How do you set currencies?
|
||||
End If
|
||||
ElseIf CurControlType = cTextBox Then 'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
|
||||
If CurFieldLength = 0 Then 'Or oLocObject.MaxTextLen > SBMAXTEXTSIZE
|
||||
oLocObject.MaxTextLen = SBMAXTEXTSIZE
|
||||
CurFieldLength = SBMAXTEXTSIZE
|
||||
Else
|
||||
oLocObject.MaxTextLen = CurFieldLength
|
||||
End If
|
||||
oLocObject.DefaultText = CurDefaultValue
|
||||
ElseIf CurControlType = cDateBox Then
|
||||
' Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue
|
||||
ElseIf CurControlType = cTimeBox Then ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
|
||||
oLocObject.DefaultTime = CurDefaultValue
|
||||
' Todo: Property TimeFormat? from where?
|
||||
ElseIf CurControlType = cCheckBox Then
|
||||
' Todo Why does this not work?: oLocObject.DefaultState = CurDefaultValue
|
||||
End If
|
||||
If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then
|
||||
On Local Error Resume Next
|
||||
oLocObject.FormatKey = CurFormatKey
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Destroy all Shapes in Nirwana
|
||||
Sub RemoveShapes()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
Dim oShape as Object
|
||||
For n = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage(n)
|
||||
If oShape.Position.Y > -2000 Then
|
||||
oDrawPage.Remove(oShape)
|
||||
End If
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
' Destroy all Shapes in Nirwana
|
||||
Sub RemoveNirwanaShapes()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
Dim oShape as Object
|
||||
For n = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage(n)
|
||||
If oShape.Position.Y < -2000 Then
|
||||
oDrawPage.Remove(oShape)
|
||||
End If
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' Note: as Shapes cannot be removed from the DrawPage without destroying
|
||||
' the object we have to park them somewhere beyond the visible area of the page
|
||||
Sub ShapesToNirwana()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
For n = 0 To oDrawPage.Count-1
|
||||
oDrawPage(n).Position = GetPoint(-20, -10000)
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
Function CalcUniqueContentName(ByVal oContainer as Object, sBaseName as String) as String
|
||||
|
||||
Dim nPostfix as Integer
|
||||
Dim sReturn as String
|
||||
nPostfix = 2
|
||||
sReturn = sBaseName
|
||||
while (oContainer.hasByName(sReturn))
|
||||
sReturn = sBaseName & nPostfix
|
||||
nPostfix = nPostfix + 1
|
||||
Wend
|
||||
CalcUniqueContentName = sReturn
|
||||
End Function
|
||||
|
||||
|
||||
Function CountItemsInArray(BigArray(), SearchItem)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim ResCount as Integer
|
||||
ResCount = 0
|
||||
MaxIndex = Ubound(BigArray())
|
||||
For i = 0 To MaxIndex
|
||||
If SearchItem = BigArray(i) Then
|
||||
ResCount = ResCount + 1
|
||||
End If
|
||||
Next i
|
||||
CountItemsInArray() = ResCount
|
||||
End Function
|
||||
|
||||
|
||||
Function GetDBHeight(oDBModel as Object)
|
||||
If CurControlType = cImageControl Then
|
||||
nDBHeight = 2000
|
||||
Else
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
|
||||
oDBModel.MultiLine = True
|
||||
nDBHeight = nDBRefHeight * 4
|
||||
Else
|
||||
nDBHeight = nDBRefHeight
|
||||
End If
|
||||
End If
|
||||
GetDBHeight() = nDBHeight
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFormWizardPaths() as Boolean
|
||||
FormPath = GetOfficeSubPath("Template","../wizard/bitmap")
|
||||
If FormPath <> "" Then
|
||||
WizardPath = GetOfficeSubPath("Template","wizard/")
|
||||
If Wizardpath <> "" Then
|
||||
TexturePath = GetOfficeSubPath("Gallery", "backgrounds/")
|
||||
If TexturePath <> "" Then
|
||||
WorkPath = GetPathSettings("Work")
|
||||
If WorkPath <> "" Then
|
||||
TempPath = GetPathSettings("Temp")
|
||||
If TempPath <> "" Then
|
||||
GetFormWizardPaths = True
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
DisposeDocument(oDocument)
|
||||
GetFormWizardPaths() = False
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFilterName(sApplicationKey as String) as String
|
||||
Dim oArgs()
|
||||
Dim oFactory
|
||||
Dim i as Integer
|
||||
Dim Maxindex as Integer
|
||||
Dim UIName as String
|
||||
oFactory = createUnoService("com.sun.star.document.FilterFactory")
|
||||
oArgs() = oFactory.getByName(sApplicationKey)
|
||||
MaxIndex = Ubound(oArgs())
|
||||
For i = 0 to MaxIndex
|
||||
If (oArgs(i).Name="UIName") Then
|
||||
UIName = oArgs(i).Value
|
||||
Exit For
|
||||
End If
|
||||
next i
|
||||
GetFilterName() = UIName
|
||||
End Function
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user