fpspreadsheet: Add demo how to write all Excel8 colors.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4157 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/other/demo_write_colors.lpi

@@ -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>

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.
+

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';

components/fpspreadsheet/fpsutils.pas

@@ -2010,10 +2010,15 @@ begin
     scYellow     : Result := rsYellow;
     scTransparent: Result := rsTransparent;
     scNotDefined : Result := rsNotDefined;
-    else           if rgba.a = 0 then
+    else
-                     Result := Format('r%d g%d b%d', [rgba.r, rgba.g, rgba.b])
+      case rgba.a of
-                   else
+        $00:
-                     Result := '';
+          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;