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

fpspreadsheet: Replace workbook's EmbeddedStream by a more general EmbeddedObj storing image width, height and format as well.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4556 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-15 12:29:58 +00:00
parent 5879d12600
commit 998c8b0dfc
11 changed files with 209 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/other/demo_write_headerfooter_images.lpr
View File

@ -39,6 +39,7 @@ begin
MyDir := ExtractFilePath(ParamStr(0));
MyWorkbook.WriteToFile(MyDir + 'hfimg.xlsx', sfOOXML, true);
MyWorkbook.WriteToFile(MyDir + 'hfimg.ods', sfOpenDocument, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg.xls', sfExcel8, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg5.xls', sfExcel5, true);
// MyWorkbook.WriteToFile(MyDir + 'hfimg2.xls', sfExcel2, true);

20
components/fpspreadsheet/fpsclasses.pas
View File

@ -201,15 +201,6 @@ type
function Pop: Integer;
end;
{ TsEmbeddedStream }
TsEmbeddedStream = class(TMemoryStream)
private
FName: String;
public
constructor Create(AName: String);
property Name: String read FName;
end;
function FindFontInList(AFontList: TFPList; AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Integer;
@ -1344,17 +1335,6 @@ begin
end;
{==============================================================================}
{ TsEmbeddedStream }
{==============================================================================}
constructor TsEmbeddedStream.Create(AName: String);
begin
inherited Create;
FName := AName;
end;
{==============================================================================}
{ Utilities }
{==============================================================================}

74
components/fpspreadsheet/fpsimages.pas
View File

@ -27,6 +27,26 @@ var
itEMF: TsImageType;
itPCX: TsImageType;
type
{ TsEmbeddedObj }
TsEmbeddedObj = class
private
FStream: TMemoryStream;
FName: String;
FImageType: TsImageType; // image type, see itXXXX
FWidth: Double; // image width, in mm
FHeight: Double; // image height, in mm
public
constructor Create(AName: String);
destructor Destroy; override;
property Name: String read FName;
property ImageType: TsImagetype read FImageType;
property ImageWidth: Double read FWidth;
property ImageHeight: Double read FHeight;
property Stream: TMemoryStream read FStream;
end;
function GetImageInfo(AStream: TStream; out AWidthInches, AHeightInches: Double;
AImagetype: TsImageType = itUnknown): TsImageType; overload;
@ -34,6 +54,7 @@ function GetImageInfo(AStream: TStream; out AWidth, AHeight: DWord;
out dpiX, dpiY: Double; AImageType: TsImageType = itUnknown): TsImageType; overload;
function GetImageMimeType(AImageType: TsImageType): String;
function GetImageTypeExt(AImageType: TsImageType): String;
function GetImageTypeFromFileName(const AFilename: String): TsImageType;
function RegisterImageType(AMimeType, AExt: String; AGetImageSize: TGetImageSizeFunc): TsImageType;
@ -735,6 +756,26 @@ begin
Result := '';
end;
{@@ ----------------------------------------------------------------------------
Returns the file extension belonging the specified image type. If there
are several extensions the first one is selected. The extension is returned
without a leading period.
-------------------------------------------------------------------------------}
function GetImageTypeExt(AImageType: TsImageType): String;
var
p: Integer;
begin
if InRange(AImageType, 0, High(ImageTypeRegistry)) then
begin
Result := ImageTypeRegistry[AImageType].Ext;
p := pos('|', Result);
if p > 0 then
Result := copy(Result, 1, p-1);
if Result[1] = '.' then Delete(Result, 1, 1);
end else
Result := '';
end;
{@@ ----------------------------------------------------------------------------
Extracts the image file type identifier from the extension of the specified
file name.
@ -790,6 +831,39 @@ begin
end;
{==============================================================================}
{ TsEmbeddedObj }
{==============================================================================}
constructor TsEmbeddedObj.Create(AName: String);
var
w, h: Double;
begin
inherited Create;
FName := AName;
FStream := TMemoryStream.Create;
FStream.LoadFromFile(AName);
FImageType := GetImageInfo(FStream, w, h, GetImageTypefromFileName(AName));
if FImageType <> itUnknown then
begin
FWidth := inToMM(w);
FHeight := inToMM(h);
end else
begin
FreeAndNil(FStream);
abort;
end;
end;
destructor TsEmbeddedObj.Destroy;
begin
FreeAndNil(FStream);
inherited Destroy;
end;
initialization
itPNG := RegisterImageType('image/png', 'png', @GetPNGSize);

43
components/fpspreadsheet/fpsopendocument.pas
View File

@ -3966,6 +3966,7 @@ procedure TsSpreadOpenDocWriter.GetHeaderFooterImageName(
var
sct: TsHeaderFooterSectionIndex;
img: TsHeaderFooterImage;
ext: String;
begin
AHeader := '';
AFooter := '';
@ -3976,14 +3977,16 @@ begin
if APageLayout.HeaderImages[sct].Index > -1 then
begin
img := APageLayout.HeaderImages[sct];
AHeader := IntToStr(img.Index+1) + ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).ImageType);
AHeader := Format('%d.%s', [img.Index+1, ext]);
break;
end;
for sct in TsHeaderFooterSectionIndex do
if APageLayout.FooterImages[sct].Index > -1 then
begin
img := APageLayout.FooterImages[sct];
AFooter := IntToStr(img.Index+1) + ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).Imagetype);
AFooter := Format('%d.%s', [img.Index+1, ext]);
break;
end;
end;
@ -4297,7 +4300,7 @@ var
ext: String;
mime: String;
imgtype: Integer;
embStream: TsEmbeddedStream;
embObj: TsEmbeddedObj;
begin
AppendToStream(FSMetaInfManifest,
'<manifest:manifest xmlns:manifest="' + SCHEMAS_XMLNS_MANIFEST + '">');
@ -4311,16 +4314,16 @@ begin
'<manifest:file-entry manifest:media-type="text/xml" manifest:full-path="meta.xml" />');
AppendToStream(FSMetaInfManifest,
'<manifest:file-entry manifest:media-type="text/xml" manifest:full-path="settings.xml" />');
for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do
for i:=0 to FWorkbook.GetEmbeddedObjCount-1 do
begin
embstream := FWorkbook.GetEmbeddedStream(i);
imgtype := GetImageTypeFromFileName(embStream.Name);
embObj := FWorkbook.GetEmbeddedObj(i);
imgtype := embObj.ImageType;
if imgtype = itUnknown then
continue;
mime := GetImageMimeType(imgtype);
ext := ExtractFileExt(embStream.Name);
ext := GetImageTypeExt(imgType);
AppendToStream(FSMetaInfManifest, Format(
'<manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d%s" />',
'<manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d.%s" />',
[mime, i+1, ext]
));
end;
@ -4357,17 +4360,19 @@ end;
procedure TsSpreadOpenDocWriter.ZipPictures(AZip: TZipper);
var
i: Integer;
embStream: TsEmbeddedStream;
embObj: TsEmbeddedObj;
embName: String;
ext: String;
begin
for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do
for i:=0 to FWorkbook.GetEmbeddedObjCount-1 do
begin
embStream := FWorkbook.GetEmbeddedStream(i);
embObj := FWorkbook.GetEmbeddedObj(i);
// The original ods files have a very long, ranomd, unique (?) filename.
// Test show that a simple, unique, increasing number works as well.
embName := IntToStr(i+1) + ExtractFileExt(embStream.Name);
embStream.Position := 0;
AZip.Entries.AddFileEntry(embStream, 'Pictures/' + embname);
// Tests show that a simple, unique, increasing number works as well.
ext := GetImageTypeExt(embObj.ImageType);
embName := Format('%d.%s', [i+1, ext]);
embObj.Stream.Position := 0;
AZip.Entries.AddFileEntry(embObj.Stream, 'Pictures/' + embname);
end;
end;
@ -5997,7 +6002,7 @@ var
img: TsImage;
r1,c1,r2,c2: Cardinal;
roffs1,coffs1, roffs2, coffs2: Double;
x,y,w,h: Double;
x, y, w, h: Double;
begin
if ASheet.GetImageCount = 0 then
exit;
@ -6013,7 +6018,7 @@ begin
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h) // mm
then begin
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedStream(img.Index).Name]);
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
continue;
end;
AppendToStream(AStream, Format(
@ -6021,14 +6026,14 @@ begin
'draw:style-name="gr1" draw:text-style-name="P1" '+
'svg:width="%.2fmm" svg:height="%.2fmm" '+
'svg:x="%.2fmm" svg:y="%.2fmm">' +
'<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 />' +
'</draw:image>' +
'</draw:frame>', [
i+1, i+1,
w, h,
x, y,
img.Index+1, ExtractFileExt(Workbook.GetEmbeddedStream(img.Index).Name)
img.Index+1, GetImageTypeExt(Workbook.GetEmbeddedObj(img.Index).ImageType)
], FPointSeparatorSettings));
end;

