open-source/file-online-preview
1
0
Fork 0
mirror of https://gitee.com/kekingcn/file-online-preview.git synced 2026-05-09 08:24:02 +00:00
Code Issues Packages Projects Releases Wiki Activity

更新windows内置office目录名, 适配jodconverter

Browse Source
This commit is contained in:
陈精华
2022-12-19 14:45:45 +08:00
parent 7d3a4ebc4e
commit d761d0cc88
12504 changed files with 3 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

347
server/libreoffice/share/basic/FormWizard/DBMeta.xba Normal file
View File

@@ -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
&apos;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
&apos; If bStartUp Then
&apos; bStartUp = false
&apos; Exit Sub
&apos; End Sub
ToggleDatabasePage(False)
With DialogModel
If GetConnection(sDBName) Then
If GetDBMetaData() Then
LocList() = AddListToList(Array(sSelectDBTable), TableNames())
.lstTables.StringItemList() = AddListToList(LocList(), QueryNames())
&apos; bSelectContent = True
.lstTables.SelectedItems() = Array(0)
iCommandTypes() = CreateCommandTypeList()
EmptyFieldsListboxes()
End If
End If
bEnableBinaryOptionGroup = False
.lstTables.Enabled = True
.lblTables.Enabled = True
&apos; Else
&apos; DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
&apos; EmptyFieldsListboxes()
&apos; 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)
&apos; If Not oDBContext.hasbyName(sDBName) Then
&apos; GetConnection() = False
&apos; Exit Function
&apos; End If
If Not oDataSource.IsPasswordRequired Then
oDBConnection = oDBContext.GetByName(sDBName).GetConnection(&quot;&quot;,&quot;&quot;)
GetConnection() = True
Else
oInteractionHandler = createUnoService(&quot;com.sun.star.task.InteractionHandler&quot;)
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()
&apos; Build a structure which maps the position of a selected field (within the selection) to the column position within
&apos; 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&lt; 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
&apos; If oField.Description &lt;&gt; &quot;&quot; Then
&apos;&apos; Todo: What&apos;s wrong with this line?
&apos; Msgbox oField.Helptext
&apos; 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()) &gt; -1 Then
FieldNames() = oColumns.GetElementNames()
MaxIndex = Ubound(FieldNames())
If MaxIndex &lt;&gt; -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) &lt;&gt; -1 Then
ResultFieldNames(m) = FieldNames(n)
m = m + 1
End If
If GetIndexInMultiArray(ImgWidthList(), iType, 0) &lt;&gt; -1 Then
ImgFieldNames(s) = FieldNames(n)
s = s + 1
End If
Next n
If s &lt;&gt; 0 Then
Redim Preserve ImgFieldNames(s-1)
bEnableBinaryOptionGroup = True
Else
bEnableBinaryOptionGroup = False
End If
If (DialogModel.optBinariesasGraphics.State = 1) And (s &lt;&gt; 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(&quot;com.sun.star.form.component.Form&quot;)
oDrawpage.Forms.InsertByIndex (0, oDBForm)
Else
oDBForm = oDrawPage.Forms.GetByIndex(0)
End If
oDBForm.Name = &quot;Standard&quot;
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 &lt;&gt; 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 &gt; -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 &gt;= 65535 Then
AssignFieldLength() = -1
Else
AssignFieldLength() = FieldLength
End If
End Function
</script:module>

111
server/libreoffice/share/basic/FormWizard/DlgFormDB.xdl Normal file
View File

@@ -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&amp;location=application" script:language="Script"/>
<script:event script:event-name="on-mousedown" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.DeleteFirstTableListBoxEntry?language=Basic&amp;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&amp;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&amp;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="-&gt;">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveSelected?language=Basic&amp;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="=&gt;&gt;">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveAll?language=Basic&amp;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="&lt;-">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveSelected?language=Basic&amp;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="&lt;&lt;=">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveAll?language=Basic&amp;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&amp;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&amp;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&amp;location=application" script:language="Script"/>
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&amp;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&amp;location=application" script:language="Script"/>
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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&amp;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>

440
server/libreoffice/share/basic/FormWizard/FormWizard.xba Normal file
View File

@@ -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 = &quot;The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog.&quot;
Public bDisposeDoc as Boolean
Public bDebug as Boolean
&apos;Public bStartUp as Boolean
Public bConnectionIsovergiven as Boolean
Public FormName As String
Public sFormUrl as String
Public oFormDocuments
&apos; The macro can be called in 4 possible scenarios:
&apos; Scenario 1. No parameters at given
&apos; Scenario 2: Only Datasourcename is given, but no connection and no Content
&apos; Scenario 3: a data source and a connection are given
&apos; Scenario 4: all parameters (data source name, connection, object type and object) are given
Sub Main()
Dim oLocDBContext as Object
Dim oLocConnection as Object
&apos; Scenario 1. No parameters at given
MainWithDefault()
&apos; Scenario 2: Only Datasourcename is given, but no connection and no Content
&apos; MainWithDefault(&quot;Bibliography&quot;)
&apos; Scenario 3: a data source and a connection are given
&apos; oLocDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
&apos; oLocConnection = oLocDBContext.GetByName(&quot;Bibliography&quot;).GetConnection(&quot;&quot;,&quot;&quot;)
&apos; MainWithDefault(&quot;Bibliography&quot;, oLocConnection)
&apos; Scenario 4: all parameters (data source name, connection, object type and object) are given
&apos; oLocDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
&apos; oLocConnection = oLocDBContext.GetByName(&quot;Bibliography&quot;).GetConnection(&quot;&quot;,&quot;&quot;)
&apos; MainWithDefault(&quot;Bibliography&quot;, oLocConnection, com.sun.star.sdb.CommandType.TABLE, &quot;biblio&quot;)
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(&quot;Tools&quot;)
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(&quot;Formwizard&quot;) Then
Exit Sub
End If
oDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
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, &quot;/stl&quot;)
CurIndex = GetCurIndex(DialogModel, Styles(), 2)
oProgressBar.Value = 40
ConfigurePageStyle()
oProgressBar.Value = 50
InitializeLabelValues()
bNeedFieldRefresh = True
SetDialogLanguage()
&apos; 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
&apos; 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
&apos; 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(&quot;lstTables&quot;).SelectItem(sContent, True)
Else
If CommandType = com.sun.star.sdb.CommandType.QUERY Then
SelIndex = IndexInArray(sContent, QueryNames())
DlgFormDB.GetControl(&quot;lstTables&quot;).SelectItemPos(SelIndex, True)
ElseIf CommandType = com.sun.star.sdb.CommandType.TABLE Then
SelIndex = IndexInArray(sContent, TableNames())
DlgFormDB.GetControl(&quot;lstTables&quot;).SelectItemPos(Ubound(QueryNames()+1 + SelIndex, True))
End If
End If
CurCommandType = CommandType
FillUpFieldsListbox(False)
Else
LocList() = AddListToList(Array(sSelectDBTable), LocList())
DialogModel.lstTables.StringItemList() = LocList()
&apos; bSelectContent = True
DialogModel.lstTables.SelectedItems() = Array(0)
End If
End If
Else
&apos; Scenario 2: Only Datasourcename is given, but no connection and no Content
GetSelectedDBMetaData(sDBName)
End If
Else
&apos; 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 &amp; &quot;FormWizard_1.png&quot;
DialogModel.imgTheme.BackGroundColor = RGB(0,60,126)
ToggleDatabasePage(True)
oProgressBar.Value = 100
DlgFormDB.GetControl(&quot;lstTables&quot;).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 &amp; &quot;_&quot; &amp; i
End If
Loop Until Not bLinkExists
aPropertyValues(0).Name = &quot;Name&quot;
aPropertyValues(0).Value = FormName
aPropertyValues(1).Name = &quot;Parent&quot;
aPropertyValues(1).Value = oFormDocuments()
aPropertyValues(2).Name = &quot;URL&quot;
aPropertyValues(2).Value = sFormUrl
Dim oDBDocument
oDBDocument = oFormDocuments.createInstanceWithArguments(&quot;com.sun.star.sdb.DocumentDefinition&quot;, 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 &lt;&gt; 0 Then
Msgbox(sMsgErrMsg, 16, GetProductName())
Resume LOCERROR
LOCERROR:
End If
End Sub
Sub FormGetFields()
Dim i as Integer
&apos; If bSelectContent Then
&apos; bSelectContent = False
&apos; Exit Sub
&apos; End If
DeleteFirstListBoxEntry(&quot;lstTables&quot;, 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(&quot;lstTables&quot;).getSelectedItemPos() &apos;.SelectedItems())
If SelIndex &gt; -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() &lt;&gt; -1 Then
ToggleListboxControls(DialogModel, True)
Exit Sub
End If
End If
EmptyFieldsListboxes()
NOFIELDS:
If Err &lt;&gt; 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 &amp; &quot;FormWizard_1.png&quot;
End With
FormSetMoveRights()
WIZARDERROR:
If Err &lt;&gt; 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 &amp; &quot;FormWizard_&quot; &amp; DialogModel.Step &amp; &quot;.png&quot;
DlgFormDB.Title = WizardTitle(DialogModel.Step)
WIZARDERROR:
If Err &lt;&gt; 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 &lt;&gt; 0 Then
DlgFormDB.GetControl(&quot;optAlign2&quot;).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()) &lt;&gt; -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
&apos; This Sub is called from the Procedure &quot;StoreDocument&quot; in the &quot;Tools&quot; 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 &amp; &quot;_&quot; &amp; 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 = &quot;Form_&quot; &amp; sDBName &amp; &quot;_&quot; &amp; TableName &amp; &quot;.sxw&quot;
sFormUrl = TempPath &amp; &quot;/&quot; &amp; 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(&quot;org.openoffice.TypeDetection.Types/&quot;)
oTypes() = oMasterKey.Types
TypeNames(0,0) = GetFilterName(&quot;StarOffice XML (Writer)&quot;)
TypeNames(0,1) = &quot;*.sxw&quot;
TypeNames(0,2) = &quot;&quot;
StoreFormInDatabase()
&apos; sTargetPath = StoreDocument(oDocument, TypeNames(), &quot;Form_&quot; &amp; sDBName &amp; &quot;_&quot; &amp; TableName &amp; &quot;.sxw&quot;, 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(&quot;lstTables&quot;, 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 &gt; 0 Then
oListBox.selectItemPos(iSelPos-1, True)
End If
End If
End Sub
</script:module>

297
server/libreoffice/share/basic/FormWizard/Language.xba Normal file
View File

@@ -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(&quot;RID_FORM_0&quot;)
sMsgErrMsg = GetResText(&quot;RID_DB_COMMON_6&quot;)
sMsgErrNoDatabase = GetResText(&quot;RID_DB_COMMON_8&quot;)
sMsgErrNoTableInDatabase = GetResText(&quot;RID_DB_COMMON_9&quot;)
sMsgErrTitleSuggestedExist = GetResText(&quot;RID_DB_COMMON_10&quot;)
sMsgErrTitleAsTableExist = GetResText(&quot;RID_DB_COMMON_10&quot;)
sMsgErrTitleSyntaxError = GetResText(&quot;RID_DB_COMMON_11&quot;)
sMsgNoConnection = GetResText(&quot;RID_DB_COMMON_14&quot;)
sMsgProgressText = GetResText(&quot;RID_FORM_2&quot;)
sMsgCreatedForm = GetResText(&quot;RID_FORM_26&quot;)
sMsgErrNameToLong = GetResText(&quot;RID_FORM_27&quot;)
sMsgErrCouldNotOpenObject = GetResText(&quot;RID_DB_COMMON_13&quot;)
&apos; Internal Logic
sDateAppendix = GetResText(&quot;RID_FORM_4&quot;)
sTimeAppendix = GetResText(&quot;RID_FORM_5&quot;)
sReady = GetResText(&quot;RID_DB_COMMON_0&quot;)
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(&quot;FormWizard&quot;, &quot;DlgFormDB&quot;)
DialogModel = DlgFormDB.Model
With DialogModel
.cmdCancel.Label = GetResText(&quot;RID_DB_COMMON_1&quot;)
.cmdBack.Label = GetResText(&quot;RID_DB_COMMON_2&quot;)
.cmdHelp.Label = GetResText(&quot;RID_DB_COMMON_20&quot;)
sGoOn = GetResText(&quot;RID_DB_COMMON_3&quot;)
.cmdGoOn.Label = sGoOn
.lblTables.Label = GetResText(&quot;RID_FORM_6&quot;)
slblFields = GetResText(&quot;RID_FORM_12&quot;)
slblSelFields = GetResText(&quot;RID_FORM_13&quot;)
.lblFields.Label = slblFields
.lblSelFields.Label = slblSelFields
.lblStyles.Label = GetResText(&quot;RID_FORM_21&quot;)
.hlnBorderLayout.Label = GetResText(&quot;RID_FORM_28&quot;)
.hlnAlign.Label = GetResText(&quot;RID_FORM_32&quot;)
.hlnArrangements.Label = GetResText(&quot;RID_FORM_35&quot;)
WizardTitle(1) = sMsgWizardName &amp; &quot; - &quot; &amp; GetResText(&quot;RID_FORM_45&quot;)
WizardTitle(2) = sMsgWizardName &amp; &quot; - &quot; &amp; GetResText(&quot;RID_FORM_46&quot;)
WizardTitle(3) = sMsgWizardName &amp; &quot; - &quot; &amp; GetResText(&quot;RID_FORM_47&quot;)
.hlnBinaries.Label = GetResText(&quot;RID_FORM_50&quot;)
.optIgnoreBinaries.Label = GetResText(&quot;RID_FORM_51&quot;)
.optBinariesasGraphics.Label = GetResText(&quot;RID_FORM_52&quot;)
.hlnBackground.Label = GetResText(&quot;RID_FORM_55&quot;)
.optTiled.Label = GetResText(&quot;RID_FORM_56&quot;)
.optArea.Label = GetResText(&quot;RID_FORM_57&quot;)
.optBorder0.Label = GetResText(&quot;RID_FORM_29&quot;)
.optBorder1.Label = GetResText(&quot;RID_FORM_30&quot;)
.optBorder2.Label = GetResText(&quot;RID_FORM_31&quot;)
.optBorder1.State = 1
.optAlign0.Label = GetResText(&quot;RID_FORM_33&quot;)
.optAlign2.Label = GetResText(&quot;RID_FORM_34&quot;)
.optAlign0.State = 1
REM//FIXME: Remove this unused FNameAddOn through the file
FNameAddOn = &quot;&quot;
IDArray = Array(&quot;RID_FORM_36&quot;, &quot;RID_FORM_37&quot;, &quot;RID_FORM_40&quot;, &quot;RID_FORM_38&quot;, &quot;RID_FORM_39&quot;)
For i = 1 To 5
ButtonHelpText = GetResText(IDArray(i-1))
cmdButton = DlgFormDB.getControl(&quot;cmdArrange&quot; &amp; i)
cmdButton.Model.ImageURL = FormPath &amp; &quot;Arrange_&quot; &amp; i &amp; FNameAddOn &amp; &quot;.gif&quot;
cmdButton.Model.HelpText = ButtonHelpText
cmdButton.getPeer().setProperty(&quot;AccessibleName&quot;, ButtonHelpText)
Next i
&apos; .cmdArrange1.ImageURL = FormPath &amp; &quot;Arrange_1&quot; &amp; FNameAddOn &amp; &quot;.gif&quot;
&apos; .cmdArrange1.HelpText = GetResText(&quot;RID_FORM_36&quot;)
&apos;
&apos; .cmdArrange2.ImageURL = FormPath &amp; &quot;Arrange_2&quot; &amp; FNameAddOn &amp; &quot;.gif&quot;
&apos; .cmdArrange2.HelpText = GetResText(&quot;RID_FORM_37&quot;)
&apos;
&apos; .cmdArrange3.ImageURL = FormPath &amp; &quot;Arrange_3&quot; &amp; FNameAddOn &amp; &quot;.gif&quot;
&apos; .cmdArrange3.HelpText = GetResText(&quot;RID_FORM_40&quot;)
&apos;
&apos; .cmdArrange4.ImageURL = FormPath &amp; &quot;Arrange_4&quot; &amp; FNameAddOn &amp; &quot;.gif&quot;
&apos; .cmdArrange4.HelpText = GetResText(&quot;RID_FORM_38&quot;)
&apos;
&apos; .cmdArrange5.ImageURL = FormPath &amp; &quot;Arrange_5&quot; &amp; FNameAddOn &amp; &quot;.gif&quot;
&apos; .cmdArrange5.HelpText = GetResText(&quot;RID_FORM_39&quot;)
End With
DlgFormDB.GetControl(&quot;cmdMoveSelected&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, GetResText(&quot;RID_DB_COMMON_39&quot;))
DlgFormDB.GetControl(&quot;cmdRemoveSelected&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, GetResText(&quot;RID_DB_COMMON_40&quot;))
DlgFormDB.GetControl(&quot;cmdMoveAll&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, GetResText(&quot;RID_DB_COMMON_41&quot;))
DlgFormDB.GetControl(&quot;cmdRemoveAll&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, GetResText(&quot;RID_DB_COMMON_42&quot;))
DlgFormDB.getControl(&quot;lstFields&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, DeleteStr(slblFields, &quot;~&quot;))
DlgFormDB.getControl(&quot;lstSelFields&quot;).getPeer().setProperty(&quot;AccessibleName&quot;, DeleteStr(slblSelFields, &quot;~&quot;))
sSelectDatasource = GetResText(&quot;RID_DB_COMMON_37&quot;)
sSelectDBTable = GetResText(&quot;RID_DB_COMMON_38&quot;)
End Sub
Sub InitializeWidthList()
If Ubound(WidthList(),1) &gt; 16 Then
ReDim WidthList(16,4)
End If
WidthList(0,0) = com.sun.star.sdbc.DataType.BIT &apos; = -7;
WidthList(0,1) = cCheckbox
WidthList(0,2) = False
WidthList(0,3) = &quot;CheckBox&quot;
WidthList(1,0) = com.sun.star.sdbc.DataType.TINYINT &apos; = -6;
WidthList(1,1) = cNumericBox
WidthList(1,2) = False
WidthList(1,3) = &quot;FormattedField&quot;
WidthList(2,0) = com.sun.star.sdbc.DataType.SMALLINT &apos; = 5;
WidthList(2,1) = cNumericBox
WidthList(2,2) = False
WidthList(2,3) = &quot;FormattedField&quot;
WidthList(3,0) = com.sun.star.sdbc.DataType.INTEGER &apos; = 4;
WidthList(3,1) = cNumericBox
WidthList(3,2) = False
WidthList(3,3) = &quot;FormattedField&quot;
WidthList(4,0) = com.sun.star.sdbc.DataType.BIGINT &apos; = -5;
WidthList(4,1) = cNumericBox
WidthList(4,2) = False
WidthList(4,3) = &quot;FormattedField&quot;
WidthList(5,0) = com.sun.star.sdbc.DataType.FLOAT &apos; = 6;
WidthList(5,1) = cNumericBox
WidthList(5,2) = False
WidthList(5,3) = &quot;FormattedField&quot;
WidthList(6,0) = com.sun.star.sdbc.DataType.REAL &apos; = 7;
WidthList(6,1) = cNumericBox
WidthList(6,2) = False
WidthList(6,3) = &quot;FormattedField&quot;
WidthList(7,0) = com.sun.star.sdbc.DataType.DOUBLE &apos; = 8;
WidthList(7,1) = cNumericBox
WidthList(7,2) = False
WidthList(7,3) = &quot;FormattedField&quot;
WidthList(8,0) = com.sun.star.sdbc.DataType.NUMERIC &apos; = 2;
WidthList(8,1) = cNumericBox
WidthList(8,2) = False
WidthList(8,3) = &quot;FormattedField&quot;
WidthList(9,0) = com.sun.star.sdbc.DataType.DECIMAL &apos; = 3; (including decimal places)
WidthList(9,1) = cNumericBox
WidthList(9,2) = False
WidthList(9,3) = &quot;FormattedField&quot;
WidthList(10,0) = com.sun.star.sdbc.DataType.CHAR &apos; = 1;
WidthList(10,1) = cTextBox
WidthList(10,2) = False
WidthList(10,3) = &quot;TextField&quot;
WidthList(11,0) = com.sun.star.sdbc.DataType.VARCHAR &apos; = 12;
WidthList(11,1) = cTextBox
WidthList(11,2) = True
WidthList(11,3) = &quot;TextField&quot;
WidthList(12,0) = com.sun.star.sdbc.DataType.LONGVARCHAR &apos; = -1;
WidthList(12,1) = cTextBox
WidthList(12,2) = True
WidthList(12,3) = &quot;TextField&quot;
WidthList(13,0) = com.sun.star.sdbc.DataType.DATE &apos; = 91;
WidthList(13,1) = cDateBox
WidthList(13,2) = False
WidthList(13,3) = &quot;DateField&quot;
WidthList(14,0) = com.sun.star.sdbc.DataType.TIME &apos; = 92;
WidthList(14,1) = cTimeBox
WidthList(14,2) = False
WidthList(14,3) = &quot;TimeField&quot;
WidthList(15,0) = com.sun.star.sdbc.DataType.TIMESTAMP &apos; = 93;
WidthList(15,1) = cDateBox
WidthList(15,2) = False
WidthList(15,3) = &quot;DateField&quot;
WidthList(16,0) = com.sun.star.sdbc.DataType.BOOLEAN &apos; = 16;
WidthList(16,1) = cCheckbox
WidthList(16,2) = False
WidthList(16,3) = &quot;CheckBox&quot;
ImgWidthList(0,0) = com.sun.star.sdbc.DataType.BINARY &apos; = -2;
ImgWidthList(0,1) = cImageControl
ImgWidthList(0,2) = False
ImgWidthList(0,3) = &quot;ImageControl&quot;
ImgWidthList(1,0) = com.sun.star.sdbc.DataType.VARBINARY &apos; = -3;
ImgWidthList(1,1) = cImageControl
ImgWidthList(1,2) = False
ImgWidthList(1,3) = &quot;ImageControl&quot;
ImgWidthList(2,0) = com.sun.star.sdbc.DataType.LONGVARBINARY &apos; = -4;
ImgWidthList(2,1) = cImageControl
ImgWidthList(2,2) = False
ImgWidthList(2,3) = &quot;ImageControl&quot;
ImgWidthList(3,0) = com.sun.star.sdbc.DataType.BLOB &apos; = 2004;
ImgWidthList(3,1) = cImageControl
ImgWidthList(3,2) = False
ImgWidthList(3,3) = &quot;ImageControl&quot;
&apos; Note: the following Fieldtypes are ignored
&apos;ExcludeList(0) = com.sun.star.sdbc.DataType.SQLNULL
&apos;ExcludeList(1) = com.sun.star.sdbc.DataType.OTHER
&apos;ExcludeList(2) = com.sun.star.sdbc.DataType.OBJECT
&apos;ExcludeList(3) = com.sun.star.sdbc.DataType.DISTINCT
&apos;ExcludeList(4) = com.sun.star.sdbc.DataType.STRUCT
&apos;ExcludeList(5) = com.sun.star.sdbc.DataType.ARRAY
&apos;ExcludeList(6) = com.sun.star.sdbc.DataType.CLOB
&apos;ExcludeList(7) = com.sun.star.sdbc.DataType.REF
oModelService(cLabel) = &quot;com.sun.star.form.component.FixedText&quot;
oModelService(cTextBox) = &quot;com.sun.star.form.component.TextField&quot;
oModelService(cCheckBox) = &quot;com.sun.star.form.component.CheckBox&quot;
oModelService(cDateBox) = &quot;com.sun.star.form.component.DateField&quot;
oModelService(cTimeBox) = &quot;com.sun.star.form.component.TimeField&quot;
oModelService(cNumericBox) = &quot;com.sun.star.form.component.FormattedField&quot;
oModelService(cGridControl) = &quot;com.sun.star.form.component.GridControl&quot;
oModelService(cImageControl) = &quot;com.sun.star.form.component.DatabaseImageControl&quot;
End Sub
</script:module>

397
server/libreoffice/share/basic/FormWizard/Layouter.xba Normal file
View File

@@ -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
&apos; 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)
&apos; Description of this List:
&apos; CurFieldType = FieldMetaValues(Index,0)
&apos; CurFieldLength = FieldMetaValues(Index,1)
&apos; CurControlType = FieldMetaValues(Index,2) (ControlType, e.g., cLabel, cTextbox, etc.)
&apos; CurControlName = FieldMetaValues(Index,3)
&apos; CurFormatKey = FieldMetaValues(Index,4)
&apos; CurDefaultValue = FieldMetaValues(Index,5)
&apos; CurIsCurrency = FieldMetaValues(Index,6)
&apos; CurScale = FieldMetaValues(Index,7)
&apos; 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 (&quot;com.sun.star.drawing.ControlShape&quot;)
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(&quot;&quot;, MaxIndex)
If oDBForm.HasbyName(&quot;Grid1&quot;) 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(&quot;swriter&quot;)
oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
oProgressbar.Start(&quot;&quot;, 100)
oDocument.ApplyFormDesignMode = False
oController = oDocument.GetCurrentController
oViewSettings = oDocument.CurrentController.ViewSettings
oViewSettings.ShowTableBoundaries = False
oViewSettings.ShowOnlineLayout = True
oDrawPage = oDocument.DrawPage
oPageStyle = oDocument.StyleFamilies.GetByName(&quot;PageStyles&quot;).GetByName(&quot;Standard&quot;)
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(&quot;com.sun.star.form.component.FixedText&quot;)
oTBModel = CreateUnoService(&quot;com.sun.star.form.component.TextField&quot;)
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, &quot;The quick brown fox...&quot;)
nTCHeight = (aLabelSize.Height+1) * YPixelFactor
aTBSize = GetPeerSize(oTBModel, oLocControl, &quot;The quick brown fox...&quot;)
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
&apos; 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 &lt;&gt; CurBorderType Then
For i = 0 To MaxIndex
If oDBShapeList(i).SupportsService(&quot;com.sun.star.drawing.GroupShape&quot;) Then
oGroupShape = oDBShapeList(i)
For s = 0 To oGroupShape.Count-1
oGroupShape(s).Control.Border = CurBorderType
Next s
Else
If oDBModelList(i).PropertySetInfo.HasPropertyByName(&quot;Border&quot;) Then
oDBModelList(i).Border = CurBorderType
End If
End If
Next i
End If
End If
ToggleLayoutPage(True)
WIZARDERROR:
If Err &lt;&gt; 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 &lt;&gt; 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 &lt;&gt; 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(&quot;cmdArrange&quot; &amp; OldArrangement).Model.State = 0
If CurArrangement &lt;&gt; OldArrangement Then
ArrangeControls()
Select Case CurArrangement
Case cTabled
ToggleBorderGroup(False)
ToggleAlignGroup(False)
Case Else &apos; 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 &lt;&gt; 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 &apos; 0: No border
.optBorder1.Enabled = bDoEnable &apos; 1: 3D border
.optBorder2.Enabled = bDoEnable &apos; 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 = &quot;com.sun.star.drawing.ControlShape&quot; Then
oShape.Dispose()
End If
Next i
End Sub
Sub SwitchArrangementButtons(ByVal LocArrangement as Integer)
OldArrangement = CurArrangement
CurArrangement = LocArrangement
If OldArrangement &lt;&gt; 0 Then
DlgFormDB.GetControl(&quot;cmdArrange&quot; &amp; OldArrangement).Model.State = 0
End If
DlgFormDB.GetControl(&quot;cmdArrange&quot; &amp; 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>

550
server/libreoffice/share/basic/FormWizard/develop.xba Normal file
View File

File diff suppressed because it is too large Load Diff

5
server/libreoffice/share/basic/FormWizard/dialog.xlb Normal file
View File

@@ -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>

10
server/libreoffice/share/basic/FormWizard/script.xlb Normal file
View File

@@ -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>

363
server/libreoffice/share/basic/FormWizard/tools.xba Normal file
View File

@@ -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
&apos; Label
aPeerSize = GetPeerSize(oModel, oControl, LocText)
ElseIf CurControlType = cImageControl Then
GetPreferredWidth() = 2000
Exit Function
Else
aPeerSize = GetPeerSize(oModel, oControl)
End If
nWidth = aPeerSize.Width
&apos; We increase the preferred Width a bit so that the control does not become too small
&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
GetPreferredWidth = (nWidth + 10) * XPixelFactor &apos; 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
&apos; Label
aPeerSize = GetPeerSize(oModel, oControl, LocText)
ElseIf CurControlType = cImageControl Then
GetPreferredHeight() = 2000
Exit Function
Else
aPeerSize = GetPeerSize(oModel, oControl)
End If
nHeight = aPeerSize.Height
&apos; We increase the preferred Height a bit so that the control does not become too small
&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
GetPreferredHeight = (nHeight+1) * YPixelFactor &apos; 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(&quot;EffectiveMax&quot;) Then
If oControl.Model.EffectiveMax = 0 Then
&apos; 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 &gt; SBMAXTEXTSIZE Then
oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
Else
oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
End If
GetPeerSize() = oPeer.PreferredSize()
oControl.Text = &quot;&quot;
End If
End Function
Function TwipToCM(BYVAL nValue as long) as String
TwipToCM = trim(str(nValue / 567)) + &quot;cm&quot;
End function
Function TwipTo100telMM(BYVAL nValue as long) as long
TwipTo100telMM = nValue / 0.567
End function
Function TwipToPixel(BYVAL nValue as long) as long &apos; 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)
&apos; PixelTo100thMM = nValue * 28 &apos; not an exact calculation
End function
Function PixelTo100thMMY(oControl as Object) as long
oPeer = oControl.GetPeer()
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
&apos; PixelTo100thMM = nValue * 28 &apos; 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 &lt;&gt; OldIndex Then
ToggleLayoutPage(False)
Dim sImportPath as String
sImportPath = Styles(CurIndex, 8)
bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
ControlCaptionsToStandardLayout()
ToggleLayoutPage(True, &quot;lstStyles&quot;)
End If
WIZARDERROR:
If Err &lt;&gt; 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)
&apos; 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
&apos;Todo: oLocObject.DecimalAccuracy = ...
oLocObject.EffectiveDefault = CurDefaultValue
&apos; Todo: HelpText???
End Select
If oLocObject.PropertySetinfo.HasPropertyByName(&quot;Width&quot;)Then &apos; Note: an Access AutoincrementField does not provide this property Width
oLocObject.Width = CurFieldLength + CurScale + 1
End If
If CurIsCurrency Then
&apos;Todo: How do you set currencies?
End If
ElseIf CurControlType = cTextBox Then &apos;com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
If CurFieldLength = 0 Then &apos;Or oLocObject.MaxTextLen &gt; SBMAXTEXTSIZE
oLocObject.MaxTextLen = SBMAXTEXTSIZE
CurFieldLength = SBMAXTEXTSIZE
Else
oLocObject.MaxTextLen = CurFieldLength
End If
oLocObject.DefaultText = CurDefaultValue
ElseIf CurControlType = cDateBox Then
&apos; Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue
ElseIf CurControlType = cTimeBox Then &apos; com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
oLocObject.DefaultTime = CurDefaultValue
&apos; Todo: Property TimeFormat? from where?
ElseIf CurControlType = cCheckBox Then
&apos; Todo Why does this not work?: oLocObject.DefaultState = CurDefaultValue
End If
If oLocObject.PropertySetInfo.HasPropertybyName(&quot;FormatKey&quot;) Then
On Local Error Resume Next
oLocObject.FormatKey = CurFormatKey
End If
End Function
&apos; 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 &gt; -2000 Then
oDrawPage.Remove(oShape)
End If
Next n
End Sub
&apos; 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 &lt; -2000 Then
oDrawPage.Remove(oShape)
End If
Next n
End Sub
&apos; Note: as Shapes cannot be removed from the DrawPage without destroying
&apos; 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 &amp; 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(&quot;Template&quot;,&quot;../wizard/bitmap&quot;)
If FormPath &lt;&gt; &quot;&quot; Then
WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
If Wizardpath &lt;&gt; &quot;&quot; Then
TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;backgrounds/&quot;)
If TexturePath &lt;&gt; &quot;&quot; Then
WorkPath = GetPathSettings(&quot;Work&quot;)
If WorkPath &lt;&gt; &quot;&quot; Then
TempPath = GetPathSettings(&quot;Temp&quot;)
If TempPath &lt;&gt; &quot;&quot; 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(&quot;com.sun.star.document.FilterFactory&quot;)
oArgs() = oFactory.getByName(sApplicationKey)
MaxIndex = Ubound(oArgs())
For i = 0 to MaxIndex
If (oArgs(i).Name=&quot;UIName&quot;) Then
UIName = oArgs(i).Value
Exit For
End If
next i
GetFilterName() = UIName
End Function
</script:module>