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

fpspreadsheet: Activate scaling factor for embedded images.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4546 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-13 22:28:59 +00:00
parent a5e8d60e81
commit 44b8adf293
3 changed files with 13 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpspreadsheet/examples/other/demo_write_images.lpr
View File

@ -24,10 +24,11 @@ begin
MyWorkbook.Options := [boFileStream]; MyWorkbook.Options := [boFileStream];
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 1'); MyWorksheet := MyWorkbook.AddWorksheet('Sheet 1');
MyWorksheet.DefaultRowHeight := 1.2;
MyWorksheet.WriteText(0, 0, 'There are images in cells A3 and B3'); // MyWorksheet.WriteText(0, 0, 'There are images in cells A3 and B3'); //
MyWorksheet.WriteImage(2, 0, image1); MyWorksheet.WriteImage(2, 0, image1, 1.0, 1.0, 2.0, 2.0);
MyWorksheet.WriteImage(3, 0, image2); MyWorksheet.WriteImage(2, 1, image2, 1.0, 1.0);
{
MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2'); MyWorksheet := MyWorkbook.AddWorksheet('Sheet 2');
MyWorksheet.WriteText(0, 0, 'There is an image in cell B3'); MyWorksheet.WriteText(0, 0, 'There is an image in cell B3');
MyWorksheet.WriteImage(2, 1, image3); MyWorksheet.WriteImage(2, 1, image3);
@ -35,7 +36,7 @@ begin
// MyWorksheet.WriteHyperlink(0, 0, 'http://www.chip.de'); // MyWorksheet.WriteHyperlink(0, 0, 'http://www.chip.de');
// MyWorksheet.PageLayout.AddHeaderImage(1, hfsLeft, 'D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\read_write\ooxmldemo\laz_open.png'); // MyWorksheet.PageLayout.AddHeaderImage(1, hfsLeft, 'D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\read_write\ooxmldemo\laz_open.png');
// MyWorksheet.PageLayout.Headers[1] := '&LThis is a header&R&G'; // MyWorksheet.PageLayout.Headers[1] := '&LThis is a header&R&G';
}
// Save the spreadsheet to a file // Save the spreadsheet to a file
MyDir := ExtractFilePath(ParamStr(0)); MyDir := ExtractFilePath(ParamStr(0));
MyWorkbook.WriteToFile(MyDir + 'img.xlsx', sfOOXML, true); MyWorkbook.WriteToFile(MyDir + 'img.xlsx', sfOOXML, true);

7
components/fpspreadsheet/fpsopendocument.pas
View File

@ -6007,9 +6007,10 @@ begin
continue; continue;
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<draw:frame draw:z-index="%d" draw:name="Image %d" draw:style-name="gr1" '+ '<draw:frame draw:z-index="%d" draw:name="Image %d" '+
'draw:text-style-name="P1" svg:width="%gmm" svg:height="%gmm" '+ 'draw:style-name="gr1" draw:text-style-name="P1" '+
'svg:x="%gmm" svg:y="%gmm">' + 'svg:width="%.2gmm" svg:height="%.2gmm" '+
'svg:x="%.2gmm" svg:y="%.2gmm">' +
'<draw:image xlink:href="Pictures/%d%s" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad">' + '<draw:image xlink:href="Pictures/%d%s" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad">' +
'<text:p />' + '<text:p />' +
'</draw:image>' + '</draw:image>' +

8
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -499,7 +499,7 @@ type
procedure RemoveAllImages; procedure RemoveAllImages;
procedure RemoveImage(AIndex: Integer); procedure RemoveImage(AIndex: Integer);
function WriteImage(ARow, ACol: Cardinal; AFileName: String; function WriteImage(ARow, ACol: Cardinal; AFileName: String;
AOffsetX: Integer = 0; AOffsetY: Integer = 0; AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
// Notification of changed cells // Notification of changed cells
@ -3361,8 +3361,8 @@ begin
stream := FWorkbook.GetEmbeddedStream(img.Index); stream := FWorkbook.GetEmbeddedStream(img.Index);
Result := GetImageSize(stream, ExtractFileExt(stream.Name), AWidth, AHeight); // in inches! Result := GetImageSize(stream, ExtractFileExt(stream.Name), AWidth, AHeight); // in inches!
AWidth := inToMM(AWidth); // in millimeters now AWidth := inToMM(AWidth*img.ScaleX); // in millimeters now
AHeight := inToMM(AHeight); AHeight := inToMM(AHeight*img.ScaleY);
// Find x coordinate of left image edge, in inches. // Find x coordinate of left image edge, in inches.
factor := FWorkbook.GetDefaultFont.Size/2; // Width of "0" character in pts factor := FWorkbook.GetDefaultFont.Size/2; // Width of "0" character in pts
@ -3430,7 +3430,7 @@ end;
@return Index into the internal image list. @return Index into the internal image list.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String; function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String;
AOffsetX: Integer = 0; AOffsetY: Integer = 0; AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var var
img: PsImage; img: PsImage;