diff --git a/components/fpspreadsheet/examples/db_import_export/main.lfm b/components/fpspreadsheet/examples/db_import_export/main.lfm new file mode 100644 index 000000000..f84059760 --- /dev/null +++ b/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 diff --git a/components/fpspreadsheet/examples/db_import_export/main.pas b/components/fpspreadsheet/examples/db_import_export/main.pas new file mode 100644 index 000000000..ce8c31c87 --- /dev/null +++ b/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. + diff --git a/components/fpspreadsheet/examples/db_import_export/project1.lpi b/components/fpspreadsheet/examples/db_import_export/project1.lpi new file mode 100644 index 000000000..856d3dc98 --- /dev/null +++ b/components/fpspreadsheet/examples/db_import_export/project1.lpi @@ -0,0 +1,98 @@ + + + + + + + + + + <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> diff --git a/components/fpspreadsheet/examples/db_import_export/project1.lpr b/components/fpspreadsheet/examples/db_import_export/project1.lpr new file mode 100644 index 000000000..e1fb48503 --- /dev/null +++ b/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. + diff --git a/components/fpspreadsheet/examples/db_import_export/readme.txt b/components/fpspreadsheet/examples/db_import_export/readme.txt new file mode 100644 index 000000000..48c9e18b9 --- /dev/null +++ b/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. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 589311952..a4fb19450 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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; - 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;