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

fpspreadsheet: Add properties for setting cell borders to TsWorksheetGrid. Redo border and selection painting again. Fix issues due to adjacent cells having different borders.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3037 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-11 09:20:52 +00:00
parent 203059b3df
commit 0fe1742400
7 changed files with 3570 additions and 1481 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -107,7 +107,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="53">
<Units Count="55">
<Unit0>
<Filename Value="fpsgrid.lpr"/>
<IsPartOfProject Value="True"/>
@ -116,7 +116,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="10" Y="7"/>
<UsageCount Value="184"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -129,11 +129,11 @@
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="378"/>
<CursorPos X="1" Y="410"/>
<UsageCount Value="184"/>
<TopLine Value="204"/>
<CursorPos X="28" Y="223"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="31" Y="442" ID="1"/>
<Item0 X="49" Y="470" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@ -141,11 +141,11 @@
<Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="4"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="1906"/>
<CursorPos X="32" Y="1918"/>
<UsageCount Value="86"/>
<TopLine Value="228"/>
<CursorPos X="36" Y="241"/>
<UsageCount Value="98"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -153,9 +153,9 @@
<UnitName Value="fpspreadsheetgrid"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="1351"/>
<CursorPos X="1" Y="1380"/>
<UsageCount Value="87"/>
<TopLine Value="65"/>
<CursorPos X="60" Y="87"/>
<UsageCount Value="99"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -164,7 +164,7 @@
<WindowIndex Value="0"/>
<TopLine Value="25"/>
<CursorPos X="4" Y="44"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit4>
<Unit5>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\winunits-base\src\activex.pp"/>
@ -172,7 +172,7 @@
<WindowIndex Value="0"/>
<TopLine Value="49"/>
<CursorPos X="10" Y="24"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit5>
<Unit6>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\fcl-base\src\avl_tree.pp"/>
@ -180,7 +180,7 @@
<WindowIndex Value="0"/>
<TopLine Value="37"/>
<CursorPos X="14" Y="83"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit6>
<Unit7>
<Filename Value="c:\Lazarus\lcl\grids.pas"/>
@ -188,14 +188,14 @@
<WindowIndex Value="0"/>
<TopLine Value="1516"/>
<CursorPos X="28" Y="1534"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit7>
<Unit8>
<Filename Value="c:\Lazarus\lcl\include\customform.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="2021"/>
<CursorPos X="1" Y="2041"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpsallformats.pas"/>
@ -203,7 +203,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="62" Y="13"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit9>
<Unit10>
<Filename Value="..\..\wikitable.pas"/>
@ -211,7 +211,7 @@
<WindowIndex Value="0"/>
<TopLine Value="48"/>
<CursorPos X="41" Y="60"/>
<UsageCount Value="15"/>
<UsageCount Value="13"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpsopendocument.pas"/>
@ -219,17 +219,15 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="992"/>
<CursorPos X="15" Y="1010"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
<TopLine Value="6924"/>
<CursorPos X="20" Y="6956"/>
<UsageCount Value="46"/>
</Unit12>
<Unit13>
<Filename Value="..\..\fpsutils.pas"/>
@ -237,38 +235,38 @@
<WindowIndex Value="0"/>
<TopLine Value="35"/>
<CursorPos X="1" Y="62"/>
<UsageCount Value="50"/>
<UsageCount Value="48"/>
</Unit13>
<Unit14>
<Filename Value="d:\lazarus-svn\lcl\include\canvas.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1212"/>
<CursorPos X="3" Y="1218"/>
<UsageCount Value="7"/>
<UsageCount Value="5"/>
</Unit14>
<Unit15>
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<WindowIndex Value="0"/>
<TopLine Value="2563"/>
<CursorPos X="22" Y="2571"/>
<UsageCount Value="30"/>
<TopLine Value="573"/>
<CursorPos X="43" Y="593"/>
<UsageCount Value="29"/>
</Unit15>
<Unit16>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="248"/>
<CursorPos X="22" Y="263"/>
<UsageCount Value="15"/>
<UsageCount Value="13"/>
</Unit16>
<Unit17>
<Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/>
<EditorIndex Value="6"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="1493"/>
<CursorPos X="1" Y="1514"/>
<UsageCount Value="61"/>
<TopLine Value="2008"/>
<CursorPos X="39" Y="1983"/>
<UsageCount Value="73"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
@ -277,43 +275,43 @@
<WindowIndex Value="0"/>
<TopLine Value="1091"/>
<CursorPos X="12" Y="1122"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit18>
<Unit19>
<Filename Value="d:\lazarus-svn\lcl\include\wincontrol.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="7344"/>
<CursorPos X="30" Y="7349"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit19>
<Unit20>
<Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/>
<EditorIndex Value="5"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="20"/>
<CursorPos X="3" Y="51"/>
<UsageCount Value="57"/>
<TopLine Value="1461"/>
<CursorPos X="43" Y="1479"/>
<UsageCount Value="69"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/>
<EditorIndex Value="7"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="1250"/>
<CursorPos X="60" Y="1273"/>
<UsageCount Value="44"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="56"/>
<Loaded Value="True"/>
</Unit21>
<Unit22>
<Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/>
<EditorIndex Value="8"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="547"/>
<CursorPos X="1" Y="563"/>
<UsageCount Value="45"/>
<UsageCount Value="57"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
@ -322,7 +320,7 @@
<WindowIndex Value="0"/>
<TopLine Value="841"/>
<CursorPos X="19" Y="852"/>
<UsageCount Value="4"/>
<UsageCount Value="2"/>
</Unit23>
<Unit24>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/>
@ -330,7 +328,7 @@
<WindowIndex Value="0"/>
<TopLine Value="111"/>
<CursorPos X="3" Y="112"/>
<UsageCount Value="17"/>
<UsageCount Value="15"/>
</Unit24>
<Unit25>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/>
@ -338,14 +336,14 @@
<WindowIndex Value="0"/>
<TopLine Value="74"/>
<CursorPos X="3" Y="93"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit25>
<Unit26>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\lists.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="141"/>
<CursorPos X="3" Y="143"/>
<UsageCount Value="13"/>
<UsageCount Value="11"/>
</Unit26>
<Unit27>
<Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/>
@ -353,29 +351,29 @@
<WindowIndex Value="0"/>
<TopLine Value="114"/>
<CursorPos X="42" Y="152"/>
<UsageCount Value="13"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="d:\lazarus-svn\lcl\include\pen.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="272"/>
<CursorPos X="3" Y="286"/>
<UsageCount Value="13"/>
<TopLine Value="354"/>
<CursorPos X="1" Y="385"/>
<UsageCount Value="16"/>
</Unit28>
<Unit29>
<Filename Value="d:\lazarus-svn\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<WindowIndex Value="0"/>
<TopLine Value="1480"/>
<CursorPos X="15" Y="1498"/>
<UsageCount Value="12"/>
<TopLine Value="2222"/>
<CursorPos X="14" Y="2242"/>
<UsageCount Value="11"/>
</Unit29>
<Unit30>
<Filename Value="d:\lazarus-svn\lcl\include\control.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="4129"/>
<CursorPos X="1" Y="4161"/>
<UsageCount Value="12"/>
<UsageCount Value="10"/>
</Unit30>
<Unit31>
<Filename Value="..\..\fpspreadsheetchart.pas"/>
@ -383,7 +381,7 @@
<WindowIndex Value="0"/>
<TopLine Value="170"/>
<CursorPos X="37" Y="204"/>
<UsageCount Value="8"/>
<UsageCount Value="6"/>
</Unit31>
<Unit32>
<Filename Value="d:\lazarus-svn\components\lazutils\lazutf8.pas"/>
@ -391,7 +389,7 @@
<WindowIndex Value="0"/>
<TopLine Value="3180"/>
<CursorPos X="1" Y="3212"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit32>
<Unit33>
<Filename Value="d:\lazarus-svn\lcl\colorbox.pas"/>
@ -399,7 +397,7 @@
<WindowIndex Value="0"/>
<TopLine Value="13"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit33>
<Unit34>
<Filename Value="d:\lazarus-svn\lcl\dialogs.pp"/>
@ -407,7 +405,7 @@
<WindowIndex Value="0"/>
<TopLine Value="222"/>
<CursorPos X="3" Y="253"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit34>
<Unit35>
<Filename Value="d:\lazarus-svn\lcl\forms.pp"/>
@ -415,7 +413,7 @@
<WindowIndex Value="0"/>
<TopLine Value="932"/>
<CursorPos X="3" Y="939"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit35>
<Unit36>
<Filename Value="C:\development\lazarus\lcl\graphics.pp"/>
@ -423,7 +421,7 @@
<WindowIndex Value="0"/>
<TopLine Value="2053"/>
<CursorPos X="30" Y="1945"/>
<UsageCount Value="12"/>
<UsageCount Value="10"/>
</Unit36>
<Unit37>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpcanvas.pp"/>
@ -431,14 +429,14 @@
<WindowIndex Value="0"/>
<TopLine Value="89"/>
<CursorPos X="15" Y="97"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit37>
<Unit38>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpfont.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="54"/>
<CursorPos X="3" Y="57"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit38>
<Unit39>
<Filename Value="C:\development\lazarus\lcl\graphmath.pp"/>
@ -446,7 +444,7 @@
<WindowIndex Value="0"/>
<TopLine Value="584"/>
<CursorPos X="3" Y="439"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="C:\development\lazarus\lcl\graphtype.pp"/>
@ -454,7 +452,7 @@
<WindowIndex Value="0"/>
<TopLine Value="234"/>
<CursorPos X="3" Y="33"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit40>
<Unit41>
<Filename Value="C:\development\lazarus\lcl\lcltype.pp"/>
@ -462,7 +460,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1628"/>
<CursorPos X="3" Y="1643"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit41>
<Unit42>
<Filename Value="C:\development\lazarus\lcl\graphutil.pp"/>
@ -470,7 +468,7 @@
<WindowIndex Value="0"/>
<TopLine Value="128"/>
<CursorPos X="12" Y="143"/>
<UsageCount Value="11"/>
<UsageCount Value="9"/>
</Unit42>
<Unit43>
<Filename Value="C:\development\fpc\rtl\objpas\math.pp"/>
@ -478,14 +476,14 @@
<WindowIndex Value="0"/>
<TopLine Value="144"/>
<CursorPos X="10" Y="159"/>
<UsageCount Value="14"/>
<UsageCount Value="12"/>
</Unit43>
<Unit44>
<Filename Value="C:\development\fpc\rtl\i386\i386.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1551"/>
<CursorPos X="3" Y="1563"/>
<UsageCount Value="12"/>
<UsageCount Value="10"/>
</Unit44>
<Unit45>
<Filename Value="C:\development\lazarus\lcl\grids.pas"/>
@ -493,7 +491,7 @@
<WindowIndex Value="0"/>
<TopLine Value="794"/>
<CursorPos X="15" Y="1010"/>
<UsageCount Value="18"/>
<UsageCount Value="16"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\spktoolbar\SpkGraphTools\SpkGraphTools.pas"/>
@ -501,172 +499,154 @@
<WindowIndex Value="0"/>
<TopLine Value="136"/>
<CursorPos X="1" Y="143"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</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"/>
<UsageCount Value="15"/>
</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"/>
<UsageCount Value="15"/>
</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"/>
<UsageCount Value="15"/>
</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"/>
<UsageCount Value="9"/>
</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"/>
<UsageCount Value="9"/>
</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"/>
<UsageCount Value="9"/>
</Unit52>
<Unit53>
<Filename Value="d:\lazarus-svn\lcl\include\menuitem.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="69"/>
<CursorPos X="28" Y="82"/>
<UsageCount Value="15"/>
</Unit53>
<Unit54>
<Filename Value="d:\lazarus-svn\lcl\include\application.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1371"/>
<CursorPos X="1" Y="1390"/>
<UsageCount Value="14"/>
</Unit54>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="22" HistoryIndex="21">
<Position1>
<Filename Value="mainform.pas"/>
<Caret Line="456" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="701" Column="22" TopLine="694"/>
</Position1>
<Position2>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="5203" Column="1" TopLine="5184"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="701" Column="32" TopLine="681"/>
</Position2>
<Position3>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="5204" Column="1" TopLine="5184"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="704" Column="1" TopLine="693"/>
</Position3>
<Position4>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1370" Column="1" TopLine="1351"/>
<Caret Line="710" Column="1" TopLine="686"/>
</Position4>
<Position5>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1371" Column="1" TopLine="1351"/>
<Caret Line="748" Column="1" TopLine="715"/>
</Position5>
<Position6>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1372" Column="1" TopLine="1351"/>
<Caret Line="1709" Column="38" TopLine="1709"/>
</Position6>
<Position7>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1373" Column="1" TopLine="1351"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1374" Column="1" TopLine="1351"/>
<Caret Line="45" Column="49" TopLine="13"/>
</Position8>
<Position9>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1375" Column="1" TopLine="1351"/>
<Caret Line="1161" Column="41" TopLine="1135"/>
</Position9>
<Position10>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1380" Column="1" TopLine="1351"/>
<Caret Line="1164" Column="21" TopLine="1129"/>
</Position10>
<Position11>
<Filename Value="mainform.pas"/>
<Caret Line="457" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1146" Column="56" TopLine="1127"/>
</Position11>
<Position12>
<Filename Value="mainform.pas"/>
<Caret Line="458" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1149" Column="53" TopLine="1127"/>
</Position12>
<Position13>
<Filename Value="mainform.pas"/>
<Caret Line="459" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1158" Column="61" TopLine="1140"/>
</Position13>
<Position14>
<Filename Value="mainform.pas"/>
<Caret Line="458" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1727" Column="25" TopLine="1708"/>
</Position14>
<Position15>
<Filename Value="mainform.pas"/>
<Caret Line="459" Column="1" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="mainform.pas"/>
<Caret Line="460" Column="17" TopLine="431"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="45" Column="37" TopLine="13"/>
</Position16>
<Position17>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="5184" Column="33" TopLine="5184"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1137" Column="55" TopLine="1135"/>
</Position17>
<Position18>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1727" Column="22" TopLine="1708"/>
</Position18>
<Position19>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="310" Column="16" TopLine="278"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1755" Column="19" TopLine="1737"/>
</Position19>
<Position20>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1032" Column="25" TopLine="1002"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1154" Column="1" TopLine="1135"/>
</Position20>
<Position21>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1213" Column="33" TopLine="1181"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1142" Column="19" TopLine="1133"/>
</Position21>
<Position22>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1239" Column="25" TopLine="1208"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1929" Column="3" TopLine="1898"/>
</Position22>
<Position23>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1373" Column="85" TopLine="1343"/>
</Position23>
<Position24>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1480" Column="26" TopLine="1450"/>
</Position24>
<Position25>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="1699" Column="26" TopLine="1669"/>
</Position25>
<Position26>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="3692" Column="32" TopLine="3660"/>
</Position26>
<Position27>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="7048" Column="20" TopLine="7032"/>
</Position27>
<Position28>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<Caret Line="6948" Column="3" TopLine="6942"/>
</Position28>
<Position29>
<Filename Value="mainform.pas"/>
<Caret Line="377" Column="31" TopLine="377"/>
</Position29>
<Position30>
<Filename Value="mainform.pas"/>
<Caret Line="2" Column="37" TopLine="76"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -695,15 +675,6 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="1">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="mainform.pas"/>
<Line Value="456"/>
</Item1>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="acol"/>

