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

fpspreadsheet: Add stream variant of TsWorksheet.WriteImage.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4557 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-15 14:04:06 +00:00
parent 998c8b0dfc
commit 6adaa12975
6 changed files with 194 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

102
components/fpspreadsheet/fpsimages.pas
View File

@ -14,32 +14,45 @@ type
TsImageType = integer;
const
{@@ Identifier for unknown image type }
itUnknown = -1;
var
{@@ Identifier for the PNG image type (value 0) }
itPNG: TsImageType;
{@@ Identifier for the JPEG image type (value 1) }
itJPEG: TsImageType;
{@@ Identifier for the TIFF image type (value 2) }
itTIFF: TsImageType;
{@@ Identifier for the BMP image type (value 3) }
itBMP: TsImageType;
{@@ Identifier for the GIF image type (value 4) }
itGIF: TsImageType;
{@@ Identifier for the SVG image type (value 5) }
itSVG: TsImageType;
{@@ Identifier for the WMF image type (value 6) }
itWMF: TsImageType;
{@@ Identifier for the EMF image type (value 7) }
itEMF: TsImageType;
{@@ Identifier for the PCX image type (value 8) }
itPCX: TsImageType;
type
{ TsEmbeddedObj }
TsEmbeddedObj = class
private
FFileName: String;
FStream: TMemoryStream;
FName: String;
FImageType: TsImageType; // image type, see itXXXX
FWidth: Double; // image width, in mm
FHeight: Double; // image height, in mm
protected
function CheckStream(AImageType: TsImageType): Boolean;
public
constructor Create(AName: String);
destructor Destroy; override;
property Name: String read FName;
function LoadFromFile(const AFileName: String): Boolean;
function LoadFromStream(AStream: TStream): Boolean;
property FileName: String read FFileName;
property ImageType: TsImagetype read FImageType;
property ImageWidth: Double read FWidth;
property ImageHeight: Double read FHeight;
@ -522,6 +535,9 @@ begin
end;
end;
end;
if not done then
exit;
sW := Extract('width', s);
sH := Extract('height', s);
sVB := Extract('viewBox', s);
@ -724,15 +740,16 @@ function GetImageInfo(AStream: TStream; out AWidth, AHeight: DWord;
var
itr: TImageTypeRecord; // [i]mage [t]ype [r]ecord
begin
AStream.Position := 0;
if InRange(AImageType, 0, High(ImageTypeRegistry)) then
begin
AStream.Position := 0;
if ImageTypeRegistry[AImageType].GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY)
then Result := AImageType;
end else
begin
for Result := 0 to High(ImageTypeRegistry) do
begin
AStream.Position := 0;
itr := ImageTypeRegistry[Result];
if itr.GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY) then
exit;
@ -835,45 +852,62 @@ 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;
function TsEmbeddedObj.CheckStream(AImageType: TsImageType): Boolean;
var
w, h: Double;
begin
FImageType := GetImageInfo(FStream, w, h, AImageType);
if FImageType <> itUnknown then
begin
FWidth := inToMM(w);
FHeight := inToMM(h);
Result := true;
end else
Result := false;
end;
function TsEmbeddedObj.LoadFromFile(const AFileName: String): Boolean;
var
s: TStream;
begin
FreeAndNil(FStream);
FStream := TMemoryStream.Create;
s := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
try
FStream.LoadFromStream(s);
Result := CheckStream(GetImageTypeFromFileName(AFileName));
if Result then FFileName := AFileName;
finally
s.Free;
end;
end;
function TsEmbeddedObj.LoadFromStream(AStream: TStream): Boolean;
begin
FreeAndNil(FStream);
FStream := TMemoryStream.Create;
FStream.CopyFrom(AStream, AStream.Size);
Result := CheckStream(itUnknown);
end;
initialization
itPNG := RegisterImageType('image/png', 'png', @GetPNGSize);
itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
itBMP := RegisterImageType('image/bmp', 'bmp', @GetBMPSize);
itGIF := RegisterImageType('image/gif', 'gif', @GetGIFSize);
itSVG := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
itWMF := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
itEMF := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
itPCX := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);
{0} itPNG := RegisterImageType('image/png', 'png', @GetPNGSize);
{1} itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
{2} itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
{3} itBMP := RegisterImageType('image/bmp', 'bmp', @GetBMPSize);
{4} itGIF := RegisterImageType('image/gif', 'gif', @GetGIFSize);
{5} itSVG := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
{6} itWMF := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
{7} itEMF := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
{8} itPCX := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);
end.

