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

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

components/fpspreadsheet/examples/other/header_footer_images/demo_write_headerfooter_images.lpr

@@ -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.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
     MyDir := ExtractFilePath(ParamStr(0));

components/fpspreadsheet/source/common/fpspagelayout.pas

@@ -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;
+      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;
     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

components/fpspreadsheet/source/common/fpstypes.pas

@@ -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 

components/fpspreadsheet/source/common/xlsxooxml.pas

@@ -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 +
+      '   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 +
       //    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;