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

fpspreadsheet: Improved painting of range-selected cells in TsWorksheetGrid, not perfect yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3030 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-08 22:44:52 +00:00
parent 72bcfc3a5b
commit 9d68a4809d
2 changed files with 115 additions and 137 deletions
Download Patch File Download Diff File Expand all files Collapse all files

204
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -107,7 +107,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item2> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="46"> <Units Count="47">
<Unit0> <Unit0>
<Filename Value="fpsgrid.lpr"/> <Filename Value="fpsgrid.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -116,7 +116,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<CursorPos X="10" Y="7"/> <CursorPos X="10" Y="7"/>
<UsageCount Value="159"/> <UsageCount Value="161"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -128,9 +128,12 @@
<UnitName Value="mainform"/> <UnitName Value="mainform"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="313"/> <TopLine Value="88"/>
<CursorPos X="3" Y="341"/> <CursorPos X="15" Y="106"/>
<UsageCount Value="159"/> <UsageCount Value="161"/>
<Bookmarks Count="1">
<Item0 X="1" Y="164" ID="1"/>
</Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
<LoadedDesigner Value="True"/> <LoadedDesigner Value="True"/>
</Unit1> </Unit1>
@ -138,24 +141,21 @@
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/> <UnitName Value="fpspreadsheet"/>
<IsVisibleTab Value="True"/> <IsVisibleTab Value="True"/>
<EditorIndex Value="5"/> <EditorIndex Value="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="385"/> <TopLine Value="349"/>
<CursorPos X="15" Y="402"/> <CursorPos X="40" Y="359"/>
<UsageCount Value="74"/> <UsageCount Value="75"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/> <UnitName Value="fpspreadsheetgrid"/>
<EditorIndex Value="3"/> <EditorIndex Value="2"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1052"/> <TopLine Value="518"/>
<CursorPos X="13" Y="1057"/> <CursorPos X="66" Y="536"/>
<UsageCount Value="75"/> <UsageCount Value="76"/>
<Bookmarks Count="1">
<Item0 X="10" Y="1065" ID="1"/>
</Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
@ -224,22 +224,18 @@
<Unit12> <Unit12>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/> <Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<UnitName Value="Grids"/> <UnitName Value="Grids"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="6220"/> <TopLine Value="651"/>
<CursorPos X="22" Y="6221"/> <CursorPos X="57" Y="683"/>
<UsageCount Value="33"/> <UsageCount Value="34"/>
<Loaded Value="True"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="..\..\fpsutils.pas"/> <Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/> <UnitName Value="fpsutils"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="35"/> <TopLine Value="35"/>
<CursorPos X="1" Y="62"/> <CursorPos X="1" Y="62"/>
<UsageCount Value="50"/> <UsageCount Value="51"/>
<Loaded Value="True"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="d:\lazarus-svn\lcl\include\canvas.inc"/> <Filename Value="d:\lazarus-svn\lcl\include\canvas.inc"/>
@ -252,8 +248,8 @@
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<UnitName Value="Graphics"/> <UnitName Value="Graphics"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="649"/> <TopLine Value="2563"/>
<CursorPos X="28" Y="675"/> <CursorPos X="22" Y="2571"/>
<UsageCount Value="31"/> <UsageCount Value="31"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
@ -266,11 +262,11 @@
<Unit17> <Unit17>
<Filename Value="..\..\xlsbiff8.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/> <UnitName Value="xlsbiff8"/>
<EditorIndex Value="7"/> <EditorIndex Value="5"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="104"/> <TopLine Value="104"/>
<CursorPos X="15" Y="123"/> <CursorPos X="15" Y="123"/>
<UsageCount Value="49"/> <UsageCount Value="50"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
@ -291,31 +287,31 @@
<Unit20> <Unit20>
<Filename Value="..\..\xlscommon.pas"/> <Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/> <UnitName Value="xlscommon"/>
<EditorIndex Value="6"/> <EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1269"/> <TopLine Value="1269"/>
<CursorPos X="1" Y="1286"/> <CursorPos X="1" Y="1286"/>
<UsageCount Value="45"/> <UsageCount Value="46"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit20> </Unit20>
<Unit21> <Unit21>
<Filename Value="..\..\xlsbiff5.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/> <UnitName Value="xlsbiff5"/>
<EditorIndex Value="8"/> <EditorIndex Value="6"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1319"/> <TopLine Value="1319"/>
<CursorPos X="3" Y="1325"/> <CursorPos X="3" Y="1325"/>
<UsageCount Value="32"/> <UsageCount Value="33"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit21> </Unit21>
<Unit22> <Unit22>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/> <UnitName Value="xlsbiff2"/>
<EditorIndex Value="9"/> <EditorIndex Value="7"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="547"/> <TopLine Value="547"/>
<CursorPos X="1" Y="563"/> <CursorPos X="1" Y="563"/>
<UsageCount Value="33"/> <UsageCount Value="34"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit22> </Unit22>
<Unit23> <Unit23>
@ -497,128 +493,64 @@
<CursorPos X="15" Y="936"/> <CursorPos X="15" Y="936"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
</Unit45> </Unit45>
<Unit46>
<Filename Value="..\..\..\spktoolbar\SpkGraphTools\SpkGraphTools.pas"/>
<UnitName Value="SpkGraphTools"/>
<WindowIndex Value="0"/>
<TopLine Value="136"/>
<CursorPos X="1" Y="143"/>
<UsageCount Value="10"/>
</Unit46>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="12" HistoryIndex="11">
<Position1> <Position1>
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1766" Column="1" TopLine="1746"/> <Caret Line="115" Column="17" TopLine="96"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1767" Column="1" TopLine="1746"/> <Caret Line="281" Column="16" TopLine="281"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1046" Column="1" TopLine="1027"/> <Caret Line="1" Column="1" TopLine="1"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="..\..\xlscommon.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1277" Column="3" TopLine="1269"/> <Caret Line="134" Column="22" TopLine="134"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1279" Column="1" TopLine="1269"/>
</Position5>
<Position6>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1280" Column="1" TopLine="1269"/>
</Position6>
<Position7>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1281" Column="1" TopLine="1269"/>
</Position7>
<Position8>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1282" Column="1" TopLine="1269"/>
</Position8>
<Position9>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1284" Column="1" TopLine="1269"/>
</Position9>
<Position10>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1285" Column="1" TopLine="1269"/>
</Position10>
<Position11>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1286" Column="1" TopLine="1269"/>
</Position11>
<Position12>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="376" Column="15" TopLine="359"/>
</Position12>
<Position13>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="337" Column="37" TopLine="304"/>
</Position13>
<Position14>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="353" Column="30" TopLine="353"/>
</Position14>
<Position15>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1" Column="1" TopLine="1"/> <Caret Line="1" Column="1" TopLine="1"/>
</Position15> </Position5>
<Position16> <Position6>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="333" Column="22" TopLine="328"/> <Caret Line="515" Column="3" TopLine="503"/>
</Position16> </Position6>
<Position17> <Position7>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="35" Column="1" TopLine="33"/> <Caret Line="535" Column="1" TopLine="504"/>
</Position17> </Position7>
<Position18> <Position8>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="38" Column="15" TopLine="19"/> <Caret Line="306" Column="22" TopLine="288"/>
</Position18> </Position8>
<Position19> <Position9>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="354" Column="44" TopLine="322"/> <Caret Line="536" Column="1" TopLine="518"/>
</Position19> </Position9>
<Position20> <Position10>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1184" Column="52" TopLine="1151"/> <Caret Line="306" Column="1" TopLine="286"/>
</Position20> </Position10>
<Position21> <Position11>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="37" Column="15" TopLine="18"/> <Caret Line="309" Column="1" TopLine="286"/>
</Position21> </Position11>
<Position22> <Position12>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="371" Column="91" TopLine="347"/> <Caret Line="310" Column="1" TopLine="286"/>
</Position22> </Position12>
<Position23>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="372" Column="33" TopLine="353"/>
</Position23>
<Position24>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="20" Column="1" TopLine="20"/>
</Position24>
<Position25>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1480" Column="24" TopLine="1461"/>
</Position25>
<Position26>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1479" Column="14" TopLine="1461"/>
</Position26>
<Position27>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1064" Column="10" TopLine="1051"/>
</Position27>
<Position28>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="353" Column="1" TopLine="348"/>
</Position28>
<Position29>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1070" Column="23" TopLine="1045"/>
</Position29>
<Position30>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1057" Column="13" TopLine="1052"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

