fpspreadsheet: Add a new example project showing database export in virtual mode.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3423 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/db_import_export/main.lfm

@@ -0,0 +1,174 @@
+object Form1: TForm1
+  Left = 340
+  Height = 229
+  Top = 154
+  Width = 404
+  Caption = 'Form1'
+  ClientHeight = 229
+  ClientWidth = 404
+  OnCreate = FormCreate
+  LCLVersion = '1.3'
+  object PageControl: TPageControl
+    Left = 4
+    Height = 221
+    Top = 4
+    Width = 396
+    ActivePage = TabSheet1
+    Align = alClient
+    BorderSpacing.Around = 4
+    TabIndex = 0
+    TabOrder = 0
+    object TabSheet1: TTabSheet
+      Caption = '1 - Create database'
+      ClientHeight = 193
+      ClientWidth = 388
+      object Label2: TLabel
+        Left = 4
+        Height = 15
+        Top = 4
+        Width = 380
+        Align = alTop
+        BorderSpacing.Around = 4
+        Caption = 'Create a database with random records'
+        Font.Style = [fsBold]
+        ParentColor = False
+        ParentFont = False
+      end
+      object Panel1: TPanel
+        Left = 0
+        Height = 170
+        Top = 23
+        Width = 388
+        Align = alClient
+        BevelOuter = bvNone
+        ClientHeight = 170
+        ClientWidth = 388
+        TabOrder = 0
+        object HeaderLabel1: TLabel
+          Left = 8
+          Height = 15
+          Top = 11
+          Width = 71
+          Caption = 'Record count'
+          ParentColor = False
+        end
+        object EdRecordCount: TEdit
+          Left = 107
+          Height = 23
+          Top = 8
+          Width = 64
+          Alignment = taRightJustify
+          TabOrder = 0
+          Text = '10000'
+        end
+        object BtnCreateDbf: TButton
+          Left = 280
+          Height = 25
+          Top = 116
+          Width = 99
+          Anchors = [akRight, akBottom]
+          Caption = 'Run'
+          OnClick = BtnCreateDbfClick
+          TabOrder = 1
+        end
+        object Bevel1: TBevel
+          Left = 0
+          Height = 3
+          Top = 0
+          Width = 388
+          Align = alTop
+          Shape = bsTopLine
+        end
+        object InfoLabel1: TLabel
+          Left = 4
+          Height = 15
+          Top = 151
+          Width = 380
+          Align = alBottom
+          BorderSpacing.Around = 4
+          Caption = 'InfoLabe1'
+          ParentColor = False
+        end
+        object Label1: TLabel
+          Left = 8
+          Height = 15
+          Top = 40
+          Width = 324
+          Caption = 'Please note: the binary xls files can handle only 65536 records.'
+          ParentColor = False
+        end
+      end
+    end
+    object TabSheet2: TTabSheet
+      Caption = '2 - Write to spreadsheet'
+      ClientHeight = 193
+      ClientWidth = 388
+      object HeaderLabel2: TLabel
+        Left = 4
+        Height = 15
+        Top = 4
+        Width = 380
+        Align = alTop
+        BorderSpacing.Around = 4
+        Caption = 'Export database table to spreadsheet file'
+        Font.Style = [fsBold]
+        ParentColor = False
+        ParentFont = False
+      end
+      object Bevel2: TBevel
+        Left = 0
+        Height = 3
+        Top = 23
+        Width = 388
+        Align = alTop
+        Shape = bsTopLine
+      end
+      object InfoLabel2: TLabel
+        Left = 4
+        Height = 15
+        Top = 174
+        Width = 380
+        Align = alBottom
+        BorderSpacing.Around = 4
+        Caption = 'InfoLabel2'
+        ParentColor = False
+      end
+      object RgFileFormat: TRadioGroup
+        Left = 8
+        Height = 134
+        Top = 32
+        Width = 185
+        AutoFill = True
+        Caption = 'Spreadsheet file format'
+        ChildSizing.LeftRightSpacing = 6
+        ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+        ChildSizing.EnlargeVertical = crsHomogenousChildResize
+        ChildSizing.ShrinkHorizontal = crsScaleChilds
+        ChildSizing.ShrinkVertical = crsScaleChilds
+        ChildSizing.Layout = cclLeftToRightThenTopToBottom
+        ChildSizing.ControlsPerLine = 1
+        ClientHeight = 116
+        ClientWidth = 181
+        ItemIndex = 2
+        Items.Strings = (
+          'xls (Excel 2)'
+          'xls (Excel5)'
+          'xls (Excel 97-2003)'
+          'xlsx (Excel 2007 and later)'
+          'ods'
+        )
+        TabOrder = 0
+      end
+      object BtnExport: TButton
+        Left = 280
+        Height = 25
+        Top = 140
+        Width = 99
+        Anchors = [akRight, akBottom]
+        Caption = 'Run'
+        OnClick = BtnExportClick
+        TabOrder = 1
+      end
+    end
+  end
+end

