diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 16:51:28 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 16:51:28 +0000 |
commit | 940b4d1848e8c70ab7642901a68594e8016caffc (patch) | |
tree | eb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /odk/examples/OLE/delphi/InsertTables | |
parent | Initial commit. (diff) | |
download | libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.tar.xz libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.zip |
Adding upstream version 1:7.0.4.upstream/1%7.0.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'odk/examples/OLE/delphi/InsertTables')
-rw-r--r-- | odk/examples/OLE/delphi/InsertTables/Project1.dpr | 14 | ||||
-rw-r--r-- | odk/examples/OLE/delphi/InsertTables/Project1.res | 0 | ||||
-rw-r--r-- | odk/examples/OLE/delphi/InsertTables/SampleCode.pas | 393 | ||||
-rw-r--r-- | odk/examples/OLE/delphi/InsertTables/SampleUI.dfm | 4 | ||||
-rw-r--r-- | odk/examples/OLE/delphi/InsertTables/SampleUI.pas | 168 |
5 files changed, 579 insertions, 0 deletions
diff --git a/odk/examples/OLE/delphi/InsertTables/Project1.dpr b/odk/examples/OLE/delphi/InsertTables/Project1.dpr new file mode 100644 index 000000000..9f2bd2fd5 --- /dev/null +++ b/odk/examples/OLE/delphi/InsertTables/Project1.dpr @@ -0,0 +1,14 @@ +program Project1; + +uses + Forms, + SampleUI in 'SampleUI.pas' {OKBottomDlg}, + SampleCode in 'SampleCode.pas'; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TOKBottomDlg, OKBottomDlg); + Application.Run; +end. diff --git a/odk/examples/OLE/delphi/InsertTables/Project1.res b/odk/examples/OLE/delphi/InsertTables/Project1.res new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/odk/examples/OLE/delphi/InsertTables/Project1.res diff --git a/odk/examples/OLE/delphi/InsertTables/SampleCode.pas b/odk/examples/OLE/delphi/InsertTables/SampleCode.pas new file mode 100644 index 000000000..f314f7ea6 --- /dev/null +++ b/odk/examples/OLE/delphi/InsertTables/SampleCode.pas @@ -0,0 +1,393 @@ +{*********************************************************************** + * + * The Contents of this file are made available subject to the terms of + * the BSD license. + * + * Copyright 2000, 2010 Oracle and/or its affiliates. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of Sun Microsystems, Inc. nor the names of its + * contributors may be used to endorse or promote products derived + * from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS + * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND + * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR + * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + *************************************************************************} +unit SampleCode; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComObj, Variants; + + type + TSampleCode = class + + function Connect() : boolean; + procedure Disconnect(); + + function CreateDocument(bReadOnly : boolean) : boolean; + + procedure InsertTable(sTableName : String; dbPointer : String); + + procedure InsertDatabaseTable( + oDoc : Variant; + sTableName : String; + oCursor : Variant; + iRows : Integer; + iColumns : Integer; + dbPointer : String ); + function CreateTextTable( + oDoc : Variant; + oCursor : Variant; + sName : String; + iRow : Integer; + iColumn : Integer) : Variant; + function getCellContent( + sBookmarkName : String ) : Variant; + function getDatabasePointer( + sTableName : String; + sCellname : String ) : String; + procedure InsertBookmark( + oDoc : Variant; + oTextCursor : Variant; + sBookmarkName : String ); + function CreateBookmarkName( + sTableName : String; + sCellName : String; + sDatabasepointer : String ) : String; + procedure ChangeCellContent( + oDoc : Variant; + sTableName : String; + sCellName : String; + dValue : Double ); + function GetBookmarkFromDBPointer( + oDoc : Variant; + sBookmarkName : String) : Variant; + function GetBookmarkFromAdress( + oDoc : Variant; + sTableName : String; + sCellAdress : String) : Variant; + function JumpToBookmark( + oBookmark : Variant) : Variant; + function CreateUniqueTablename(oDoc : Variant) : String; + + private + StarOffice : Variant; + Document : Variant; + + { Private-Deklarationen } + public + { Public-Deklarationen } + end; + +implementation + +{ Insert a table texttable and insert in each cell a Bookmark with the address + of the cell and database pointer +} + +function TSampleCode.Connect() : boolean; +begin + if VarIsEmpty(StarOffice) then + StarOffice := CreateOleObject('com.sun.star.ServiceManager'); + + Connect := not (VarIsEmpty(StarOffice) or VarIsNull(StarOffice)); +end; + +procedure TSampleCode.Disconnect(); +begin + StarOffice := Unassigned; +end; + +function TSampleCode.CreateDocument(bReadOnly : boolean) : boolean; +var + StarDesktop : Variant; + LoadParams : Variant; + CoreReflection : Variant; + PropertyValue : Variant; +begin + StarDesktop := StarOffice.createInstance('com.sun.star.frame.Desktop'); + + if (bReadOnly) then begin + LoadParams := VarArrayCreate([0, 0], varVariant); + CoreReflection := StarOffice.createInstance('com.sun.star.reflection.CoreReflection'); + + CoreReflection + .forName('com.sun.star.beans.PropertyValue') + .createObject(PropertyValue); + + PropertyValue.Name := 'ReadOnly'; + PropertyValue.Value := true; + + LoadParams[0] := PropertyValue; + end + else + LoadParams := VarArrayCreate([0, -1], varVariant); + + Document := StarDesktop.LoadComponentFromURL( 'private:factory/swriter', '_blank', 0, LoadParams); + + CreateDocument := not (VarIsEmpty(Document) or VarIsNull(Document)); +end; + + +function TSampleCode.getCellContent( + sBookmarkName : String ) : Variant; +var + oBookmark : Variant; + oTextCursor : Variant; +begin + oBookmark := GetBookmarkFromDBPointer( Document, sBookmarkName ); + oTextCursor := JumpToBookmark( oBookmark ); + + getCellContent := oTextCursor.Cell.Value; + +end; + + +function TSampleCode.getDatabasePointer( + sTableName : String; + sCellname : String ) : String; +var + oBookmark : Variant; + sBookmarkName : String; + iPos : Integer; +begin + oBookmark := GetBookmarkFromAdress( Document, sTableName, sCellName ); + + sBookmarkName := oBookmark.getName(); + + iPos := Pos('/%', sBookmarkName); + while Pos('/%', sBookmarkName) > 0 do + begin + iPos := Pos('/%', sBookmarkName); + sBookmarkName[iPos] := '%'; + end; + + Delete( sBookmarkName, 1, iPos+1); + getDatabasePointer := sBookmarkName; +end; + + +procedure TSampleCode.InsertTable(sTableName : String; dbPointer : String); +var + oCursor : Variant; +begin + { create a cursor object on the current position in the document } + oCursor := Document.Text.CreateTextCursor(); + + { Create for each table a unique database name } + if (sTableName = '') then + sTableName := createUniqueTablename(Document); + + InsertDatabaseTable( Document, sTableName, oCursor, 4, 2, dbPointer ); + + ChangeCellContent( Document, sTableName, 'B2', 1.12 ); +end; + +procedure TSampleCode.InsertDatabaseTable( + oDoc : Variant; + sTableName : String; + oCursor : Variant; + iRows : Integer; + iColumns : Integer; + dbPointer : String); +var + oTable : Variant; + sCellnames : Variant; + iCellcounter : Integer; + oCellCursor : Variant; + oTextCursor : Variant; + sCellName : String; +begin + oTable := CreateTextTable( oDoc, oCursor, sTableName, iRows, iColumns ); + sCellnames := oTable.getCellNames(); + + For iCellcounter := VarArrayLowBound( sCellnames, 1) to VarArrayHighBound(sCellnames, 1) do + begin + sCellName := sCellnames[iCellcounter]; + + oCellCursor := oTable.getCellByName(sCellName); + oCellCursor.Value := iCellcounter; + oTextCursor := oCellCursor.getEnd(); + InsertBookmark( + oDoc, + oTextCursor, + createBookmarkName(sTableName, sCellName, dbPointer)); + end; +end; + +{ + +' Change the content of a cell +} + +procedure TSampleCode.ChangeCellContent( + oDoc : Variant; + sTableName : String; + sCellName : String; + dValue : Double ); +var + oBookmark : Variant; + oTextCursor : Variant; + sBookmarkName : String; +begin + oBookmark := GetBookmarkFromAdress( oDoc, sTableName, sCellName ); + oTextCursor := JumpToBookmark( oBookmark ); + oTextCursor.Cell.Value := dValue; + + { create a new bookmark for the new number } + sBookmarkName := oBookmark.getName(); + oBookmark.dispose(); + InsertBookmark( oDoc, oTextCursor, sBookmarkName ); +end; + + +{ ' Jump to Bookmark and return for this position the cursor } + +function TSampleCode.JumpToBookmark( + oBookmark : Variant) : Variant; + +begin + JumpToBookmark := oBookmark.Anchor.Text.createTextCursorByRange( + oBookmark.Anchor ); +end; + + +{ ' Create a Texttable on a Textdocument } +function TSampleCode.CreateTextTable( + oDoc : Variant; + oCursor : Variant; + sName : String; + iRow : Integer; + iColumn : Integer) : Variant; +var + ret : Variant; +begin + ret := oDoc.createInstance( 'com.sun.star.text.TextTable' ); + + ret.setName( sName ); + ret.initialize( iRow, iColumn ); + oDoc.Text.InsertTextContent( oCursor, ret, False ); + + CreateTextTable := ret; +end; + + +{ 'create a unique name for the Texttables } +function TSampleCode.CreateUniqueTablename(oDoc : Variant) : String; +var + iHighestNumber : Integer; + sTableNames : Variant; + iTableCounter : Integer; + sTableName : String; + iTableNumber : Integer; + i : Integer; +begin + sTableNames := oDoc.getTextTables.getElementNames(); + iHighestNumber := 0; + For iTableCounter := VarArrayLowBound(sTableNames, 1) to VarArrayHighBound(sTableNames, 1) do + begin + sTableName := sTableNames[iTableCounter]; + i := Pos( '$$', sTableName ); + iTableNumber := strtoint( Copy(sTableName, i + 2, Length( sTableName ) - i - 1 ) ); + + If iTableNumber > iHighestNumber then + iHighestNumber := iTableNumber; + end; + createUniqueTablename := 'DBTable$$' + inttostr(iHighestNumber + 1); +end; + + +{' Insert a Bookmark on the cursor } +procedure TSampleCode.InsertBookmark( + oDoc : Variant; + oTextCursor : Variant; + sBookmarkName : String); +var + oBookmarkInst : Variant; +begin + oBookmarkInst := oDoc.createInstance('com.sun.star.text.Bookmark'); + + oBookmarkInst.Name := sBookmarkName; + oTextCursor.gotoStart( true ); + oTextCursor.text.InsertTextContent( oTextCursor, oBookmarkInst, true ); +end; + + +function TSampleCode.CreateBookmarkName( + sTableName : String; + sCellName : String; + sDatabasepointer : String ) : String; +begin + createBookmarkName := '//' + sTableName + '/%' + sCellName + '/%' + sDatabasePointer + ':' + sCellName; +end; + +{ ' Returns the Bookmark the Tablename and Cellname } +function TSampleCode.GetBookmarkFromAdress( + oDoc : Variant; + sTableName : String; + sCellAdress : String) : Variant; +var + sTableAddress : String; + iTableNameLength : Integer; + sBookNames : Variant; + iBookCounter : Integer; +begin + sTableAddress := '//' + sTableName + '/%' + sCellAdress; + iTableNameLength := Length( sTableAddress ); + + sBookNames := oDoc.Bookmarks.getElementNames; + + for iBookCounter := VarArrayLowBound(sBookNames, 1) to VarArrayHighBound(sBookNames, 1) do + begin + If sTableAddress = Copy( sBookNames[iBookCounter], 1, iTableNameLength) then + begin + GetBookmarkFromAdress := oDoc.Bookmarks.getByName(sBookNames[iBookCounter]); + exit; + end; + end; +end; + +{ ' Returns the Bookmark the Tablename and Cellname } +function TSampleCode.GetBookmarkFromDBPointer( + oDoc : Variant; + sBookmarkName : String) : Variant; +var + sBookNames : Variant; + iBookCounter : Integer; +begin + sBookNames := oDoc.Bookmarks.getElementNames; + + for iBookCounter := VarArrayLowBound(sBookNames, 1) to VarArrayHighBound(sBookNames, 1) do + begin + If Pos(sBookmarkName, sBookNames[iBookCounter]) = (1 + Length(sBookNames[iBookCounter]) - Length(sBookmarkName)) then + begin + GetBookmarkFromDBPointer := oDoc.Bookmarks.getByName(sBookNames[iBookCounter]); + exit; + end; + end; +end; + +end. + + diff --git a/odk/examples/OLE/delphi/InsertTables/SampleUI.dfm b/odk/examples/OLE/delphi/InsertTables/SampleUI.dfm new file mode 100644 index 000000000..082fce7b7 --- /dev/null +++ b/odk/examples/OLE/delphi/InsertTables/SampleUI.dfm @@ -0,0 +1,4 @@ +ÿ +ParentFont OldCreateOrder PositionpoScreenCenter
PixelsPerInch` +TextHeight
Table NameTable namedisconnectEnabledTabOrderOnClickOnDisconnectTStatusBar +StatusBar1LeftSimpleTextReady
\ No newline at end of file diff --git a/odk/examples/OLE/delphi/InsertTables/SampleUI.pas b/odk/examples/OLE/delphi/InsertTables/SampleUI.pas new file mode 100644 index 000000000..fcd4f4301 --- /dev/null +++ b/odk/examples/OLE/delphi/InsertTables/SampleUI.pas @@ -0,0 +1,168 @@ +{*********************************************************************** + * + * The Contents of this file are made available subject to the terms of + * the BSD license. + * + * Copyright 2000, 2010 Oracle and/or its affiliates. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of Sun Microsystems, Inc. nor the names of its + * contributors may be used to endorse or promote products derived + * from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS + * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND + * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR + * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + *************************************************************************} +unit SampleUI; + +interface + +uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, + Buttons, ExtCtrls, SampleCode, ComCtrls; + +type + TOKBottomDlg = class(TForm) + Bevel1: TBevel; + Button1: TButton; + Button2: TButton; + Button3: TButton; + Button4: TButton; + Edit1: TEdit; + Label1: TLabel; + Edit2: TEdit; + Label2: TLabel; + Button5: TButton; + Button6: TButton; + Edit3: TEdit; + Label3: TLabel; + Label4: TLabel; + Label6: TLabel; + Edit6: TEdit; + Bevel2: TBevel; + Bevel3: TBevel; + Bevel4: TBevel; + StatusBar1: TStatusBar; + Edit4: TEdit; + Label7: TLabel; + procedure OnConnect(Sender: TObject); + procedure OnDisconnect(Sender: TObject); + procedure OnCreateDocument(Sender: TObject); + procedure OnInsertTable(Sender: TObject); + procedure OnGetDatabasePointer(Sender: TObject); + procedure OnGetCellContent(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + OKBottomDlg: TOKBottomDlg; + Sample : TSampleCode; +implementation + +{$R *.DFM} + +procedure TOKBottomDlg.OnConnect(Sender: TObject); +begin + StatusBar1.SimpleText := 'Connection to StarOffice ...'; + Sample := TSampleCode.Create(); + if Sample.Connect() then + begin + Button1.Enabled := false; + Button2.Enabled := true; + Button3.Enabled := true; + Button4.Enabled := false; + Button5.Enabled := false; + Button6.Enabled := false; + end; + StatusBar1.SimpleText := 'Ready'; +end; + +procedure TOKBottomDlg.OnDisconnect(Sender: TObject); +begin + StatusBar1.SimpleText := 'Disconnection from StarOffice ...'; + Sample.Disconnect(); + Button1.Enabled := true; + Button2.Enabled := false; + Button3.Enabled := false; + Button4.Enabled := false; + Button5.Enabled := false; + Button6.Enabled := false; + StatusBar1.SimpleText := 'Ready'; +end; + +procedure TOKBottomDlg.OnCreateDocument(Sender: TObject); +begin + StatusBar1.SimpleText := 'Creating new text document ...'; + try + if Sample.CreateDocument(false) then + begin + Button4.Enabled := true; + Button5.Enabled := true; + Button6.Enabled := true; + end; + StatusBar1.SimpleText := 'Ready'; + except + StatusBar1.SimpleText := 'Error'; + end; +end; + +procedure TOKBottomDlg.OnInsertTable(Sender: TObject); +begin + try + StatusBar1.SimpleText := 'Inserting Table ...'; + Sample.InsertTable(Edit2.Text, Edit1.Text); + StatusBar1.SimpleText := 'Ready'; + except + StatusBar1.SimpleText := 'Error'; + end; +end; + +procedure TOKBottomDlg.OnGetDatabasePointer(Sender: TObject); +var + res : String; +begin + try + StatusBar1.SimpleText := 'Getting database pointer ...'; + res := Sample.getDatabasePointer(Edit4.Text, Edit3.Text); + Application.MessageBox(PChar('the pointer: ' + res), PChar('Result'), ID_OK); + StatusBar1.SimpleText := 'Ready'; + except + StatusBar1.SimpleText := 'Error'; + end; +end; + +procedure TOKBottomDlg.OnGetCellContent(Sender: TObject); +var + res : String; +begin + try + StatusBar1.SimpleText := 'Getting cell content ...'; + res := Sample.getCellContent(Edit6.Text); + Application.MessageBox(PChar('the content: ' + res), PChar('Result'), ID_OK); + StatusBar1.SimpleText := 'Ready'; + except + StatusBar1.SimpleText := 'Error'; + end; +end; + +end. |