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

fpspreadsheet: Improved painting of the selection rectangle and cell borders in TsWorksheetGrid.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3032 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-09 22:00:53 +00:00
parent 568cfdc673
commit e1ddf966a7
3 changed files with 597 additions and 207 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -97,6 +97,7 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<CommandLineParams Value="&quot;D:\Prog_Lazarus\BIFF Explorer\sample data\Kommentar-ColWidth.xls&quot;"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
@ -107,7 +108,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item2> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="47"> <Units Count="53">
<Unit0> <Unit0>
<Filename Value="fpsgrid.lpr"/> <Filename Value="fpsgrid.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -116,7 +117,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="161"/> <UsageCount Value="182"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -128,34 +129,34 @@
<UnitName Value="mainform"/> <UnitName Value="mainform"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="88"/> <TopLine Value="356"/>
<CursorPos X="15" Y="106"/> <CursorPos X="64" Y="364"/>
<UsageCount Value="161"/> <UsageCount Value="182"/>
<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>
<Unit2> <Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/> <UnitName Value="fpspreadsheet"/>
<IsVisibleTab Value="True"/> <EditorIndex Value="4"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="349"/> <TopLine Value="1906"/>
<CursorPos X="40" Y="359"/> <CursorPos X="32" Y="1918"/>
<UsageCount Value="75"/> <UsageCount Value="85"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/> <UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="518"/> <TopLine Value="1007"/>
<CursorPos X="66" Y="536"/> <CursorPos X="3" Y="1022"/>
<UsageCount Value="76"/> <UsageCount Value="86"/>
<Bookmarks Count="1">
<Item0 X="25" Y="1018" ID="1"/>
</Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
@ -164,7 +165,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="25"/> <TopLine Value="25"/>
<CursorPos X="4" Y="44"/> <CursorPos X="4" Y="44"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\winunits-base\src\activex.pp"/> <Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\winunits-base\src\activex.pp"/>
@ -172,7 +173,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="49"/> <TopLine Value="49"/>
<CursorPos X="10" Y="24"/> <CursorPos X="10" Y="24"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\fcl-base\src\avl_tree.pp"/> <Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\fcl-base\src\avl_tree.pp"/>
@ -180,7 +181,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="37"/> <TopLine Value="37"/>
<CursorPos X="14" Y="83"/> <CursorPos X="14" Y="83"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="c:\Lazarus\lcl\grids.pas"/> <Filename Value="c:\Lazarus\lcl\grids.pas"/>
@ -188,14 +189,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1516"/> <TopLine Value="1516"/>
<CursorPos X="28" Y="1534"/> <CursorPos X="28" Y="1534"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="c:\Lazarus\lcl\include\customform.inc"/> <Filename Value="c:\Lazarus\lcl\include\customform.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="2021"/> <TopLine Value="2021"/>
<CursorPos X="1" Y="2041"/> <CursorPos X="1" Y="2041"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
<Filename Value="..\..\fpsallformats.pas"/> <Filename Value="..\..\fpsallformats.pas"/>
@ -203,7 +204,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<CursorPos X="62" Y="13"/> <CursorPos X="62" Y="13"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="..\..\wikitable.pas"/> <Filename Value="..\..\wikitable.pas"/>
@ -211,7 +212,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="48"/> <TopLine Value="48"/>
<CursorPos X="41" Y="60"/> <CursorPos X="41" Y="60"/>
<UsageCount Value="16"/> <UsageCount Value="15"/>
</Unit10> </Unit10>
<Unit11> <Unit11>
<Filename Value="..\..\fpsopendocument.pas"/> <Filename Value="..\..\fpsopendocument.pas"/>
@ -219,15 +220,17 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit11> </Unit11>
<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="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="651"/> <TopLine Value="144"/>
<CursorPos X="57" Y="683"/> <CursorPos X="31" Y="158"/>
<UsageCount Value="34"/> <UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="..\..\fpsutils.pas"/> <Filename Value="..\..\fpsutils.pas"/>
@ -235,14 +238,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="35"/> <TopLine Value="35"/>
<CursorPos X="1" Y="62"/> <CursorPos X="1" Y="62"/>
<UsageCount Value="51"/> <UsageCount Value="50"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="d:\lazarus-svn\lcl\include\canvas.inc"/> <Filename Value="d:\lazarus-svn\lcl\include\canvas.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1212"/> <TopLine Value="1212"/>
<CursorPos X="3" Y="1218"/> <CursorPos X="3" Y="1218"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
@ -250,23 +253,23 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="2563"/> <TopLine Value="2563"/>
<CursorPos X="22" Y="2571"/> <CursorPos X="22" Y="2571"/>
<UsageCount Value="31"/> <UsageCount Value="30"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="248"/> <TopLine Value="248"/>
<CursorPos X="22" Y="263"/> <CursorPos X="22" Y="263"/>
<UsageCount Value="16"/> <UsageCount Value="15"/>
</Unit16> </Unit16>
<Unit17> <Unit17>
<Filename Value="..\..\xlsbiff8.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/> <UnitName Value="xlsbiff8"/>
<EditorIndex Value="5"/> <EditorIndex Value="6"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="104"/> <TopLine Value="1658"/>
<CursorPos X="15" Y="123"/> <CursorPos X="1" Y="1677"/>
<UsageCount Value="50"/> <UsageCount Value="60"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
@ -275,43 +278,43 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1091"/> <TopLine Value="1091"/>
<CursorPos X="12" Y="1122"/> <CursorPos X="12" Y="1122"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit18> </Unit18>
<Unit19> <Unit19>
<Filename Value="d:\lazarus-svn\lcl\include\wincontrol.inc"/> <Filename Value="d:\lazarus-svn\lcl\include\wincontrol.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="7344"/> <TopLine Value="7344"/>
<CursorPos X="30" Y="7349"/> <CursorPos X="30" Y="7349"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit19> </Unit19>
<Unit20> <Unit20>
<Filename Value="..\..\xlscommon.pas"/> <Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/> <UnitName Value="xlscommon"/>
<EditorIndex Value="4"/> <EditorIndex Value="5"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1269"/> <TopLine Value="1269"/>
<CursorPos X="1" Y="1286"/> <CursorPos X="1" Y="1286"/>
<UsageCount Value="46"/> <UsageCount Value="56"/>
<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="6"/> <EditorIndex Value="7"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1319"/> <TopLine Value="1319"/>
<CursorPos X="3" Y="1325"/> <CursorPos X="3" Y="1325"/>
<UsageCount Value="33"/> <UsageCount Value="43"/>
<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="7"/> <EditorIndex Value="8"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="547"/> <TopLine Value="547"/>
<CursorPos X="1" Y="563"/> <CursorPos X="1" Y="563"/>
<UsageCount Value="34"/> <UsageCount Value="44"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit22> </Unit22>
<Unit23> <Unit23>
@ -320,7 +323,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="841"/> <TopLine Value="841"/>
<CursorPos X="19" Y="852"/> <CursorPos X="19" Y="852"/>
<UsageCount Value="5"/> <UsageCount Value="4"/>
</Unit23> </Unit23>
<Unit24> <Unit24>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/>
@ -328,7 +331,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="111"/> <TopLine Value="111"/>
<CursorPos X="3" Y="112"/> <CursorPos X="3" Y="112"/>
<UsageCount Value="18"/> <UsageCount Value="17"/>
</Unit24> </Unit24>
<Unit25> <Unit25>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/>
@ -336,14 +339,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="74"/> <TopLine Value="74"/>
<CursorPos X="3" Y="93"/> <CursorPos X="3" Y="93"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit25> </Unit25>
<Unit26> <Unit26>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\lists.inc"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\lists.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="141"/> <TopLine Value="141"/>
<CursorPos X="3" Y="143"/> <CursorPos X="3" Y="143"/>
<UsageCount Value="14"/> <UsageCount Value="13"/>
</Unit26> </Unit26>
<Unit27> <Unit27>
<Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/> <Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/>
@ -351,14 +354,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="114"/> <TopLine Value="114"/>
<CursorPos X="42" Y="152"/> <CursorPos X="42" Y="152"/>
<UsageCount Value="14"/> <UsageCount Value="13"/>
</Unit27> </Unit27>
<Unit28> <Unit28>
<Filename Value="d:\lazarus-svn\lcl\include\pen.inc"/> <Filename Value="d:\lazarus-svn\lcl\include\pen.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="272"/> <TopLine Value="272"/>
<CursorPos X="3" Y="286"/> <CursorPos X="3" Y="286"/>
<UsageCount Value="14"/> <UsageCount Value="13"/>
</Unit28> </Unit28>
<Unit29> <Unit29>
<Filename Value="d:\lazarus-svn\lcl\controls.pp"/> <Filename Value="d:\lazarus-svn\lcl\controls.pp"/>
@ -366,14 +369,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1480"/> <TopLine Value="1480"/>
<CursorPos X="15" Y="1498"/> <CursorPos X="15" Y="1498"/>
<UsageCount Value="13"/> <UsageCount Value="12"/>
</Unit29> </Unit29>
<Unit30> <Unit30>
<Filename Value="d:\lazarus-svn\lcl\include\control.inc"/> <Filename Value="d:\lazarus-svn\lcl\include\control.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="4129"/> <TopLine Value="4129"/>
<CursorPos X="1" Y="4161"/> <CursorPos X="1" Y="4161"/>
<UsageCount Value="13"/> <UsageCount Value="12"/>
</Unit30> </Unit30>
<Unit31> <Unit31>
<Filename Value="..\..\fpspreadsheetchart.pas"/> <Filename Value="..\..\fpspreadsheetchart.pas"/>
@ -381,7 +384,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="170"/> <TopLine Value="170"/>
<CursorPos X="37" Y="204"/> <CursorPos X="37" Y="204"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit31> </Unit31>
<Unit32> <Unit32>
<Filename Value="d:\lazarus-svn\components\lazutils\lazutf8.pas"/> <Filename Value="d:\lazarus-svn\components\lazutils\lazutf8.pas"/>
@ -389,7 +392,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="3180"/> <TopLine Value="3180"/>
<CursorPos X="1" Y="3212"/> <CursorPos X="1" Y="3212"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit32> </Unit32>
<Unit33> <Unit33>
<Filename Value="d:\lazarus-svn\lcl\colorbox.pas"/> <Filename Value="d:\lazarus-svn\lcl\colorbox.pas"/>
@ -397,7 +400,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="13"/> <TopLine Value="13"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit33> </Unit33>
<Unit34> <Unit34>
<Filename Value="d:\lazarus-svn\lcl\dialogs.pp"/> <Filename Value="d:\lazarus-svn\lcl\dialogs.pp"/>
@ -405,7 +408,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="222"/> <TopLine Value="222"/>
<CursorPos X="3" Y="253"/> <CursorPos X="3" Y="253"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit34> </Unit34>
<Unit35> <Unit35>
<Filename Value="d:\lazarus-svn\lcl\forms.pp"/> <Filename Value="d:\lazarus-svn\lcl\forms.pp"/>
@ -413,7 +416,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="932"/> <TopLine Value="932"/>
<CursorPos X="3" Y="939"/> <CursorPos X="3" Y="939"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit35> </Unit35>
<Unit36> <Unit36>
<Filename Value="C:\development\lazarus\lcl\graphics.pp"/> <Filename Value="C:\development\lazarus\lcl\graphics.pp"/>
@ -421,7 +424,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="2053"/> <TopLine Value="2053"/>
<CursorPos X="30" Y="1945"/> <CursorPos X="30" Y="1945"/>
<UsageCount Value="13"/> <UsageCount Value="12"/>
</Unit36> </Unit36>
<Unit37> <Unit37>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpcanvas.pp"/> <Filename Value="C:\development\fpc\packages\fcl-image\src\fpcanvas.pp"/>
@ -429,14 +432,14 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="89"/> <TopLine Value="89"/>
<CursorPos X="15" Y="97"/> <CursorPos X="15" Y="97"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit37> </Unit37>
<Unit38> <Unit38>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpfont.inc"/> <Filename Value="C:\development\fpc\packages\fcl-image\src\fpfont.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="54"/> <TopLine Value="54"/>
<CursorPos X="3" Y="57"/> <CursorPos X="3" Y="57"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit38> </Unit38>
<Unit39> <Unit39>
<Filename Value="C:\development\lazarus\lcl\graphmath.pp"/> <Filename Value="C:\development\lazarus\lcl\graphmath.pp"/>
@ -444,7 +447,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="584"/> <TopLine Value="584"/>
<CursorPos X="3" Y="439"/> <CursorPos X="3" Y="439"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit39> </Unit39>
<Unit40> <Unit40>
<Filename Value="C:\development\lazarus\lcl\graphtype.pp"/> <Filename Value="C:\development\lazarus\lcl\graphtype.pp"/>
@ -452,7 +455,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="234"/> <TopLine Value="234"/>
<CursorPos X="3" Y="33"/> <CursorPos X="3" Y="33"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit40> </Unit40>
<Unit41> <Unit41>
<Filename Value="C:\development\lazarus\lcl\lcltype.pp"/> <Filename Value="C:\development\lazarus\lcl\lcltype.pp"/>
@ -460,7 +463,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1628"/> <TopLine Value="1628"/>
<CursorPos X="3" Y="1643"/> <CursorPos X="3" Y="1643"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit41> </Unit41>
<Unit42> <Unit42>
<Filename Value="C:\development\lazarus\lcl\graphutil.pp"/> <Filename Value="C:\development\lazarus\lcl\graphutil.pp"/>
@ -468,30 +471,30 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="128"/> <TopLine Value="128"/>
<CursorPos X="12" Y="143"/> <CursorPos X="12" Y="143"/>
<UsageCount Value="12"/> <UsageCount Value="11"/>
</Unit42> </Unit42>
<Unit43> <Unit43>
<Filename Value="C:\development\fpc\rtl\objpas\math.pp"/> <Filename Value="C:\development\fpc\rtl\objpas\math.pp"/>
<UnitName Value="math"/> <UnitName Value="math"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="120"/> <TopLine Value="144"/>
<CursorPos X="10" Y="135"/> <CursorPos X="10" Y="159"/>
<UsageCount Value="10"/> <UsageCount Value="14"/>
</Unit43> </Unit43>
<Unit44> <Unit44>
<Filename Value="C:\development\fpc\rtl\i386\i386.inc"/> <Filename Value="C:\development\fpc\rtl\i386\i386.inc"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1499"/> <TopLine Value="1551"/>
<CursorPos X="1" Y="1513"/> <CursorPos X="3" Y="1563"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
</Unit44> </Unit44>
<Unit45> <Unit45>
<Filename Value="C:\development\lazarus\lcl\grids.pas"/> <Filename Value="C:\development\lazarus\lcl\grids.pas"/>
<UnitName Value="Grids"/> <UnitName Value="Grids"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="923"/> <TopLine Value="794"/>
<CursorPos X="15" Y="936"/> <CursorPos X="15" Y="1010"/>
<UsageCount Value="10"/> <UsageCount Value="18"/>
</Unit45> </Unit45>
<Unit46> <Unit46>
<Filename Value="..\..\..\spktoolbar\SpkGraphTools\SpkGraphTools.pas"/> <Filename Value="..\..\..\spktoolbar\SpkGraphTools\SpkGraphTools.pas"/>
@ -499,58 +502,168 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="136"/> <TopLine Value="136"/>
<CursorPos X="1" Y="143"/> <CursorPos X="1" Y="143"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit46> </Unit46>
<Unit47>
<Filename Value="C:\development\fpc\rtl\objpas\classes\lists.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="34"/>
<CursorPos X="1" Y="49"/>
<UsageCount Value="17"/>
</Unit47>
<Unit48>
<Filename Value="C:\development\lazarus\lcl\include\canvas.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1705"/>
<CursorPos X="1" Y="1720"/>
<UsageCount Value="17"/>
</Unit48>
<Unit49>
<Filename Value="C:\development\lazarus\lcl\include\font.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1139"/>
<CursorPos X="25" Y="1161"/>
<UsageCount Value="17"/>
</Unit49>
<Unit50>
<Filename Value="C:\development\lazarus\lcl\include\winapih.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="156"/>
<CursorPos X="10" Y="171"/>
<UsageCount Value="11"/>
</Unit50>
<Unit51>
<Filename Value="C:\development\lazarus\lcl\include\intfbasewinapi.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1577"/>
<CursorPos X="3" Y="1579"/>
<UsageCount Value="11"/>
</Unit51>
<Unit52>
<Filename Value="C:\development\fpc\rtl\inc\except.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="202"/>
<CursorPos X="1" Y="227"/>
<UsageCount Value="11"/>
</Unit52>
</Units> </Units>
<JumpHistory Count="12" HistoryIndex="11"> <JumpHistory Count="29" HistoryIndex="28">
<Position1> <Position1>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="115" Column="17" TopLine="96"/> <Caret Line="1885" Column="1" TopLine="1865"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="281" Column="16" TopLine="281"/> <Caret Line="1886" Column="1" TopLine="1865"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/> <Caret Line="1887" Column="1" TopLine="1865"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="134" Column="22" TopLine="134"/> <Caret Line="1648" Column="1" TopLine="1629"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="1" Column="1" TopLine="1"/> <Caret Line="1649" Column="1" TopLine="1629"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="515" Column="3" TopLine="503"/> <Caret Line="1650" Column="1" TopLine="1629"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="535" Column="1" TopLine="504"/> <Caret Line="1651" Column="1" TopLine="1629"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="306" Column="22" TopLine="288"/> <Caret Line="1653" Column="1" TopLine="1629"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="536" Column="1" TopLine="518"/> <Caret Line="1654" Column="1" TopLine="1629"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="306" Column="1" TopLine="286"/> <Caret Line="1666" Column="1" TopLine="1634"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="309" Column="1" TopLine="286"/> <Caret Line="1905" Column="1" TopLine="1886"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="310" Column="1" TopLine="286"/> <Caret Line="1677" Column="1" TopLine="1658"/>
</Position12> </Position12>
<Position13>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1905" Column="1" TopLine="1886"/>
</Position13>
<Position14>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1906" Column="1" TopLine="1886"/>
</Position14>
<Position15>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1908" Column="1" TopLine="1886"/>
</Position15>
<Position16>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1912" Column="1" TopLine="1886"/>
</Position16>
<Position17>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1913" Column="1" TopLine="1886"/>
</Position17>
<Position18>
<Filename Value="mainform.pas"/>
<Caret Line="404" Column="25" TopLine="404"/>
</Position18>
<Position19>
<Filename Value="mainform.pas"/>
<Caret Line="286" Column="3" TopLine="282"/>
</Position19>
<Position20>
<Filename Value="mainform.pas"/>
<Caret Line="364" Column="64" TopLine="356"/>
</Position20>
<Position21>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1913" Column="1" TopLine="1886"/>
</Position21>
<Position22>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="1677" Column="1" TopLine="1658"/>
</Position22>
<Position23>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1913" Column="1" TopLine="1886"/>
</Position23>
<Position24>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="382" Column="62" TopLine="362"/>
</Position24>
<Position25>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1104" Column="52" TopLine="1073"/>
</Position25>
<Position26>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1379" Column="58" TopLine="1347"/>
</Position26>
<Position27>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1384" Column="56" TopLine="1353"/>
</Position27>
<Position28>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1395" Column="54" TopLine="1364"/>
</Position28>
<Position29>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1401" Column="53" TopLine="1370"/>
</Position29>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -581,7 +694,7 @@
<Debugging> <Debugging>
<Watches Count="2"> <Watches Count="2">
<Item1> <Item1>
<Expression Value="lcell^.fontindex"/> <Expression Value="acol"/>
</Item1> </Item1>
<Item2> <Item2>
<Expression Value="arow"/> <Expression Value="arow"/>