components/fpspreadsheet/examples/db_import_export/main.pas

@@ -0,0 +1,216 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ComCtrls, ExtCtrls, db, dbf, fpspreadsheet, fpsallformats;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Bevel1: TBevel;
+    Bevel2: TBevel;
+    BtnCreateDbf: TButton;
+    BtnExport: TButton;
+    EdRecordCount: TEdit;
+    InfoLabel2: TLabel;
+    HeaderLabel1: TLabel;
+    InfoLabel1: TLabel;
+    Label1: TLabel;
+    Label2: TLabel;
+    HeaderLabel2: TLabel;
+    PageControl: TPageControl;
+    Panel1: TPanel;
+    RgFileFormat: TRadioGroup;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    procedure BtnCreateDbfClick(Sender: TObject);
+    procedure BtnExportClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { private declarations }
+    FDataset: TDbf;
+    FWorkbook: TsWorkbook;
+    FHeaderTemplateCell: PCell;
+    FDateTemplateCell: PCell;
+    procedure WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
+      var AValue: variant; var AStyleCell: PCell);
+  public
+    { public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+const
+  NUM_LAST_NAMES = 8;
+  NUM_FIRST_NAMES = 8;
+  NUM_CITIES = 10;
+  LAST_NAMES: array[0..NUM_LAST_NAMES-1] of string = (
+    'Chaplin', 'Washington', 'Dylan', 'Springsteen', 'Brando',
+    'Monroe', 'Dean', 'Lincoln');
+  FIRST_NAMES: array[0..NUM_FIRST_NAMES-1] of string = (
+    'Charley', 'George', 'Bob', 'Bruce', 'Marlon',
+    'Marylin', 'James', 'Abraham');
+  CITIES: array[0..NUM_CITIES-1] of string = (
+    'New York', 'Los Angeles', 'San Francisco', 'Chicago', 'Miami',
+    'New Orleans', 'Washington', 'Boston', 'Seattle', 'Las Vegas');
+
+
+{ TForm1 }
+
+{ This procedure creates a test database table with random data for us to play with }
+procedure TForm1.BtnCreateDbfClick(Sender: TObject);
+var
+  i: Integer;
+  startDate: TDate;
+  maxAge: Integer = 80 * 365;
+begin
+  if FDataset <> nil then
+    FDataset.Free;
+
+  ForceDirectories('data');
+  startDate := EncodeDate(2010, 8, 1);
+
+  FDataset := TDbf.Create(self);
+  FDataset.FilePathFull := 'data' + DirectorySeparator;
+  FDataset.TableName := 'people.dbf';
+  FDataset.FieldDefs.Add('Last name', ftString);
+  FDataset.FieldDefs.Add('First name', ftString);
+  FDataset.FieldDefs.Add('City', ftString);
+  FDataset.FieldDefs.Add('Birthday', ftDateTime);
+  DeleteFile(FDataset.FilePathFull + FDataset.TableName);
+  FDataset.CreateTable;
+
+  FDataset.Open;
+  for i:=1 to StrToInt(EdRecordCount.Text) do begin
+    if (i mod 25) = 0 then begin
+      InfoLabel1.Caption := Format('Adding record %d...', [i]);
+      Application.ProcessMessages;
+    end;
+    FDataset.Insert;
+    FDataset.FieldByName('Last name').AsString := LAST_NAMES[Random(NUM_LAST_NAMES)];
+    FDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
+    FDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
+    FDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge);
+      // creates a random date between "startDate" and "maxAge" days back
+    FDataset.Post;
+  end;
+  FDataset.Close;
+
+  InfoLabel1.Caption := Format('Done. Created file "%s" in folder "data".', [
+    FDataset.TableName, FDataset.FilePathFull
+  ]);
+  InfoLabel2.Caption := '';
+end;
+
+procedure TForm1.BtnExportClick(Sender: TObject);
+const
+  FILE_FORMATS: array[0..4] of TsSpreadsheetFormat = (
+    sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument
+  );
+  EXT: array[0..4] of string = (
+    '_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods');
+var
+  fn: String;
+  worksheet: TsWorksheet;
+begin
+  InfoLabel2.Caption := '';
+  Application.ProcessMessages;
+
+  if FDataset = nil then begin
+    FDataset := TDbf.Create(self);
+    FDataset.FilePathFull := 'data' + DirectorySeparator;
+    FDataset.TableName := 'people.dbf';
+  end;
+
+  fn := FDataset.FilePathFull + FDataset.TableName;
+  if not FileExists(fn) then begin
+    MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.',
+      [fn]), mtError, [mbOK], 0);
+    exit;
+  end;
+
+  FDataset.Open;
+
+  FWorkbook := TsWorkbook.Create;
+  try
+    worksheet := FWorkbook.AddWorksheet(FDataset.TableName);
+
+    // Make header line frozen
+    worksheet.Options := worksheet.Options + [soHasFrozenPanes];
+    worksheet.TopPaneHeight := 1;
+
+    // Prepare template for header line
+    FHeaderTemplateCell := worksheet.GetCell(0, 0);
+    worksheet.WriteFontStyle(FHeaderTemplateCell, [fssBold]);
+    worksheet.WriteFontColor(FHeaderTemplateCell, scWhite);
+    worksheet.WriteBackgroundColor(FHeaderTemplateCell, scGray);
+
+    // Prepare template for date column
+    FDateTemplateCell := worksheet.GetCell(0, 1);
+    worksheet.WriteDateTimeFormat(FDateTemplateCell, nfShortDate);
+
+    // Make first three columns a bit wider
+    worksheet.WriteColWidth(0, 20);
+    worksheet.WriteColWidth(1, 20);
+    worksheet.WriteColWidth(2, 20);
+
+    // Setup virtual mode
+//    FWorkbook.Options := FWorkbook.Options + [boVirtualMode, boBufStream];
+    FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
+    FWorkbook.OnWriteCellData := @WriteCellDataHandler;
+    FWorkbook.VirtualRowCount := FDataset.RecordCount + 1;  // +1 for the header line
+    FWorkbook.VirtualColCount := FDataset.FieldCount;
+
+    // Write
+    fn := ChangeFileExt(fn, EXT[RgFileFormat.ItemIndex]);
+    FWorkbook.WriteToFile(fn, FILE_FORMATS[RgFileFormat.ItemIndex], true);
+  finally
+    FreeAndNil(FWorkbook);
+  end;
+
+  InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"',
+    [ChangeFileExt(FDataset.TableName, EXT[RgFileFormat.ItemIndex]), FDataset.FilePathFull]);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  InfoLabel1.Caption := '';
+  InfoLabel2.Caption := '';
+  PageControl.ActivePageIndex := 0;
+end;
+
+procedure TForm1.WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
+  var AValue: variant; var AStyleCell: PCell);
+begin
+  // Header line: we want to show the field names here.
+  if ARow = 0 then begin
+    AValue := FDataset.Fields[ACol].FieldName;
+    AStyleCell := FHeaderTemplateCell;
+    FDataset.First;
+  end else begin
+    AValue := FDataset.Fields[ACol].Value;
+    if FDataset.Fields[ACol].DataType = ftDate then
+      AStyleCell := FDateTemplateCell;
+    if ACol = FWorkbook.VirtualColCount-1 then begin
+      FDataset.Next;
+      if (ARow-1) mod 25 = 0 then begin
+        InfoLabel1.Caption := Format('Writing record %d...', [ARow-1]);
+        Application.ProcessMessages;
+      end;
+    end;
+  end;
+end;
+
+end.
+