48
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -5,6 +5,12 @@ Grid component which can load and write data from / to FPSpreadsheet documents
AUTHORS: Felipe Monteiro de Carvalho, Werner Pamler AUTHORS: Felipe Monteiro de Carvalho, Werner Pamler
} }
{ To do:
- When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in
FindNearestPaletteIndex.
}
unit fpspreadsheetgrid; unit fpspreadsheetgrid;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -42,6 +48,7 @@ type
procedure SetFrozenRows(AValue: Integer); procedure SetFrozenRows(AValue: Integer);
procedure SetShowGridLines(AValue: Boolean); procedure SetShowGridLines(AValue: Boolean);
procedure SetShowHeaders(AValue: Boolean); procedure SetShowHeaders(AValue: Boolean);
protected protected
{ Protected declarations } { Protected declarations }
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override; procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override;
@ -64,6 +71,7 @@ type
property FrozenRows: Integer read FFrozenRows write SetFrozenRows; property FrozenRows: Integer read FFrozenRows write SetFrozenRows;
property ShowGridLines: Boolean read GetShowGridLines write SetShowGridLines default true; property ShowGridLines: Boolean read GetShowGridLines write SetShowGridLines default true;
property ShowHeaders: Boolean read GetShowHeaders write SetShowHeaders default true; property ShowHeaders: Boolean read GetShowHeaders write SetShowHeaders default true;
public public
{ public methods } { public methods }
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -143,6 +151,7 @@ type
property PopupMenu; property PopupMenu;
property RowCount; property RowCount;
property ScrollBars; property ScrollBars;
property SelectedColor default $00E8E8E8;
property ShowHint; property ShowHint;
property TabOrder; property TabOrder;
property TabStop; property TabStop;
@ -290,6 +299,22 @@ begin
end; end;
end; end;
function DimColorByPercent(c: TColor; APercentage: Integer) : TColor;
type
TRGBA = record R,G,B,A: Byte end;
begin
c := ColorToRGB(c);
Result := rgb(Integer(TRGBA(c).R) * (100 - APercentage) div 100,
Integer(TRGBA(c).G) * (100 - APercentage) div 100,
Integer(TRGBA(c).B) * (100 - APercentage) div 100
);
{
Result := rgb(Max(0, Min(255, TRGBA(c1).R + TRGBA(c2).R))),
Max(0, Min(255, TRGBA(c1).G + TRGBA(c2).G)),
Max(0, Min(255, TRGBA(c1).B + TRGBA(c2).B)));
}
end;
procedure Register; procedure Register;
begin begin
RegisterComponents('Additional',[TsWorksheetGrid]); RegisterComponents('Additional',[TsWorksheetGrid]);
@ -302,6 +327,7 @@ constructor TsCustomWorksheetGrid.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FHeaderCount := 1; FHeaderCount := 1;
SelectedColor := $00E8E8E8;
end; end;
destructor TsCustomWorksheetGrid.Destroy; destructor TsCustomWorksheetGrid.Destroy;
@ -447,7 +473,9 @@ var
r, c: Integer; r, c: Integer;
fnt: TsFont; fnt: TsFont;
style: TFontStyles; style: TFontStyles;
isSelected: Boolean;
begin begin
GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font); Canvas.Font.Assign(Font);
Canvas.Brush.Bitmap := nil; Canvas.Brush.Bitmap := nil;
ts := Canvas.TextStyle; ts := Canvas.TextStyle;
@ -503,6 +531,10 @@ begin
// Wordwrap, text alignment and text rotation are handled by "DrawTextInCell". // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
end; end;
end; end;
if IsSelected then
Canvas.Brush.Color := DimColorByPercent(Canvas.Brush.Color, 15);
Canvas.TextStyle := ts; Canvas.TextStyle := ts;
inherited DoPrepareCanvas(ACol, ARow, AState); inherited DoPrepareCanvas(ACol, ARow, AState);
@ -835,7 +867,7 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor;
procedure ColorToHSL(RGB: TColor; var H, S, L : double); procedure ColorToHSL(RGB: TColor; var H, S, L : double);
// Taken from https://code.google.com/p/thtmlviewer/source/browse/trunk/source/HSLUtils.pas?r=277 // Taken from https://code.google.com/p/thtmlviewer/source/browse/trunk/source/HSLUtils.pas?r=277
// The procedure in GraphUtils is crashing for clFuchsia. // The procedure in GraphUtils is crashing for some colors in Laz < 1.3
var var
R, G, B, D, Cmax, Cmin: double; R, G, B, D, Cmax, Cmin: double;
begin begin
@ -886,6 +918,20 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor;
Result := sqr(H1-H2) + sqr(S1-S2) + sqr(L1-L2); Result := sqr(H1-H2) + sqr(S1-S2) + sqr(L1-L2);
end; end;
(*
// will be activated when Lazarus 1.4 is available. (RgbToHLS bug in Laz < 1.3)
function ColorDistance(color1, color2: TColor): Integer;
type
TRGBA = packed record R, G, B, A: Byte end;
var
H1,L1,S1, H2,L2,S2: Byte;
begin
ColorToHLS(color1, H1,L1,S1);
ColorToHLS(color2, H2,L2,S2);
result := sqr(Integer(H1)-H2) + sqr(Integer(L1)-L2) + sqr(Integer(S1)-S2);
end; *)
var var
i: Integer; i: Integer;
dist, mindist: Double; dist, mindist: Double;