20
components/fpspreadsheet/fpsopendocument.pas
View File

@ -6000,6 +6000,7 @@ procedure TsSpreadOpenDocWriter.WriteShapes(AStream: TStream;
var
i: Integer;
img: TsImage;
imgType: TsImageType;
r1,c1,r2,c2: Cardinal;
roffs1,coffs1, roffs2, coffs2: Double;
x, y, w, h: Double;
@ -6013,14 +6014,15 @@ begin
for i:=0 to ASheet.GetImageCount-1 do
begin
img := ASheet.GetImage(i);
if not ASheet.CalcImageExtent(i,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h) // mm
then begin
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
continue;
end;
imgType := FWorkbook.GetEmbeddedObj(img.Index).ImageType;
if imgType = itUnknown then
Continue;
ASheet.CalcImageExtent(i,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h); // mm
AppendToStream(AStream, Format(
'<draw:frame draw:z-index="%d" draw:name="Image %d" '+
'draw:style-name="gr1" draw:text-style-name="P1" '+
@ -6033,7 +6035,7 @@ begin
i+1, i+1,
w, h,
x, y,
img.Index+1, GetImageTypeExt(Workbook.GetEmbeddedObj(img.Index).ImageType)
img.Index+1, GetImageTypeExt(imgType)
], FPointSeparatorSettings));
end;