components/fpspreadsheet/examples/db_import_export/project1.lpi

@@ -0,0 +1,98 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="project1"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LazUtils"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="main"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="project1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\.."/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/fpspreadsheet/examples/db_import_export/project1.lpr

@@ -0,0 +1,21 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/fpspreadsheet/examples/db_import_export/readme.txt

@@ -0,0 +1,11 @@
+This demo shows how a large database table can be exported to a spreadsheet file
+using virtual mode. 
+
+First, run the section 1 to create a dBase file with random data.
+Then, in section 2, the dBase file can be converted to any spreadsheet format
+supported.
+
+Please note that this example is mainly educational to show a "real-world"
+application of virtual mode, but, strictly speaking, virtual mode would not
+be absolutely necessary due to the small number of columns.
+fpspreadsheet.

components/fpspreadsheet/fpspreadsheet.pas

@@ -635,13 +635,18 @@ type
     function  WriteFont(ACell: PCell; const AFontName: String;
       AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
     procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
-    function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
+    procedure WriteFont(ACell: PCell; AFontIndex: Integer); overload;
-    function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
+    function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer; overload;
-    function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
+    function WriteFontColor(ACell: PCell; AFontColor: TsColor): Integer; overload;
+    function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer; overload;
+    function WriteFontName(ACell: PCell; AFontName: String): Integer; overload;
+    function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer; overload;
+    function WriteFontSize(ACell: PCell; ASize: Single): Integer; overload;
     function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; overload;
     function WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; overload;
 
-    procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
+    procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); overload;
+    procedure WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment); overload;
 
     procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat;
       const AFormatString: String = ''); overload;
