You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
174
components/fpspreadsheet/examples/db_import_export/main.lfm
Normal file
174
components/fpspreadsheet/examples/db_import_export/main.lfm
Normal file
@ -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
|
||||
216
components/fpspreadsheet/examples/db_import_export/main.pas
Normal file
216
components/fpspreadsheet/examples/db_import_export/main.pas
Normal file
@ -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.
|
||||
|
||||
@ -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>
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
@ -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;
|
||||
function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
|
||||
function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
|
||||
procedure WriteFont(ACell: PCell; AFontIndex: Integer); overload;
|
||||
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer; overload;
|
||||
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);
|
||||
fnt := Workbook.GetFont(lCell^.FontIndex);
|
||||
Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
|
||||
if ACell = nil then begin
|
||||
Result := 0;
|
||||
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);
|
||||
fnt := Workbook.GetFont(lCell^.FontIndex);
|
||||
result := WriteFont(ARow, ACol, AFontName, fnt.Size, fnt.Style, fnt.Color);
|
||||
if ACell = nil then begin
|
||||
Result := 0;
|
||||
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);
|
||||
fnt := Workbook.GetFont(lCell^.FontIndex);
|
||||
Result := WriteFont(ARow, ACol, fnt.FontName, ASize, fnt.Style, fnt.Color);
|
||||
if ACell = nil then begin
|
||||
Result := 0;
|
||||
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);
|
||||
Include(lCell^.UsedFormattingFields, uffHorAlign);
|
||||
lCell^.HorAlignment := AValue;
|
||||
ChangedCell(ARow, ACol);
|
||||
WriteHorAlignment(GetCell(ARow, ACol), AValue);
|
||||
end;
|
||||
|
||||
{@@
|
||||
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);
|
||||
Include(lCell^.UsedFormattingFields, uffVertAlign);
|
||||
lCell^.VertAlignment := AValue;
|
||||
ChangedCell(ARow, ACol);
|
||||
WriteVertAlignment(GetCell(ARow, ACol), AValue);
|
||||
end;
|
||||
|
||||
{@@
|
||||
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);
|
||||
ChangedCell(ARow, ACol);
|
||||
Exclude(ACell^.UsedFormattingFields, uffWordwrap);
|
||||
ChangedCell(ACell^.Row, ACell^.Col);
|
||||
end;
|
||||
|
||||
function TsWorksheet.GetFormatSettings: TFormatSettings;
|
||||
|
||||
Reference in New Issue
Block a user