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

fpspreadsheet: Add demo how to write all Excel8 colors.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4157 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-28 21:54:05 +00:00
parent 545bd7ed0f
commit cb6433ad15
4 changed files with 133 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
components/fpspreadsheet/examples/other/demo_write_colors.lpi Normal file
View File

@ -0,0 +1,58 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo_write_colors"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCLBase"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="demo_write_colors.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="demo_write_colors"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
</CONFIG>

65
components/fpspreadsheet/examples/other/demo_write_colors.lpr Normal file
View File

@ -0,0 +1,65 @@
{
test_write_colors.lpr
Demonstrates how to write the Excel-97 colors to a worksheet
AUTHOR: Wernber Pamler
}
program demo_write_colors;
{$mode delphi}{$H+}
uses
Classes, SysUtils,
fpsTypes, fpsutils, fpspalette, fpspreadsheet, xlsbiff8;
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
MyDir: string;
palette: TsPalette;
row: Cardinal;
const
TestFile = 'test_colors.xls';
begin
Writeln('Starting program.');
MyDir := ExtractFilePath(ParamStr(0));
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
MyWorksheet := MyWorkbook.AddWorksheet('Colors');
// Create the palette
palette := TsPalette.Create;
try
palette.AddExcelColors;
// Write colors to worksheet
for row := 0 to palette.Count-1 do begin
Myworksheet.WriteBackgroundColor(row, 0, palette[row]);
Myworksheet.WriteUTF8Text(row, 0, GetColorName(palette[row]));
MyWorksheet.WriteFontColor(row, 0, HighContrastColor(palette[row]));
MyWorksheet.WriteHorAlignment(row, 0, haCenter);
end;
finally
palette.Free;
end;
MyWorksheet.WriteColWidth(0, 25);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + TestFile, sfExcel8, True);
finally
MyWorkbook.Free;
end;
writeln('Finished.');
WriteLn('Please open "'+Testfile+'" in your spreadsheet program.');
ReadLn;
end.

1
components/fpspreadsheet/fpsstrings.pas
View File

@ -126,6 +126,7 @@ resourcestring
rsNotDefined = 'not defined';
rsTransparent = 'transparent';
rsPaletteIndex = 'Palette index %d';
rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings?
rsFALSE = 'FALSE';

13
components/fpspreadsheet/fpsutils.pas
View File

@ -2010,10 +2010,15 @@ begin
scYellow : Result := rsYellow;
scTransparent: Result := rsTransparent;
scNotDefined : Result := rsNotDefined;
else if rgba.a = 0 then
Result := Format('r%d g%d b%d', [rgba.r, rgba.g, rgba.b])
else
Result := '';
else
case rgba.a of
$00:
Result := Format('R%d G%d B%d', [rgba.r, rgba.g, rgba.b]);
scPaletteIndexMask shr 24:
Result := Format(rsPaletteIndex, [AColor and $00FFFFFF]);
else
Result := '';
end;
end;
end;