97
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -490,17 +490,20 @@ type
procedure UnmergeCells(ARange: String); overload;
{ Embedded images }
function CalcImageExtent(AIndex: Integer;
procedure CalcImageExtent(AIndex: Integer;
out ARow1, ACol1, ARow2, ACol2: Cardinal;
out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
out x, y, AWidth, AHeight: Double): Boolean;
out x, y, AWidth, AHeight: Double);
function GetImage(AIndex: Integer): TsImage;
function GetImageCount: Integer;
procedure RemoveAllImages;
procedure RemoveImage(AIndex: Integer);
function WriteImage(ARow, ACol: Cardinal; AFileName: String;
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; overload;
function WriteImage(ARow, ACol: Cardinal; AStream: TStream;
AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
// Notification of changed cells
procedure ChangedCell(ARow, ACol: Cardinal);
@ -765,8 +768,9 @@ type
ATransposed: Boolean = false);
{ Embedded objects }
function AddEmbeddedObj(const AName: String): Integer;
function FindEmbeddedObj(const AName: String): Integer;
function AddEmbeddedObj(const AFileName: String): Integer; overload;
function AddEmbeddedObj(AStream: TStream): Integer; overload;
function FindEmbeddedObj(const AFileName: String): Integer;
function GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
function GetEmbeddedObjCount: Integer;
function HasEmbeddedSheetImages: Boolean;
@ -3338,12 +3342,11 @@ end;
@param y Absolute coordinate of top edge of image, in mm
@param AWidth Width of the image, in mm
@param AHeight Height of the image, in mm
@return FALSE if the image stream cannot be read or the format is unsupported.
-------------------------------------------------------------------------------}
function TsWorksheet.CalcImageExtent(AIndex: Integer;
procedure TsWorksheet.CalcImageExtent(AIndex: Integer;
out ARow1, ACol1, ARow2, ACol2: Cardinal;
out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
out x,y, AWidth, AHeight: Double): Boolean; // mm
out x,y, AWidth, AHeight: Double); // mm
var
img: TsImage;
obj: TsEmbeddedObj;
@ -3451,6 +3454,42 @@ begin
Result := FImages.Add(img);
end;
{@@ ----------------------------------------------------------------------------
Adds an embedded image to the worksheet. The image passed in a stream.
@param ARow Index of the row at which the image begins (top edge)
@param ACol Index of the column at which the image begins (left edge)
@param AStream Stream which contains the image data
@param AOffsetX The image is offset horizontally from the left edge of
the anchor cell. May reach into another cell.
Value is in millimeters.
@param AOffsetY The image is offset vertically from the top edge of the
anchor cell. May reach into another cell.
Value is in millimeters.
@param AScaleX Horizontal scaling factor of the image
@param AScaleY Vertical scaling factor of the image
@return Index into the internal image list.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AStream: TStream;
AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
var
img: PsImage;
idx: Integer;
begin
// Copy the stream to a new item in embedded object list.
idx := Workbook.AddEmbeddedObj(AStream);
// 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 := idx;
Result := FImages.Add(img);
end;
{@@ ----------------------------------------------------------------------------
Removes an image from the internal image list.
The image is identified by its index.
@ -8360,43 +8399,59 @@ end;
{@@ ----------------------------------------------------------------------------
Creates a new stream with the specified name, adds it to the internal list
and returns its index.
Embedded streams are used to store embedded images. AName is normally the
Embedded streams are used to store embedded images. AFileName is the
filename of the image. The image will be loaded to the stream later.
-------------------------------------------------------------------------------}
function TsWorkbook.AddEmbeddedObj(const AName: String): Integer;
function TsWorkbook.AddEmbeddedObj(const AFileName: String): Integer;
var
obj: TsEmbeddedObj = nil;
w, h: Double;
it: TsImageType;
begin
if not FileExists(AName) then
if not FileExists(AFileName) then
begin
AddErrorMsg(rsFileNotFound, [AName]);
AddErrorMsg(rsFileNotFound, [AFileName]);
Result := -1;
exit;
end;
try
obj := TsEmbeddedObj.Create(AName);
Result := FEmbeddedObjList.Add(obj);
except
AddErrorMsg(rsFileFormatNotSupported, [AName]);
obj := TsEmbeddedObj.Create;
if obj.LoadFromFile(AFileName) then
Result := FEmbeddedObjList.Add(obj)
else
begin
AddErrorMsg(rsFileFormatNotSupported, [AFileName]);
obj.Free;
Result := -1;
end;
end;
function TsWorkbook.AddEmbeddedObj(AStream: TStream): Integer;
var
obj: TsEmbeddedObj = nil;
w, h: Double;
begin
obj := TsEmbeddedObj.Create;
if obj.LoadFromStream(AStream) then
Result := FEmbeddedObjList.Add(obj)
else begin
AddErrorMsg(rsImageFormatNotSupported);
obj.Free;
Result := -1;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether an embedded object with the specified name already exists.
Checks whether an embedded object with the specified file name already exists.
If yes, returns its index in the object list, or -1 if no.
-------------------------------------------------------------------------------}
function TsWorkbook.FindEmbeddedObj(const AName: String): Integer;
function TsWorkbook.FindEmbeddedObj(const AFileName: String): Integer;
var
obj: TsEmbeddedObj;
begin
for Result:=0 to FEmbeddedObjList.Count-1 do
begin
obj := TsEmbeddedObj(FEmbeddedObjList[Result]);
if obj.Name = AName then
if obj.FileName = AFileName then
exit;
end;
Result := -1;

1
components/fpspreadsheet/fpsstrings.pas
View File

@ -62,6 +62,7 @@ resourcestring
rsCircularReference = 'Circular reference found when calculating worksheet formulas';
rsFileNotFound = 'File "%s" not found.';
rsFileFormatNotSupported = 'File format of "%s" not supported.';
rsImageFormatNotSupported = 'Image format not supported.';
rsFileAlreadyExists = 'File "%s" already exists.';
rsWorksheetNotFound = 'Worksheet "%s" not found.';
rsWorksheetNotFound1 = 'Worksheet not found.';

10
components/fpspreadsheet/fpsutils.pas
View File

@ -157,6 +157,7 @@ function TintedColor(AColor: TsColor; tint: Double): TsColor;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
procedure FixLineEndings(var AText: String; var ARichTextParams: TsRichTextParams);
function RandomString(ALen: Integer): String;
function SplitStr(const AText: String; ADelimiter: Char): TStringArray;
function UnquoteStr(AString: String): String;
@ -1968,6 +1969,15 @@ begin
end;
end;
function RandomString(ALen: Integer): String;
var
i: Integer;
begin
SetLength(Result, ALen);
for i:=1 to ALen do
Result[i] := char(Random(26) + ord('a'));
end;
{@@ ----------------------------------------------------------------------------
Splits a string at the specified delimiters into individual strings and passes
them in an array.

50
components/fpspreadsheet/xlsxooxml.pas
View File

@ -3262,6 +3262,7 @@ var
r1, c1, r2, c2: Cardinal;
roffs1, coffs1, roffs2, coffs2: Double;
x, y, w, h: Double;
descr: String;
begin
if AWorksheet.GetImageCount= 0 then
exit;
@ -3279,14 +3280,16 @@ begin
for i:=0 to AWorksheet.GetImageCount - 1 do
begin
img := AWorksheet.GetImage(i);
if not AWorksheet.CalcImageExtent(i,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h) // mm
then begin
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
continue;
end;
if FWorkbook.GetEmbeddedObj(img.Index).ImageType = itUnknown then
Continue;
AWorksheet.CalcImageExtent(i,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h); // mm;
descr := ExtractFileName(FWorkbook.GetEmbeddedObj(img.index).Filename);
if descr = '' then descr := 'image';
AppendToStream(FSDrawings[FCurSheetNum],
'<xdr:twoCellAnchor editAs="oneCell">');
AppendToStream(FSDrawings[FCurSheetNum], Format(
@ -3334,7 +3337,7 @@ begin
'</xdr:spPr>'+
'</xdr:pic>' +
'<xdr:clientData/>', [
i+2, i+1, ExtractFilename(Workbook.GetEmbeddedObj(img.Index).Name),
i+2, i+1, descr,
i+1,
mmToEMU(x), mmToEMU(y),
mmToEMU(w), mmToEMU(h)
@ -3565,7 +3568,8 @@ procedure TsSpreadOOXMLWriter.WriteVMLDrawings_HeaderFooterImages(
FWorkbook.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]);
exit;
end;
fn := ChangeFileExt(Workbook.GetEmbeddedObj(AImage.Index).Name, '');
fn := ChangeFileExt(Workbook.GetEmbeddedObj(AImage.Index).FileName, '');
if fn = '' then fn := 'image';
AppendToStream(AStream, Format(
' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding +
// e.g. "CH" _x0000_s1025
@ -3671,12 +3675,12 @@ end;
procedure TsSpreadOOXMLWriter.WriteVmlDrawingRels(AWorksheet: TsWorksheet);
var
fileindex: Integer;
// fn: String;
sec: TsHeaderFooterSectionIndex;
rId: Integer;
img: TsHeaderFooterImage;
imgIdx: Integer;
imgName: String;
// imgIdx: Integer;
// imgName: String;
ext: String;
begin
if not AWorksheet.PageLayout.HasHeaderFooterImages then
exit;
@ -3704,14 +3708,15 @@ begin
img := AWorksheet.PageLayout.HeaderImages[sec];
if img.Index = -1 then
continue;
imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
imgIdx := img.Index;
// imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
// imgIdx := img.Index;
ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).ImageType);
// imgIdx := FWorkbook.FindEmbeddedObj(imgName);
AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
' <Relationship Id="rId%d" Target="../media/image%d%s" '+
' <Relationship Id="rId%d" Target="../media/image%d.%s" '+
'Type="' + SCHEMAS_IMAGE + '" />' + LineEnding, [
rId, // Id="rID1"
imgIdx + 1, ExtractFileExt(imgName) // Target="../media/image1.png"
rId, // Id="rID1"
img.Index + 1, ext // Target="../media/image1.png"
]));
inc(rId);
end;
@ -3721,15 +3726,16 @@ begin
img := AWorksheet.PageLayout.FooterImages[sec];
if img.Index = -1 then
continue;
imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
imgIdx := img.Index;
// imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
// imgIdx := img.Index;
// imgIdx := FWorkbook.FindEmbeddedObj(imgName);
ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).Imagetype);
AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
' <Relationship Id="rId%d" Target="../media/image%d%s" '+ //
' <Relationship Id="rId%d" Target="../media/image%d.%s" '+ //
// e.g. "rId1" "..(media/image1.png"
'Type="' + SCHEMAS_IMAGE + '" />', [
rId,
imgIdx + 1, ExtractFileExt(imgName)
img.Index + 1, ext
]));
inc(rId);
end;