@@ -654,13 +659,16 @@ type
       ADecimals: Integer; ACurrencySymbol: String = '';
       APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); overload;
 
-    procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
+    procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation); overload;
+    procedure WriteTextRotation(ACell: PCell; ARotation: TsTextRotation); overload;
 
     procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
 
-    procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment);
+    procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment); overload;
+    procedure WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment); overload;
 
-    procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
+    procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean); overload;
+    procedure WriteWordwrap(ACell: PCell; AValue: boolean); overload;
 
     { Data manipulation methods - For Cells }
     procedure CalcFormulas;
@@ -3593,18 +3601,29 @@ end;
   @param  AFontIndex  Index of the font in the workbook's font list
 }
 procedure TsWorksheet.WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer);
-var
-  lCell: PCell;
 begin
-  if (AFontIndex >= 0) and (AFontIndex < Workbook.GetFontCount) and (AFontIndex <> 4)
+  WriteFont(GetCell(ARow, ACol), AFontIndex);
+end;
+
+{@@
+  Applies a font to the formatting of a cell. The font is determined by its
+  index in the workbook's font list:
+
+  @param  ACell       Pointer to the cell considered
+  @param  AFontIndex  Index of the font in the workbook's font list
+}
+procedure TsWorksheet.WriteFont(ACell: PCell; AFontIndex: Integer);
+begin
+  if ACell = nil then
+    exit;
+
+  if (AFontIndex < 0) or (AFontIndex >= Workbook.GetFontCount) or (AFontIndex = 4) then
     // note: Font index 4 is not defined in BIFF
-  then begin
-    lCell := GetCell(ARow, ACol);
-    Include(lCell^.UsedFormattingFields, uffFont);
-    lCell^.FontIndex := AFontIndex;
-    ChangedFont(ARow, ACol);
-  end else
     raise Exception.Create(lpInvalidFontIndex);
+
+  Include(ACell^.UsedFormattingFields, uffFont);
+  ACell^.FontIndex := AFontIndex;
+  ChangedFont(ACell^.Row, ACell^.Col);
 end;
 
 {@@
@@ -3619,13 +3638,30 @@ end;
   @return Index of the font in the workbook's font list.
 }
 function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
