diff --git a/components/fpspreadsheet/examples/other/demo_write_colors.lpi b/components/fpspreadsheet/examples/other/demo_write_colors.lpi new file mode 100644 index 000000000..c28b1fa0e --- /dev/null +++ b/components/fpspreadsheet/examples/other/demo_write_colors.lpi @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + <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> diff --git a/components/fpspreadsheet/examples/other/demo_write_colors.lpr b/components/fpspreadsheet/examples/other/demo_write_colors.lpr new file mode 100644 index 000000000..178c185db --- /dev/null +++ b/components/fpspreadsheet/examples/other/demo_write_colors.lpr @@ -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. + diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 41892224f..bd43da88d 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -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'; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 6c0758565..aa1d7e5e0 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -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;