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

fpspreadsheet: Optional calculation of image position based on pixels improves slight distortion of images written for xlsx.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4570 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-18 21:23:09 +00:00
parent 9280718d44
commit 222427e8f6
3 changed files with 72 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/fpsopendocument.pas
View File

@@ -6138,7 +6138,7 @@ begin
if imgType = itUnknown then
Continue;
ASheet.CalcImageExtent(i,
ASheet.CalcImageExtent(i, false, // not clear if UsePixels=false is correct. Not harmful at least
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h); // mm

100
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -497,7 +497,7 @@ type
{ Embedded images }
procedure CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double;
out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double);
procedure CalcImageExtent(AIndex: Integer;
procedure CalcImageExtent(AIndex: Integer; UsePixels: Boolean;
out ARow1, ACol1, ARow2, ACol2: Cardinal;
out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
out x, y, AWidth, AHeight: Double);
@@ -3378,6 +3378,9 @@ end;
{@@ ----------------------------------------------------------------------------
Calculates image extent
@param AIndex Index of the image into the worksheet's image list
@param UsePixels if TRUE then pixels are used for calculation - this improves
the display of the images in Excel
@param ARow1 Index of the row containing the top edge of the image
@param ACol1 Index of the column containing the left edege of the image
@param ARow2 Index of the row containing the right edge of the image
@@ -3393,7 +3396,7 @@ end;
All dimensions are in workbook units
-------------------------------------------------------------------------------}
procedure TsWorksheet.CalcImageExtent(AIndex: Integer;
procedure TsWorksheet.CalcImageExtent(AIndex: Integer; UsePixels: Boolean;
out ARow1, ACol1, ARow2, ACol2: Cardinal;
out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
out x,y, AWidth, AHeight: Double);
@@ -3403,9 +3406,17 @@ var
colW, rowH: Double;
totH, totW: Double;
r, c: Integer;
w_px, h_px: Integer;
totH_px, rowH_px: Integer;
totW_px, colW_px: Integer;
ppi: Integer;
u: TsSizeUnits;
begin
img := GetImage(AIndex);
// Abbreviations
ppi := ScreenPixelsPerInch;
u := FWorkbook.Units;
img := GetImage(AIndex);
ARow1 := img.Row;
ACol1 := img.Col;
ARowOffs1 := img.OffsetX; // in workbook units
@@ -3415,29 +3426,20 @@ begin
AWidth := obj.ImageWidth * img.ScaleX; // in workbook units
AHeight := obj.ImageHeight * img.ScaleY; // in workbook units
if UsePixels then
begin
// If we don't know the ppi of the screen the calculation is not exact!
w_px := ptsToPx(FWorkbook.ConvertUnits(AWidth, u, suPoints), ppi);
h_px := ptsToPx(FWorkbook.ConvertUnits(AHeight, u, suPoints), ppi);
end;
// Find x coordinate of left image edge, in workbook units
x := AColOffs1;
for c := 0 to ACol1-1 do
begin
colW := GetColWidth(c, FWorkbook.Units);
colW := GetColWidth(c, u);
x := x + colW;
end;
// Find cell with right image edge. Find horizontal within-cell-offsets
totW := -AColOffs1;
ACol2 := ACol1;
while (totW < AWidth) do
begin
colW := GetColWidth(ACol2, FWorkbook.Units);
totW := totW + colW;
if totW >= AWidth then
begin
AColOffs2 := colW - (totW - AWidth);
break;
end;
inc(ACol2);
end;
// Find y coordinate of top image edge, in workbook units.
y := ARowOffs1;
for r := 0 to ARow1 - 1 do
@@ -3446,19 +3448,57 @@ begin
y := y + rowH;
end;
// Find cell with bottom image edge. Find vertical within-cell-offsets
totH := -ARowOffs1;
ARow2 := ARow1;
while (totH < AHeight) do
if UsePixels then
// Use pixels for calculation. Better for Excel, maybe due to rounding error?
begin
rowH := CalcRowHeight(ARow2);
totH := totH + rowH;
if totH >= AHeight then
// Find cell with right image edge. Find horizontal within-cell-offsets
totW_px := -ptsToPx(FWorkbook.ConvertUnits(AColOffs1, u, suPoints), ppi);
ACol2 := ACol1;
while (totW_px < w_px) do
begin
ARowOffs2 := rowH - (totH - AHeight);
break;
colW := GetColWidth(ACol2, u);
colW_px := ptsToPx(FWorkbook.ConvertUnits(colW, u, suPoints), ppi);
totW_px := totW_px + colW_px;
if totW_px > w_px then
begin
AColOffs2 := FWorkbook.ConvertUnits(pxToPts(colW_px - (totW_px - w_px), ppi), suPoints, u);
break;
end;
inc(ACol2);
end;
// Find cell with bottom image edge. Find vertical within-cell-offset.
totH_px := -ptsToPx(FWorkbook.ConvertUnits(ARowOffs1, u, suPoints), ppi);
ARow2 := ARow1;
while (totH_px < h_px) do
begin
rowH := CalcRowHeight(ARow2);
rowH_px := ptsToPx(FWorkbook.ConvertUnits(rowH, u, suPoints), ppi);
totH_px := totH_px + rowH_px;
if totH_px > h_px then
begin
ARowOffs2 := FWorkbook.ConvertUnits(pxToPts(rowH_px - (totH_px - h_px), ppi), suPoints, u);
break;
end;
inc(ARow2);
end;
end
else // Use workbook units for calculation
begin
// Find cell with right image edge. Find horizontal within-cell-offsets
totH := -ARowOffs1;
ARow2 := ARow1;
while (totH < AHeight) do
begin
rowH := CalcRowHeight(ARow2);
totH := totH + rowH;
if totH >= AHeight then
begin
ARowOffs2 := rowH - (totH - AHeight);
break;
end;
inc(ARow2);
end;
inc(ARow2);
end;
end;

2
components/fpspreadsheet/xlsxooxml.pas
View File

@@ -3265,7 +3265,7 @@ begin
img := AWorksheet.GetImage(i);
if FWorkbook.GetEmbeddedObj(img.Index).ImageType = itUnknown then
Continue;
AWorksheet.CalcImageExtent(i,
AWorksheet.CalcImageExtent(i, true,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h); // mm;