+begin
+  Result := WriteFontColor(GetCell(ARow, ACol), AFontColor);
+end;
+
+{@@
+  Replaces the text color used in formatting of a cell. Looks in the workbook's
+  font list if this modified font has already been used. If not a new font entry
+  is created. Returns the index of this font in the font list.
+
+  @param  ACell       Pointer to the cell
+  @param  AFontColor  Index into the workbook's color palette identifying the
+                      new text color.
+  @return Index of the font in the workbook's font list.
+}
+function TsWorksheet.WriteFontColor(ACell: PCell; AFontColor: TsColor): Integer;
 var
-  lCell: PCell;
   fnt: TsFont;
 begin
-  lCell := GetCell(ARow, ACol);
+  if ACell = nil then begin
-  fnt := Workbook.GetFont(lCell^.FontIndex);
+    Result := 0;
-  Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
+    exit;
+  end;
+  fnt := Workbook.GetFont(ACell^.FontIndex);
+  Result := WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
 end;
 
 {@@
@@ -3640,13 +3676,30 @@ end;
   @return Index of the font in the workbook's font list.
 }
 function TsWorksheet.WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
+begin
+  result := WriteFontName(GetCell(ARow, ACol), AFontName);
+end;
+
+{@@
+  Replaces the font used in formatting of a cell considering only the font face
+  and leaving font size, style and color unchanged. Looks in the workbook's
+  font list if this modified font has already been used. If not a new font entry
+  is created. Returns the index of this font in the font list.
+
+  @param  ACell       Pointer to the cell
+  @param  AFontName   Name of the new font to be used
+  @return Index of the font in the workbook's font list.
+}
+function TsWorksheet.WriteFontName(ACell: PCell; AFontName: String): Integer;
 var
-  lCell: PCell;
   fnt: TsFont;
 begin
-  lCell := GetCell(ARow, ACol);
+  if ACell = nil then begin
-  fnt := Workbook.GetFont(lCell^.FontIndex);
+    Result := 0;
-  result := WriteFont(ARow, ACol, AFontName, fnt.Size, fnt.Style, fnt.Color);
+    exit;
+  end;
+  fnt := Workbook.GetFont(ACell^.FontIndex);
+  result := WriteFont(ACell, AFontName, fnt.Size, fnt.Style, fnt.Color);
 end;
 
 {@@
@@ -3660,13 +3713,29 @@ end;
   @return Index of the font in the workbook's font list.
 }
 function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
+begin
+  Result := WriteFontSize(GetCell(ARow, ACol), ASize);
+end;
+
+{@@
+  Replaces the font size in formatting of a cell. Looks in the workbook's
+  font list if this modified font has already been used. If not a new font entry
+  is created. Returns the index of this font in the font list.
+
+  @param  ACell       Pointer to the cell
+  @param  ASize       Size of the font to be used (in points).
+  @return Index of the font in the workbook's font list.
+}
+function TsWorksheet.WriteFontSize(ACell: PCell; ASize: Single): Integer;
 var
-  lCell: PCell;
   fnt: TsFont;
 begin
-  lCell := GetCell(ARow, ACol);
+  if ACell = nil then begin
-  fnt := Workbook.GetFont(lCell^.FontIndex);
+    Result := 0;
-  Result := WriteFont(ARow, ACol, fnt.FontName, ASize, fnt.Style, fnt.Color);
+    exit;
+  end;
+  fnt := Workbook.GetFont(ACell^.FontIndex);
+  Result := WriteFont(ACell, fnt.FontName, ASize, fnt.Style, fnt.Color);
 end;
 
 {@@
@@ -3724,13 +3793,25 @@ end;
 }
 procedure TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal;
   ARotation: TsTextRotation);
-var
-  ACell: PCell;
 begin
