You've already forked lazarus-ccr
fpspreadsheet: Support individual fill colors of bars, bubbles, symbols. Fix dash line pattern broken after previous commit.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8997 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -3,11 +3,15 @@ program write_chart_demo;
|
||||
{.$DEFINE DARK_MODE}
|
||||
|
||||
uses
|
||||
SysUtils, fpspreadsheet, fpstypes, fpschart, xlsxooxml, fpsopendocument;
|
||||
SysUtils, fpspreadsheet, fpstypes, fpsUtils, fpschart, xlsxooxml, fpsopendocument;
|
||||
const
|
||||
SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries; //TsScatterSeries;
|
||||
SERIES_CLASS: TsChartSeriesClass = TsAreaSeries;
|
||||
// SERIES_CLASS: TsChartSeriesClass = TsBarSeries;
|
||||
// SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries;
|
||||
// SERIES_CLASS: TsChartSeriesClass = TsLineSeries;
|
||||
r1 = 1;
|
||||
r2 = 8;
|
||||
FILL_COLORS: array[0..r2-r1] of TsColor = (scRed, scGreen, scBlue, scYellow, scMagenta, scSilver, scBlack, scOlive);
|
||||
var
|
||||
b: TsWorkbook;
|
||||
sheet1, sheet2, sheet3: TsWorksheet;
|
||||
@ -21,13 +25,23 @@ begin
|
||||
sheet1 := b.AddWorksheet('test1');
|
||||
sheet1.WriteText(0, 1, '1+sin(x)');
|
||||
sheet1.WriteText(0, 2, '1+sin(x/2)');
|
||||
sheet1.WriteText(0, 3, 'Bubble');
|
||||
sheet1.WriteText(0, 3, 'Bubble Radius');
|
||||
sheet1.WriteText(0, 4, 'Fill Color');
|
||||
sheet1.WriteText(0, 5, 'Border Color');
|
||||
for i := r1 to r2-1 do
|
||||
begin
|
||||
// x values or labels
|
||||
sheet1.WriteNumber(i, 0, i-1);
|
||||
// 1st series y values
|
||||
sheet1.WriteNumber(i, 1, 1+sin(i-1));
|
||||
// 2nd series y values
|
||||
sheet1.WriteNumber(i, 2, 1+sin((i-1)/2));
|
||||
sheet1.WriteNumber(i, 3, i*i); // Bubble series radii
|
||||
// Bubble radii
|
||||
sheet1.WriteNumber(i, 3, i*i);
|
||||
// Fill colors
|
||||
sheet1.WriteNumber(i, 4, FlipColorBytes(FILL_COLORS[i-r1])); // !! ODS need red and blue channels exchanged !!
|
||||
// Border colors
|
||||
sheet1.WriteNumber(i, 5, FlipColorBytes(FILL_COLORS[r2-i]));
|
||||
end;
|
||||
sheet1.WriteNumber(r2, 0, 9);
|
||||
sheet1.WriteNumber(r2, 1, 2);
|
||||
@ -45,6 +59,7 @@ begin
|
||||
ser.SetYRange(r1, 1, r2, 1);
|
||||
ser.Line.Color := scBlue;
|
||||
ser.Fill.FgColor := scBlue;
|
||||
ser.SetFillColorRange(r1, 4, r2, 4);
|
||||
if (ser is TsLineSeries) then
|
||||
begin
|
||||
TsLineSeries(ser).ShowSymbols := true;
|
||||
|
||||
@ -193,6 +193,7 @@ type
|
||||
FXRange: TsCellRange; // cell range containing the x data
|
||||
FYRange: TsCellRange;
|
||||
FLabelRange: TsCellRange;
|
||||
FFillColorRange: TsCellRange;
|
||||
FYAxis: TsChartAxisLink;
|
||||
FTitleAddr: TsCellCoord;
|
||||
FLabelFormat: String;
|
||||
@ -211,12 +212,14 @@ type
|
||||
procedure SetLabelRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
procedure SetXRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
procedure SetYRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
procedure SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
function LabelsInCol: Boolean;
|
||||
function XValuesInCol: Boolean;
|
||||
function YValuesInCol: Boolean;
|
||||
|
||||
property ChartType: TsChartType read FChartType;
|
||||
property Count: Integer read GetCount;
|
||||
property FillColorRange: TsCellRange read FFillColorRange;
|
||||
property LabelFormat: String read FLabelFormat write FLabelFormat; // Number format in Excel notation, e.g. '0.00'
|
||||
property LabelRange: TsCellRange read FLabelRange;
|
||||
property TitleAddr: TsCellCoord read FTitleAddr write FTitleAddr;
|
||||
@ -654,6 +657,16 @@ begin
|
||||
FTitleAddr.Col := ACol;
|
||||
end;
|
||||
|
||||
procedure TsChartSeries.SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
begin
|
||||
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
|
||||
raise Exception.Create('Series fill color values can only be located in a single column or row.');
|
||||
FFillColorRange.Row1 := ARow1;
|
||||
FFillColorRange.Col1 := ACol1;
|
||||
FFillColorRange.Row2 := ARow2;
|
||||
FFillColorRange.Col2 := ACol2;
|
||||
end;
|
||||
|
||||
procedure TsChartSeries.SetLabelRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
begin
|
||||
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
|
||||
@ -725,6 +738,7 @@ begin
|
||||
FChartType := ctBar;
|
||||
end;
|
||||
|
||||
|
||||
{ TsBubbleSeries }
|
||||
|
||||
constructor TsBubbleSeries.Create(AChart: TsChart);
|
||||
@ -736,13 +750,14 @@ end;
|
||||
procedure TsBubbleSeries.SetBubbleRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
|
||||
begin
|
||||
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
|
||||
raise Exception.Create('Series bubble values can only be located in a single column or row.');
|
||||
raise Exception.Create('Bubble series values can only be located in a single column or row.');
|
||||
FBubbleRange.Row1 := ARow1;
|
||||
FBubbleRange.Col1 := ACol1;
|
||||
FBubbleRange.Row2 := ARow2;
|
||||
FBubbleRange.Col2 := ACol2;
|
||||
end;
|
||||
|
||||
|
||||
{ TsLineSeries }
|
||||
|
||||
constructor TsLineSeries.Create(AChart: TsChart);
|
||||
|
||||
@ -277,7 +277,6 @@ type
|
||||
function WriteDefaultGraphicStyleXMLAsString: String; overload;
|
||||
function WriteDocumentProtectionXMLAsString: String;
|
||||
function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String; overload;
|
||||
// function WriteFontStyleXMLAsString(AFont: TsFont): String; overload;
|
||||
function WriteHeaderFooterFontXMLAsString(AFont: TsHeaderFooterFont): String;
|
||||
function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String;
|
||||
function WriteNumFormatStyleXMLAsString(const AFormat: TsCellFormat): String;
|
||||
@ -296,8 +295,6 @@ type
|
||||
// Streams with the contents of files
|
||||
FSMeta, FSSettings, FSStyles, FSContent: TStream;
|
||||
FSMimeType, FSMetaInfManifest: TStream;
|
||||
// FSCharts: array of TStream;
|
||||
// FSObjectStyles: array of TStream;
|
||||
|
||||
{ Helpers }
|
||||
procedure AddBuiltinNumFormats; override;
|
||||
@ -6120,8 +6117,8 @@ begin
|
||||
begin
|
||||
embObj := TsWorkbook(FWorkbook).GetEmbeddedObj(i);
|
||||
imgtype := embObj.ImageType;
|
||||
if imgtype = itUnknown then
|
||||
continue;
|
||||
if imgtype <> itUnknown then
|
||||
begin
|
||||
mime := GetImageMimeType(imgtype);
|
||||
ext := GetImageTypeExt(imgType);
|
||||
AppendToStream(FSMetaInfManifest, Format(
|
||||
@ -6129,24 +6126,10 @@ begin
|
||||
[mime, i+1, ext]
|
||||
));
|
||||
end;
|
||||
|
||||
for i:=0 to (FWorkbook as TsWorkbook).GetChartCount-1 do
|
||||
begin
|
||||
AppendToStream(FSMetaInfManifest, Format(
|
||||
' <manifest:file-entry manifest:media-type="application/vnd.oasis.opendocument.chart" manifest:full-path="Object %d/" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
AppendToStream(FSMetaInfManifest, Format(
|
||||
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/content.xml" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
AppendToStream(FSMetaInfManifest, Format(
|
||||
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/styles.xml" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
// Object X/meta.xml and ObjectReplacement/Object X not needed necessarily
|
||||
end;
|
||||
|
||||
TsSpreadOpenDocChartWriter(FChartWriter).AddToMetaInfManifest(FSMetaInfManifest);
|
||||
|
||||
AppendToStream(FSMetaInfManifest,
|
||||
'</manifest:manifest>');
|
||||
end;
|
||||
@ -6461,30 +6444,6 @@ begin
|
||||
'<office:scripts />'
|
||||
);
|
||||
|
||||
{
|
||||
'<office:document-content xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
|
||||
'" xmlns:fo="' + SCHEMAS_XMLNS_FO +
|
||||
'" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/' +
|
||||
'" xmlns:style="' + SCHEMAS_XMLNS_STYLE +
|
||||
'" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
|
||||
'" xmlns:table="' + SCHEMAS_XMLNS_TABLE +
|
||||
'" xmlns:svg="' + SCHEMAS_XMLNS_SVG +
|
||||
'" xmlns:number="' + SCHEMAS_XMLNS_NUMBER +
|
||||
'" xmlns:meta="' + SCHEMAS_XMLNS_META +
|
||||
'" xmlns:chart="' + SCHEMAS_XMLNS_CHART +
|
||||
'" xmlns:dr3d="' + SCHEMAS_XMLNS_DR3D +
|
||||
'" xmlns:math="' + SCHEMAS_XMLNS_MATH +
|
||||
'" xmlns:form="' + SCHEMAS_XMLNS_FORM +
|
||||
'" xmlns:script="' + SCHEMAS_XMLNS_SCRIPT +
|
||||
'" xmlns:ooo="' + SCHEMAS_XMLNS_OOO +
|
||||
'" xmlns:ooow="' + SCHEMAS_XMLNS_OOOW +
|
||||
'" xmlns:oooc="' + SCHEMAS_XMLNS_OOOC +
|
||||
'" xmlns:dom="' + SCHEMAS_XMLNS_DOM +
|
||||
'" xmlns:xforms="' + SCHEMAS_XMLNS_XFORMS +
|
||||
'" xmlns:xsd="' + SCHEMAS_XMLNS_XSD +
|
||||
'" xmlns:xsi="' + SCHEMAS_XMLNS_XSI + '">' +
|
||||
'<office:scripts />');
|
||||
}
|
||||
// Fonts
|
||||
AppendToStream(FSContent,
|
||||
'<office:font-face-decls>');
|
||||
|
||||
@ -56,6 +56,7 @@ type
|
||||
public
|
||||
constructor Create(AWriter: TsBasicSpreadWriter);
|
||||
procedure AddChartsToZip(AZip: TZipper);
|
||||
procedure AddToMetaInfManifest(AStream: TStream);
|
||||
procedure CreateStreams; override;
|
||||
procedure DestroyStreams; override;
|
||||
procedure ResetStreams; override;
|
||||
@ -119,6 +120,30 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Writes the chart entries needed in the META-INF/manifest.xml file }
|
||||
procedure TsSpreadOpenDocChartWriter.AddToMetaInfManifest(AStream: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to TsWorkbook(Writer.Workbook).GetChartCount-1 do
|
||||
begin
|
||||
AppendToStream(AStream, Format(
|
||||
' <manifest:file-entry manifest:media-type="application/vnd.oasis.opendocument.chart" manifest:full-path="Object %d/" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
AppendToStream(AStream, Format(
|
||||
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/content.xml" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
AppendToStream(AStream, Format(
|
||||
' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/styles.xml" />' + LE,
|
||||
[i+1]
|
||||
));
|
||||
|
||||
// Object X/meta.xml and ObjectReplacement/Object X are not necessarily needed.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOpenDocChartWriter.CreateStreams;
|
||||
var
|
||||
i, n: Integer;
|
||||
@ -1167,6 +1192,8 @@ var
|
||||
valuesRange: String;
|
||||
domainRangeX: String = '';
|
||||
domainRangeY: String = '';
|
||||
fillColorRange: String = '';
|
||||
borderColorRange: String = '';
|
||||
rangeStr: String = '';
|
||||
titleAddr: String;
|
||||
count: Integer;
|
||||
@ -1211,6 +1238,17 @@ begin
|
||||
rfAllRel, false
|
||||
);
|
||||
|
||||
// Fill colors for bars, line series symbols, bubbles
|
||||
if (series.FillColorRange.Row1 <> series.FillColorRange.Row2) or
|
||||
(series.FillColorRange.Col1 <> series.FillColorRange.Col2)
|
||||
then
|
||||
fillColorRange := GetSheetCellRangeString_ODS(
|
||||
sheet.Name, sheet.Name,
|
||||
series.FillColorRange.Row1, series.FillColorRange.Col1,
|
||||
series.FillColorRange.Row2, series.FillColorRange.Col2,
|
||||
rfAllRel, false
|
||||
);
|
||||
|
||||
// And these are the data point labels.
|
||||
titleAddr := GetSheetCellRangeString_ODS(
|
||||
sheet.Name, sheet.Name,
|
||||
@ -1238,6 +1276,19 @@ begin
|
||||
indent + '<chart:domain table:cell-range-address="%s"/>' + LE,
|
||||
[ domainRangeX ]
|
||||
));
|
||||
if fillColorRange <> '' then
|
||||
AppendToStream(AChartStream, Format(
|
||||
indent + '<loext:propertry-mapping loext:property="FillColor" loext:cell-range-address="%s"/>' + LE,
|
||||
[ fillColorRange ]
|
||||
));
|
||||
|
||||
{ --- not working...
|
||||
if borderColorRange <> '' then
|
||||
AppendToStream(AChartStream, Format(
|
||||
indent + '<loext:propertry-mapping loext:property="BorderColor" loext:cell-range-address="%s"/>' + LE,
|
||||
[ borderColorRange ]
|
||||
));
|
||||
}
|
||||
|
||||
AppendToStream(AChartStream, Format(
|
||||
indent + ' <chart:data-point chart:repeated="%d"/>' + LE,
|
||||
@ -1265,6 +1316,7 @@ begin
|
||||
begin
|
||||
chart := TsWorkbook(Writer.Workbook).GetChartByIndex(i);
|
||||
WriteChart(FSCharts[i], chart);
|
||||
WriteObjectStyles(FSObjectStyles[i], chart);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1450,6 +1502,5 @@ begin
|
||||
inc(AStyleID);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -189,6 +189,7 @@ function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double
|
||||
function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String;
|
||||
function HTMLColorStrToColor(AValue: String): TsColor;
|
||||
|
||||
function FlipColorBytes(AColor: TsColor): TsColor;
|
||||
function GetColorName(AColor: TsColor): String;
|
||||
function HighContrastColor(AColor: TsColor): TsColor;
|
||||
function IsPaletteIndex(AColor: TsColor): Boolean;
|
||||
@ -2213,6 +2214,16 @@ begin
|
||||
raise EFPSpreadsheet.Create('Unknown length units');
|
||||
end;
|
||||
|
||||
function FlipColorBytes(AColor: TsColor): TsColor;
|
||||
var
|
||||
r,g,b: Byte;
|
||||
begin
|
||||
r := (AColor and $0000FF);
|
||||
g := (AColor and $00FF00) shr 8;
|
||||
b := (AColor and $FF0000) shr 16;
|
||||
Result := b + g shl 8 + r shl 16;
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Determines the name of a color from its rgb value
|
||||
-------------------------------------------------------------------------------}
|
||||
|
||||
Reference in New Issue
Block a user