pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Introduce image scaling factor for header/footer images. Supported by xlsx writer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8337 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-07-04 17:48:22 +00:00
parent 37685f0c64
commit 802af455b3
4 changed files with 65 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/fpspreadsheet/examples/other/header_footer_images/demo_write_headerfooter_images.lpr
View File

@ -10,16 +10,14 @@ var
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyDir: string; MyDir: string;
cell: PCell;
i, r, c: Integer;
const const
image1 = '../../../images/components/TSWORKBOOKSOURCE.png'; image1 = '../../../images/components/TSWORKBOOKSOURCE.png';
image2 = '../../../images/components/TSWORKSHEETGRID.png'; image2 = '../../../images/components/TSWORKSHEETGRID.png';
image3 = '../../../images/components/TSCELLEDIT.png';
begin begin
Writeln('Starting program "demo_write_headerfooter_images"...'); Writeln('Starting program "demo_write_headerfooter_images"...');
if not FileExists(image1) then if not FileExists(image1) then
begin begin
WriteLn(ExpandFilename(image1) + ' not found.'); WriteLn(ExpandFilename(image1) + ' not found.');
@ -32,12 +30,6 @@ begin
Halt; Halt;
end; end;
if not FileExists(image3) then
begin
WriteLn(ExpandFilename(image3) + ' not found.');
Halt;
end;
// Create the spreadsheet // Create the spreadsheet
MyWorkbook := TsWorkbook.Create; MyWorkbook := TsWorkbook.Create;
try try
@ -50,8 +42,8 @@ begin
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2'); MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2');
MyWorksheet.WriteText(0, 0, 'The footer of this sheet contains an image'); MyWorksheet.WriteText(0, 0, 'The footer of this sheet contains an image');
MyWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] := '&CFooter with image!'; MyWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] := '&CFooter with image, scaled by factor 2!';
MyWorksheet.PageLayout.AddFooterImage(HEADER_FOOTER_INDEX_ALL, hfsRight, image2); MyWorksheet.PageLayout.AddFooterImage(HEADER_FOOTER_INDEX_ALL, hfsRight, image2, 2.0, 2.0);
// Save the spreadsheet to files // Save the spreadsheet to files
MyDir := ExtractFilePath(ParamStr(0)); MyDir := ExtractFilePath(ParamStr(0));

56
components/fpspreadsheet/source/common/fpspagelayout.pas
View File