-  ACell := GetCell(ARow, ACol);
+  WriteTextRotation(GetCell(ARow, ACol), ARotation);
+end;
+
+{@@
+  Adds text rotation to the formatting of a cell
+
+  @param  ACell      Pointer to the cell
+  @param  ARotation  How to rotate the text
+
+  @see    TsTextRotation
+}
+procedure TsWorksheet.WriteTextRotation(ACell: PCell; ARotation: TsTextRotation);
+begin
+  if ACell = nil then
+    exit;
   Include(ACell^.UsedFormattingFields, uffTextRotation);
   ACell^.TextRotation := ARotation;
-  ChangedFont(ARow, ACol);
+  ChangedFont(ACell^.Row, ACell^.Col);
 end;
 
 {@@
@@ -4018,13 +4099,24 @@ end;
                  By default, texts are left-aligned, numbers and dates are right-aligned.
 }
 procedure TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
-var
-  lCell: PCell;
 begin
-  lCell := GetCell(ARow, ACol);
+  WriteHorAlignment(GetCell(ARow, ACol), AValue);
-  Include(lCell^.UsedFormattingFields, uffHorAlign);
+end;
-  lCell^.HorAlignment := AValue;
+
-  ChangedCell(ARow, ACol);
+{@@
+  Defines the horizontal alignment of text in a cell.
+
+  @param ACell   Pointer to the cell considered
+  @param AValue  Parameter for horizontal text alignment (haDefault, vaLeft, haCenter, haRight)
+                 By default, texts are left-aligned, numbers and dates are right-aligned.
+}
+procedure TsWorksheet.WriteHorAlignment(ACell: PCell; AValue: TsHorAlignment);
+begin
+  if ACell = nil then
+    exit;
+  Include(ACell^.UsedFormattingFields, uffHorAlign);
+  ACell^.HorAlignment := AValue;
+  ChangedCell(ACell^.Row, ACell^.Col);
 end;
 
 {@@
@@ -4036,13 +4128,24 @@ end;
                  By default, texts are bottom-aligned.
 }
 procedure TsWorksheet.WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment);
-var
-  lCell: PCell;
 begin
-  lCell := GetCell(ARow, ACol);
+  WriteVertAlignment(GetCell(ARow, ACol), AValue);
-  Include(lCell^.UsedFormattingFields, uffVertAlign);
+end;
-  lCell^.VertAlignment := AValue;
+
-  ChangedCell(ARow, ACol);
+{@@
+  Defines the vertical alignment of text in a cell.
+
+  @param ACell   Poiner to the cell considered
+  @param AValue  Parameter for vertical text alignment (vaDefault, vaTop, vaCenter, vaBottom)
+                 By default, texts are bottom-aligned.
+}
+procedure TsWorksheet.WriteVertAlignment(ACell: PCell; AValue: TsVertAlignment);
+begin
+  if ACell = nil then
+    exit;
+  Include(ACell^.UsedFormattingFields, uffVertAlign);
+  ACell^.VertAlignment := AValue;
+  ChangedCell(ACell^.Row, ACell^.Col);
 end;
 
 {@@
@@ -4053,15 +4156,25 @@ end;
   @param AValue  true = word-wrapping enabled, false = disabled.
 }
 procedure TsWorksheet.WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
-var
-  lCell: PCell;
 begin
-  lCell := GetCell(ARow, ACol);
+  WriteWordWrap(GetCell(ARow, ACol), AValue);
+end;
+
+{@@
+  Enables or disables the word-wrapping feature for a cell.
+
+  @param ACel    Pointer to the cell considered
+  @param AValue  true = word-wrapping enabled, false = disabled.
+}
+procedure TsWorksheet.WriteWordwrap(ACell: PCell; AValue: boolean);
+begin
+  if ACell = nil then
+    exit;
   if AValue then
-    Include(lCell^.UsedFormattingFields, uffWordwrap)
+    Include(ACell^.UsedFormattingFields, uffWordwrap)
   else
-    Exclude(lCell^.UsedFormattingFields, uffWordwrap);
+    Exclude(ACell^.UsedFormattingFields, uffWordwrap);
-  ChangedCell(ARow, ACol);
+  ChangedCell(ACell^.Row, ACell^.Col);
 end;
 
 function TsWorksheet.GetFormatSettings: TFormatSettings;