18
components/fpspreadsheet/fpspagelayout.pas
View File

@ -269,12 +269,11 @@ begin
if FWorksheet = nil then
raise Exception.Create('[TsPageLayout.AddHeaderImage] Worksheet is nil.');
book := TsWorksheet(FWorksheet).Workbook;
idx := book.FindEmbeddedStream(AFilename);
idx := book.FindEmbeddedObj(AFilename);
if idx = -1 then
begin
idx := book.AddEmbeddedStream(AFilename);
book.GetEmbeddedStream(idx).LoadFromFile(AFileName);
end;
idx := book.AddEmbeddedObj(AFilename);
if idx = -1 then // Image not found? Unsupported file format?
exit;
FHeaderImages[ASection].Index := idx;
SplitHeaderFooterText(FHeaders[AHeaderIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
s[ASection] := s[ASection] + '&G';
@ -291,12 +290,11 @@ begin
if FWorksheet = nil then
raise Exception.Create('[TsPageLayout.AddFooterImage] Worksheet is nil.');
book := TsWorksheet(FWorksheet).Workbook;
idx := book.FindEmbeddedStream(AFilename);
idx := book.FindEmbeddedObj(AFilename);
if idx = -1 then
begin
idx := book.AddEmbeddedStream(AFilename);
book.GetEmbeddedStream(idx).LoadFromFile(AFileName);
end;
idx := book.AddEmbeddedObj(AFilename);
if idx = -1 then // Image not found? Unsupported file format?
exit;
FFooterImages[ASection].Index := idx;
SplitHeaderFooterText(FFooters[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]);
s[ASection] := s[ASection] + '&G';

116
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -34,7 +34,7 @@ uses
clocale,
{$endif}{$endif}{$endif}
Classes, SysUtils, fpimage, AVL_Tree, avglvltree, lconvencoding,
fpsTypes, fpsClasses, fpsNumFormat, fpsPageLayout;
fpsTypes, fpsClasses, fpsNumFormat, fpsPageLayout, fpsImages;
type
{ Forward declarations }
@ -654,7 +654,7 @@ type
FFontList: TFPList;
FNumFormatList: TFPList;
FCellFormatList: TsCellFormatList;
FEmbeddedStreamList: TFPList;
FEmbeddedObjList: TFPList;
{ Internal methods }
class function GetFormatFromFileHeader(const AFileName: TFileName;
@ -764,13 +764,13 @@ type
AOperation: TsCopyOperation; AParams: TsStreamParams = [];
ATransposed: Boolean = false);
{ Embedded images }
function AddEmbeddedStream(const AName: String): Integer;
function FindEmbeddedStream(const AName: String): Integer;
function GetEmbeddedStream(AIndex: Integer): TsEmbeddedStream;
function GetEmbeddedStreamCount: Integer;
{ Embedded objects }
function AddEmbeddedObj(const AName: String): Integer;
function FindEmbeddedObj(const AName: String): Integer;
function GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
function GetEmbeddedObjCount: Integer;
function HasEmbeddedSheetImages: Boolean;
procedure RemoveAllEmbeddedStreams;
procedure RemoveAllEmbeddedObj;
{ Utilities }
procedure DisableNotifications;
@ -829,7 +829,7 @@ uses
Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser,
fpsStrings, uvirtuallayer_ole,
fpsUtils, fpsHTMLUtils, fpsRegFileFormats, fpsReaderWriter,
fpsCurrency, fpsExprParser, fpsNumFormatParser, fpsImages;
fpsCurrency, fpsExprParser, fpsNumFormatParser;
(*
const
@ -3346,12 +3346,11 @@ function TsWorksheet.CalcImageExtent(AIndex: Integer;
out x,y, AWidth, AHeight: Double): Boolean; // mm
var
img: TsImage;
stream: TsEmbeddedStream;
obj: TsEmbeddedObj;
colW, rowH: Double;
totH, totW: Double;
r, c: Integer;
factor: Double;
imgtype: Integer;
begin
img := GetImage(AIndex);
@ -3360,13 +3359,9 @@ begin
ARowOffs1 := img.OffsetX; // millimeters
AColOffs1 := img.OffsetY;
stream := FWorkbook.GetEmbeddedStream(img.Index);
imgtype := GetImageTypeFromFileName(stream.Name);
if GetImageInfo(stream, AWidth, AHeight, imgtype) = itUnknown then // in inches
exit(false);
AWidth := inToMM(AWidth*img.ScaleX); // in millimeters now
AHeight := inToMM(AHeight*img.ScaleY);
obj := FWorkbook.GetEmbeddedObj(img.Index);
AWidth := obj.ImageWidth * img.ScaleX;
AHeight := obj.ImageHeight * img.ScaleY;
// Find x coordinate of left image edge, in inches.
factor := FWorkbook.GetDefaultFont.Size/2; // Width of "0" character in pts
@ -3438,14 +3433,21 @@ function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var
img: PsImage;
idx: Integer;
begin
// Does the image already exist?
idx := Workbook.FindEmbeddedObj(AFileName);
// No? Open and store in embedded object list.
if idx = -1 then
idx := Workbook.AddEmbeddedObj(AFileName);
// An error has occured? Error is already logged. Just exit.
if idx = -1 then
exit;
// Everything ok here...
New(img);
InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY);
img^.Index := Workbook.FindEmbeddedStream(AFileName);
if img^.Index = -1 then begin
img^.Index := Workbook.AddEmbeddedStream(AFileName);
Workbook.GetEmbeddedStream(img^.Index).LoadFromFile(AFileName);
end;
img^.Index := idx;
Result := FImages.Add(img);
end;
@ -3463,6 +3465,11 @@ begin
FImages.Delete(AIndex);
end;
{@@ ----------------------------------------------------------------------------
Removes all image from the internal image list.
The image streams (stored by the workbook), however, are retained because
images may also be used as header/footer images.
-------------------------------------------------------------------------------}
procedure TsWorksheet.RemoveAllImages;
var
i: Integer;
@ -6836,7 +6843,7 @@ begin
FNumFormatList := TsNumFormatList.Create(FormatSettings, true);
FCellFormatList := TsCellFormatList.Create(false);
FEmbeddedStreamList := TFPList.Create;
FEmbeddedObjList := TFPList.Create;
// Add default cell format
InitFormatRecord(fmt);
@ -6857,8 +6864,8 @@ begin
RemoveAllFonts;
FFontList.Free;
RemoveAllEmbeddedStreams;
FEmbeddedStreamList.Free;
RemoveAllEmbeddedObj;
FEmbeddedObjList.Free;
FLog.Free;
FreeAndNil(FSearchEngine);
@ -8356,44 +8363,61 @@ end;
Embedded streams are used to store embedded images. AName is normally the
filename of the image. The image will be loaded to the stream later.
-------------------------------------------------------------------------------}
function TsWorkbook.AddEmbeddedStream(const AName: String): Integer;
function TsWorkbook.AddEmbeddedObj(const AName: String): Integer;
var
obj: TsEmbeddedObj = nil;
w, h: Double;
it: TsImageType;
begin
Result := FEmbeddedStreamList.Add(TsEmbeddedStream.Create(AName));
if not FileExists(AName) then
begin
AddErrorMsg(rsFileNotFound, [AName]);
Result := -1;
exit;
end;
try
obj := TsEmbeddedObj.Create(AName);
Result := FEmbeddedObjList.Add(obj);
except
AddErrorMsg(rsFileFormatNotSupported, [AName]);
Result := -1;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether an embedded stream with the specified name already exists.
If yes, returns its index in the stream list, or -1 if no.
Checks whether an embedded object with the specified name already exists.
If yes, returns its index in the object list, or -1 if no.
-------------------------------------------------------------------------------}
function TsWorkbook.FindEmbeddedStream(const AName: String): Integer;
function TsWorkbook.FindEmbeddedObj(const AName: String): Integer;
var
stream: TsEmbeddedStream;
obj: TsEmbeddedObj;
begin
for Result:=0 to FEmbeddedStreamList.Count-1 do
for Result:=0 to FEmbeddedObjList.Count-1 do
begin
stream := TsEmbeddedStream(FEmbeddedStreamList[Result]);
if stream.Name = AName then
obj := TsEmbeddedObj(FEmbeddedObjList[Result]);
if obj.Name = AName then
exit;
end;
Result := -1;
end;
{@@ ----------------------------------------------------------------------------
Returns the embedded stream stored in the embedded stream list at the
Returns the embedded object stored in the embedded object list at the
specified index.
-------------------------------------------------------------------------------}
function TsWorkbook.GetEmbeddedStream(AIndex: Integer): TsEmbeddedStream;
function TsWorkbook.GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
begin
Result := TsEmbeddedStream(FEmbeddedStreamList[AIndex]);
Result := TsEmbeddedObj(FEmbeddedObjList[AIndex]);
end;
{@@ ----------------------------------------------------------------------------
Returns the count of embedded streams
Returns the count of embedded objects
-------------------------------------------------------------------------------}
function TsWorkbook.GetEmbeddedStreamCount: Integer;
function TsWorkbook.GetEmbeddedObjCount: Integer;
begin
Result := FEmbeddedStreamList.Count;
Result := FEmbeddedObjList.Count;
end;
{@@ ----------------------------------------------------------------------------
@ -8415,15 +8439,15 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Removes all embedded streams
Removes all embedded objects
-------------------------------------------------------------------------------}
procedure TsWorkbook.RemoveAllEmbeddedStreams;
procedure TsWorkbook.RemoveAllEmbeddedObj;
var
i: Integer;
begin
for i:= 0 to FEmbeddedStreamList.Count-1 do
TsEmbeddedStream(FEmbeddedStreamList[i]).Free;
FEmbeddedStreamList.Clear;
for i:= 0 to FEmbeddedObjList.Count-1 do
TsEmbeddedObj(FEmbeddedObjList[i]).Free;
FEmbeddedObjList.Clear;
end;
{@@ ----------------------------------------------------------------------------

6
components/fpspreadsheet/fpsstrings.pas
View File

@ -61,6 +61,7 @@ resourcestring
rsIncorrectParamCount = 'Funtion %s requires at least %d and at most %d parameters.';
rsCircularReference = 'Circular reference found when calculating worksheet formulas';
rsFileNotFound = 'File "%s" not found.';
rsFileFormatNotSupported = 'File format of "%s" not supported.';
rsFileAlreadyExists = 'File "%s" already exists.';
rsWorksheetNotFound = 'Worksheet "%s" not found.';
rsWorksheetNotFound1 = 'Worksheet not found.';
@ -82,6 +83,9 @@ resourcestring
rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.';
rsFormulaNotSupported = 'The formula in cell %s is not supported by this file format: %s';
rsCannotSortMerged = 'The cell range cannot be sorted because it contains merged cells.';
// Hyperlinks
rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.';
rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.';
rsLocalFileHyperlinkAbs = 'The hyperlink "%s" points to a local file. ' +
@ -90,8 +94,6 @@ resourcestring
rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.';
rsStdHyperlinkTooltip = 'Hold the left mouse button down for a short time to activate the hyperlink.';
rsCannotSortMerged = 'The cell range cannot be sorted because it contains merged cells.';
// PageLayout
rsDifferentSheetPrintRange = 'Print range "%s" requires a different worksheet.';
rsFooter = 'Footer';

1
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -4,6 +4,7 @@
unit laz_fpspreadsheet;
{$warn 5023 off : no warning about unused units}
interface
uses

1
components/fpspreadsheet/laz_fpspreadsheet_visual.pas
View File

@ -4,6 +4,7 @@
unit laz_fpspreadsheet_visual;
{$warn 5023 off : no warning about unused units}
interface
uses

1
components/fpspreadsheet/laz_fpspreadsheetexport_visual.pas
View File

@ -4,6 +4,7 @@
unit laz_fpspreadsheetexport_visual;
{$warn 5023 off : no warning about unused units}
interface
uses

46
components/fpspreadsheet/xlsxooxml.pas
View File

@ -227,7 +227,7 @@ implementation
uses
variants, strutils, math, lazutf8, LazFileUtils, uriparser,
{%H-}fpsPatches,
fpsStrings, fpsStreams, fpsNumFormatParser, fpsClasses,
fpsStrings, fpsStreams, fpsNumFormatParser, fpsClasses, fpsImages,
fpsRegFileFormats;
const
@ -3284,7 +3284,7 @@ begin
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h) // mm
then begin
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedStream(img.Index).Name]);
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
continue;
end;
AppendToStream(FSDrawings[FCurSheetNum],
@ -3334,7 +3334,7 @@ begin
'</xdr:spPr>'+
'</xdr:pic>' +
'<xdr:clientData/>', [
i+2, i+1, ExtractFilename(Workbook.GetEmbeddedStream(img.Index).Name),
i+2, i+1, ExtractFilename(Workbook.GetEmbeddedObj(img.Index).Name),
i+1,
mmToEMU(x), mmToEMU(y),
mmToEMU(w), mmToEMU(h)
@ -3370,9 +3370,9 @@ begin
for i:=0 to AWorksheet.GetImageCount - 1 do
begin
img := AWorksheet.GetImage(i);
ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).Imagetype);
AppendToStream(FSDrawingsRels[FCurSheetNum], Format(
' <Relationship Id="rId%d" Type="%s" Target="../media/image%d%s"/>' + LineEnding, [
' <Relationship Id="rId%d" Type="%s" Target="../media/image%d.%s"/>' + LineEnding, [
i+1, SCHEMAS_IMAGE, img.Index+1, ext
]));
end;
@ -3565,8 +3565,7 @@ procedure TsSpreadOOXMLWriter.WriteVMLDrawings_HeaderFooterImages(
FWorkbook.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]);
exit;
end;
fn := Workbook.GetEmbeddedStream(AImage.Index).Name;
fn := ChangeFileExt(ExtractFileName(fn), '');
fn := ChangeFileExt(Workbook.GetEmbeddedObj(AImage.Index).Name, '');
AppendToStream(AStream, Format(
' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding +
// e.g. "CH" _x0000_s1025
@ -3705,8 +3704,9 @@ begin
img := AWorksheet.PageLayout.HeaderImages[sec];
if img.Index = -1 then
continue;
imgName := FWorkbook.GetEmbeddedStream(img.Index).Name;
imgIdx := FWorkbook.FindEmbeddedStream(imgName);
imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
imgIdx := img.Index;
// imgIdx := FWorkbook.FindEmbeddedObj(imgName);
AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
' <Relationship Id="rId%d" Target="../media/image%d%s" '+
'Type="' + SCHEMAS_IMAGE + '" />' + LineEnding, [
@ -3721,8 +3721,9 @@ begin
img := AWorksheet.PageLayout.FooterImages[sec];
if img.Index = -1 then
continue;
imgName := FWorkbook.GetEmbeddedStream(img.Index).Name;
imgIdx := FWorkbook.FindEmbeddedStream(imgName);
imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
imgIdx := img.Index;
// imgIdx := FWorkbook.FindEmbeddedObj(imgName);
AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
' <Relationship Id="rId%d" Target="../media/image%d%s" '+ //
// e.g. "rId1" "..(media/image1.png"
@ -3891,15 +3892,19 @@ end;
procedure TsSpreadOOXMLWriter.WriteMedia(AZip: TZipper);
var
i: Integer;
embStream: TsEmbeddedStream;
stream: TMemoryStream;
embObj: TsEmbeddedObj;
embName: String;
ext: String;
begin
for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do
for i:=0 to FWorkbook.GetEmbeddedObjCount-1 do
begin
embStream := FWorkbook.GetEmbeddedStream(i);
embStream.Position := 0;
embName := Format('image%d', [i+1]) + ExtractFileExt(embStream.Name);
AZip.Entries.AddFileEntry(embStream, OOXML_PATH_XL_MEDIA + embname);
embObj := FWorkbook.GetEmbeddedObj(i);
stream := embObj.Stream;
stream.Position := 0;
ext := GetImageTypeExt(embObj.ImageType);
embName := Format('image%d.%s', [i+1, ext]);
AZip.Entries.AddFileEntry(stream, OOXML_PATH_XL_MEDIA + embname);
end;
end;
@ -3979,14 +3984,13 @@ begin
AppendToStream(FSContentTypes, Format(
'<Default Extension="vml" ContentType="%s" />' + LineEnding, [MIME_VMLDRAWING]));
if Workbook.GetEmbeddedStreamCount > 0 then
if Workbook.GetEmbeddedObjCount > 0 then
begin
imgExt := TStringList.Create;
try
for i:=0 to Workbook.GetEmbeddedStreamCount-1 do
for i:=0 to Workbook.GetEmbeddedObjCount-1 do
begin
ext := ExtractFileExt(Workbook.GetEmbeddedStream(i).Name);
if ext[1] = '.' then Delete(ext, 1, 1);
ext := GetImageTypeExt(Workbook.GetEmbeddedObj(i).ImageType);
j := imgExt.IndexOf(ext);
if j = -1 then
imgExt.Add(ext);