1166
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

File diff suppressed because it is too large Load Diff

2644
components/fpspreadsheet/examples/fpsgrid/mainform.lrs
View File

File diff suppressed because it is too large Load Diff

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

@ -33,6 +33,16 @@ type
AcBorderBottomMedium: TAction;
AcBorderLeft: TAction;
AcBorderRight: TAction;
AcBorderNone: TAction;
AcBorderHCenter: TAction;
AcBorderVCenter: TAction;
AcBorderTopBottom: TAction;
AcBorderTopBottomThick: TAction;
AcBorderInner: TAction;
AcBorderAll: TAction;
AcBorderOuter: TAction;
AcBorderOuterMedium: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
AcVAlignTop: TAction;
AcVAlignCenter: TAction;
@ -49,12 +59,34 @@ type
Label2: TLabel;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem2: TMenuItem;
MenuItem20: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
MenuItem23: TMenuItem;
MenuItem24: TMenuItem;
MenuItem25: TMenuItem;
MenuItem26: TMenuItem;
MenuItem27: TMenuItem;
MenuItem28: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MnuWordwrap: TMenuItem;
MnuVertBottom: TMenuItem;
MnuVertCentered: TMenuItem;
MnuVertTop: TMenuItem;
@ -72,6 +104,7 @@ type
OpenDialog1: TOpenDialog;
PageControl1: TPageControl;
Panel1: TPanel;
BordersPopupMenu: TPopupMenu;
SaveDialog1: TSaveDialog;
EdFrozenCols: TSpinEdit;
sWorksheetGrid1: TsWorksheetGrid;
@ -90,12 +123,8 @@ type
ToolButton18: TToolButton;
ToolButton19: TToolButton;
ToolButton2: TToolButton;
TbBorders: TToolButton;
ToolButton20: TToolButton;
ToolButton21: TToolButton;
ToolButton22: TToolButton;
ToolButton23: TToolButton;
ToolButton24: TToolButton;
ToolButton25: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
@ -109,11 +138,12 @@ type
procedure AcFontStyleExecute(Sender: TObject);
procedure AcHorAlignmentExecute(Sender: TObject);
procedure AcVertAlignmentExecute(Sender: TObject);
procedure AcWordwrapExecute(Sender: TObject);
procedure CbShowHeadersClick(Sender: TObject);
procedure CbShowGridLinesClick(Sender: TObject);
procedure acOpenExecute(Sender: TObject);
procedure acQuitExecute(Sender: TObject);
procedure acSaveAsExecute(Sender: TObject);
procedure AcOpenExecute(Sender: TObject);
procedure AcQuitExecute(Sender: TObject);
procedure AcSaveAsExecute(Sender: TObject);
procedure EdFrozenColsChange(Sender: TObject);
procedure EdFrozenRowsChange(Sender: TObject);
procedure FontComboBoxSelect(Sender: TObject);
@ -124,10 +154,10 @@ type
private
{ private declarations }
procedure LoadFile(const AFileName: String);
procedure UpdateBorderActions(ACell: PCell);
procedure UpdateHorAlignmentActions;
procedure UpdateFontActions(AFont: TsFont);
procedure UpdateHorAlignmentActions;
procedure UpdateVertAlignmentActions;
procedure UpdateWordwraps;
public
{ public declarations }
end;
@ -144,6 +174,24 @@ const
HORALIGN_TAG = 100;
VERTALIGN_TAG = 110;
LEFT_BORDER_THIN = $0001;
LEFT_BORDER_THICK = $0002;
LR_INNER_BORDER_THIN = $0008;
RIGHT_BORDER_THIN = $0010;
RIGHT_BORDER_THICK = $0020;
TOP_BORDER_THIN = $0100;
TOP_BORDER_THICK = $0200;
TB_INNER_BORDER_THIN = $0800;
BOTTOM_BORDER_THIN = $1000;
BOTTOM_BORDER_THICK = $2000;
BOTTOM_BORDER_DOUBLE = $3000;
LEFT_BORDER_MASK = $0007;
RIGHT_BORDER_MASK = $0070;
TOP_BORDER_MASK = $0700;
BOTTOM_BORDER_MASK = $7000;
LR_INNER_BORDER = $0008;
TB_INNER_BORDER = $0800;
// Use a combination of these bits for the "Tag" of the Border actions.
{ TForm1 }
@ -156,28 +204,85 @@ begin
end;
procedure TForm1.AcBorderExecute(Sender: TObject);
const
LINESTYLES: Array[1..3] of TsLinestyle = (lsThin, lsMedium, lsDouble);
var
r,c: Cardinal;
borders: TsCellBorders;
lCell: PCell;
r,c: Integer;
ls: integer;
bs: TsCellBorderStyle;
begin
bs.Color := scBlack;
with sWorksheetGrid1 do begin
if Worksheet <> nil then begin
c := GetWorksheetCol(Col);
r := GetWorksheetRow(Row);
borders := [];
if AcBorderTop.Checked then borders := borders + [cbNorth];
if AcBorderLeft.Checked then borders := borders + [cbWest];
if AcBorderRight.Checked then borders := borders + [cbEast];
if AcBorderBottom.Checked or AcBorderBottomDbl.Checked or AcBorderBottomMedium.Checked then
borders := borders + [cbSouth];
Worksheet.WriteBorders(r, c, borders);
if AcBorderBottom.Checked then
Worksheet.WriteBorderLineStyle(r, c, cbSouth, lsThin);
if AcBorderBottomMedium.Checked then
Worksheet.WriteBorderLineStyle(r, c, cbSouth, lsMedium);
if AcBorderBottomDbl.Checked then
Worksheet.WriteBorderLineStyle(r, c, cbSouth, lsDouble);
TbBorders.Action := TAction(Sender);
BeginUpdate;
try
if TAction(Sender).Tag = 0 then begin
CellBorders[Selection] := [];
exit;
end;
// Top and bottom edges
for c := Selection.Left to Selection.Right do begin
ls := (TAction(Sender).Tag and TOP_BORDER_MASK) shr 8;
if (ls <> 0) then begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbNorth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Top, cbNorth] := bs;
end;
ls := (TAction(Sender).Tag and BOTTOM_BORDER_MASK) shr 12;
if ls <> 0 then begin
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbSouth];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[c, Selection.Bottom, cbSouth] := bs;
end;
end;
// Left and right edges
for r := Selection.Top to Selection.Bottom do begin
ls := (TAction(Sender).Tag and LEFT_BORDER_MASK);
if ls <> 0 then begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbWest];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Left, r, cbWest] := bs;
end;
ls := (TAction(Sender).Tag and RIGHT_BORDER_MASK) shr 4;
if ls <> 0 then begin
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbEast];
bs.LineStyle := LINESTYLES[ls];
CellBorderStyle[Selection.Right, r, cbEast] := bs;
end;
end;
// Inner edges along row (vertical border lines) - we assume only thin lines.
bs.LineStyle := lsThin;
if (TAction(Sender).Tag and LR_INNER_BORDER <> 0) and (Selection.Right > Selection.Left)
then
for r := Selection.Top to Selection.Bottom do begin
CellBorder[Selection.Left, r] := CellBorder[Selection.Left, r] + [cbEast];
CellBorderStyle[Selection.Left, r, cbEast] := bs;
for c := Selection.Left+1 to Selection.Right-1 do begin
CellBorder[c,r] := CellBorder[c, r] + [cbEast, cbWest];
CellBorderStyle[c, r, cbEast] := bs;
CellBorderStyle[c, r, cbWest] := bs;
end;
CellBorder[Selection.Right, r] := CellBorder[Selection.Right, r] + [cbWest];
CellBorderStyle[Selection.Right, r, cbWest] := bs;
end;
// Inner edges along column (horizontal border lines)
if (TAction(Sender).Tag and TB_INNER_BORDER <> 0) and (Selection.Bottom > Selection.Top)
then
for c := Selection.Left to Selection.Right do begin
CellBorder[c, Selection.Top] := CellBorder[c, Selection.Top] + [cbSouth];
CellBorderStyle[c, Selection.Top, cbSouth] := bs;
for r := Selection.Top+1 to Selection.Bottom-1 do begin
CellBorder[c, r] := CellBorder[c, r] + [cbNorth, cbSouth];
CellBorderStyle[c, r, cbNorth] := bs;
CellBorderStyle[c, r, cbSouth] := bs;
end;
CellBorder[c, Selection.Bottom] := CellBorder[c, Selection.Bottom] + [cbNorth];
CellBorderStyle[c, Selection.Bottom, cbNorth] := bs;
end;
finally
EndUpdate;
end;
end;
end;
@ -259,6 +364,11 @@ begin
UpdateVertAlignmentActions;
end;
procedure TForm1.AcWordwrapExecute(Sender: TObject);
begin
with sWorksheetGrid1 do Wordwraps[Selection] := TAction(Sender).Checked;
end;
procedure TForm1.CbShowHeadersClick(Sender: TObject);
begin
sWorksheetGrid1.ShowHeaders := CbShowHeaders.Checked;
@ -339,8 +449,29 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Adjust format toolbar height, looks strange at 120 dpi
FormatToolbar.Height := FontCombobox.Height + 2*FontCombobox.Top;
FormatToolbar.ButtonHeight := FormatToolbar.Height - 4;
// Populate font combobox
FontCombobox.Items.Assign(Screen.Fonts);
// Set the Tags of the Border actions
AcBorderNone.Tag := 0;
AcBorderLeft.Tag := LEFT_BORDER_THIN;
AcBorderHCenter.Tag := LR_INNER_BORDER_THIN;
AcBorderRight.Tag := RIGHT_BORDER_THIN;
AcBorderTop.Tag := TOP_BORDER_THIN;
AcBorderVCenter.Tag := TB_INNER_BORDER_THIN;
AcBorderBottom.Tag := BOTTOM_BORDER_THIN;
AcBorderBottomDbl.Tag := BOTTOM_BORDER_DOUBLE;
AcBorderBottomMedium.Tag := BOTTOM_BORDER_THICK;
AcBorderTopBottom.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderTopBottomThick.Tag := TOP_BORDER_THIN + BOTTOM_BORDER_THICK;
AcBorderInner.Tag := LR_INNER_BORDER_THIN + TB_INNER_BORDER_THIN;
AcBorderOuter.Tag := LEFT_BORDER_THIN + RIGHT_BORDER_THIN + TOP_BORDER_THIN + BOTTOM_BORDER_THIN;
AcBorderOuterMedium.Tag := LEFT_BORDER_THICK + RIGHT_BORDER_THICK + TOP_BORDER_THICK + BOTTOM_BORDER_THICK;
AcBorderAll.Tag := AcBorderOuter.Tag + AcBorderInner.Tag;
end;
procedure TForm1.LoadFile(const AFileName: String);
@ -399,26 +530,13 @@ begin
end;
UpdateHorAlignmentActions;
UpdateVertAlignmentActions;
UpdateBorderactions(cell);
UpdateWordwraps;
if cell = nil then
exit;
lFont := sWorksheetGrid1.Workbook.GetFont(cell^.FontIndex);
UpdateFontActions(lFont);
end;
procedure TForm1.UpdateBorderActions(ACell: PCell);
begin
AcBorderTop.Checked := (ACell <> nil) and (cbNorth in ACell^.Border);
AcBorderLeft.Checked := (ACell <> nil) and (cbWest in ACell^.Border);
AcBorderRight.Checked := (ACell <> nil) and (cbEast in ACell^.Border);
AcBorderBottom.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsThin);
AcBorderBottomDbl.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsDouble);
AcBorderBottomMedium.Checked := (ACell <> nil) and (cbSouth in ACell^.Border) and
(ACell^.BorderStyles[cbSouth].LineStyle = lsMedium);
end;
procedure TForm1.UpdateHorAlignmentActions;
var
i: Integer;
@ -459,6 +577,13 @@ begin
end;
end;
procedure TForm1.UpdateWordwraps;
var
wrapped: Boolean;
begin
with sWorksheetGrid1 do wrapped := Wordwraps[Selection];
AcWordwrap.Checked := wrapped;
end;
initialization
{$I mainform.lrs}

