odk/examples/OLE/delphi/InsertTables/SampleCode.pas

   1 {***********************************************************************
   2  *
   3  *  $RCSfile: SampleCode.pas,v $
   4  *
   5  *  $Revision: 1.2 $
   6  *
   7  *  last change: $Author: hr $ $Date: 2003-06-30 15:51:30 $
   8  *
   9  *  The Contents of this file are made available subject to the terms of
  10  *  the BSD license.
  11  *
  12  *  Copyright (c) 2003 by Sun Microsystems, Inc.
  13  *  All rights reserved.
  14  *
  15  *  Redistribution and use in source and binary forms, with or without
  16  *  modification, are permitted provided that the following conditions
  17  *  are met:
  18  *  1. Redistributions of source code must retain the above copyright
  19  *     notice, this list of conditions and the following disclaimer.
  20  *  2. Redistributions in binary form must reproduce the above copyright
  21  *     notice, this list of conditions and the following disclaimer in the
  22  *     documentation and/or other materials provided with the distribution.
  23  *  3. Neither the name of Sun Microsystems, Inc. nor the names of its
  24  *     contributors may be used to endorse or promote products derived
  25  *     from this software without specific prior written permission.
  26  *
  27  *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  28  *  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  29  *  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  30  *  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  31  *  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  32  *  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  33  *  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
  34  *  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  35  *  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
  36  *  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
  37  *  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  38  *
  39  *************************************************************************}
  40 unit SampleCode;
  41
  42 interface
  43
  44 uses
  45   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  46   StdCtrls, ComObj, Variants;
  47
  48   type
  49     TSampleCode = class
  50
  51     function Connect() : boolean;
  52     procedure Disconnect();
  53
  54     function CreateDocument(bReadOnly : boolean) : boolean;
  55
  56     procedure InsertTable(sTableName : String; dbPointer : String);
  57
  58     procedure InsertDatabaseTable(
  59         oDoc : Variant;
  60         sTableName : String;
  61         oCursor : Variant;
  62         iRows : Integer;
  63         iColumns : Integer;
  64         dbPointer : String );
  65     function CreateTextTable(
  66         oDoc : Variant;
  67         oCursor : Variant;
  68         sName : String;
  69         iRow : Integer;
  70         iColumn : Integer) : Variant;
  71     function getCellContent(
  72         sBookmarkName : String ) : Variant;
  73     function getDatabasePointer(
  74         sTableName : String;
  75         sCellname : String ) : String;
  76     procedure InsertBookmark(
  77         oDoc : Variant;
  78         oTextCursor : Variant;
  79         sBookmarkName : String );
  80     function CreateBookmarkName(
  81         sTableName : String;
  82         sCellName : String;
  83         sDatabasepointer : String ) : String;
  84     procedure ChangeCellContent(
  85         oDoc : Variant;
  86         sTableName : String;
  87         sCellName : String;
  88         dValue : Double );
  89     function GetBookmarkFromDBPointer(
  90         oDoc : Variant;
  91         sBookmarkName : String) : Variant;
  92     function GetBookmarkFromAdress(
  93         oDoc : Variant;
  94         sTableName : String;
  95         sCellAdress : String) : Variant;
  96     function JumpToBookmark(
  97         oBookmark : Variant) : Variant;
  98     function CreateUniqueTablename(oDoc : Variant) : String;
  99
 100   private
 101    StarOffice : Variant;
 102    Document : Variant;
 103
 104     { Private-Deklarationen }
 105   public
 106     { Public-Deklarationen }
 107   end;
 108
 109 implementation
 110
 111 { Insert a table texttable and insert in each cell a Bookmark with the address
 112   of the cell and database pointer
 113 }
 114
 115 function TSampleCode.Connect() : boolean;
 116 begin
 117     if  VarIsEmpty(StarOffice) then
 118         StarOffice := CreateOleObject('com.sun.star.ServiceManager');
 119
 120     Connect := not (VarIsEmpty(StarOffice) or VarIsNull(StarOffice));
 121 end;
 122
 123 procedure TSampleCode.Disconnect();
 124 begin
 125     StarOffice := Unassigned;
 126 end;
 127
 128 function TSampleCode.CreateDocument(bReadOnly : boolean) : boolean;
 129 var
 130     StarDesktop : Variant;
 131     LoadParams : Variant;
 132     CoreReflection : Variant;
 133     PropertyValue : Variant;
 134 begin
 135    StarDesktop := StarOffice.createInstance('com.sun.star.frame.Desktop');
 136
 137    if (bReadOnly) then begin
 138         LoadParams := VarArrayCreate([0, 0], varVariant);
 139         CoreReflection := StarOffice.createInstance('com.sun.star.reflection.CoreReflection');
 140
 141         CoreReflection
 142                 .forName('com.sun.star.beans.PropertyValue')
 143                 .createObject(PropertyValue);
 144
 145         PropertyValue.Name := 'ReadOnly';
 146         PropertyValue.Value := true;
 147
 148         LoadParams[0] := PropertyValue;
 149    end
 150    else
 151         LoadParams := VarArrayCreate([0, -1], varVariant);
 152
 153    Document := StarDesktop.LoadComponentFromURL( 'private:factory/swriter', '_blank', 0,  LoadParams);
 154
 155    CreateDocument := not (VarIsEmpty(Document) or VarIsNull(Document));
 156 end;
 157
 158
 159 function TSampleCode.getCellContent(
 160     sBookmarkName : String ) : Variant;
 161 var
 162     oBookmark : Variant;
 163     oTextCursor : Variant;
 164 begin
 165     oBookmark := GetBookmarkFromDBPointer( Document, sBookmarkName );
 166     oTextCursor := JumpToBookmark( oBookmark );
 167
 168     getCellContent := oTextCursor.Cell.Value;
 169
 170 end;
 171
 172
 173 function TSampleCode.getDatabasePointer(
 174     sTableName : String;
 175     sCellname : String ) : String;
 176 var
 177     oBookmark : Variant;
 178     sBookmarkName : String;
 179     iPos : Integer;
 180 begin
 181     oBookmark := GetBookmarkFromAdress( Document, sTableName, sCellName );
 182
 183     sBookmarkName := oBookmark.getName();
 184
 185     iPos := Pos('/%', sBookmarkName);
 186     while Pos('/%', sBookmarkName) > 0 do
 187     begin
 188         iPos := Pos('/%', sBookmarkName);
 189         sBookmarkName[iPos] := '%';
 190     end;
 191
 192     Delete( sBookmarkName, 1, iPos+1);
 193     getDatabasePointer := sBookmarkName;
 194 end;
 195
 196
 197 procedure TSampleCode.InsertTable(sTableName : String; dbPointer : String);
 198 var
 199    oCursor : Variant;
 200 begin
 201    { create a cursor object on the current position in the document }
 202    oCursor := Document.Text.CreateTextCursor();
 203
 204    { Create for each table a unique database name }
 205    if (sTableName = '') then
 206         sTableName := createUniqueTablename(Document);
 207
 208    InsertDatabaseTable( Document, sTableName, oCursor, 4, 2, dbPointer );
 209
 210    ChangeCellContent( Document, sTableName, 'B2', 1.12 );
 211 end;
 212
 213 procedure TSampleCode.InsertDatabaseTable(
 214     oDoc : Variant;
 215     sTableName : String;
 216     oCursor : Variant;
 217     iRows : Integer;
 218     iColumns : Integer;
 219     dbPointer : String);
 220 var
 221     oTable : Variant;
 222     sCellnames : Variant;
 223     iCellcounter : Integer;
 224     oCellCursor : Variant;
 225     oTextCursor : Variant;
 226     sCellName : String;
 227 begin
 228     oTable := CreateTextTable( oDoc, oCursor, sTableName, iRows, iColumns );
 229     sCellnames := oTable.getCellNames();
 230
 231     For iCellcounter := VarArrayLowBound( sCellnames, 1) to VarArrayHighBound(sCellnames, 1) do
 232     begin
 233         sCellName := sCellnames[iCellcounter];
 234
 235         oCellCursor := oTable.getCellByName(sCellName);
 236         oCellCursor.Value := iCellcounter;
 237         oTextCursor := oCellCursor.getEnd();
 238         InsertBookmark(
 239                 oDoc,
 240                 oTextCursor,
 241                 createBookmarkName(sTableName, sCellName, dbPointer));
 242     end;
 243 end;
 244
 245 {
 246
 247 ' Change the content of a cell
 248 }
 249
 250 procedure TSampleCode.ChangeCellContent(
 251         oDoc : Variant;
 252         sTableName : String;
 253         sCellName : String;
 254         dValue : Double );
 255 var
 256     oBookmark : Variant;
 257     oTextCursor : Variant;
 258     sBookmarkName : String;
 259 begin
 260     oBookmark := GetBookmarkFromAdress( oDoc, sTableName, sCellName );
 261     oTextCursor := JumpToBookmark( oBookmark );
 262     oTextCursor.Cell.Value := dValue;
 263
 264     { create a new bookmark for the new number }
 265     sBookmarkName := oBookmark.getName();
 266     oBookmark.dispose();
 267     InsertBookmark( oDoc, oTextCursor, sBookmarkName );
 268 end;
 269
 270
 271 { ' Jump to Bookmark and return for this position the cursor }
 272
 273 function TSampleCode.JumpToBookmark(
 274         oBookmark : Variant) : Variant;
 275
 276 begin
 277         JumpToBookmark := oBookmark.Anchor.Text.createTextCursorByRange(
 278                 oBookmark.Anchor );
 279 end;
 280
 281
 282 { ' Create a Texttable on a Textdocument }
 283 function TSampleCode.CreateTextTable(
 284         oDoc : Variant;
 285         oCursor : Variant;
 286         sName : String;
 287         iRow : Integer;
 288         iColumn : Integer) : Variant;
 289 var
 290     ret : Variant;
 291 begin
 292     ret := oDoc.createInstance( 'com.sun.star.text.TextTable' );
 293
 294     ret.setName( sName );
 295     ret.initialize( iRow, iColumn );
 296     oDoc.Text.InsertTextContent( oCursor, ret, False );
 297
 298     CreateTextTable := ret;
 299 end;
 300
 301
 302 { 'create a unique name for the Texttables }
 303 function TSampleCode.CreateUniqueTablename(oDoc : Variant) : String;
 304 var
 305     iHighestNumber : Integer;
 306     sTableNames : Variant;
 307     iTableCounter : Integer;
 308     sTableName : String;
 309     iTableNumber : Integer;
 310     i : Integer;
 311 begin
 312     sTableNames := oDoc.getTextTables.getElementNames();
 313     iHighestNumber := 0;
 314     For iTableCounter := VarArrayLowBound(sTableNames, 1) to VarArrayHighBound(sTableNames, 1) do
 315     begin
 316         sTableName := sTableNames[iTableCounter];
 317         i := Pos( '$$', sTableName );
 318         iTableNumber := strtoint( Copy(sTableName, i + 2, Length( sTableName ) - i - 1 ) );
 319
 320         If iTableNumber > iHighestNumber then
 321                 iHighestNumber := iTableNumber;
 322     end;
 323     createUniqueTablename := 'DBTable$$' + inttostr(iHighestNumber + 1);
 324 end;
 325
 326
 327 {' Insert a Bookmark on the cursor }
 328 procedure TSampleCode.InsertBookmark(
 329         oDoc : Variant;
 330         oTextCursor : Variant;
 331         sBookmarkName : String);
 332 var
 333     oBookmarkInst : Variant;
 334 begin
 335     oBookmarkInst := oDoc.createInstance('com.sun.star.text.Bookmark');
 336
 337     oBookmarkInst.Name := sBookmarkName;
 338     oTextCursor.gotoStart( true );
 339     oTextCursor.text.InsertTextContent( oTextCursor, oBookmarkInst, true );
 340 end;
 341
 342
 343 function TSampleCode.CreateBookmarkName(
 344         sTableName : String;
 345         sCellName : String;
 346         sDatabasepointer : String ) : String;
 347 begin
 348     createBookmarkName := '//' + sTableName + '/%' + sCellName + '/%' + sDatabasePointer + ':' + sCellName;
 349 end;
 350
 351 { ' Returns the Bookmark the Tablename and Cellname }
 352 function TSampleCode.GetBookmarkFromAdress(
 353         oDoc : Variant;
 354         sTableName : String;
 355         sCellAdress : String) : Variant;
 356 var
 357     sTableAddress : String;
 358     iTableNameLength : Integer;
 359     sBookNames : Variant;
 360     iBookCounter : Integer;
 361 begin
 362     sTableAddress := '//' + sTableName + '/%' + sCellAdress;
 363     iTableNameLength := Length( sTableAddress );
 364
 365     sBookNames := oDoc.Bookmarks.getElementNames;
 366
 367     for iBookCounter := VarArrayLowBound(sBookNames, 1) to VarArrayHighBound(sBookNames, 1) do
 368     begin
 369         If sTableAddress = Copy( sBookNames[iBookCounter], 1, iTableNameLength) then
 370         begin
 371                 GetBookmarkFromAdress := oDoc.Bookmarks.getByName(sBookNames[iBookCounter]);
 372                 exit;
 373         end;
 374     end;
 375 end;
 376
 377 { ' Returns the Bookmark the Tablename and Cellname }
 378 function TSampleCode.GetBookmarkFromDBPointer(
 379         oDoc : Variant;
 380         sBookmarkName : String) : Variant;
 381 var
 382     sBookNames : Variant;
 383     iBookCounter : Integer;
 384 begin
 385     sBookNames := oDoc.Bookmarks.getElementNames;
 386
 387     for iBookCounter := VarArrayLowBound(sBookNames, 1) to VarArrayHighBound(sBookNames, 1) do
 388     begin
 389         If Pos(sBookmarkName, sBookNames[iBookCounter]) = (1 + Length(sBookNames[iBookCounter]) - Length(sBookmarkName)) then
 390         begin
 391                 GetBookmarkFromDBPointer := oDoc.Bookmarks.getByName(sBookNames[iBookCounter]);
 392                 exit;
 393         end;
 394     end;
 395 end;
 396
 397 end.
 398
 399