summaryrefslogtreecommitdiffstats
path: root/odk/examples/OLE/delphi/InsertTables
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
commit940b4d1848e8c70ab7642901a68594e8016caffc (patch)
treeeb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /odk/examples/OLE/delphi/InsertTables
parentInitial commit. (diff)
downloadlibreoffice-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.dpr14
-rw-r--r--odk/examples/OLE/delphi/InsertTables/Project1.res0
-rw-r--r--odk/examples/OLE/delphi/InsertTables/SampleCode.pas393
-rw-r--r--odk/examples/OLE/delphi/InsertTables/SampleUI.dfm4
-rw-r--r--odk/examples/OLE/delphi/InsertTables/SampleUI.pas168
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 namedisconnectEnabledTabOrderOnClick OnDisconnectTStatusBar
+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.