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;
MyWorksheet: TsWorksheet;
MyDir: string;
cell: PCell;
i, r, c: Integer;
const
image1 = '../../../images/components/TSWORKBOOKSOURCE.png';
image2 = '../../../images/components/TSWORKSHEETGRID.png';
image3 = '../../../images/components/TSCELLEDIT.png';
begin
Writeln('Starting program "demo_write_headerfooter_images"...');
if not FileExists(image1) then
begin
WriteLn(ExpandFilename(image1) + ' not found.');
@ -32,12 +30,6 @@ begin
Halt;
end;
if not FileExists(image3) then
begin
WriteLn(ExpandFilename(image3) + ' not found.');
Halt;
end;
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
@ -50,8 +42,8 @@ begin
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2');
MyWorksheet.WriteText(0, 0, 'The footer of this sheet contains an image');
MyWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] := '&CFooter with image!';
MyWorksheet.PageLayout.AddFooterImage(HEADER_FOOTER_INDEX_ALL, hfsRight, image2);
MyWorksheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] := '&CFooter with image, scaled by factor 2!';
MyWorksheet.PageLayout.AddFooterImage(HEADER_FOOTER_INDEX_ALL, hfsRight, image2, 2.0, 2.0);
// Save the spreadsheet to files
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 }
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;
AStream: TStream): Integer; overload;
AStream: TStream; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
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;
const AFilename: String): Integer; overload;
const AFilename: String; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
function AddFooterImage(AFooterIndex: integer; ASection: TsHeaderFooterSectionIndex;
AStream: TStream): Integer; overload;
procedure AddFooterImage(AFooterIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer); overload;
AStream: TStream; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
procedure AddFooterImage(AFooterIndex: Integer; ASection: TsHeaderFooterSectionIndex;
AImageIndex: Integer; AScaleX: Double = 1.0; AScaleY: Double = 1.0); overload;
function JoinHeaderFooterText(const ALeft, ACenter, ARight: String): String;
procedure SplitHeaderFooterText(const AText: String; out ALeft, ACenter, ARight: String);
@ -277,12 +277,15 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header.
@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
if the same image will be used in another header or footer.
-------------------------------------------------------------------------------}
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
book: TsWorkbook;
begin
@ -293,7 +296,7 @@ begin
if Result = -1 then
Result := book.AddEmbeddedObj(AFilename);
if Result > -1 then
AddHeaderImage(AHeaderIndex, ASection, Result);
AddHeaderImage(AHeaderIndex, ASection, Result, AScaleX, AScaleY);
end;
{@@ ----------------------------------------------------------------------------
@ -305,12 +308,15 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header.
@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
if the same image will be used in another header or footer.
-------------------------------------------------------------------------------}
function TsPageLayout.AddHeaderImage(AHeaderIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream): Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var
book: TsWorkbook;
begin
@ -319,7 +325,7 @@ begin
book := TsWorksheet(FWorksheet).Workbook;
Result := book.AddEmbeddedObj(AStream);
if Result > -1 then
AddHeaderImage(AHeaderIndex, ASection, Result);
AddHeaderImage(AHeaderIndex, ASection, Result, AScaleX, AScaleY);
end;
{@@ ----------------------------------------------------------------------------
@ -331,13 +337,18 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part
of the header.
@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;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer);
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer;
AScaleX: Double = 1.0; AScaleY: Double = 1.0);
var
s: Array[TsHeaderFooterSectionIndex] of string;
begin
FHeaderImages[ASection].Index := AImageIndex;
FHeaderImages[ASection].ScaleX := AScaleX;
FHeaderImages[ASection].ScaleY := AScaleY;
SplitHeaderFooterText(FHeaders[AHeaderIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
// Add the symbol &G only once!
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
of the footer.
@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
if the same image will be used in another header or footer.
-------------------------------------------------------------------------------}
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
book: TsWorkbook;
begin
@ -371,7 +385,7 @@ begin
Result := book.AddEmbeddedObj(AFilename);
if Result = -1 then // Image not found? Unsupported file format?
exit;
AddFooterImage(AFooterIndex, ASection, Result);
AddFooterImage(AFooterIndex, ASection, Result, AScaleX, AScaleY);
end;
{@@ ----------------------------------------------------------------------------
@ -383,11 +397,14 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part
of the footer.
@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
if the same image will be used in another header or footer.
-------------------------------------------------------------------------------}
function TsPageLayout.AddFooterImage(AFooterIndex: Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream): Integer;
ASection: TsHeaderFooterSectionIndex; AStream: TStream;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var
book: TsWorkbook;
begin
@ -396,7 +413,7 @@ begin
book := TsWorksheet(FWorksheet).Workbook;
Result := book.AddEmbeddedObj(AStream);
if Result > -1 then
AddFooterImage(AFooterIndex, ASection, Result);
AddFooterImage(AFooterIndex, ASection, Result, AScaleX, AScaleY);
end;
{@@ ----------------------------------------------------------------------------
@ -408,13 +425,18 @@ end;
(hfsLeft), center (hfsCenter) or right (hfsRight) part
of the footer.
@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;
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer);
ASection: TsHeaderFooterSectionIndex; AImageIndex: Integer;
AScaleX: Double = 1.0; AScaleY: Double = 1.0);
var
s: Array[TsHeaderFooterSectionIndex] of string;
begin
FFooterImages[ASection].Index := AImageIndex;
FFooterImages[ASection].ScaleX := AScaleX;
FFooterImages[ASection].ScaleY := AScaleY;
SplitHeaderFooterText(FFooters[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
// Add the symbol &G only once!
if (pos('&G', s[ASection]) < 1) or (pos('&g', s[ASection]) < 1) then begin

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

@ -1088,9 +1088,13 @@ type
PsImage = ^TsImage;
{@@ 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
Index: Integer;
ScaleX: Double;
ScaleY: Double;
end;
{@@ 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 WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat);
procedure WriteStyleList(AStream: TStream; ANodeName: String);
procedure WriteVmlDrawings(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings_Comments(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings_HeaderFooterImages(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawingRels(AWorksheet: TsBasicWorksheet);
@ -6380,32 +6380,6 @@ begin
AppendToStream(FSDrawingsRels[FCurSheetNum],
'</Relationships>');
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.
@ -6556,6 +6530,8 @@ var
AImage: TsHeaderFooterImage; var id, index: Integer);
var
fn: String;
w, h: Double;
img: TsEmbeddedObj;
begin
if AImage.Index = -1 then
exit;
@ -6569,19 +6545,28 @@ var
book.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]);
exit;
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';
w := mmToPts(img.ImageWidth * AImage.ScaleX);
h := mmToPts(img.ImageHeight * AImage.ScaleY);
AppendToStream(AStream, Format(
' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding +
// e.g. "CH" _x0000_s1025
' style=''position:absolute;margin-left:0;margin-top:0;width:12pt;height:12pt;z-index:%d''>' + LineEnding +
// e.g. z-index:1
' style=''position:absolute;margin-left:0;margin-top:0;width:%.1fpt;height:%.1fpt;z-index:%d''>' + LineEnding +
// e.g. width height z-index:1
' <v:imagedata o:relid="rId%d" o:title="%s"/>' + LineEnding +
// e.g. "rId1" "arrow_down"
' <o:lock v:ext="edit" rotation="t" />' + LineEnding +
' </v:shape>' + LineEnding, [
ATag + AChar, id, index, index, fn
]));
ATag + AChar, id,
w, h, index,
index, fn
], FPointSeparatorSettings));
inc(id);
inc(index);
end;