2
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -237,7 +237,7 @@ type
TsCellBorders = set of TsCellBorder;
{@@ Line style (for cell borders) }
TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair);
{@@ Cell border style }
TsCellBorderStyle = record

731
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -42,14 +42,23 @@ type
function CalcRowHeight(AHeight: Single): Integer;
procedure ChangedCellHandler(ASender: TObject; ARow, ACol: Cardinal);
procedure ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal);
procedure FixNeighborCellBorders(ACol, ARow: Integer);
function GetCellBorder(ACol, ARow: Integer): TsCellBorders;
function GetCellBorders(ARect: TGridRect): TsCellBorders;
function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder): TsCellBorderStyle;
function GetHorAlignment(ACol, ARow: Integer): TsHorAlignment;
function GetHorAlignments(ARect: TGridRect): TsHorAlignment;
function GetShowGridLines: Boolean;
function GetShowHeaders: Boolean;
function GetVertAlignment(ACol, ARow: Integer): TsVertAlignment;
function GetVertAlignments(ARect: TGridRect): TsVertAlignment;
function IsSelection(ACol, ARow: Integer; ABorder: TsCellBorder): Boolean;
function IsSelectionNeighbor(ACol, ARow: Integer; ABorder: TsCellBorder): Boolean;
function GetWordwrap(ACol, ARow: Integer): Boolean;
function GetWordwraps(ARect: TGridRect): Boolean;
procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders);
procedure SetCellBorders(ARect: TGridRect; AValue: TsCellBorders);
procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle);
procedure SetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder; AValue: TsCellBorderStyle);
procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenRows(AValue: Integer);
procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment);
@ -58,21 +67,25 @@ type
procedure SetShowHeaders(AValue: Boolean);
procedure SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment);
procedure SetVertAlignments(ARect: TGridRect; AValue: TsVertAlignment);
procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean);
procedure SetWordwraps(ARect: TGridRect; AValue: boolean);
protected
{ Protected declarations }
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override;
procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect);
procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
procedure DrawAllRows; override;
procedure DrawCellBorders; overload;
procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect); overload;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
procedure DrawSelectionBorders(ACol, ARow: Integer; ARect: TRect);
procedure DrawSelection;
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 GetCellText(ACol, ARow: Integer): String;
function GetEditText(ACol, ARow: Integer): String; override;
function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override;
@ -118,6 +131,14 @@ type
property HeaderCount: Integer read FHeaderCount;
{ maybe these should become published ... }
property CellBorder[ACol, ARow: Integer]: TsCellBorders
read GetCellBorder write SetCellBorder;
property CellBorders[ARect: TGridRect]: TsCellBorders
read GetCellBorders write SetCellBorders;
property CellBorderStyle[ACol, ARow: Integer; ABorder: TsCellBorder]: TsCellBorderStyle
read GetCellBorderStyle write SetCellBorderStyle;
property CellBorderStyles[ARect: TGridRect; ABorder: TsCellBorder]: TsCellBorderStyle
read GetCellBorderStyles write SetCellBorderStyles;
property HorAlignment[ACol, ARow: Integer]: TsHorAlignment
read GetHorAlignment write SetHorAlignment;
property HorAlignments[ARect: TGridRect]: TsHorAlignment
@ -126,6 +147,10 @@ type
read GetVertAlignment write SetVertAlignment;
property VertAlignments[ARect: TGridRect]: TsVertAlignment
read GetVertAlignments write SetVertAlignments;
property Wordwrap[ACol, ARow: Integer]: Boolean
read GetWordwrap write SetWordwrap;
property Wordwraps[ARect: TGridRect]: Boolean
read GetWordwraps write SetWordwraps;
end;
{ TsWorksheetGrid }
@ -257,6 +282,34 @@ begin
end;
end;
procedure DrawHairLineHor(ACanvas: TCanvas; x1, x2, y: Integer);
var
clr: TColor;
x: Integer;
begin
if odd(x1) then inc(x1);
x := x1;
clr := ACanvas.Pen.Color;
while (x <= x2) do begin
ACanvas.Pixels[x, y] := clr;
inc(x, 2);
end;
end;
procedure DrawHairLineVert(ACanvas: TCanvas; x, y1, y2: Integer);
var
clr: TColor;
y: Integer;
begin
if odd(y1) then inc(y1);
y := y1;
clr := ACanvas.Pen.Color;
while (y <= y2) do begin
ACanvas.Pixels[x, y] := clr;
inc(y, 2);
end;
end;
function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string;
// code posted by taazz in the Lazarus Forum:
// http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124743.html#msg124743
@ -366,9 +419,9 @@ begin
inc(FLockCount);
end;
// Converts the column width, given in "characters" of the default font, to pixels
// All chars are assumed to have the same width defined by the "0".
// Therefore, this calculation is only approximate.
{ Converts the column width, given in "characters" of the default font, to pixels
All chars are assumed to have the same width defined by the "0".
Therefore, this calculation is only approximate. }
function TsCustomWorksheetGrid.CalcColWidth(AWidth: Single): Integer;
var
w0: Integer;
@ -456,6 +509,8 @@ begin
end;
end;
{ Is overridden to show "frozen" cells in the same style as normal cells.
"Frozen" cells are internally "fixed" cells of the grid. }
procedure TsCustomWorksheetGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
AState: TGridDrawState);
var
@ -565,6 +620,59 @@ begin
inherited DoPrepareCanvas(ACol, ARow, AState);
end;
{ Is overridden in order to paint the cell borders and the selection rectangle.
Both features can extend into the neighbor cells and thus are clipped at the
cell borders by the standard painting mechanism. In DrawAllRows, clipping at
cell borders is no longer active. }
procedure TsCustomWorksheetGrid.DrawAllRows;
var
cliprect: TRect;
rgn: HRGN;
tmp: Integer;
begin
inherited;
Canvas.SaveHandleState;
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);
DrawCellBorders;
DrawSelection;
DeleteObject(rgn);
finally
Canvas.RestoreHandleState;
end;
end;
{ Draws the borders of all cells. }
procedure TsCustomWorksheetGrid.DrawCellBorders;
var
cell: PCell;
c, r: Integer;
rect: TRect;
begin
if FWorksheet = nil then exit;
cell := FWorksheet.GetFirstCell;
while cell <> nil do begin
if (uffBorder in cell^.UsedFormattingFields) then begin
c := cell^.Col + FHeaderCount;
r := cell^.Row + FHeaderCount;
rect := CellRect(c, r);
DrawCellBorders(c, r, rect);
end;
cell := FWorksheet.GetNextCell;
end;
end;
{ Draws the border lines around a given cell. Note that when this procedure is
called the output is clipped by the cell rectangle, but thick and double
border styles extend into the neighbor cell. Therefore, these border lines
@ -574,30 +682,61 @@ procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRec
procedure DrawBorderLine(ACoord: Integer; ARect: TRect; IsHor: Boolean;
ABorderStyle: TsCellBorderStyle);
const
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair);
PEN_STYLES: array[TsLineStyle] of TPenStyle =
(psSolid, psSolid, psDash, psDot, psSolid, psSolid);
{
PEN_PATTERNS: array[TsLineStyle] of TPenPattern =
($FFFFFFFF, $FFFFFFFF, $07070707, $AAAAAAAA, $FFFFFFFF, $FFFFFFFF); }
(psSolid, psSolid, psDash, psDot, psSolid, psSolid, psSolid);
PEN_WIDTHS: array[TsLineStyle] of Integer =
(1, 2, 1, 1, 3, 1, 1);
var
width3: Boolean; // line is 3 pixels wide
begin
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := 1;
Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle];
Canvas.Pen.Color := FWorkbook.GetPaletteColor(ABorderStyle.Color);
if IsHor then begin
if ABorderStyle.LineStyle <> lsDouble then
Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord);
if (ACoord = ARect.Top-1) and (ABorderStyle.LineStyle in [lsDouble, lsThick]) then
Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1);
if (ACoord = ARect.Bottom-1) and (ABorderStyle.LineStyle in [lsDouble, lsMedium, lsThick]) then
Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1);
end else begin
if ABorderStyle.LineStyle <> lsDouble then
Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
if (ACoord = ARect.Left-1) and (ABorderStyle.LineStyle in [lsDouble, lsThick]) then
Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom);
if (ACoord = ARect.Right-1) and (ABorderStyle.LineStyle in [lsDouble, lsMedium, lsThick]) then
Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom);
Canvas.Pen.EndCap := pecSquare;
width3 := (ABorderStyle.LineStyle in [lsThick, lsDouble]);
// Tuning the rectangle to avoid issues at the grid borders and to get nice corners
if (ABorderStyle.LineStyle in [lsMedium, lsThick, lsDouble]) then begin
if ACol = ColCount-1 then begin
if not IsHor and (ACoord = ARect.Right-1) and width3 then dec(ACoord);
dec(ARect.Right);
end;
if ARow = RowCount-1 then begin
if IsHor and (ACoord = ARect.Bottom-1) and width3 then dec(ACoord);
dec(ARect.Bottom);
end;
end;
if ABorderStyle.LineStyle in [lsMedium, lsThick] then begin
if IsHor then dec(ARect.Right, 1) else dec(ARect.Bottom, 1);
end;
// Painting
case ABorderStyle.LineStyle of
lsThin, lsMedium, lsThick, lsDotted, lsDashed:
if IsHor then
Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord)
else
Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
lsHair:
if IsHor then
DrawHairLineHor(Canvas, ARect.Left, ARect.Right, ACoord)
else
DrawHairLineVert(Canvas, ACoord, ARect.Top, ARect.Bottom);
lsDouble:
if IsHor then begin
Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1);
Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1);
Canvas.Pen.Color := Color;
Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord);
end else begin
Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom);
Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom);
Canvas.Pen.Color := Color;
Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
end;
end;
end;
@ -620,214 +759,38 @@ begin
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
with Canvas, ARect do begin
// fixed cells
if (gdFixed in aState) then begin
Dv := goFixedVertLine in Options;
Dh := goFixedHorzLine in Options;
Pen.Style := psSolid;
if GridLineWidth > 0 then
Pen.Width := 1
else
Pen.Width := 0;
if not Flat then begin
if TitleStyle = tsNative then
exit
else
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;
Pen.Color := cl3DDKShadow;
end else begin
Dv := (goVertLine in Options);
Dh := (goHorzLine in Options);
Pen.Style := GridLineStyle;
Pen.Color := GridLineColor;
Pen.Width := GridLineWidth;
end;
// non-fixed cells
if (GridLineWidth > 0) then begin
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;
{ Is responsible for painting of the focus rectangle. We don't want the red
dashed rectangle here, but the thick Excel-like rectangle. }
procedure TsCustomWorksheetGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin
// We don't want the red dashed focus rectangle here, but the thick Excel-like
// border line. Since this frame extends into neighboring cells painting of
// focus rect has been added to the DrawCellGrid method.
// Nothing do to
end;
{ 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);
{ Draws the selection rectangle, 3 pixels wide as in Excel. }
procedure TsCustomWorksheetGrid.DrawSelection;
var
P1, P2: TPoint;
selrect: 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;
// Cosmetics at the edges of the grid to avoid spurious rests
P1 := CellRect(Selection.Left, Selection.Top).TopLeft;
P2 := CellRect(Selection.Right, Selection.Bottom).BottomRight;
if Selection.Top > TopRow then dec(P1.Y) else inc(P1.Y);
if Selection.Left > LeftCol then dec(P1.X) else inc(P1.X);
if Selection.Right = ColCount-1 then dec(P2.X);
if Selection.Bottom = RowCount-1 then dec(P2.Y);
// Set up the canvas
Canvas.Pen.Style := psSolid;
Canvas.Pen.Width := 3;
Canvas.Pen.JoinStyle := pjsMiter;
if UseXORFeatures then begin
Canvas.Pen.Color := clWhite;
Canvas.Pen.Mode := pmXOR;
end else
Canvas.Pen.Color := clBlack;
Canvas.Brush.Style := bsClear;
// Paint
Canvas.Rectangle(P1.X, P1.Y, P2.X, P2.Y);
end;
{ Draws the cell text. Calls "GetCellText" to determine the text in the cell.
@ -852,7 +815,7 @@ var
i: Integer;
L: TStrings;
c, r: Integer;
wordwrap: Boolean;
wrapped: Boolean;
horAlign: TsHorAlignment;
vertAlign: TsVertAlignment;
lCell: PCell;
@ -890,7 +853,7 @@ begin
end;
end;
vertAlign := lCell^.VertAlignment;
wordwrap := (uffWordWrap in lCell^.UsedFormattingFields)
wrapped := (uffWordWrap in lCell^.UsedFormattingFields)
or (lCell^.TextRotation = rtStacked);
InflateRect(ARect, -constCellPadding, -constCellPadding);
@ -900,7 +863,7 @@ begin
then begin
// HORIZONAL TEXT DRAWING DIRECTION
ts := Canvas.TextStyle;
if wordwrap then begin
if wrapped then begin
ts.Wordbreak := true;
ts.SingleLine := false;
flags := DT_WORDBREAK and not DT_SINGLELINE;
@ -933,7 +896,7 @@ begin
try
txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left);
hline := Canvas.TextHeight('Tg');
if wordwrap then begin
if wrapped then begin
L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left);
flags := DT_WORDBREAK and not DT_SINGLELINE;
LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect,
@ -1045,6 +1008,43 @@ begin
if FLockCount = 0 then Invalidate;
end;
{ Copies the borders of a cell to its neighbors. This avoids the nightmare of
changing borders due to border conflicts of adjacent cells. }
procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACol, ARow: Integer);
procedure SetNeighborBorder(NewRow, NewCol: Integer;
ANewBorder: TsCellBorder; const ANewBorderStyle: TsCellBorderStyle;
AInclude: Boolean);
var
neighbor: PCell;
border: TsCellBorders;
begin
neighbor := FWorksheet.FindCell(NewRow, NewCol);
if neighbor <> nil then begin
border := neighbor^.Border;
if AInclude then begin
Include(border, ANewBorder);
FWorksheet.WriteBorderStyle(NewRow, NewCol, ANewBorder, ANewBorderStyle);
end else
Exclude(border, ANewBorder);
FWorksheet.WriteBorders(NewRow, NewCol, border);
end;
end;
var
cell: PCell;
begin
if FWorksheet = nil then exit;
cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (FWorksheet <> nil) and (cell <> nil) then
with cell^ do begin
SetNeighborBorder(Row, Col-1, cbEast, BorderStyles[cbWest], cbWest in Border);
SetNeighborBorder(Row, Col+1, cbWest, BorderStyles[cbEast], cbEast in Border);
SetNeighborBorder(Row-1, Col, cbSouth, BorderStyles[cbNorth], cbNorth in Border);
SetNeighborBorder(Row+1, Col, cbNorth, BorderStyles[cbSouth], cbSouth in Border);
end;
end;
{ The "colors" used by the spreadsheet are indexes into the workbook's color
palette. If the user wants to set a color to a particular rgb value this is
not possible in general. The method FindNearestPaletteIndex finds the bast
@ -1104,7 +1104,7 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor;
Result := sqr(H1-H2) + sqr(S1-S2) + sqr(L1-L2);
end;
(*
{
// will be activated when Lazarus 1.4 is available. (RgbToHLS bug in Laz < 1.3)
function ColorDistance(color1, color2: TColor): Integer;
@ -1116,7 +1116,8 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor;
ColorToHLS(color1, H1,L1,S1);
ColorToHLS(color2, H2,L2,S2);
result := sqr(Integer(H1)-H2) + sqr(Integer(L1)-L2) + sqr(Integer(S1)-S2);
end; *)
end;
}
var
i: Integer;
@ -1135,13 +1136,72 @@ begin
end;
end;
function TsCustomWorksheetGrid.GetCellBorder(ACol, ARow: Integer): TsCellBorders;
var
cell: PCell;
begin
Result := [];
if Assigned(FWorksheet) then begin
cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (cell <> nil) and (uffBorder in cell^.UsedFormattingFields) then
Result := cell^.Border;
end;
end;
function TsCustomWorksheetGrid.GetCellBorders(ARect: TGridRect): TsCellBorders;
var
c, r: Integer;
b: TsCellBorders;
begin
Result := GetCellBorder(ARect.Left, ARect.Top);
b := Result;
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do begin
Result := GetCellBorder(c, r);
if Result <> b then begin
Result := [];
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetCellBorderStyle(ACol, ARow: Integer;
ABorder: TsCellBorder): TsCellBorderStyle;
var
cell: PCell;
begin
Result := DEFAULT_BORDERSTYLES[ABorder];
if Assigned(FWorksheet) then begin
cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (cell <> nil) then
Result := cell^.BorderStyles[ABorder];
end;
end;
function TsCustomWorksheetGrid.GetCellBorderStyles(ARect: TGridRect;
ABorder: TsCellBorder): TsCellBorderStyle;
var
c, r: Integer;
bs: TsCellBorderStyle;
begin
Result := GetCellBorderStyle(ARect.Left, ARect.Top, ABorder);
bs := Result;
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do begin
Result := GetCellBorderStyle(c, r, ABorder);
if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then begin
Result := DEFAULT_BORDERSTYLES[ABorder];
exit;
end;
end;
end;
{ Returns the height (in pixels) of the cell at ACol/ARow (of the grid). }
function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer;
var
lCell: PCell;
s: String;
wordwrap: Boolean;
wrapped: Boolean;
txtR: TRect;
cellR: TRect;
flags: Cardinal;
@ -1158,10 +1218,10 @@ begin
if s = '' then
exit;
DoPrepareCanvas(ACol, ARow, []);
wordwrap := (uffWordWrap in lCell^.UsedFormattingFields)
wrapped := (uffWordWrap in lCell^.UsedFormattingFields)
or (lCell^.TextRotation = rtStacked);
// *** multi-line text ***
if wordwrap then begin
if wrapped then begin
// horizontal
if ( (uffTextRotation in lCell^.UsedFormattingFields) and
(lCell^.TextRotation in [trHorizontal, rtStacked]))
@ -1230,7 +1290,6 @@ begin
Result := '';
for i:=1 to Length(s) do
Result := Result + s[i] + LineEnding;
// Result := Result + s[Length(s)];
end;
end;
end;
@ -1379,6 +1438,35 @@ begin
end;
end;
function TsCustomWorksheetGrid.GetWordwrap(ACol, ARow: Integer): Boolean;
var
cell: PCell;
begin
Result := false;
if Assigned(FWorksheet) then begin
cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (cell <> nil) and (uffWordwrap in cell^.UsedFormattingFields) then
Result := true;
end;
end;
function TsCustomWorksheetGrid.GetWordwraps(ARect: TGridRect): Boolean;
var
c, r: Integer;
wrapped: Boolean;
begin
Result := GetWordwrap(ARect.Left, ARect.Top);
wrapped := Result;
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do begin
Result := GetWordwrap(c, r);
if Result <> wrapped then begin
Result := false;
exit;
end;
end;
end;
{ Calculates the index of the worksheet column that is displayed in the
given column of the grid. If the sheet headers are turned on, both numbers
differ by 1, otherwise they are equal. Saves an "if" in cases. }
@ -1395,6 +1483,13 @@ begin
Result := AGridRow - FHeaderCount;
end;
{ Returns if the cell has the given border }
function TsCustomWorksheetGrid.HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
begin
Result := (ACell <> nil) and (uffBorder in ACell^.UsedFormattingfields) and
(ABorder in ACell^.Border);
end;
{ Column width or row heights have changed. Stores the new number in the
worksheet. }
procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer);
@ -1419,49 +1514,6 @@ begin
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 }
procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
begin
@ -1481,8 +1533,9 @@ end;
selection border. }
procedure TsCustomWorksheetGrid.MoveSelection;
begin
//Refresh;
inherited;
Refresh;
Inherited;
end;
{ Is called when editing starts. Stores the old text just for the case that
@ -1493,6 +1546,77 @@ begin
inherited;
end;
procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer;
AValue: TsCellBorders);
var
c, r: Cardinal;
begin
if Assigned(FWorkbook) then begin
BeginUpdate;
try
c := GetWorksheetCol(ACol);
r := GetWorksheetRow(ARow);
FWorksheet.WriteBorders(r, c, AValue);
FixNeighborCellBorders(ACol, ARow);
finally
EndUpdate;
end;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorders(ARect: TGridRect;
AValue: TsCellBorders);
var
c,r: Integer;
begin
BeginUpdate;
try
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do
SetCellBorder(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorderStyle(ACol, ARow: Integer;
ABorder: TsCellBorder; AValue: TsCellBorderStyle);
begin
if Assigned(FWorkbook) then begin
BeginUpdate;
try
FWorksheet.WriteBorderStyle(GetWorksheetRow(ARow), GetWorksheetCol(ACol), ABorder, AValue);
FixNeighborCellBorders(ACol, ARow);
finally
EndUpdate;
end;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorderStyles(ARect: TGridRect;
ABorder: TsCellBorder; AValue: TsCellBorderStyle);
var
c,r: Integer;
begin
BeginUpdate;
try
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do
SetCellBorderStyle(c, r, ABorder, AValue);
finally
EndUpdate;
end;
end;
{ 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. }
procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string);
begin
FEditText := AValue;
FEditing := true;
inherited SetEditText(aCol, aRow, aValue);
end;
procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer);
begin
FFrozenCols := AValue;
@ -1530,7 +1654,9 @@ end;
{ Shows / hides the worksheet's grid lines }
procedure TsCustomWorksheetGrid.SetShowGridLines(AValue: Boolean);
begin
if AValue = GetShowGridLines then Exit;
if AValue = GetShowGridLines then
Exit;
if AValue then
Options := Options + [goHorzLine, goVertLine]
else
@ -1545,15 +1671,6 @@ begin
Setup;
end;
{ 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. }
procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string);
begin
FEditText := AValue;
FEditing := true;
inherited SetEditText(aCol, aRow, aValue);
end;
procedure TsCustomWorksheetGrid.Setup;
var
i: Integer;
@ -1624,6 +1741,28 @@ begin
end;
end;
procedure TsCustomWorksheetGrid.SetWordwrap(ACol, ARow: Integer;
AValue: Boolean);
begin
if Assigned(FWorkbook) then
FWorksheet.WriteWordwrap(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
end;
procedure TsCustomWorksheetGrid.SetWordwraps(ARect: TGridRect;
AValue: Boolean);
var
c,r: Integer;
begin
BeginUpdate;
try
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do
SetWordwrap(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.LoadFromWorksheet(AWorksheet: TsWorksheet);
begin
FWorksheet := AWorksheet;
@ -1639,6 +1778,8 @@ begin
FrozenCols := 0;
FrozenRows := 0;
end;
Row := FrozenRows;
Col := FrozenCols;
end;
Setup;
end;

4
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1910,8 +1910,8 @@ procedure TsSpreadBIFF8Reader.ReadXF(const AStream: TStream);
{ Not all line styles defined in BIFF8 are supported by fpspreadsheet. }
begin
case dw of
$01..$06: result := TsLineStyle(dw-1);
$07: Result := lsDotted;
$01..$07: result := TsLineStyle(dw-1);
// $07: Result := lsDotted;
else Result := lsDashed;
end;
end;