16
components/fpspreadsheet/examples/fpsgrid/mainform.pas
View File

@ -361,7 +361,7 @@ var
i: Integer; i: Integer;
begin begin
// Load file // Load file
sWorksheetGrid1.LoadFromSpreadsheetFile(AFileName); sWorksheetGrid1.LoadFromSpreadsheetFile(UTF8ToSys(AFileName));
// Update user interface // Update user interface
Caption := Format('fpsGrid - %s (%s)', [ Caption := Format('fpsGrid - %s (%s)', [
@ -407,9 +407,9 @@ begin
r := GetWorksheetRow(ARow); r := GetWorksheetRow(ARow);
cell := Worksheet.FindCell(r, c); cell := Worksheet.FindCell(r, c);
end; end;
UpdateBorders(cell);
if cell = nil then if cell = nil then
exit; exit;
UpdateBorders(cell);
UpdateHorAlignment(cell^.HorAlignment); UpdateHorAlignment(cell^.HorAlignment);
UpdateVertAlignment(cell^.VertAlignment); UpdateVertAlignment(cell^.VertAlignment);
lFont := sWorksheetGrid1.Workbook.GetFont(cell^.FontIndex); lFont := sWorksheetGrid1.Workbook.GetFont(cell^.FontIndex);
@ -418,14 +418,14 @@ end;
procedure TForm1.UpdateBorders(ACell: PCell); procedure TForm1.UpdateBorders(ACell: PCell);
begin begin
AcBorderTop.Checked := cbNorth in ACell^.Border; AcBorderTop.Checked := (ACell <> nil) and (cbNorth in ACell^.Border);
AcBorderLeft.Checked := cbWest in ACell^.Border; AcBorderLeft.Checked := (ACell <> nil) and (cbWest in ACell^.Border);
AcBorderRight.Checked := cbEast in ACell^.Border; AcBorderRight.Checked := (ACell <> nil) and (cbEast in ACell^.Border);
AcBorderBottom.Checked := (cbSouth in ACell^.BOrder) and AcBorderBottom.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsThin); (ACell^.BorderStyles[cbSouth].LineStyle = lsThin);
AcBorderBottomDbl.Checked := (cbSouth in ACell^.Border) and AcBorderBottomDbl.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsDouble); (ACell^.BorderStyles[cbSouth].LineStyle = lsDouble);
AcBorderBottomMedium.Checked := (cbSouth in ACell^.Border) and AcBorderBottomMedium.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsMedium); (ACell^.BorderStyles[cbSouth].LineStyle = lsMedium);
end; end;

477
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -44,6 +44,8 @@ type
procedure ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal); procedure ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal);
function GetShowGridLines: Boolean; function GetShowGridLines: Boolean;
function GetShowHeaders: Boolean; function GetShowHeaders: Boolean;
function IsSelection(ACol, ARow: Integer; ABorder: TsCellBorder): Boolean;
function IsSelectionNeighbor(ACol, ARow: Integer; ABorder: TsCellBorder): Boolean;
procedure SetFrozenCols(AValue: Integer); procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenRows(AValue: Integer); procedure SetFrozenRows(AValue: Integer);
procedure SetShowGridLines(AValue: Boolean); procedure SetShowGridLines(AValue: Boolean);
@ -53,9 +55,15 @@ type
{ 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;
procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override; procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
procedure DrawAllRows; override; // procedure DrawAllRows; override;
procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect);
procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override; procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
procedure DrawSelectionBorders(ACol, ARow: Integer; ARect: TRect);
// procedure DrawSelectionBorders(ACol, ARow: Integer; ARect: TRect);
procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override; procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
function GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer;
var ABorderStyle: TsCellBorderStyle): Boolean;
function GetCellHeight(ACol, ARow: Integer): Integer; function GetCellHeight(ACol, ARow: Integer): Integer;
function GetCellText(ACol, ARow: Integer): String; function GetCellText(ACol, ARow: Integer): String;
function GetEditText(ACol, ARow: Integer): String; override; function GetEditText(ACol, ARow: Integer): String; override;
@ -63,6 +71,7 @@ type
procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override; procedure Loaded; override;
procedure LoadFromWorksheet(AWorksheet: TsWorksheet); procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
procedure MoveSelection; override;
procedure SelectEditor; override; procedure SelectEditor; override;
procedure SetEditText(ACol, ARow: Longint; const AValue: string); override; procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
procedure Setup; procedure Setup;
@ -151,7 +160,6 @@ 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;
@ -299,20 +307,21 @@ begin
end; end;
end; end;
function DimColorByPercent(c: TColor; APercentage: Integer) : TColor; function CalcSelectionColor(c: TColor; ADelta: Byte) : TColor;
type type
TRGBA = record R,G,B,A: Byte end; TRGBA = record R,G,B,A: Byte end;
begin begin
c := ColorToRGB(c); c := ColorToRGB(c);
Result := rgb(Integer(TRGBA(c).R) * (100 - APercentage) div 100, TRGBA(Result).A := 0;
Integer(TRGBA(c).G) * (100 - APercentage) div 100, if TRGBA(c).R < 128
Integer(TRGBA(c).B) * (100 - APercentage) div 100 then TRGBA(Result).R := TRGBA(c).R + ADelta
); else TRGBA(Result).R := TRGBA(c).R - ADelta;
{ if TRGBA(c).G < 128
Result := rgb(Max(0, Min(255, TRGBA(c1).R + TRGBA(c2).R))), then TRGBA(Result).G := TRGBA(c).G + ADelta
Max(0, Min(255, TRGBA(c1).G + TRGBA(c2).G)), else TRGBA(Result).G := TRGBA(c).G - ADelta;
Max(0, Min(255, TRGBA(c1).B + TRGBA(c2).B))); if TRGBA(c).B < 128
} then TRGBA(Result).B := TRGBA(c).B + ADelta
else TRGBA(Result).B := TRGBA(c).B - ADelta;
end; end;
procedure Register; procedure Register;
@ -327,7 +336,6 @@ 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;
@ -478,6 +486,7 @@ begin
GetSelectedState(AState, isSelected); GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font); Canvas.Font.Assign(Font);
Canvas.Brush.Bitmap := nil; Canvas.Brush.Bitmap := nil;
Canvas.Brush.Color := Color;
ts := Canvas.TextStyle; ts := Canvas.TextStyle;
if ShowHeaders then begin if ShowHeaders then begin
// Formatting of row and column headers // Formatting of row and column headers
@ -533,115 +542,276 @@ begin
end; end;
if IsSelected then if IsSelected then
Canvas.Brush.Color := DimColorByPercent(Canvas.Brush.Color, 15); Canvas.Brush.Color := CalcSelectionColor(Canvas.Brush.Color, 16);
Canvas.TextStyle := ts; Canvas.TextStyle := ts;
inherited DoPrepareCanvas(ACol, ARow, AState); inherited DoPrepareCanvas(ACol, ARow, AState);
end; end;
{ Paints the cell borders. This cannot be done in DrawCellGrid because the { Draws the border lines around a given cell. Note that when this procedure is
lower border line is overwritten when painting the next row. } called the output is clipped by the cell rectangle, but thick and double
procedure TsCustomWorksheetGrid.DrawAllRows; border styles extend into the neighbor cell. Therefore, these border lines
var are drawn in parts. }
cell: PCell; procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect);
c, r, tmp: Integer;
rect, cliprect: TRect;
rgn: HRGN;
procedure DrawBorderLine(ACell: PCell; ARect: TRect; ABorder: TsCellBorder; procedure DrawBorderLine(ACoord: Integer; ARect: TRect; IsHor: Boolean;
ALineStyle: TsLineStyle); ABorderStyle: TsCellBorderStyle);
const const
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble); // TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
PEN_WIDTHS: array[TsLineStyle] of Byte =
(1, 2, 1, 1, 3, 1);
PEN_STYLES: array[TsLineStyle] of TPenStyle = PEN_STYLES: array[TsLineStyle] of TPenStyle =
(psSolid, psSolid, psDash, psDot, psSolid, psSolid); (psSolid, psSolid, psDash, psDot, psSolid, psSolid);
// (psSolid, psSolid, psPattern, psPattern, psSolid, psSolid); {
PEN_PATTERNS: array[TsLineStyle] of TPenPattern = PEN_PATTERNS: array[TsLineStyle] of TPenPattern =
($FFFFFFFF, $FFFFFFFF, $07070707, $AAAAAAAA, $FFFFFFFF, $FFFFFFFF); ($FFFFFFFF, $FFFFFFFF, $07070707, $AAAAAAAA, $FFFFFFFF, $FFFFFFFF); }
var
w: Integer;
begin begin
if ALineStyle = lsDouble then Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
case ABorder of Canvas.Pen.Width := 1;
cbEast, cbWest: Canvas.Pen.Color := FWorkbook.GetPaletteColor(ABorderStyle.Color);
begin if IsHor then begin
InflateRect(ARect, -1, 0); if ABorderStyle.LineStyle <> lsDouble then
DrawBorderLine(ACell, ARect, ABorder, lsThin); Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord);
InflateRect(ARect, +2, 0); if (ACoord = ARect.Top-1) and (ABorderStyle.LineStyle in [lsDouble, lsThick]) then
DrawBorderLine(ACell, ARect, ABorder, lsThin); Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1);
end; if (ACoord = ARect.Bottom-1) and (ABorderStyle.LineStyle in [lsDouble, lsMedium, lsThick]) then
cbNorth, cbSouth: Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1);
begin end else begin
InflateRect(ARect, 0, -1); if ABorderStyle.LineStyle <> lsDouble then
DrawBorderLine(ACell, ARect, ABorder, lsThin); Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
InflateRect(ARect, 0, +2); if (ACoord = ARect.Left-1) and (ABorderStyle.LineStyle in [lsDouble, lsThick]) then
DrawBorderLine(ACell, ARect, ABorder, lsThin) Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom);
end; if (ACoord = ARect.Right-1) and (ABorderStyle.LineStyle in [lsDouble, lsMedium, lsThick]) then
end Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom);
else begin
w := PEN_WIDTHS[ACell^.BorderStyles[ABorder].LineStyle] div 2;
Canvas.Pen.Style := PEN_STYLES[ACell^.BorderStyles[ABorder].LineStyle];
Canvas.Pen.Width := PEN_WIDTHS[ACell^.BorderStyles[ABorder].LineStyle];
Canvas.Pen.Color := FWorkBook.GetPaletteColor(ACell^.BorderStyles[ABorder].Color);
//Canvas.Pen.Pattern := PEN_PATTERNS[ACell^.BorderStyles[ABorder].LineStyle];
//Canvas.Pen.EndCap := pecSquare;
case ABorder of
cbEast : Canvas.Line(ARect.Right-1, ARect.Top, ARect.Right-1, ARect.Bottom-w);
cbSouth: Canvas.Line(ARect.Left-1, ARect.Bottom-1, ARect.Right-w, ARect.Bottom-1);
cbWest : Canvas.Line(ARect.Left-1, ARect.Top, ARect.Left-1, ARect.Bottom-w);
cbNorth: Canvas.Line(ARect.Left-1, ARect.Top-1, ARect.Right-w, ARect.Top-1);
end;
end; end;
end; end;
var
bs: TsCellBorderStyle;
begin
if Assigned(FWorksheet) then begin
// Left border
if GetBorderStyle(ACol, ARow, -1, 0, bs) then
DrawBorderLine(ARect.Left-1, ARect, false, bs);
// Right border
if GetBorderStyle(ACol, ARow, +1, 0, bs) then
DrawBorderLine(ARect.Right-1, ARect, false, bs);
// Top border
if GetBorderstyle(ACol, ARow, 0, -1, bs) then
DrawBorderLine(ARect.Top-1, ARect, true, bs);
// Bottom border
if GetBorderStyle(ACol, ARow, 0, +1, bs) then
DrawBorderLine(ARect.Bottom-1, ARect, true, bs);
end;
end;
procedure TsCustomWorksheetGrid.DrawCellGrid(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
const
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
PEN_WIDTHS: array[TsLineStyle] of Byte =
(1, 2, 1, 1, 3, 1);
PEN_STYLES: array[TsLineStyle] of TPenStyle =
(psSolid, psSolid, psDash, psDot, psSolid, psSolid);
// (psSolid, psSolid, psPattern, psPattern, psSolid, psSolid);
PEN_PATTERNS: array[TsLineStyle] of TPenPattern =
($FFFFFFFF, $FFFFFFFF, $07070707, $AAAAAAAA, $FFFFFFFF, $FFFFFFFF);
procedure DrawHorBorderLine(x1, x2, y: Integer; ABorderStyle: TsCellBorderStyle;
IsAtBottom: Boolean);
begin
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := 1;
Canvas.Pen.Color := FWorkBook.GetPaletteColor(ABorderStyle.Color);
case ABorderStyle.LineStyle of
lsThin, lsDashed, lsDotted:
Canvas.Line(x1, y, x2, y);
lsMedium:
begin
Canvas.Line(x1, y, x2, y);
if IsAtBottom then Canvas.Line(x1, y-1, x2, y-1);
end;
lsThick:
begin
Canvas.Line(x1, y, x2, y);
if IsAtBottom
then Canvas.Line(x1, y-1, x2, y-1)
else Canvas.Line(x1, y+1, x2, y+1);
end;
lsDouble:
if IsAtBottom
then Canvas.Line(x1, y-1, x2, y-1)
else Canvas.Line(x1, y+1, x2, y+1);
end;
end;
procedure DrawVertBorderLine(x, y1, y2: Integer; ABorderStyle: TsCellBorderStyle;
IsAtRight: Boolean);
begin
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := 1;
Canvas.Pen.Color := FWorkBook.GetPaletteColor(ABorderStyle.Color);
case ABorderStyle.LineStyle of
lsThin, lsDashed, lsDotted:
Canvas.Line(x, y1, x, y2);
lsMedium:
begin
Canvas.Line(x, y1, x, y2);
if IsAtRight then Canvas.Line(x-1, y1, x-1, y2);
end;
lsThick:
begin
Canvas.Line(x, y1, x, y2);
if IsAtRight
then Canvas.Line(x-1, y1, x-1, y2)
else Canvas.Line(x+1, y1, x+1, y2);
end;
lsDouble:
if IsAtRight
then Canvas.Line(x-1, y1, x-1, y2)
else Canvas.Line(x+2, y1, x+2, y2);
end;
end;
var
dv,dh: Boolean;
isSelH, isSelV: Boolean;
isSelNeighbor: Boolean;
// cell: PCell;
c, r: Cardinal;
begin begin
inherited;
if FWorksheet = nil then exit;
Canvas.SaveHandleState; with Canvas, ARect do begin
try
// Avoid painting into the fixed cells
cliprect := ClientRect;
if FixedCols > 0 then
ColRowToOffset(True, True, FixedCols-1, tmp, cliprect.Left);
if FixedRows > 0 then
ColRowToOffset(False, True, FixedRows-1, tmp, cliprect.Top);
rgn := CreateRectRgn(cliprect.Left, cliprect.top, cliprect.Right, cliprect.Bottom);
SelectClipRgn(Canvas.Handle, Rgn);
cell := FWorksheet.GetFirstCell; // fixed cells
while cell <> nil do begin if (gdFixed in aState) then begin
if (uffBorder in cell^.UsedFormattingFields) then begin Dv := goFixedVertLine in Options;
c := cell^.Col + FHeaderCount; Dh := goFixedHorzLine in Options;
r := cell^.Row + FHeaderCount; Pen.Style := psSolid;
rect := CellRect(c, r); if GridLineWidth > 0 then
if (cbNorth in cell^.Border) then Pen.Width := 1
DrawBorderLine(cell, rect, cbNorth, cell^.BorderStyles[cbNorth].LineStyle); else
if cbEast in cell^.Border then Pen.Width := 0;
DrawBorderLine(cell, rect, cbEast, cell^.BorderStyles[cbEast].LineStyle); if not Flat then begin
if cbSouth in cell^.Border then if TitleStyle = tsNative then
DrawBorderLine(cell, rect, cbSouth, cell^.BorderStyles[cbSouth].LineStyle); exit
if cbWest in cell^.Border then else
DrawBorderLine(cell, rect, cbWest, cell^.BorderStyles[cbWest].LineStyle); if GridLineWidth > 0 then begin
if gdPushed in aState then
Pen.Color := cl3DShadow
else
Pen.Color := cl3DHilight;
if UseRightToLeftAlignment then begin
//the light still on the left but need to new x
MoveTo(Right, Top);
LineTo(Left + 1, Top);
LineTo(Left + 1, Bottom);
end else begin
MoveTo(Right - 1, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
end;
if TitleStyle=tsStandard then begin
// more contrast
if gdPushed in aState then
Pen.Color := cl3DHilight
else
Pen.Color := cl3DShadow;
if UseRightToLeftAlignment then begin
MoveTo(Left+2, Bottom-2);
LineTo(Right, Bottom-2);
LineTo(Right, Top);
end else begin
MoveTo(Left+1, Bottom-2);
LineTo(Right-2, Bottom-2);
LineTo(Right-2, Top);
end;
end;
end;
end; end;
cell := FWorksheet.GetNextCell; Pen.Color := cl3DDKShadow;
end else begin
Dv := (goVertLine in Options);
Dh := (goHorzLine in Options);
Pen.Style := GridLineStyle;
Pen.Color := GridLineColor;
Pen.Width := GridLineWidth;
end; end;
DeleteObject(rgn);
finally // non-fixed cells
Canvas.RestoreHandleState; if (GridLineWidth > 0) then begin
end; if Dh then begin
MoveTo(Left, Bottom - 1);
LineTo(Right, Bottom - 1);
end;
if Dv then begin
if UseRightToLeftAlignment then begin
MoveTo(Left, Top);
LineTo(Left, Bottom);
end else begin
MoveTo(Right - 1, Top);
LineTo(Right - 1, Bottom);
end;
end;
end;
// Draw cell border
DrawCellBorders(ACol, ARow, ARect);
// Draw Selection
DrawSelectionBorders(ACol, ARow, ARect);
end; // with canvas,rect
end; end;
procedure TsCustomWorksheetGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); procedure TsCustomWorksheetGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin begin
Canvas.Pen.Color := clBlack; // We don't want the red dashed focus rectangle here, but the thick Excel-like
Canvas.Pen.Width := 3; // border line. Since this frame extends into neighboring cells painting of
Canvas.Brush.Style := bsClear; // focus rect has been added to the DrawCellGrid method.
InflateRect(ARect, -1, -1); end;
Canvas.Rectangle(ARect);
{ Draws the selection rectangle.
Note that painting is clipped at the edges of ARect. Since the selection
rectangle is 3 pixels wide and extends into the neighboring cell this
method is called from several cells to complete. }
procedure TsCustomWorksheetGrid.DrawSelectionBorders(ACol, ARow: Integer;
ARect: TRect);
begin
with Canvas, ARect do begin
Pen.Color := clBlack;
Pen.Width := 1;
Pen.Style := psSolid;
if IsSelection(ACol, ARow, cbNorth) then begin
Line(Left, Top, Right, Top);
Line(Left, Top+1, Right, Top+1);
if ARow = TopRow then
Line(Left, Top+2, Right, Top+2);
end;
if IsSelection(ACol, ARow, cbSouth) then begin
Line(Left, Bottom-1, Right, Bottom-1);
Line(Left, Bottom-2, Right, Bottom-2);
end;
if IsSelection(ACol, ARow, cbWest) then begin
Line(Left, Top, Left, Bottom);
Line(Left+1, Top, Left+1, Bottom);
if ACol = LeftCol then
Line(Left+2, Top, Left+2, Bottom);
end;
if IsSelection(ACol, ARow, cbEast) then begin
Line(Right-1, Top, Right-1, Bottom);
Line(Right-2, Top, Right-2, Bottom);
end;
if IsSelectionNeighbor(ACol, ARow, cbEast) then
Line(Right-1, Top, Right-1, Bottom);
if IsSelectionNeighbor(ACol, ARow, cbWest) then
Line(Left, Top, Left, Bottom);
if IsSelectionNeighbor(ACol, ARow, cbNorth) then
Line(Left, Top, Right, Top);
if IsSelectionNeighbor(ACol, ARow, cbSouth) then
Line(Left, Bottom-1, Right, Bottom-1);
end;
end; end;
{ Draws the cell text. Calls "GetCellText" to determine the text in the cell. { Draws the cell text. Calls "GetCellText" to determine the text in the cell.
@ -833,7 +1003,7 @@ begin
else else
if TryStrToDateTime(FEditText, cell^.DateTimeValue) then begin if TryStrToDateTime(FEditText, cell^.DateTimeValue) then begin
cell^.ContentType := cctDateTime; cell^.ContentType := cctDateTime;
if cell^.DateTimeValue < 1.0 then begin if cell^.DateTimeValue < 1.0 then begin // this is a TTime
if not (cell^.NumberFormat in [nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM]) if not (cell^.NumberFormat in [nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM])
then cell^.NumberFormat := nfLongTime; then cell^.NumberFormat := nfLongTime;
end else end else
@ -1057,6 +1227,62 @@ begin
if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result); if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result);
end; end;
{ Determines the style of the border between a cell and its neighbor given by
ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1).
ACol and ARow are in grid units. }
function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer;
var ABorderStyle: TsCellBorderStyle): Boolean;
var
cell, neighborcell: PCell;
border, neighborborder: TsCellBorder;
r, c: Cardinal;
begin
Result := true;
if (ADeltaCol = -1) and (ADeltaRow = 0) then begin
border := cbWest;
neighborborder := cbEast;
end else
if (ADeltaCol = +1) and (ADeltaRow = 0) then begin
border := cbEast;
neighborborder := cbWest;
end else
if (ADeltaCol = 0) and (ADeltaRow = -1) then begin
border := cbNorth;
neighborborder := cbSouth;
end else
if (ADeltaCol = 0) and (ADeltaRow = +1) then begin
border := cbSouth;
neighborBorder := cbNorth;
end else
raise Exception.Create('TsCustomWorksheetGrid: incorrect col/row for GetBorderStyle.');
r := GetWorksheetRow(ARow);
c := GetWorksheetCol(ACol);
cell := FWorksheet.FindCell(r, c);
neighborcell := FWorksheet.FindCell(r+ADeltaRow, c+ADeltaCol);
// Only cell has border, but neighbor has not
if ((cell <> nil) and (border in cell^.Border)) and
((neighborcell = nil) or (neighborborder in neighborcell^.Border))
then
ABorderStyle := cell^.BorderStyles[border]
else
// Only neighbor has border, cell has not
if ((cell = nil) or not (border in cell^.Border)) and
(neighborcell <> nil) and (neighborborder in neighborcell^.Border)
then
ABorderStyle := neighborcell^.BorderStyles[neighborborder]
else
// Both cells have shared border -> use top or left border
if (cell <> nil) and (border in cell^.Border) and
(neighborcell <> nil) and (neighborborder in neighborcell^.Border)
then begin
if (border in [cbNorth, cbWest]) then
ABorderStyle := neighborcell^.BorderStyles[neighborborder]
else
ABorderStyle := cell^.BorderStyles[border];
end else
Result := false;
end;
{ Returns a list of worksheets contained in the file. Useful for assigning to { Returns a list of worksheets contained in the file. Useful for assigning to
user controls like TabControl, Combobox etc. in order to select a sheet. } user controls like TabControl, Combobox etc. in order to select a sheet. }
procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings); procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings);
@ -1114,11 +1340,54 @@ begin
end else begin end else begin
// The grid's row heights are in "pixels", the worksheet's row heights are // The grid's row heights are in "pixels", the worksheet's row heights are
// in millimeters. // in millimeters.
h := (RowHeights[Index] - 2*constCellPadding) / Screen.PixelsPerInch * 25.4; h := (RowHeights[Index] - 4) / Screen.PixelsPerInch * 25.4;
FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h); FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h);
end; end;
end; end;
{ Determines if the current cell is at the given edge of the selection. }
function TsCustomWorksheetGrid.IsSelection(ACol, ARow: Integer;
ABorder: TsCellBorder): Boolean;
var
selRect: TGridRect;
begin
selRect := Selection;
case ABorder of
cbNorth:
Result := InRange(ACol, selRect.Left, selRect.Right) and (ARow = selRect.Top);
cbSouth:
Result := InRange(ACol, selRect.Left, selRect.Right) and (ARow = selRect.Bottom);
cbEast:
Result := InRange(ARow, selRect.Top, selRect.Bottom) and (ACol = selRect.Right);
cbWest:
Result := InRange(ARow, selRect.Top, selRect.Bottom) and (ACol = selRect.Left);
end;
end;
{ Determines if the neighbor cell is selected (for drawing of the rest of the
thick selection border that extends into the current cell):
ABorder = cbNorth: look for the top neighbor
ABorder = cbSouth: look for the bottom neighbor
ABorder = cbLeft: look for the left neighbor
ABorder = cbRight: look for the right neighbor }
function TsCustomWorksheetGrid.IsSelectionNeighbor(ACol, ARow: Integer;
ABorder: TsCellBorder): Boolean;
var
selRect: TGridRect;
begin
selRect := Selection;
case ABorder of
cbNorth :
Result := InRange(ACol, selRect.Left, selRect.Right) and (ARow - 1 = selRect.Bottom);
cbSouth :
Result := InRange(ACol, selRect.Left, selRect.Right) and (ARow + 1 = selRect.Top);
cbEast :
Result := InRange(ARow, selRect.Top, selRect.Bottom) and (ACol + 1 = selRect.Left);
cbWest :
Result := InRange(ARow, selRect.Top, selRect.Bottom) and (ACol - 1 = selRect.Right);
end;
end;
{ Catches the ESC key during editing in order to restore the old cell text } { Catches the ESC key during editing in order to restore the old cell text }
procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState); procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
begin begin
@ -1134,6 +1403,14 @@ begin
Setup; Setup;
end; end;
{ Repaints after moving selection to avoid spurious rests of the old thick
selection border. }
procedure TsCustomWorksheetGrid.MoveSelection;
begin
Refresh;
Inherited;
end;
{ Is called when editing starts. Stores the old text just for the case that { Is called when editing starts. Stores the old text just for the case that
the user presses ESC to cancel editing. } the user presses ESC to cancel editing. }
procedure TsCustomWorksheetGrid.SelectEditor; procedure TsCustomWorksheetGrid.SelectEditor;
@ -1172,7 +1449,7 @@ begin
Setup; Setup;
end; end;
{ fetches the text that is currently in the editor. It is not yet transferred { Fetches the text that is currently in the editor. It is not yet transferred
to the Worksheet because input is checked only at the end of editing. } to the Worksheet because input is checked only at the end of editing. }
procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string); procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string);
begin begin