@ -55,18 +55,18 @@ type
{ Images embedded in header and/or footer } { Images embedded in header and/or footer }
function AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex; function AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex;
const AFilename: String): Integer; overload; const AFilename: String; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
function AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex; function AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex;
AStream: TStream): Integer; overload; AStream: TStream; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
procedure AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex; procedure AddHeaderImage(AHeaderIndex: Integer; ASection: TsHeaderFooterSectionIndex;
AImageIndex: Integer); overload; AImageIndex: Integer; AScaleX: Double = 1.0; AScaleY: Double = 1.0); overload;
function AddFooterImage(AFooterIndex: Integer; ASection: TsHeaderFooterSectionIndex; function AddFooterImage(AFooterIndex: Integer; ASection: TsHeaderFooterSectionIndex;
const AFilename: String): Integer; overload; const AFilename: String; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
function AddFooterImage(AFooterIndex: integer; ASection: TsHeaderFooterSectionIndex; function AddFooterImage(AFooterIndex: integer; ASection: TsHeaderFooterSectionIndex;
AStream: TStream): Integer; overload; AStream: TStream; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
procedure AddFooterImage(AFooterIndex: Integer; procedure AddFooterImage(AFooterIndex: Integer; ASection: TsHeaderFooterSectionIndex;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer); overload; AImageIndex: Integer; AScaleX: Double = 1.0; AScaleY: Double = 1.0); overload;
function JoinHeaderFooterText(const ALeft, ACenter, ARight: String): String; function JoinHeaderFooterText(const ALeft, ACenter, ARight: String): String;
procedure SplitHeaderFooterText(const AText: String; out ALeft, ACenter, ARight: String); procedure SplitHeaderFooterText(const AText: String; out ALeft, ACenter, ARight: String);
@ -277,12 +277,15 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header. of the header.
@param AFileName Name of the file containing the image @param AFileName Name of the file containing the image
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
@return Index of the image data in the workbook's EmbeddedObjList. Useful @return Index of the image data in the workbook's EmbeddedObjList. Useful
if the same image will be used in another header or footer. if the same image will be used in another header or footer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsPageLayout.AddHeaderImage(AHeaderIndex: Integer; function TsPageLayout.AddHeaderImage(AHeaderIndex: Integer;
ASection: TsHeaderFooterSectionIndex; const AFilename: String): Integer; ASection: TsHeaderFooterSectionIndex; const AFilename: String;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var var
book: TsWorkbook; book: TsWorkbook;
begin begin
@ -293,7 +296,7 @@ begin
if Result = -1 then if Result = -1 then
Result := book.AddEmbeddedObj(AFilename); Result := book.AddEmbeddedObj(AFilename);
if Result > -1 then if Result > -1 then
AddHeaderImage(AHeaderIndex, ASection, Result); AddHeaderImage(AHeaderIndex, ASection, Result, AScaleX, AScaleY);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -305,12 +308,15 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header. of the header.
@param AStream Stream from which the image is read and copied @param AStream Stream from which the image is read and copied
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
@return Index of the image data in the workbook's EmbeddedObjList. Useful @return Index of the image data in the workbook's EmbeddedObjList. Useful
if the same image will be used in another header or footer. if the same image will be used in another header or footer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsPageLayout.AddHeaderImage(AHeaderIndex: Integer; function TsPageLayout.AddHeaderImage(AHeaderIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream): Integer; ASection: TsHeaderFooterSectionIndex; AStream: TStream;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var var
book: TsWorkbook; book: TsWorkbook;
begin begin
@ -319,7 +325,7 @@ begin
book := TsWorksheet(FWorksheet).Workbook; book := TsWorksheet(FWorksheet).Workbook;
Result := book.AddEmbeddedObj(AStream); Result := book.AddEmbeddedObj(AStream);
if Result > -1 then if Result > -1 then
AddHeaderImage(AHeaderIndex, ASection, Result); AddHeaderImage(AHeaderIndex, ASection, Result, AScaleX, AScaleY);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -331,13 +337,18 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header. of the header.
@param AImageIndex Index of the image data into the workbooks EmbeddedObjList @param AImageIndex Index of the image data into the workbooks EmbeddedObjList
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsPageLayout.AddHeaderImage(AHeaderIndex: Integer; procedure TsPageLayout.AddHeaderImage(AHeaderIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer); ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer;
AScaleX: Double = 1.0; AScaleY: Double = 1.0);
var var
s: Array[TsHeaderFooterSectionIndex] of string; s: Array[TsHeaderFooterSectionIndex] of string;
begin begin
FHeaderImages[ASection].Index := AImageIndex; FHeaderImages[ASection].Index := AImageIndex;
FHeaderImages[ASection].ScaleX := AScaleX;
FHeaderImages[ASection].ScaleY := AScaleY;
SplitHeaderFooterText(FHeaders[AHeaderIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]); SplitHeaderFooterText(FHeaders[AHeaderIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
// Add the symbol &G only once! // Add the symbol &G only once!
if (pos('&G', s[ASection]) < 1) or (pos('&g', s[ASection]) < 1) then begin if (pos('&G', s[ASection]) < 1) or (pos('&g', s[ASection]) < 1) then begin
@ -355,11 +366,14 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the footer. of the footer.
@param AFilename Name of the file containing the image @param AFilename Name of the file containing the image
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
@return Index of the image data in the workbook's EmbeddedObjList. Useful @return Index of the image data in the workbook's EmbeddedObjList. Useful
if the same image will be used in another header or footer. if the same image will be used in another header or footer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsPageLayout.AddFooterImage(AFooterIndex: Integer; function TsPageLayout.AddFooterImage(AFooterIndex: Integer;
ASection: TsHeaderFooterSectionIndex; const AFileName: String): Integer; ASection: TsHeaderFooterSectionIndex; const AFileName: String;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var var
book: TsWorkbook; book: TsWorkbook;
begin begin
@ -371,7 +385,7 @@ begin
Result := book.AddEmbeddedObj(AFilename); Result := book.AddEmbeddedObj(AFilename);
if Result = -1 then // Image not found? Unsupported file format? if Result = -1 then // Image not found? Unsupported file format?
exit; exit;
AddFooterImage(AFooterIndex, ASection, Result); AddFooterImage(AFooterIndex, ASection, Result, AScaleX, AScaleY);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -383,11 +397,14 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the footer. of the footer.
@param AStream Stream from which the image is copied @param AStream Stream from which the image is copied
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
@return Index of the image data in the workbook's EmbeddedObjList. Useful @return Index of the image data in the workbook's EmbeddedObjList. Useful
if the same image will be used in another header or footer. if the same image will be used in another header or footer.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsPageLayout.AddFooterImage(AFooterIndex: Integer; function TsPageLayout.AddFooterImage(AFooterIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream): Integer; ASection: TsHeaderFooterSectionIndex; AStream: TStream;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var var
book: TsWorkbook; book: TsWorkbook;
begin begin
@ -396,7 +413,7 @@ begin
book := TsWorksheet(FWorksheet).Workbook; book := TsWorksheet(FWorksheet).Workbook;
Result := book.AddEmbeddedObj(AStream); Result := book.AddEmbeddedObj(AStream);
if Result > -1 then if Result > -1 then
AddFooterImage(AFooterIndex, ASection, Result); AddFooterImage(AFooterIndex, ASection, Result, AScaleX, AScaleY);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -408,13 +425,18 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part (hfsLeft), center (hfsCenter) or right (hfsRight) part
of the footer. of the footer.
@param AImageIndex Index of the image data into the workbooks EmbeddedObjList @param AImageIndex Index of the image data into the workbooks EmbeddedObjList
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsPageLayout.AddFooterImage(AFooterIndex: Integer; procedure TsPageLayout.AddFooterImage(AFooterIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer); ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer;
AScaleX: Double = 1.0; AScaleY: Double = 1.0);
var var
s: Array[TsHeaderFooterSectionIndex] of string; s: Array[TsHeaderFooterSectionIndex] of string;
begin begin
FFooterImages[ASection].Index := AImageIndex; FFooterImages[ASection].Index := AImageIndex;
FFooterImages[ASection].ScaleX := AScaleX;
FFooterImages[ASection].ScaleY := AScaleY;
SplitHeaderFooterText(FFooters[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]); SplitHeaderFooterText(FFooters[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
// Add the symbol &G only once! // Add the symbol &G only once!
if (pos('&G', s[ASection]) < 1) or (pos('&g', s[ASection]) < 1) then begin if (pos('&G', s[ASection]) < 1) or (pos('&g', s[ASection]) < 1) then begin

8
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -1088,9 +1088,13 @@ type
PsImage = ^TsImage; PsImage = ^TsImage;
{@@ Image embedded in header or footer {@@ Image embedded in header or footer
@member Index Index of the image in the workbook's embedded streams list } @member Index Index of the image in the workbook's embedded streams list
@member ScaleX Scaling factor in horizontal direction
@member ScaleY Scaling factor in vertical direction }
TsHeaderFooterImage = record TsHeaderFooterImage = record
Index: Integer; Index: Integer;
ScaleX: Double;
ScaleY: Double;
end; end;
{@@ Page orientation for printing {@@ Page orientation for printing

49
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -215,7 +215,7 @@ type
procedure WriteSheetViews(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheetViews(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat); procedure WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat);
procedure WriteStyleList(AStream: TStream; ANodeName: String); procedure WriteStyleList(AStream: TStream; ANodeName: String);
procedure WriteVmlDrawings(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawings(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings_Comments(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawings_Comments(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings_HeaderFooterImages(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawings_HeaderFooterImages(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawingRels(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawingRels(AWorksheet: TsBasicWorksheet);
@ -6380,32 +6380,6 @@ begin
AppendToStream(FSDrawingsRels[FCurSheetNum], AppendToStream(FSDrawingsRels[FCurSheetNum],
'</Relationships>'); '</Relationships>');
end; end;
(*
procedure TsSpreadOOXMLWriter.WriteDrawingsOfSheet(AStream: TStream;
AWorksheet: TsWorksheet; rId: Integer);
// Use stream FSDrawingS[sheetindex]
var
i: Integer;
AVLNode: TAVLTreeNode;
hyperlink: PsHyperlink;
target, bookmark: String;
begin
// Keep in sync with WriteWorksheetRels !
FNext_rID := IfThen(AWorksheet.Comments.Count = 0, 1, 3);
AVLNode := AWorksheet.Hyperlinks.FindLowest;
while AVLNode <> nil do begin
inc(FNext_rID);
AVLNode := AWorksheet.Hyperlinks.FindSuccessor(AVLNode);
end;
for i:=0 to AWorksheet.GetImageCount-1 do
begin
AppendToStream(AStream, Format(
'<drawing r:id="rId%d" />', [FNext_rId]));
inc(FNext_rId);
end;
end; *)
{@ ----------------------------------------------------------------------------- {@ -----------------------------------------------------------------------------
Writes a VmlDrawings file for the specified worksheet. Writes a VmlDrawings file for the specified worksheet.
@ -6556,6 +6530,8 @@ var
AImage: TsHeaderFooterImage; var id, index: Integer); AImage: TsHeaderFooterImage; var id, index: Integer);
var var
fn: String; fn: String;
w, h: Double;
img: TsEmbeddedObj;
begin begin
if AImage.Index = -1 then if AImage.Index = -1 then
exit; exit;
@ -6569,19 +6545,28 @@ var
book.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]); book.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]);
exit; exit;
end; end;
fn := ChangeFileExt(book.GetEmbeddedObj(AImage.Index).FileName, '');
img := book.GetEmbeddedObj(AImage.Index);
if img = nil then
exit;
fn := ChangeFileExt(img.FileName, '');
if fn = '' then fn := 'image'; if fn = '' then fn := 'image';
w := mmToPts(img.ImageWidth * AImage.ScaleX);
h := mmToPts(img.ImageHeight * AImage.ScaleY);
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding + ' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding +
// e.g. "CH" _x0000_s1025 // e.g. "CH" _x0000_s1025
' style=''position:absolute;margin-left:0;margin-top:0;width:12pt;height:12pt;z-index:%d''>' + LineEnding + ' style=''position:absolute;margin-left:0;margin-top:0;width:%.1fpt;height:%.1fpt;z-index:%d''>' + LineEnding +
// e.g. z-index:1 // e.g. width height z-index:1
' <v:imagedata o:relid="rId%d" o:title="%s"/>' + LineEnding + ' <v:imagedata o:relid="rId%d" o:title="%s"/>' + LineEnding +
// e.g. "rId1" "arrow_down" // e.g. "rId1" "arrow_down"
' <o:lock v:ext="edit" rotation="t" />' + LineEnding + ' <o:lock v:ext="edit" rotation="t" />' + LineEnding +
' </v:shape>' + LineEnding, [ ' </v:shape>' + LineEnding, [
ATag + AChar, id, index, index, fn ATag + AChar, id,
])); w, h, index,
index, fn
], FPointSeparatorSettings));
inc(id); inc(id);
inc(index); inc(index);
end; end;