diff --git a/components/kcontrols/help/KControls.chm b/components/kcontrols/help/KControls.chm new file mode 100755 index 000000000..99182e40c Binary files /dev/null and b/components/kcontrols/help/KControls.chm differ diff --git a/components/kcontrols/help/kgrid_manual.pdf b/components/kcontrols/help/kgrid_manual.pdf new file mode 100755 index 000000000..a1b7ce224 Binary files /dev/null and b/components/kcontrols/help/kgrid_manual.pdf differ diff --git a/components/kcontrols/kcontrols_readme.txt b/components/kcontrols/kcontrols_readme.txt new file mode 100755 index 000000000..bce2c7059 --- /dev/null +++ b/components/kcontrols/kcontrols_readme.txt @@ -0,0 +1,43 @@ +Software: KControls component suite for Delphi and Lazarus +Original authorship: Tomas Krysl (tk@tkweb.eu) +------------------- + + +LICENSE: +------------------- +License information for each source file can be found in it's header. +If there is none, the code is public domain. + + +SYSTEM REQUIREMENTS: +------------------- +- platforms: Win32(98(SE)+), Win64(untested), GTK, GTK2, QT, Carbon(untested), WinCE(partially tested) +- works under Delphi 7 and higher (tested on Delphi 7, Delphi2007 till Delphi 2010) + and Lazarus 0.9.29(SVN#21827) and higher +- should work under Delphi 6 +- some more problems might be experienced for older Lazarus versions +- see other readme files for additional informations about individual components + + +INSTALLATION: +------------------- +1. Compile and install package (it might be needed to specify some search paths in Delphi). +2. When compiling an application or demo, it might be needed to specify the search path to KControls sources + or JCL sources (if JCL is configured via kcontrols.inc). + + +PLANNED: +------------------- +- TKMemo - native Unicode enabled controls with rich text editing capabilities + + +TECHNICAL SUPPORT: +------------------- +Any suggestions, error reports and questions about this software please send to +the author or discuss on http://www.tkweb.eu. + + +VERSION HISTORY: +------------------- +Version 1.0 (October 2009): + Initial release - based on KGrid 1.5, KHexEditor 1.4, KIcon 1.8 \ No newline at end of file diff --git a/components/kcontrols/kgrid_readme.txt b/components/kcontrols/kgrid_readme.txt new file mode 100755 index 000000000..2e6f787e4 --- /dev/null +++ b/components/kcontrols/kgrid_readme.txt @@ -0,0 +1,192 @@ +Software: KGrid component for Delphi and Lazarus +Original authorship: Tomas Krysl (tk@tkweb.eu) +------------------- + + +LICENSE: +------------------- +License information for each source file can be found in it's header. +If there is none, the code is public domain. + + +SYSTEM REQUIREMENTS: +------------------- +- platforms: Win32(98(SE)+), Win64(untested), GTK, GTK2, QT, Carbon(untested), WinCE(untested) +- works under Delphi 7 and higher (tested on Delphi 7, Delphi2007 till Delphi 2010) + and Lazarus 0.9.29(SVN#21827) and higher +- should work under Delphi 6 +- some more problems might be experienced for older Lazarus versions + + +INSTALLATION: +------------------- +1. Compile and install package (it might be needed to specify some search paths in Delphi). +2. Put the TKGrid component into your application instead of TStringGrid or TDrawGrid. +3. When compiling an application, it might be needed to specify the search path to KGrid sources + or JCL sources (if JCL is configured). + +PLANNED: +------------------- +- filters (still a TODO, partially can be implemented now via editable fixed rows) +- multiple disjunct selections (like Excel, still a TODO) +- tree columns + +KNOWN PROBLEMS: +------------------- +Delphi common: + -none, best performance + +Lazarus common: + -KDBGrid demo does not draw unicode fields correctly for certain databases. + applies for all data aware controls, not just TKDBgrid + must be FPC/TWideStringField bug + -printing/Previewing works correctly in Win32 and Qt (for Lazarus versions with my implementation + of affine transformations for device contexts). For GTKx printing via TPostScriptPrinterCanvas, + there is no way to effectively implement affine transformations because this canvas is not implemented + via a device context mechanism. + +Target specific: +Win32: + Delphi: + -none + -tested on Windows 98SE (some time ago), Windows XP 32bit, Windows Vista 32bit + Lazarus: + -transparent editor underpainting incorrect if TKGrid is placed onto TPageControl (LCL problem) + -tested on Windows XP 32bit +Win64: none + -untested, help appreciated! +WinCE: + -slow inplace editor performance (depending on device) + -tested partially, help appreciated! +GTK: + -bad check box painting, bad selected range color, drag window flickers, sometimes infinite painting, + sometimes clipping problems (all LCL/GTK problems) + -tested on Ubuntu Jaunty +GTK2: + -slightly slow inplace editor performance with huge grids (GTK2 problem) + -scrollbar arrows don't work correctly sometimes (GTK2 problem) + -tested on Ubuntu Jaunty +QT: + -slightly slow inplace editor performance with huge grids + -checkbox not transparent (cannot be solved) + -scrollbar arrows behave differently (cannot be solved) + -tested on QT4.5.2/Windows XP +Carbon: + -none + -untested, help appreciated! + + +TECHNICAL SUPPORT: +------------------- +Any suggestions, error reports and questions about this software please send to +the author or discuss on http://www.tkweb.eu. + + +CONTRIBUTORS: +------------------- +Gianluca Culot: idea for TKCustomGrid.OnChanged event +JR: some useful functions and ideas +aki: selectable fixed cells + + +VERSION HISTORY +------------------- +Version 1.7 (November 2010): + Added: + -Windows Vista/7 style selection, + -selectable and editable fixed cells (modified contibutions by aki) + -packages for Delphi XE + Modified: + -removed some obsolete methods, several bugfixes + +Version 1.6 (October 2010): + Added: + -column/row/grid autosizing, + -automatic data type recognition and images in TKDBGrid, + -improvements in TKGridCellPainter (images, button shapes etc.), + -cell hints + -OnMouseDblClickCell event + -new features based on contributions by JR (OptionsEx property) + -PaintCell method + Modified: + -several bugfixes + +Version 1.5 (October 2009): + Added: + -printing/previewing/on the fly previewing (TKPrintPreview, TKPrintPageSetup classes etc.), + in Lazarus works only for Win32(suppose Win64 too) widget set + -OnMouseClickCell and OnMouseLeaveCell, OnMouseClickCell events + Modified: + -painting and inplace editor performance for GTK2, QT yet slightly improved + +Version 1.4 (October 2009): + Added: + -full Lazarus support (all official or beta state widget sets, tested on Win32/Win64, GTK, GTK2, QT) + -cell merging and splitting (CellSpan property & TKGridCell ColSpan and RowSpan properties) + -data aware control (TKDBGrid class) + -column/row individual maximum and minimum extent (TKGridAxisItem MinExtent & MaxExtent properties) + -smooth scrolling (ScrollModeHorz & ScrollModeVert properties) + -OnMouseEnterCell and OnMouseLeaveCell events + -KDBGrid demo for Delphi/Lazarus + Modified: + -HotFix 3.10: painting performance optimized for GTK2 + -major modifications due to platform independency in Lazarus + -some generous functions moved from KGrids.pas to KGraphics.pas or KFunctions.pas + -(very) few incompatibilities with previous versions + -KGrid demo extended + -no more InnoSetup installation but generous zip package due to platform independency + -lower case introduced for unit names etc. due to platform independency + -documentation completed + +Version 1.3 (August 2009): + Added: + -ported to Lazarus (Windows widgetset only) + -TKCustomGrid.ThroughClick property (clicking a cell will click the inplace editor as well) + -TKGridTextAttributes - text attributes (multiline text, end ellipsis, path ellipsis, word break) + -keyboard behavior extended + Modified: + -JCL not needed anymore (mainly because of the Lazarus support) + -inplace editor rendering + -documentation + +Version 1.3 beta (July 2009): + Added: + -TKGridAxisItem.Visible property + -optional visual indication of hidden columns or rows + -goIndicateHiddenCells style in TKCustomGrid.Options + -goMouseCanHideCells style in TKCustomGrid.Options + -goHeaderAlignment style in TKCustomGrid.Options + -TKCustomGrid.SortStyle property + -TKCustomGrid.UpdateSortMode method + Modified: + -moving columns/rows via OnExchangeCols/OnExchangeRows (both normal and virtual mode) + -inplace editor rendering + -documentation + +Version 1.2 (October 2008): + Added: + -OnChanged event handler + Modified: + -update to Delphi 2009 + -painting of the themed header cells fixed + -painting of some inplace editors fixed (e.g. TRichEdit) + +Version 1.1 (April 2008): + Added: + -sorting interface + -cell clipping and double buffering + -TKGridCellPainter class, + -improved compatibility with TStringGrid + -another small improvements and fixes + Modified: + -demo has been extended + -documentation + +Version 1.0 (January 2008): + Added: + -index mapping + -small demo, + -documentation + -many other improvements and bug fixes + +Version 0.9 (July 2007): Initial release \ No newline at end of file diff --git a/components/kcontrols/khexeditor_readme.txt b/components/kcontrols/khexeditor_readme.txt new file mode 100755 index 000000000..f5464a529 --- /dev/null +++ b/components/kcontrols/khexeditor_readme.txt @@ -0,0 +1,92 @@ +Software: KhexEditor component for Delphi and Lazarus +Original authorship: Tomas Krysl (tk@tkweb.eu) +------------------- + + +LICENSE: +------------------- +License information for each source file can be found in it's header. +If there is none, the code is public domain. + + +SYSTEM REQUIREMENTS: +------------------- +- platforms: Win32(98(SE)+), Win64(untested), GTK, GTK2, QT, Carbon(untested), WinCE(untested) +- works under Delphi 7 and higher (tested on Delphi 7, Delphi2007 till Delphi 2010) + and Lazarus 0.9.29(SVN#21827) and higher +- should work under Delphi 6 +- some more problems might be experienced for older Lazarus versions + + +INSTALLATION: +------------------- +1. Compile and install package (it might be needed to specify some search paths in Delphi). +2. When compiling an application or demo, it might be needed to specify the search path to KHexEditor sources. + + +PLANNED: +------------------- +- improve performance for non-Win32 widget sets in Lazarus +- byte swaps (Little and Big Endian) +- considering: visual control of modified text + + +KNOWN PROBLEMS: +------------------- +Delphi common: + -none, best performance + +Lazarus common: + -slow performance on non-Win32 widget sets + + +TECHNICAL SUPPORT: +------------------- +Any suggestions, error reports and questions about this software please send to +the author or discuss on http://www.tkweb.eu. + + +VERSION HISTORY: +------------------- +Version 1.5 (November 2010) + Added: + -Append method to append data at a position + Modified: + -packages for Delphi XE + +Version 1.4 (October 2009) + Modified: + -printing and previewing to comply with kcontrols.pas + -update to Delphi 2010 + -port to Lazarus + +Version 1.3 (October 2008) + Modified: + -update to Delphi 2009 + +Version 1.22 (January 2008) + Modified: + -packages included for newer Delphi + +Version 1.21 (June 2006) + Modified: + -bugs fixed when no printer installed + +Version 1.2 (June 2006): + Added: + -runtime package + -UpdateCharMetrics method + -keyboard features into TKHexEditorPrintPreview + Modified: + -UpdateScrollRange modified to avoid + design-time exceptions in the IDE + -minor bugfixes + +Version 1.1 (May 2006): + Added: + -print preview - new component (KHexEditorPreview.pas) + -PaintTo method to paint the outline to another canvas + Modified: + -little modifications + +Version 1.0 (April 2006): Initial release \ No newline at end of file diff --git a/components/kcontrols/kicon_readme.txt b/components/kcontrols/kicon_readme.txt new file mode 100755 index 000000000..e1c47c2b4 --- /dev/null +++ b/components/kcontrols/kicon_readme.txt @@ -0,0 +1,135 @@ +Software: TKIcon component for Delphi +Original authorship: Tomas Krysl (tk@tkweb.eu) +------------------- + + +LICENSE: +------------------- +License information for each source file can be found in it's header. +If there is none, the code is public domain. + + +SYSTEM REQUIREMENTS: +------------------- +- Microsoft Windows 98(SE)/ME/2000/XP/VI +- should work under Delphi 6 and higher (tested on Delphi 7, Delphi2007 and Delphi 2009) and Lazarus 0.9.26 and higher (Win32 only) + + +INSTALLATION: +------------------- +1. In your project or when compiling the demo, specify search path to + Source\KIcon.pas under Project/Options/Directories. + + +KNOWN PROBLEMS: +------------------- +CopyToBitmap does not work good in Delphi for 32 bpp images with alpha channel and in some versions of Lazarus. +Reason is errorneous TBitmap implementation. + +I expect problems with the LoadFromAssoc... methods, although I’ve tested the methods heavily. + +I have implemented these through the direct access to the registry, because other approach +(Shell) frustrated me. + + +PLANNED: +------------------- + + +TECHNICAL SUPPORT: +------------------- +Any suggestions, error reports and questions about this software please send to +the author or discuss on http://www.tkweb.eu. + +CONTRIBUTORS: +------------------- +Goran Despalatovic: fixed many bugs + + +VERSION HISTORY: +------------------- +Version 2.2 (November 2010) + Modified: + -compilation for KControls 1.2 + +Version 2.1 (April 2010): + Modified: + -CopyToAlphaBitmap fixed, BlendLine function fixed + Added: + -CopyToAlphaBitmap demo + +Version 2.0 (November 2009): + Modified: + -CopyToBitmap to be suitable for Glyph properties + Added: + -bugfixes (made by me or Goran Despalatovic) + +Version 1.9 (October 2009): + Added: + -minor fixes + +Version 1.8 (August 2009): + Added: + -ported to Lazarus + -full PNG support (read, write, display) optional. Under Delphi PngImage control is needed up to Delphi 2007. + Modified: + -JCL not needed anymore (mainly because of the Lazarus support) + +Version 1.7 (October 2008): + Added: + -TIconDrawStyle.idsAlphaChannel for displaying the alpha channel (32 bit icon images) as grayscale image + -PNG icon read/write support (contributed by maro) + Modified: + -update to Delphi 2009 + +Version 1.6 (July 2006): + Added: + -DisplayHorz property + -install package + -exe demo + Modified: + -fixed bug in LoadHandles method (color table copying) + -MaxWidth and MaxHeight property behavior + -documentation (put into source code for automated *.chm generation) + Deleted: + -TotalWidth property (had never significant meaning) + +Version 1.5 (July 2005): + Added: + -support for static cursors + +Version 1.41 (April 2005): + Modified: + -minor bugfixes (icon rendering, module loading) + +Version 1.4 (April 2005): + Added: + -icon can be stretched when drawn from now + -IconDrawStyle property (normal, mask only and no mask rendering) + -MaskFromColor method + Modified: + -icon rendering bug under W9x fixed (MaskBlt function removed) + -exception handling + +Version 1.3 (March 2005): + Added: + -icon image manipulation functions + -several LoadFrom... methods (loading from file associations, resource identification by ID) + Modified: + -minor bugfixes + +Version 1.2 (March 2005) + Added: + -several LoadFrom... methods, + -documentation + Modified: + -bug in the Assign method fixed + +Version 1.1 (February 2005): + Added: + -OverSizeWeight property + Modified: + -minor bugfixes + -fatal bugs in LoadFromResource fixed + +Version 1.0 (February 2005): Initial release diff --git a/components/kcontrols/source/kcontrols.inc b/components/kcontrols/source/kcontrols.inc new file mode 100755 index 000000000..b45acb9cd --- /dev/null +++ b/components/kcontrols/source/kcontrols.inc @@ -0,0 +1,285 @@ +{ This file contains compiler distinctions and conditional defines for all + source files in the KControls Development Suite. It has been created from + several similar resources available. } + +{$IFNDEF KCONTROLS_INC} + {$DEFINE KCONTROLS_INC} + +{ Default compiler directives for entire KControls Development Suite } + +{$IFDEF FPC} + {$MODE DELPHI} + {$B-,H+,J+,Q-,R-,T-,X+} +{$ELSE} + {$B-,H+,J+,Q-,R-,T-,X+} +{$ENDIF} + +{ Specifies if native operating system theme support should be used (Themes.pas is needed) } + +{$DEFINE USE_THEMES} + +{ COMPILERx, DELPHIx and BCBx directives from VERx } + +{$IFDEF VER220} + {$DEFINE COMPILER14} + {$IFDEF BCB} + {$DEFINE BCBXE} + {$ELSE} + {$DEFINE DELPHIXE} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER210} + {$DEFINE COMPILER13} + {$IFDEF BCB} + {$DEFINE BCB2010} + {$ELSE} + {$DEFINE DELPHI2010} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER200} + {$DEFINE COMPILER12} + {$IFDEF BCB} + {$DEFINE BCB2009} + {$ELSE} + {$DEFINE DELPHI2009} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER180} + {$IFDEF VER185} + {$DEFINE COMPILER11} + {$IFDEF BCB} + {$DEFINE BCB2007} + {$ELSE} + {$DEFINE DELPHI2007} + {$ENDIF} + {$ELSE} + {$DEFINE COMPILER10} + {$IFDEF BCB} + {$DEFINE BCB2006} + {$ELSE} + {$DEFINE DELPHI2006} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER170} + {$DEFINE COMPILER9} + {$DEFINE DELPHI2005} +{$ENDIF} + +{$IFDEF VER160} + {$DEFINE COMPILER8} + {$DEFINE DELPHI8} +{$ENDIF} + +{$IFDEF VER150} + {$DEFINE COMPILER7} + {$DEFINE DELPHI7} +{$ENDIF} + +{$IFDEF VER140} + {$DEFINE COMPILER6} + {$IFDEF BCB} + {$DEFINE BCB6} + {$ELSE} + {$DEFINE DELPHI6} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER130} + {$DEFINE COMPILER5} + {$IFDEF BCB} + {$DEFINE BCB5} + {$ELSE} + {$DEFINE DELPHI5} + {$ENDIF} +{$ENDIF} + +{$IFDEF VER125} + {$DEFINE COMPILER4} + {$DEFINE BCB} + {$DEFINE BCB4} +{$ENDIF} + +{$IFDEF VER120} + {$DEFINE COMPILER4} + {$DEFINE DELPHI4} +{$ENDIF} + +{$IFDEF VER110} + {$DEFINE COMPILER3} + {$DEFINE BCB} + {$DEFINE BCB3} +{$ENDIF} + +{$IFDEF VER100} + {$DEFINE COMPILER3} + {$DEFINE DELPHI3} +{$ENDIF} + +{$IFDEF VER93} + {$DEFINE COMPILER2} + {$DEFINE BCB} + {$DEFINE BCB1} +{$ENDIF} + +{$IFDEF VER90} + {$DEFINE COMPILER2} + {$DEFINE DELPHI2} +{$ENDIF} + +{ What is used: DELPHI or BCB ? (BCB is defined by C++Builder 5 and later) } + +{$IFNDEF BCB} + {$DEFINE DELPHI} +{$ENDIF} + +{ COMPILERx_UP directives from COMPILERx } + +{$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} +{$IFDEF COMPILER13} {$DEFINE COMPILER13_UP} {$ENDIF} +{$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} +{$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} +{$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} +{$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} +{$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} +{$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} +{$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} +{$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} +{$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} +{$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} +{$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} + +{$IFDEF COMPILER14_UP} {$DEFINE COMPILER13_UP} {$ENDIF} +{$IFDEF COMPILER13_UP} {$DEFINE COMPILER12_UP} {$ENDIF} +{$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} +{$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} +{$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} +{$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} +{$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} +{$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} +{$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} +{$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} +{$IFDEF COMPILER4_UP} {$DEFINE COMPILER3_UP} {$ENDIF} +{$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} +{$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} + +{ DELPHIx_UP directives from DELPHIx } + +{$IFDEF DELPHIXE} {$DEFINE DELPHIXE_UP} {$ENDIF} +{$IFDEF DELPHI2010} {$DEFINE DELPHI2010_UP} {$ENDIF} +{$IFDEF DELPHI2009} {$DEFINE DELPHI2009_UP} {$ENDIF} +{$IFDEF DELPHI2007} {$DEFINE DELPHI2007_UP} {$ENDIF} +{$IFDEF DELPHI2006} {$DEFINE DELPHI2006_UP} {$ENDIF} +{$IFDEF DELPHI2005} {$DEFINE DELPHI2005_UP} {$ENDIF} +{$IFDEF DELPHI8} {$DEFINE DELPHI8_UP} {$ENDIF} +{$IFDEF DELPHI7} {$DEFINE DELPHI7_UP} {$ENDIF} +{$IFDEF DELPHI6} {$DEFINE DELPHI6_UP} {$ENDIF} +{$IFDEF DELPHI5} {$DEFINE DELPHI5_UP} {$ENDIF} +{$IFDEF DELPHI4} {$DEFINE DELPHI4_UP} {$ENDIF} +{$IFDEF DELPHI3} {$DEFINE DELPHI3_UP} {$ENDIF} +{$IFDEF DELPHI2} {$DEFINE DELPHI2_UP} {$ENDIF} + +{$IFDEF DELPHIXE_UP} {$DEFINE DELPHI2010_UP} {$ENDIF} +{$IFDEF DELPHI2010_UP} {$DEFINE DELPHI2009_UP} {$ENDIF} +{$IFDEF DELPHI2009_UP} {$DEFINE DELPHI2007_UP} {$ENDIF} +{$IFDEF DELPHI2007_UP} {$DEFINE DELPHI2006_UP} {$ENDIF} +{$IFDEF DELPHI2006_UP} {$DEFINE DELPHI2005_UP} {$ENDIF} +{$IFDEF DELPHI2005_UP} {$DEFINE DELPHI8_UP} {$ENDIF} +{$IFDEF DELPHI8_UP} {$DEFINE DELPHI7_UP} {$ENDIF} +{$IFDEF DELPHI7_UP} {$DEFINE DELPHI6_UP} {$ENDIF} +{$IFDEF DELPHI6_UP} {$DEFINE DELPHI5_UP} {$ENDIF} +{$IFDEF DELPHI5_UP} {$DEFINE DELPHI4_UP} {$ENDIF} +{$IFDEF DELPHI4_UP} {$DEFINE DELPHI3_UP} {$ENDIF} +{$IFDEF DELPHI3_UP} {$DEFINE DELPHI2_UP} {$ENDIF} +{$IFDEF DELPHI2_UP} {$DEFINE DELPHI1_UP} {$ENDIF} + +{ BCBx_UP directives from BCBx } + +{$IFDEF BCBXE} {$DEFINE BCBXE_UP} {$ENDIF} +{$IFDEF BCB2010} {$DEFINE BCB2010_UP} {$ENDIF} +{$IFDEF BCB2009} {$DEFINE BCB2009_UP} {$ENDIF} +{$IFDEF BCB2007} {$DEFINE BCB2007_UP} {$ENDIF} +{$IFDEF BCB2006} {$DEFINE BCB2006_UP} {$ENDIF} +{$IFDEF BCB6} {$DEFINE BCB6_UP} {$ENDIF} +{$IFDEF BCB5} {$DEFINE BCB5_UP} {$ENDIF} +{$IFDEF BCB4} {$DEFINE BCB4_UP} {$ENDIF} +{$IFDEF BCB3} {$DEFINE BCB3_UP} {$ENDIF} +{$IFDEF BCB1} {$DEFINE BCB1_UP} {$ENDIF} + +{$IFDEF BCBXE_UP} {$DEFINE BCB2010_UP} {$ENDIF} +{$IFDEF BCB2010_UP} {$DEFINE BCB2009_UP} {$ENDIF} +{$IFDEF BCB2009_UP} {$DEFINE BCB2007_UP} {$ENDIF} +{$IFDEF BCB2007_UP} {$DEFINE BCB2006_UP} {$ENDIF} +{$IFDEF BCB2006_UP} {$DEFINE BCB6_UP} {$ENDIF} +{$IFDEF BCB6_UP} {$DEFINE BCB5_UP} {$ENDIF} +{$IFDEF BCB5_UP} {$DEFINE BCB4_UP} {$ENDIF} +{$IFDEF BCB4_UP} {$DEFINE BCB3_UP} {$ENDIF} +{$IFDEF BCB3_UP} {$DEFINE BCB1_UP} {$ENDIF} + +{ Unicode compiler directive for string type } +// Delphi 2009+ uses UTF16, Lazarus 0.9.25+ uses UTF8 +{$IF DEFINED(COMPILER12_UP) OR DEFINED(FPC)} + {$DEFINE STRING_IS_UNICODE} +{$IFEND} + +{ Prefers usage of TCanvas methods instead of WinAPI mainly to avoid Lazarus bugs. } +{$DEFINE USE_CANVAS_METHODS} + +{ Allows to use WinAPI functions in Lazarus and Delphi } +{$IF NOT DEFINED(FPC) OR DEFINED(LCLWin32)} + {$DEFINE USE_WINAPI} +{$IFEND} + +{ Allows to use WideWinProcs unit } +{$IFDEF USE_WINAPI} + {.$DEFINE USE_WIDEWINPROCS} +{$ENDIF} + +{$DEFINE LAZARUS_HAS_DC_MAPPING} + +{$IF DEFINED(USE_WINAPI) OR DEFINED(LAZARUS_HAS_DC_MAPPING)} + {$DEFINE USE_DC_MAPPING} +{$IFEND} + +{ Conditional defines for unit KGrids: } +// we want TKGridObjectCell to be a descendant of TKGridAttrTextCell +{$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDATTRTEXTCELL} + +// we want TKGridObjectCell to be a descendant of TKGridTextCell +{.$DEFINE TKGRIDOBJECTCELL_IS_TKGRIDTEXTCELL} + +// use JCLUnicode (only for TKGridAxisItem.Assign(Source: TWideStrings);) +{.$DEFINE TKGRID_USE_JCL} + + +{ Conditional defines for unit KDBGrids: } +// we want to use TKDBGrid +{$DEFINE TKDBGRID_USE} + +// we want TKDBGridCell to be a descendant of TKGridAttrTextCell +{.$DEFINE TKDBGRIDCELL_IS_TKGRIDATTRTEXTCELL} + +{ Conditional defines for unit KIcon: } +// register TKICON within TPicture automatically +{.$DEFINE TKICON_REGISTER} + +// PngImage can be used +{$IF DEFINED(FPC) OR DEFINED(COMPILER12_UP)} + {$DEFINE USE_PNG_SUPPORT} +{$IFEND} + +{$DEFINE DEFAULT_LANGUAGE_EN} // default language is english +{.$DEFINE DEFAULT_LANGUAGE_CZ} // default language is czech + +{.$DEFINE DEFAULT_LANGUAGE_DE} // default language is german + +{.$DEFINE DEFAULT_LANGUAGE_RU} // default language is russian + + +{$ENDIF ~KCONTROLS_INC} + + diff --git a/components/kcontrols/source/kcontrols.lrs b/components/kcontrols/source/kcontrols.lrs new file mode 100755 index 000000000..b072b8ad5 --- /dev/null +++ b/components/kcontrols/source/kcontrols.lrs @@ -0,0 +1,30 @@ +LazarusResources.Add('kpreview_cursor_hand_free','CUR',[ + #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 + +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#3#240#0 + +#0#3#240#0#0#7#240#0#0#15#248#0#0#31#248#0#0#31#252#0#0'?'#252#0#0'w'#252#0#0 + +'g'#254#0#0#7#246#0#0#13#182#0#0#13#178#0#0#25#176#0#0#25#176#0#0#1#128#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#248#7#255#255#248#7#255#255 + +#240#7#255#255#224#3#255#255#192#3#255#255#192#1#255#255#128#1#255#255#0#1 + +#255#255#0#0#255#255#144#0#255#255#224#0#255#255#224#0#255#255#192#5#255#255 + +#192#7#255#255#228#15#255#255#254#127#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255 +]); +LazarusResources.Add('kpreview_cursor_hand_grip','CUR',[ + #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 + +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#7#224#0#0#7#224#0#0#15#224#0#0#31#240#0#0'?'#240#0#0'?'#248 + +#0#0#15#248#0#0#15#248#0#0#31#232#0#0#27'`'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#240#15#255#255#240#15#255#255#224#15#255#255#192#7#255#255#128#7#255 + +#255#128#3#255#255#192#3#255#255#224#3#255#255#192#3#255#255#192#7#255#255 + +#228#159#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255 +]); diff --git a/components/kcontrols/source/kcontrols.pas b/components/kcontrols/source/kcontrols.pas new file mode 100755 index 000000000..8e2c6ef25 --- /dev/null +++ b/components/kcontrols/source/kcontrols.pas @@ -0,0 +1,2825 @@ +{ @abstract(This unit contains the base class for all visible controls.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(18 Sep 2009) + @lastmod(20 Jun 2010) + + This unit implements the base class TKCustomControl for all visible controls + from the KControls Development Suite. + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KControls; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LMessages, LCLProc, LResources, +{$ELSE} + Windows, Messages, +{$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, KFunctions +{$IFDEF USE_THEMES} + , Themes + {$IFNDEF FPC} + , UxTheme + {$ENDIF} +{$ENDIF} + ; + +type + { This array serves as storage place for all colors. } + TKColorArray = array of TColor; + + { Declares possible indexes e.g. for the @link(TKPreviewColors.Color) property. } + TKPreviewColorIndex = Integer; + + { Declares print options - possible values for the @link(TKPrintPageSetup.Options) property. } + TKPrintOption = ( + { If there are more printed copies these will be collated. } + poCollate, + { The printed shape will be scaled to fit on page. } + poFitToPage, + { Every even page will be printed with mirrored (swapped) margins. } + poMirrorMargins, + { Page numbers will be added to the bottom of each printed page. } + poPageNumbers, + { Paints the selection in control's specific manner. } + poPaintSelection, + { Title will be printed to the top of each printed page. } + poTitle, + { Color page will be printed instead of B/W page. } + poUseColor + ); + + { Print options can be arbitrary combined. } + TKPrintOptions = set of TKPrintOption; + + { Declares possible values for the @link(TKPrintPageSetup.Range) property. } + TKPrintRange = ( + { All pages will be printed. } + prAll, + { Only selected block will be printed. } + prSelectedOnly, + { Only given range of pages will be printed. } + prRange + ); + + { Declares measurement units for KControls printing system. } + TKPrintUnits = ( + { Corresponding value is given in millimeters. } + puMM, + { Corresponding value is given in centimeters. } + puCM, + { Corresponding value is given in inches. } + puInch, + { Corresponding value is given in hundredths of inches. } + puHundredthInch + ); + +const + { Default value for the @link(TKCustomControl.BorderStyle) property. } + cBorderStyleDef = bsSingle; + + { Minimum for the @link(TKPrintPageSetup.Copies) property } + cCopiesMin = 1; + { Maximum for the @link(TKPrintPageSetup.Copies) property } + cCopiesMax = 1000; + { Default value for the @link(TKPrintPageSetup.Copies) property } + cCopiesDef = 1; + + { Default value for the @link(TKPrintPageSetup.MarginBottom) property } + cMarginBottomDef = 2.0; + { Default value for the @link(TKPrintPageSetup.MarginLeft) property } + cMarginLeftDef = 1.5; + { Default value for the @link(TKPrintPageSetup.MarginRight) property } + cMarginRightDef = 1.5; + { Default value for the @link(TKPrintPageSetup.MarginTop) property } + cMarginTopDef = 1.8; + + { Default value for the @link(TKPrintPageSetup.Options) property. } + cOptionsDef = [poFitToPage, poPageNumbers, poUseColor]; + + { Default value for the @link(TKPrintPageSetup.Options) property. } + cRangeDef = prAll; + + { Minimum for the @link(TKPrintPageSetup.Scale) property } + cScaleDef = 100; + { Maximum for the @link(TKPrintPageSetup.Scale) property } + cScaleMin = 10; + { Default value for the @link(TKPrintPageSetup.Scale) property } + cScaleMax = 500; + + { Default value for the @link(TKPrintPageSetup.Units) property. } + cUnitsDef = puCM; + + { Default value for the @link(TKPreviewColors.Paper) color property. } + cPaperDef = clWhite; + { Default value for the @link(TKPreviewColors.BkGnd) color property. } + cBkGndDef = clAppWorkSpace; + { Default value for the @link(TKPreviewColors.Border) color property. } + cBorderDef = clBlack; + { Default value for the @link(TKPreviewColors.SelectedBorder) color property. } + cSelectedBorderDef = clNavy; + + { Index for the @link(TKPreviewColors.Paper) property. } + ciPaper = TKPreviewColorIndex(0); + { Index for the @link(TKPreviewColors.BkGnd) property. } + ciBkGnd = TKPreviewColorIndex(1); + { Index for the @link(TKPreviewColors.Border) property. } + ciBorder = TKPreviewColorIndex(2); + { Index for the @link(TKPreviewColors.SelectedBorder) property. } + ciSelectedBorder = TKPreviewColorIndex(3); + { Maximum color array index } + ciPreviewColorsMax = ciSelectedBorder; + + { Constant for control scrollbars. It means: Leave that scrollbar untouched. } + cScrollNoAction = -1; + + { Constant for control scrollbars. It means: Use given Delta to update scrollbar. } + cScrollDelta = -2; + + { Internal flag for TKPrintPreview. } + cPF_Dragging = $00000001; + { Internal flag for TKPrintPreview. } + cPF_UpdateRange = $00000002; + +type + { Declares possible values for the @link(ScaleMode) property } + TKPreviewScaleMode = ( + { Apply scale defined by the @link(Scale) property } + smScale, + { Scale the page so that it horizontally fits to the window client area } + smPageWidth, + { Scale the page so that it fits to the window client area } + smWholePage); + + { @abstract(Declares @link(TKPrintPreview.OnChanged) event handler) + + } + TKPreviewChangedEvent = procedure(Sender: TObject) of object; + + { @abstract(Declares the information structure for the @link(TKCustomControl.MeasurePages) method) + + } + TKPrintMeasureInfo = record + OutlineWidth: Integer; + OutlineHeight: Integer; + HorzPageCount: Integer; + VertPageCount: Integer; + PageCount: Integer; + end; + + { Declares possible values for the Status parameter in the @link(TKPrintNotifyEvent) event } + TKPrintStatus = ( + { This event occurs at the beginning of the print job - you may show an Abort dialog here } + epsBegin, + { This event occurs after each page has been printed - you may update the Page/Copy information + in the Abort dialog } + epsNewPage, + { This event occurs at the end of the print job - you may hide the Abort dialog here } + epsEnd + ); + + { @abstract(Declares @link(TKCustomControl.OnPrintNotify) event handler) + + Remark: At certain time slots, the print spooler allows the message queue + to be processed for the thread where the print job is running. This e.g. allows + the user to press a button on the Abort dialog. Because this message loop can be invoked + e.g. during a Printer.Canvas.TextRect function and any painting messages may hover in + the message queue, any functions used both to print a job and to process particular + messages should be reentrant to avoid conflicts. Perhaps should print jobs be run + in seperate threads? + } + TKPrintNotifyEvent = procedure(Sender: TObject; Status: TKPrintStatus; + var Abort: Boolean) of object; + + { @abstract(Declares @link(TKCustomControl.OnPrintPaint) event handler) + + } + TKPrintPaintEvent = procedure(Sender: TObject) of object; + + TKPrintPageSetup = class; + TKPrintPreview = class; + + { Base class for all visible controls in KControls. } + TKCustomControl = class(TCustomControl) + private + {$IFNDEF FPC} + FBorderStyle: TBorderStyle; + {$ENDIF} + {$IFNDEF COMPILER10_UP} + FMouseInClient: Boolean; + {$ENDIF} + FMemoryCanvas: TCanvas; + FMemoryCanvasRect: TRect; + FPageSetup: TKPrintPageSetup; + FUpdateLock: Integer; + FOnPrintNotify: TKPrintNotifyEvent; + FOnPrintPaint: TKPrintPaintEvent; + {$IFNDEF FPC} + procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE; + procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED; + {$ENDIF} + procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE; + function GetCanPrint: Boolean; + function GetPageSetup: TKPrintPageSetup; + function GetPageSetupAllocated: Boolean; + procedure KMLateUpdate(var Msg: TLMessage); message KM_LATEUPDATE; + {$IFNDEF FPC} + procedure SetBorderStyle(Value: TBorderStyle); + {$ENDIF} + procedure SetPageSetup(Value: TKPrintPageSetup); + {$IFNDEF FPC} + procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE; + {$ENDIF} + {$IFNDEF COMPILER10_UP} + procedure WMMouseLeave(var Msg: TLMessage); message KM_MOUSELEAVE; + {$ENDIF} + {$IFNDEF FPC} + procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT; + procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; + {$ENDIF} + procedure WMSize(var Msg: TLMSize); message LM_SIZE; + {$IFNDEF FPC} + {$IFDEF USE_THEMES} + procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED; + {$ENDIF} + {$ENDIF} + protected + { Holds the mutually inexclusive state as cXF... flags. } + FFlags: Cardinal; + { Defines the message queue for late update. } + FMessages: array of TLMessage; + { Gains access to the list of associated previews. } + FPreviewList: TList; + { Adds a preview control to the internal list of associated previews. } + procedure AddPreview(APreview: TKPrintPreview); + { Gives the descendant the possibility to adjust the associated TKPrintPageSetup + instance just before printing. } + procedure AdjustPageSetup; virtual; + { Cancels any dragging or resizing operations performed by mouse. } + procedure CancelMode; virtual; + { Defines additional styles. } + procedure CreateParams(var Params: TCreateParams); override; + {$IFDEF FPC} + { Overriden method. Calls @link(TKCustomControl.UpdateSize). } + procedure CreateWnd; override; + { Overriden method. Calls @link(TKCustomControl.UpdateSize). } + procedure DoOnChangeBounds; override; + {$ENDIF} + { If Value is True, includes the flag specified by AFLag to @link(FFlags). + If Value is False, excludes the flag specified by AFLag from @link(FFlags). } + procedure FlagAssign(AFlag: Cardinal; Value: Boolean); + { Excludes the flag specified by AFLag from @link(FFlags). } + procedure FlagClear(AFlag: Cardinal); + { Includes the flag specified by AFLag to @link(FFlags). } + procedure FlagSet(AFlag: Cardinal); + { If the flag specified by AFLag is included in @link(FFlags), FlagToggle + excludes it and vice versa. } + procedure FlagToggle(AFlag: Cardinal); + { Invalidates the page setup settings. If page setup is required again, + it's UpdateSettings method is called. } + procedure InvalidatePageSetup; + { Invalidates a rectangular part of the client area if control updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateRectArea(const R: TRect); virtual; + { Returns True if the control has a selection. } + function InternalGetSelAvail: Boolean; virtual; + { Called in UnlockUpdate. Allows the changes to be reflected. } + procedure InternalUnlockUpdate; virtual; + { Determines if control can be painted with OS themes. } + function IsThemed: Boolean; virtual; + { Called from KM_LATEUPDATE. Performs late update. Override to adapt. } + procedure LateUpdate(var Msg: TLMessage); virtual; + { Updates information about printed shape. } + procedure MeasurePages(var Info: TKPrintMeasureInfo); virtual; + { Retrieves a message from message queue if there is one. Used for late update.} + function MessagePeek(out Msg: TLMessage): Boolean; + { Puts a new message into the message queue. Used for late update.} + procedure MessagePoke(const Msg: TLMessage); + { Searches the message queue for given message code. } + function MessageSearch(MsgCode: Cardinal): Boolean; + { Responds to WM_MOUSELEAVE message. } + procedure MouseFormLeave; virtual; + { Overriden method - see Delphi help. } + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + { Notifies all associated previews about a change in the associated page setup. } + procedure NotifyPreviews; + { Overriden method - see Delphi help. Paints the entire control client area. } + procedure Paint; override; + { Paints a page to a printer/preview canvas. } + procedure PaintPage; virtual; + { Paints the control to the specified canvas. Must always be overriden. } + procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract; + { Adds a message to message queue for late update. Set IfNotExists to True to + add that message only if the specified message code does not exist in the + message queue at this moment. } + procedure PostLateUpdate(const Msg: TLMessage; IfNotExists: Boolean = False); + { Calls the @link(TKCustomControl.OnPrintNotify) event } + procedure PrintNotify(Status: TKPrintStatus; var Abort: Boolean); virtual; + { Calls the @link(TKCustomControl.OnPrintPaint) event } + procedure PrintPaint; virtual; + { Removse a preview control to the internal list of associated previews. } + procedure RemovePreview(APreview: TKPrintPreview); + { Updates mouse cursor according to the state determined from current mouse + position. Returns True if cursor has been changed. } + function SetMouseCursor(X, Y: Integer): Boolean; virtual; + { Updates the control size. Responds to WM_SIZE under Delphi and similar + notifications under Lazarus. } + procedure UpdateSize; virtual; + public + { Creates the instance. Assigns default values to properties, allocates + default column, row and cell data. } + constructor Create(AOwner: TComponent); override; + { Destroys the instance along with all allocated column, row and cell data. + See TObject.Destroy in Delphi help. } + destructor Destroy; override; + { Determines whether a flag specified by AFlag is included in @link(FFlags). } + function Flag(AFlag: Cardinal): Boolean; + { Invalidates the entire control if control updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure Invalidate; override; + { Locks control updating so that all possibly slow operations such as all Invalidate... + methods will not be performed. This is useful e.g. when assigning many + properties at one time. Every LockUpdate call must have + a corresponding @link(TKCustomControl.UnlockUpdate) call, please use a + try-finally section. } + procedure LockUpdate; + { Prints the control. } + procedure PrintOut; + { Unlocks back to normal control updating and calls InternalUnlockUpdate + to reflect (possible) multiple changes made. Each @link(LockUpdate) call must + be always followed by the UnlockUpdate call. } + procedure UnlockUpdate; + { Returns True if control updating is not locked, i.e. there is no open + LockUpdate and UnlockUpdate pair. } + function UpdateUnlocked: Boolean; + { Determines whether a single line border is drawn around the control. + Set BorderStyle to bsSingle to add a single line border around the control. + Set BorderStyle to bsNone to omit the border. } + {$IFDEF FPC} + property BorderStyle default cBorderStyleDef; + {$ELSE} + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default cBorderStyleDef; + {$ENDIF} + { Returns True if the control has anything to print and a printer is installed. } + property CanPrint: Boolean read GetCanPrint; + {$IFNDEF COMPILER10_UP} + { This property has the same meaning as the MouseInClient property introduced + into TWinControl in BDS 2006. } + property MouseInClient: Boolean read FMouseInClient; + {$ENDIF} + { Setting this property causes the control to be painted to MemoryCanvas in it's + Paint method. This approach replaces PaintTo as it does not work good for all + LCL widget sets. The control is painted normally on it's Canvas and then + copied only once to MemoryCanvas. MemoryCanvas is then set to nil (not freed) + to indicate the copying is complete. } + property MemoryCanvas: TCanvas read FMemoryCanvas write FMemoryCanvas; + { Specifies what rectangular part of the control should be copied on MemoryCanvas. } + property MemoryCanvasRect: TRect read FMemoryCanvasRect write FMemoryCanvasRect; + { This event is called at certain phases of the actually running print job. } + property OnPrintNotify: TKPrintNotifyEvent read FOnPrintNotify write FOnPrintNotify; + { This event is called after the shape was drawn onto the printer canvas. } + property OnPrintPaint: TKPrintPaintEvent read FOnPrintPaint write FOnPrintPaint; + { Specifies the page setup component used for this control. } + property PageSetup: TKPrintPageSetup read GetPageSetup write SetPageSetup; + {Returns True if page setup component is allocated for this control. } + property PageSetupAllocated: Boolean read GetPageSetupAllocated; + end; + + { @abstract(Class to specify the print job parameters) } + TKPrintPageSetup = class(TPersistent) + private + FActive: Boolean; + FCanvas: TCanvas; + FControl: TKCustomControl; + FCopies: Integer; + FCurrentCopy: Integer; + FCurrentPage: Integer; + FCurrentScale: Double; + FDesktopPixelsPerInchX: Integer; + FDesktopPixelsPerInchY: Integer; + FEndPage: Integer; + FFooterSpace: Double; + FHeaderSpace: Double; + FHorzPageCount: Integer; + FIsValid: Boolean; + FMarginBottom: Double; + FMarginLeft: Double; + FMarginRight: Double; + FMarginTop: Double; + FOptions: TKPrintOptions; + FOutlineHeight: Integer; + FOutlineWidth: Integer; + FPageCount: Integer; + FPageHeight: Integer; + FPageWidth: Integer; + FPaintAreaHeight: Integer; + FPaintAreaWidth: Integer; + FPreviewing: Boolean; + FPrinterFooterSpace: Integer; + FPrinterHeaderSpace: Integer; + FPrinterMarginBottom: Integer; + FPrinterMarginLeft: Integer; + FPrinterMarginLeftMirrored: Integer; + FPrinterMarginRight: Integer; + FPrinterMarginRightMirrored: Integer; + FPrinterMarginTop: Integer; + FPrinterName: string; + FPrinterPixelsPerInchX: Integer; + FPrinterPixelsPerInchY: Integer; + FPrintingMapped: Boolean; + FRange: TKPrintRange; + FStartPage: Integer; + FScale: Integer; + FTitle: string; + FUnits: TKPrintUnits; + FUpdateLock: Integer; + FValidating: Boolean; + FVertPageCount: Integer; + function GetCanPrint: Boolean; + procedure SetCopies(Value: Integer); + procedure SetEndPage(Value: Integer); + procedure SetFooterSpace(Value: Double); + procedure SetHeaderSpace(Value: Double); + procedure SetMarginBottom(Value: Double); + procedure SetMarginLeft(Value: Double); + procedure SetMarginRight(Value: Double); + procedure SetMarginTop(Value: Double); + procedure SetOptions(Value: TKPrintOptions); + procedure SetPrinterName(const Value: string); + procedure SetPrintingMapped(Value: Boolean); + procedure SetRange(Value: TKPrintRange); + procedure SetScale(Value: Integer); + procedure SetStartPage(Value: Integer); + procedure SetUnits(Value: TKPrintUnits); + function GetSelAvail: Boolean; + protected + { Called before new Units are set. Converts the margins to inches by default. } + procedure AfterUnitsChange; virtual; + { Called after new Units are set. Converts the margins from inches by default. } + procedure BeforeUnitsChange; virtual; + { Paints a page to APreview.Canvas. } + procedure PaintPageToPreview(APreview: TKPrintPreview); virtual; + { Prints the page number at the bottom of the page, horizontally centered. } + procedure PrintPageNumber(Value: Integer); virtual; + { Prints the title at the top of the page. } + procedure PrintTitle; virtual; + { Updates entire printing information. } + procedure UpdateSettings; virtual; + public + { Creates the instance. Assigns default values to properties. } + constructor Create(AControl: TKCustomControl); + { Copies shareable properties of another TKPrintPageSetup instance + to this instance. } + procedure Assign(Source: TPersistent); override; + { Returns a value mapped from desktop horizontal units to printer horizontal units. } + function HMap(Value: Integer): Integer; + { Invalidates the settings. } + procedure Invalidate; + { Prints the associated control. } + procedure PrintOut; + { Locks page setup updating. Use this if you assign many properties at the + same time. Every LockUpdate call must have a corresponding + @link(TKPrintPageSetup.UnlockUpdate) call, please use a try-finally section. } + procedure LockUpdate; virtual; + { Unlocks page setup updating and updates the page settings. + Each @link(TKPrintPageSetup.LockUpdate) call must be always followed + by the UnlockUpdate call. } + procedure UnlockUpdate; virtual; + { Returns True if updating is not locked, i.e. there is no open + LockUpdate and UnlockUpdate pair. } + function UpdateUnlocked: Boolean; virtual; + { Validates the settings. } + procedure Validate; + { Returns a value mapped from desktop vertical units to printer vertical units. } + function VMap(Value: Integer): Integer; + { Returns True if printing or previewing is active. } + property Active: Boolean read FActive; + { Returns True if the control is associated and has anything to print. } + property CanPrint: Boolean read GetCanPrint; + { Returns the Printer.Canvas or TkPrintPreview.Canvas. Do not access outside + print job. } + property Canvas: TCanvas read FCanvas; + { Returns the control to which this TKPrintPageSetup instance is assigned. } + property Control: TKCustomControl read FControl; + { Specifies the number of copies to print. } + property Copies: Integer read FCopies write SetCopies; + { Returns the currently printed copy. } + property CurrentCopy: Integer read FCurrentCopy; + { Returns the currently printed page. } + property CurrentPage: Integer read FCurrentPage; + { Returns the horizontal scale for the printed shape, without dimension. } + property CurrentScale: Double read FCurrentScale; + { Returns the amount of pixels per inch for the desktop device context's horizontal axis } + property DesktopPixelsPerInchX: Integer read FDesktopPixelsPerInchX; + { Returns the amount of pixels per inch for the desktop device context's vertical axis } + property DesktopPixelsPerInchY: Integer read FDesktopPixelsPerInchY; + { Specifies last page printed if Range is eprRange. } + property EndPage: Integer read FEndPage write SetEndPage; + { Specifies the vertical space that should stay free for application + specific footer. Value is given in Units. } + property FooterSpace: Double read FFooterSpace write SetFooterSpace; + { Specifies the vertical space that should stay free for application + specific header. Value is given in Units. } + property HeaderSpace: Double read FHeaderSpace write SetHeaderSpace; + { Returns the maximum amount of pages for horizontal axis of the control. } + property HorzPageCount: Integer read FHorzPageCount; + { Specifies the bottom margin. Value is given in Units. } + property MarginBottom: Double read FMarginBottom write SetMarginBottom; + { Specifies the left margin. Value is given in Units. } + property MarginLeft: Double read FMarginLeft write SetMarginLeft; + { Specifies the right margin. Value is given in Units. } + property MarginRight: Double read FMarginRight write SetMarginRight; + { Specifies the top margin. Value is given in Units. } + property MarginTop: Double read FMarginTop write SetMarginTop; + { Specifies the printing options. } + property Options: TKPrintOptions read FOptions write SetOptions; + { Returns the printed shape height (maximum of all pages) + in units depending on PrintingMapped.. } + property OutlineHeight: Integer read FOutlineHeight; + { Returns the printed shape width (maximum of all pages) + in units depending on PrintingMapped.. } + property OutlineWidth: Integer read FOutlineWidth; + { Returns the amount of all pages. } + property PageCount: Integer read FPageCount; + { Returns the page height in printer device context's pixels. } + property PageHeight: Integer read FPageHeight; + { Returns the page width in printer device context's pixels. } + property PageWidth: Integer read FPageWidth; + { Returns the top paint area width on canvas in units depending on PrintingMapped. } + property PaintAreaHeight: Integer read FPaintAreaHeight; + { Returns the top paint area width on canvas in units depending on PrintingMapped. } + property PaintAreaWidth: Integer read FPaintAreaWidth; + { Returns True if painting to a TKPrintPreview.Canvas is active. } + property Previewing: Boolean read FPreviewing; + { Returns the footer space in printer device context's units. } + property PrinterFooterSpace: Integer read FPrinterFooterSpace; + { Returns the header space in printer device context's units. } + property PrinterHeaderSpace: Integer read FPrinterHeaderSpace; + { Returns the bottom margin in printer device context's units. } + property PrinterMarginBottom: Integer read FPrinterMarginBottom; + { Returns the left margin in printer device context's units. } + property PrinterMarginLeft: Integer read FPrinterMarginLeft; + { Returns the left margin in printer device context's units with respect to current page. } + property PrinterMarginLeftMirrored: Integer read FPrinterMarginLeftMirrored; + { Returns the right margin in printer device context's units. } + property PrinterMarginRight: Integer read FPrinterMarginRight; + { Returns the left margin in printer device context's units with respect to current page. } + property PrinterMarginRightMirrored: Integer read FPrinterMarginRightMirrored; + { Returns the top margin in printer device context's units. } + property PrinterMarginTop: Integer read FPrinterMarginTop; + { Specifies the printer name. } + property PrinterName: string read FPrinterName write SetPrinterName; + { Returns the amount of pixels per inch for the printer device context's horizontal axis } + property PrinterPixelsPerInchX: Integer read FPrinterPixelsPerInchX; + { Returns the amount of pixels per inch for the printer device context's vertical axis } + property PrinterPixelsPerInchY: Integer read FPrinterPixelsPerInchY; + { Specifies the units for printing the control's shape and OutlineX properties. + If True, those extents are given in printer device context's pixels, + otherwise in desktop device context's pixels. It can be adjusted by the descendant + in the AdjustPageSetup method. } + property PrintingMapped: Boolean read FPrintingMapped write SetPrintingMapped; + { Specifies the printing range. } + property Range: TKPrintRange read FRange write SetRange; + { Returns True if the associated control has a selection. } + property SelAvail: Boolean read GetSelAvail; + { Specifies first page printed if Range is eprRange. } + property StartPage: Integer read FStartPage write SetStartPage; + { Specifies the requested scale for the printed shape, in percent. + If epoFitToPage is specified in Options, this parameter is ignored. } + property Scale: Integer read FScale write SetScale; + { Specifies the document title as it appears in printer manager. } + property Title: string read FTitle write FTitle; + { Specifies the units for print margins. } + property Units: TKPrintUnits read FUnits write SetUnits; + { Returns the maximum amount of pages for vertical axis of the control. } + property VertPageCount: Integer read FVertPageCount; + end; + + { @abstract(Container for all colors used by @link(TKPrintPreview) class) + This container allows to group many colors into one item in object inspector. + Colors are accessible via published properties or several public Color* + properties. } + TKPreviewColors = class(TPersistent) + private + FPreview: TKPrintPreview; + function GetColor(Index: TKPreviewColorIndex): TColor; + function GetColorEx(Index: TKPreviewColorIndex): TColor; + procedure SetColor(Index: TKPreviewColorIndex; Value: TColor); + procedure SetColorEx(Index: TKPreviewColorIndex; Value: TColor); + procedure SetColors(const Value: TKColorArray); + protected + FColors: TKColorArray; + { Initializes the color array. } + procedure Initialize; virtual; + { Returns the specific color according to ColorScheme. } + function InternalGetColor(Index: TKPreviewColorIndex): TColor; virtual; + { Replaces the specific color. } + procedure InternalSetColor(Index: TKPreviewColorIndex; Value: TColor); virtual; + public + { Creates the instance. You can create a custom instance and pass it + e.g. to a @link(TKPrintPreview.Colors) property. The APreview parameter has no meaning + in this case and you may set it to nil. } + constructor Create(APreview: TKPrintPreview); + { Copies the properties of another instance that inherits from + TPersistent into this TKPreviewColors instance. } + procedure Assign(Source: TPersistent); override; + { Returns color for given index. } + property Color[Index: TKPreviewColorIndex]: TColor read GetColorEx write SetColorEx; + { Returns array of colors. } + property Colors: TKColorArray read FColors write SetColors; + published + { Specifies the paper background color. } + property Paper: TColor index ciPaper read GetColor write SetColor default cPaperDef; + { Specifies the color of the background around paper. } + property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; + { Specifies the color of the paper border. } + property Border: TColor index ciBorder read GetColor write SetColor default cBorderDef; + { Specifies the color of the paper border when the control has input focus. } + property SelectedBorder: TColor index ciSelectedBorder read GetColor write SetColor default cSelectedBorderDef; + end; + + { @abstract(Print preview control for the TKCustomControl component) } + TKPrintPreview = class(TKCustomControl) + private + FColors: TKPreviewColors; + FControl: TKCustomControl; + FMouseWheelAccumulator: Integer; + FPage: Integer; + FPageOld: Integer; + FPageSize: TPoint; + FExtent: TPoint; + FPageOffset: TPoint; + FScale: Integer; + FScaleMode: TKPreviewScaleMode; + FScrollExtent: TPoint; + FScrollPos: TPoint; + FScrollPosOld: TPoint; + FX: Integer; + FY: Integer; + FOnChanged: TKPreviewChangedEvent; + function GetCurrentScale: Integer; + function GetEndPage: Integer; + function GetStartPage: Integer; + procedure SetControl(Value: TKCustomControl); + procedure SetPage(Value: Integer); + procedure SetScale(Value: Integer); + procedure SetScaleMode(Value: TKPreviewScaleMode); + procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; + procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; + procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; + procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; + procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; + procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; + procedure SetColors(const Value: TKPreviewColors); + protected + { Initializes a scroll message handling. } + procedure BeginScrollWindow; + { Defines additional styles. } + procedure CreateParams(var Params: TCreateParams); override; + { Overriden method - handles mouse wheel messages. } + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; override; + { Calls the ScrollWindowEx function to complete a scroll message. } + procedure EndScrollWindow; + { Returns current page rectangle inside of the window client area. } + function GetPageRect: TRect; + { Processes virtual key strokes. } + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { Processes scrollbar messages. + } + procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); + { Initializes drag&scroll functionality. } + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + { Performs drag&scroll functionality. } + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + { Finalizes drag&scroll functionality. } + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + { Notifies about associated TKCustomControl control removal. } + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + { Paints paper and control shape. } + procedure Paint; override; + { Calls the @link(OnChanged) event. } + procedure Changed; + { Grants the input focus to the control when possible and the control has had none before. } + procedure SafeSetFocus; + { Updates mouse cursor. } + function SetMouseCursor(X, Y: Integer): Boolean; override; + { Updates page sizes and scrollbar ranges. } + procedure UpdateScrollRange; + { Updates the control size. } + procedure UpdateSize; override; + public + { Performs necessary initializations - default values to properties. } + constructor Create(AOwner: TComponent); override; + { Destroy instance... } + destructor Destroy; override; + { Shows first page for the given range. } + procedure FirstPage; + { Shows last page for the given range. } + procedure LastPage; + { Shows next page. } + procedure NextPage; + { Shows previous page. } + procedure PreviousPage; + { Updates the preview. } + procedure UpdatePreview; + { Returns the page scaling with regard to the @link(ScaleMode) property. } + property CurrentScale: Integer read GetCurrentScale; + { Returns the current page area rectangle in desktop pixels. } + property PageRect: TRect read GetPageRect; + { Returns the last page for the given range. } + property EndPage: Integer read GetEndPage; + { Returns the first page for the given range. } + property StartPage: Integer read GetStartPage; + published + { Inherited property - see Delphi help. } + property Align; + { Inherited property - see Delphi help. } + property Anchors; + { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } + property BorderStyle; + { Inherited property - see Delphi help. } + property BorderWidth; + { Specifies all colors used by TKPrintPreview's default painting. } + property Colors: TKPreviewColors read FColors write SetColors; + { Inherited property - see Delphi help. } + property Constraints; + { Specifies the associated control. } + property Control: TKCustomControl read FControl write SetControl; + { Inherited property - see Delphi help. } + property DragCursor; + { Inherited property - see Delphi help. } + property DragKind; + { Inherited property - see Delphi help. } + property DragMode; + { Specifies the currently displayed page. } + property Page: Integer read FPage write SetPage default 1; + { Inherited property - see Delphi help. } + property ParentShowHint; + { Inherited property - see Delphi help. } + property PopupMenu; + { Specifies the user defined page scale - i.e. when ScaleMode = smScale. } + property Scale: Integer read FScale write SetScale default 100; + { Specifies the scale mode to display and scroll previewed pages. } + property ScaleMode: TKPreviewScaleMode read FScaleMode write SetScaleMode default smPageWidth; + { Inherited property - see Delphi help. } + property ShowHint; + { Inherited property - see Delphi help. } + property TabStop; + { Inherited property - see Delphi help. } + property TabOrder; + { Inherited property - see Delphi help. } + property Visible; + { Called whenever print preview is updated. } + property OnChanged: TKPreviewChangedEvent read FOnChanged write FOnChanged; + { Inherited property - see Delphi help. } + property OnClick; + { Inherited property - see Delphi help. } + property OnContextPopup; + { Inherited property - see Delphi help. } + property OnDblClick; + { Inherited property - see Delphi help. } + property OnDockDrop; + { Inherited property - see Delphi help. } + property OnDockOver; + { Inherited property - see Delphi help. } + property OnDragDrop; + { Inherited property - see Delphi help. } + property OnDragOver; + { Inherited property - see Delphi help. } + property OnEndDock; + { Inherited property - see Delphi help. } + property OnEndDrag; + { Inherited property - see Delphi help. } + property OnEnter; + { Inherited property - see Delphi help. } + property OnExit; + { Inherited property - see Delphi help. } + property OnGetSiteInfo; + { Inherited property - see Delphi help. } + property OnKeyDown; + { Inherited property - see Delphi help. } + property OnKeyPress; + { Inherited property - see Delphi help. } + property OnKeyUp; + { Inherited property - see Delphi help. } + property OnMouseDown; + { Inherited property - see Delphi help. } + property OnMouseMove; + { Inherited property - see Delphi help. } + property OnMouseUp; + { Inherited property - see Delphi help. } + property OnMouseWheel; + { Inherited property - see Delphi help. } + property OnMouseWheelDown; + { Inherited property - see Delphi help. } + property OnMouseWheelUp; + { Inherited property - see Delphi help. } + property OnResize; + { Inherited property - see Delphi help. } + property OnStartDock; + { Inherited property - see Delphi help. } + property OnStartDrag; + { Inherited property - see Delphi help. } + property OnUnDock; + end; + +{ Converts a value given in inches into a value given in specified units. + } +function InchesToValue(Units: TKPrintUnits; Value: Double): Double; + +{ Converts value given in specified units into a value given in inches. + } +function ValueToInches(Units: TKPrintUnits; Value: Double): Double; + +implementation + +uses + Math, Printers, KGraphics; + +const + cPreviewHorzBorder = 30; + cPreviewVertBorder = 30; + cPreviewShadowSize = 3; + +function InchesToValue(Units: TKPrintUnits; Value: Double): Double; +begin + case Units of + puMM: Result := Value * 25.4; + puCM: Result := Value * 2.54; + puHundredthInch: Result := Value * 100; + else + Result := Value; + end; +end; + +function ValueToInches(Units: TKPrintUnits; Value: Double): Double; +begin + case Units of + puMM: Result := Value / 25.4; + puCM: Result := Value / 2.54; + puHundredthInch: Result := Value / 100; + else + Result := Value; + end; +end; + +{ TKCustomControl } + +constructor TKCustomControl.Create(AOwner: TComponent); +begin + inherited; + BorderStyle := cBorderStyleDef; + FFlags := 0; + FMemoryCanvas := nil; + FMessages := nil; +{$IFNDEF COMPILER10_UP} + FMouseInClient := False; +{$ENDIF} + FPageSetup := nil; + FPreviewList := TList.Create; + FUpdateLock := 0; + FOnPrintNotify := nil; + FOnPrintPaint := nil; +end; + +destructor TKCustomControl.Destroy; +begin + inherited; + FMessages := nil; + FreeAndNil(FPreviewList); + FreeAndNil(FPageSetup); +end; + +procedure TKCustomControl.AddPreview(APreview: TKPrintPreview); +begin + if Assigned(APreview) then + FPreviewList.Add(APreview); +end; + +procedure TKCustomControl.AdjustPageSetup; +begin +end; + +procedure TKCustomControl.CancelMode; +begin +end; + +{$IFNDEF FPC} +procedure TKCustomControl.CMCancelMode(var Msg: TLMessage); +begin + inherited; + CancelMode; +end; + +procedure TKCustomControl.CMCtl3DChanged(var Msg: TLMessage); +begin + inherited; + RecreateWnd; +end; +{$ENDIF} + +procedure TKCustomControl.CMMouseLeave(var Msg: TLMessage); +begin + inherited; + try + MouseFormLeave; + except + end; +end; + +procedure TKCustomControl.CreateParams(var Params: TCreateParams); +begin + inherited; +{$IFNDEF FPC} + with Params do + begin + WindowClass.style := CS_DBLCLKS; + if BorderStyle = bsSingle then + if NewStyleControls and Ctl3D then + begin + Style := Style and not WS_BORDER; + ExStyle := ExStyle or WS_EX_CLIENTEDGE; + end + else + Style := Style or WS_BORDER; + end; +{$ENDIF} +end; + +{$IFDEF FPC} +procedure TKCustomControl.CreateWnd; +begin + inherited; + UpdateSize; +end; + +procedure TKCustomControl.DoOnChangeBounds; +begin + inherited; + UpdateSize; +end; +{$ENDIF} + +function TKCustomControl.Flag(AFlag: Cardinal): Boolean; +begin + Result := FFlags and AFlag <> 0; +end; + +procedure TKCustomControl.FlagAssign(AFlag: Cardinal; Value: Boolean); +begin + if Value then + FlagSet(AFlag) + else + FlagClear(AFlag); +end; + +procedure TKCustomControl.FlagClear(AFlag: Cardinal); +begin + FFlags := FFlags and not AFlag; +end; + +procedure TKCustomControl.FlagSet(AFlag: Cardinal); +begin + FFlags := FFlags or AFlag; +end; + +procedure TKCustomControl.FlagToggle(AFlag: Cardinal); +begin + FFlags := FFlags xor AFlag; +end; + +function TKCustomControl.GetCanPrint: Boolean; +begin + Result := PageSetup.CanPrint; +end; + +function TKCustomControl.GetPageSetup: TKPrintPageSetup; +begin + if not Assigned(FPageSetup) and not (csDestroying in ComponentState) then + begin + FPageSetup := TKPrintPageSetup.Create(Self); + AdjustPageSetup; + end; + if Assigned(FPageSetup) then + FPageSetup.Validate; + Result := FPageSetup; +end; + +function TKCustomControl.GetPageSetupAllocated: Boolean; +begin + Result := Assigned(FPageSetup); +end; + +function TKCustomControl.InternalGetSelAvail: Boolean; +begin + Result := False; +end; + +procedure TKCustomControl.InternalUnlockUpdate; +begin +end; + +procedure TKCustomControl.Invalidate; +begin + if UpdateUnlocked and HandleAllocated then + inherited; +end; + +procedure TKCustomControl.InvalidatePageSetup; +begin + if Assigned(FPageSetup) then + FPageSetup.Invalidate; +end; + +procedure TKCustomControl.InvalidateRectArea(const R: TRect); +begin + if UpdateUnlocked and HandleAllocated then + InvalidateRect(Handle, @R, False); +end; + +function TKCustomControl.IsThemed: Boolean; +begin + Result := True; +end; + +procedure TKCustomControl.KMLateUpdate(var Msg: TLMessage); +var + M: TLMessage; +begin + if MessagePeek(M) then + LateUpdate(M); +end; + +procedure TKCustomControl.LateUpdate(var Msg: TLMessage); +begin + case Msg.Msg of + LM_SIZE: UpdateSize; + end; +end; + +procedure TKCustomControl.LockUpdate; +begin + Inc(FUpdateLock); +end; + +procedure TKCustomControl.MeasurePages(var Info: TKPrintMeasureInfo); +begin +end; + +function TKCustomControl.MessagePeek(out Msg: TLMessage): Boolean; +var + ALen: Integer; +begin + ALen := Length(FMessages); + if ALen > 0 then + begin + Dec(ALen); + Msg := FMessages[ALen]; + SetLength(FMessages, ALen); + Result := True; + end else + Result := False; +end; + +procedure TKCustomControl.MessagePoke(const Msg: TLMessage); +var + ALen: Integer; +begin + ALen := Length(FMessages); + SetLength(FMessages, ALen + 1); + FMessages[ALen] := Msg; +end; + +function TKCustomControl.MessageSearch(MsgCode: Cardinal): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to Length(FMessages) - 1 do + if FMessages[I].Msg = MsgCode then + begin + Result := True; + Exit; + end; +end; + +procedure TKCustomControl.MouseFormLeave; +begin +end; + +procedure TKCustomControl.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; +{$IFNDEF COMPILER10_UP} + CallTrackMouseEvent(Self, FMouseInClient); +{$ENDIF} +{$IFDEF FPC} + if not MouseCapture then + SetMouseCursor(X, Y); +{$ENDIF} +end; + +procedure TKCustomControl.NotifyPreviews; +var + I: Integer; +begin + for I := 0 to FPreviewList.Count - 1 do + TKPrintPreview(FPreviewList[I]).UpdatePreview; +end; + +procedure TKCustomControl.Paint; +begin + PaintToCanvas(Canvas); + if Assigned(FMemoryCanvas) then + begin + {$IFDEF USE_WINAPI} + // this is the best method but does not work both on QT and GTK! + MoveWindowOrg(FMemoryCanvas.Handle, -FMemoryCanvasRect.Left, -FMemoryCanvasRect.Top); + try + PaintToCanvas(FMemoryCanvas); + finally + MoveWindowOrg(FMemoryCanvas.Handle, FMemoryCanvasRect.Left, FMemoryCanvasRect.Top); + end; + {$ELSE} + FMemoryCanvas.CopyRect(Rect(0, 0, FMemoryCanvasRect.Right - FMemoryCanvasRect.Left, + FMemoryCanvasRect.Bottom - FMemoryCanvasRect.Top), Canvas, FMemoryCanvasRect); + {$ENDIF} + FMemoryCanvas := nil; + end; +end; + +procedure TKCustomControl.PostLateUpdate(const Msg: TLMessage; + IfNotExists: Boolean); +begin + if HandleAllocated then + begin + if not IfNotExists or not MessageSearch(Msg.Msg) then + MessagePoke(Msg); + PostMessage(Handle, KM_LATEUPDATE, 0, 0); + end; +end; + +procedure TKCustomControl.PrintNotify(Status: TKPrintStatus; var Abort: Boolean); +begin + if Assigned(FOnPrintNotify) then + FOnPrintNotify(Self, Status, Abort); +end; + +procedure TKCustomControl.PrintPaint; +begin + if Assigned(FOnPrintPaint) then + FOnPrintPaint(Self); +end; + +procedure TKCustomControl.PrintOut; +begin + GetPageSetup.PrintOut; +end; + +procedure TKCustomControl.PaintPage; +begin +end; + +procedure TKCustomControl.RemovePreview(APreview: TKPrintPreview); +begin + if Assigned(FPreviewList) and (FPreviewList.IndexOf(APreview) >= 0) then + FPreviewList.Remove(APreview); +end; + +{$IFNDEF FPC} +procedure TKCustomControl.SetBorderStyle(Value: TBorderStyle); +begin + if FBorderStyle <> Value then + begin + FBorderStyle := Value; + RecreateWnd; + end; +end; +{$ENDIF} + +function TKCustomControl.SetMouseCursor(X, Y: Integer): Boolean; +begin + Result := False; +end; + +procedure TKCustomControl.SetPageSetup(Value: TKPrintPageSetup); +begin + if Value <> FPageSetup then + GetPageSetup.Assign(Value); +end; + +procedure TKCustomControl.UnlockUpdate; +begin + if FUpdateLock > 0 then + begin + Dec(FUpdateLock); + if FUpdateLock = 0 then + InternalUnlockUpdate; + end; +end; + +procedure TKCustomControl.UpdateSize; +begin +end; + +function TKCustomControl.UpdateUnlocked: Boolean; +begin + Result := FUpdateLock = 0; +end; + +{$IFNDEF FPC} +procedure TKCustomControl.WMCancelMode(var Msg: TWMCancelMode); +begin + inherited; + CancelMode; +end; +{$ENDIF} + +{$IFNDEF COMPILER10_UP} +procedure TKCustomControl.WMMouseLeave(var Msg: TLMessage); +begin + { this is because of CM_MOUSELEAVE is not sent if mouse has left client area + and entered any of the standard control scrollbars. This behavior has been + fixed via TrackMouseEvent in BDS 2006. } + inherited; + FMouseInClient := False; + Perform(CM_MOUSELEAVE, 0, 0); +end; +{$ENDIF} + +{$IFNDEF FPC} +procedure TKCustomControl.WMNCPaint(var Msg: TWMNCPaint); +{$IFDEF USE_THEMES} +var + R: TRect; + ExStyle: Integer; + TempRgn: HRGN; + BorderWidth, + BorderHeight: Integer; +{$ENDIF} +begin +{$IFDEF USE_THEMES} + with ThemeServices do if IsThemed and ThemesEnabled then + begin + // If OS themes are enabled and the client edge border is set for the window then prevent the default window proc + // from painting the old border to avoid flickering. + ExStyle := GetWindowLong(Handle, GWL_EXSTYLE); + if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then + begin + GetWindowRect(Handle, R); + // Determine width of the client edge. + BorderWidth := GetSystemMetrics(SM_CXEDGE); + BorderHeight := GetSystemMetrics(SM_CYEDGE); + InflateRect(R, -BorderWidth, -BorderHeight); + TempRgn := CreateRectRgnIndirect(R); + // Exclude the border from the message region if there is one. Otherwise just use the inflated + // window area region. + if Msg.Rgn <> 1 then + CombineRgn(TempRgn, Msg.Rgn, TempRgn, RGN_AND); + DefWindowProc(Handle, Msg.Msg, Integer(TempRgn), 0); + DeleteObject(TempRgn); + PaintBorder(Self, True); + end else + inherited; + end else +{$ENDIF} + inherited; +end; + +procedure TKCustomControl.WMSetCursor(var Msg: TWMSetCursor); +var + MousePt: TPoint; +begin + if (Msg.HitTest = HTCLIENT) and (Msg.CursorWnd = Handle) then + begin + MousePt := ScreenToClient(Mouse.CursorPos); + if SetMouseCursor(MousePt.X, MousePt.Y) then + Msg.Result := 1 + else + inherited + end else + inherited; +end; +{$ENDIF} + +procedure TKCustomControl.WMSize(var Msg: TLMSize); +begin + inherited; + PostLateUpdate(FillMessage(LM_SIZE, 0, 0), True); +end; + +{$IFNDEF FPC} +{$IFDEF USE_THEMES} +procedure TKCustomControl.WMThemeChanged(var Msg: TLMessage); +begin + if IsThemed then + begin + inherited; + ThemeServices.UpdateThemes; + RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); + end; +end; +{$ENDIF} +{$ENDIF} + +{ TKPrintPageSetup } + +constructor TKPrintPageSetup.Create(AControl: TKCustomControl); +begin + inherited Create; + FActive := False; + FCanvas := nil; + FControl := AControl; + FCopies := cCopiesDef; + FCurrentCopy := 0; + FCurrentPage := 0; + FCurrentScale := 0; + FDesktopPixelsPerInchX := 0; + FDesktopPixelsPerInchY := 0; + FEndPage := 0; + FFooterSpace := 0; + FHeaderSpace := 0; + FHorzPageCount := 0; + FIsValid := False; + FMarginBottom := cMarginBottomDef; + FMarginLeft := cMarginLeftDef; + FMarginRight := cMarginRightDef; + FMarginTop := cMarginTopDef; + FOptions := cOptionsDef; + FOutlineHeight := 0; + FOutlineWidth := 0; + FPageCount := 0; + FPageHeight := 0; + FPageWidth := 0; + FPaintAreaHeight := 0; + FPaintAreaWidth := 0; + FPreviewing := False; + FPrinterFooterSpace := 0; + FPrinterHeaderSpace := 0; + FPrinterMarginBottom := 0; + FPrinterMarginLeft := 0; + FPrinterMarginLeftMirrored := 0; + FPrinterMarginRight := 0; + FPrinterMarginRightMirrored := 0; + FPrinterMarginTop := 0; + FPrinterName := ''; + FPrinterPixelsPerInchX := 0; + FPrinterPixelsPerInchY := 0; + FPrintingMapped := True; + FRange := cRangeDef; + FStartPage := 0; + FScale := cScaleDef; + FTitle := ''; + FUnits := cUnitsDef; + FUpdateLock := 0; + FValidating := False; + FVertPageCount := 0; +end; + +function TKPrintPageSetup.GetCanPrint: Boolean; +begin + Result := Assigned(FControl) and (FPageCount > 0) and (Printer.Printers.Count > 0); +end; + +function TKPrintPageSetup.GetSelAvail: Boolean; +begin + if Assigned(FControl) then + Result := FControl.InternalGetSelAvail + else + Result := False; +end; + +procedure TKPrintPageSetup.AfterUnitsChange; +begin + FFooterSpace := InchesToValue(FUnits, FFooterSpace); + FHeaderSpace := InchesToValue(FUnits, FHeaderSpace); + FMarginBottom := InchesToValue(FUnits, FMarginBottom); + FMarginLeft := InchesToValue(FUnits, FMarginLeft); + FMarginRight := InchesToValue(FUnits, FMarginRight); + FMarginTop := InchesToValue(FUnits, FMarginTop); +end; + +procedure TKPrintPageSetup.Assign(Source: TPersistent); +begin + if Source is TKPrintPageSetup then + begin + LockUpdate; + try + Copies := TKPrintPageSetup(Source).Copies; + EndPage := TKPrintPageSetup(Source).EndPage; + FooterSpace := TKPrintPageSetup(Source).FooterSpace; + HeaderSpace := TKPrintPageSetup(Source).HeaderSpace; + MarginBottom := TKPrintPageSetup(Source).MarginBottom; + MarginLeft := TKPrintPageSetup(Source).MarginLeft; + MarginRight := TKPrintPageSetup(Source).MarginRight; + MarginTop := TKPrintPageSetup(Source).MarginTop; + Options := TKPrintPageSetup(Source).Options; + PrinterName := TKPrintPageSetup(Source).PrinterName; + Range := TKPrintPageSetup(Source).Range; + StartPage := TKPrintPageSetup(Source).StartPage; + Scale := TKPrintPageSetup(Source).Scale; + Title := TKPrintPageSetup(Source).Title; + Units := TKPrintPageSetup(Source).Units; + finally + UnlockUpdate; + end; + end; +end; + +procedure TKPrintPageSetup.BeforeUnitsChange; +begin + FFooterSpace := ValueToInches(FUnits, FFooterSpace); + FHeaderSpace := ValueToInches(FUnits, FHeaderSpace); + FMarginBottom := ValueToInches(FUnits, FMarginBottom); + FMarginLeft := ValueToInches(FUnits, FMarginLeft); + FMarginRight := ValueToInches(FUnits, FMarginRight); + FMarginTop := ValueToInches(FUnits, FMarginTop); +end; + +function TKPrintPageSetup.HMap(Value: Integer): Integer; +begin + Result := MulDiv(Value, FPrinterPixelsPerInchX, FDesktopPixelsPerInchX); +end; + +procedure TKPrintPageSetup.Invalidate; +begin + FIsValid := False; +end; + +procedure TKPrintPageSetup.LockUpdate; +begin + Inc(FUpdateLock); +end; + +procedure TKPrintPageSetup.PaintPageToPreview; +var + PaperWidth, PaperHeight, SaveIndex: Integer; + R, PageRect: TRect; +begin + if UpdateUnlocked and Assigned(FControl) then + begin + FCanvas := APreview.Canvas; + FActive := True; + FPreviewing := True; + try + FCurrentCopy := 1; + FCurrentPage := APreview.Page; + if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then + begin + FPrinterMarginLeftMirrored := FPrinterMarginRight; + FPrinterMarginRightMirrored := FPrinterMarginLeft; + end else + begin + FPrinterMarginLeftMirrored := FPrinterMarginLeft; + FPrinterMarginRightMirrored := FPrinterMarginRight; + end; + R := APreview.PageRect; + PaperWidth := R.Right - R.Left; + PaperHeight := R.Bottom - R.Top; + SaveIndex := SaveDC(FCanvas.Handle); + try + // change the canvas mapping mode to scale the page outline + CanvasSetOffset(FCanvas, + R.Left + MulDiv(FPrinterMarginLeftMirrored, PaperWidth, FPageWidth), + R.Top + MulDiv(FPrinterMarginTop + FPrinterHeaderSpace, PaperHeight, FPageHeight)); + if FPrintingMapped then + CanvasSetScale(FCanvas, Round(PaperWidth * FCurrentScale), Round(PaperHeight * FCurrentScale), + MulDiv(FPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX), + MulDiv(FPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY)) + else + CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight); + FControl.PaintPage; + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + SaveIndex := SaveDC(FCanvas.Handle); + try + CanvasSetOffset(FCanvas, R.Left, R.Top); + CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight); + PageRect := Rect(0, 0, FPageWidth, FPageHeight); + TranslateRectToDevice(FCanvas.Handle, PageRect); + SelectClipRect(FCanvas.Handle, PageRect); + FControl.PrintPaint; + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + SaveIndex := SaveDC(FCanvas.Handle); + try + CanvasSetOffset(FCanvas, R.Left, R.Top); + CanvasSetScale(FCanvas, PaperWidth, PaperHeight, FPageWidth, FPageHeight); + PageRect := Rect(0, 0, FPageWidth, FPageHeight); + TranslateRectToDevice(FCanvas.Handle, PageRect); + SelectClipRect(FCanvas.Handle, PageRect); + PrintTitle; + PrintPageNumber(FCurrentPage); + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + finally + FActive := False; + FPreviewing := False; + FCanvas := nil; + end; + end; +end; + +procedure TKPrintPageSetup.PrintPageNumber(Value: Integer); +var + S: string; +begin + if poPageNumbers in FOptions then + begin + FCanvas.Brush.Style := bsClear; + FCanvas.Font.Color := clBlack; + FCanvas.Font.Height := 1; + FCanvas.Font.Height := VMap(16); + FCanvas.Font.Name := 'Arial'; + FCanvas.Font.Pitch := fpDefault; + FCanvas.Font.Style := [fsBold]; + S := Format('- %d -', [Value]); + FCanvas.TextOut(FPrinterMarginLeftMirrored + (FPageWidth - FPrinterMarginLeft - FPrinterMarginRight - FCanvas.TextWidth(S)) div 2, + FPageHeight - FPrinterMarginBottom + VMap(5), S); + end; +end; + +procedure TKPrintPageSetup.PrintTitle; +begin + if poTitle in FOptions then + begin + FCanvas.Brush.Style := bsClear; + FCanvas.Font.Color := clBlack; + FCanvas.Font.Height := 1; + FCanvas.Font.Height := VMap(16); + FCanvas.Font.Name := 'Arial'; + FCanvas.Font.Pitch := fpDefault; + FCanvas.Font.Style := [fsBold]; + FCanvas.TextOut(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(36), Title); + FCanvas.Brush.Style := bsSolid; + FCanvas.Brush.Color := clBlack; + FCanvas.FillRect(Rect(FPrinterMarginLeftMirrored, FPrinterMarginTop - VMap(14), FPageWidth - FPrinterMarginRight, FPrinterMarginTop - VMap(12))); + end; +end; + +procedure TKPrintPageSetup.PrintOut; + + function DoPrint: Boolean; + var + SaveIndex: Integer; + PageRect: TRect; + begin + Result := False; + if (poMirrorMargins in FOptions) and (FCurrentPage and 1 <> 0) then + begin + FPrinterMarginLeftMirrored := FPrinterMarginRight; + FPrinterMarginRightMirrored := FPrinterMarginLeft; + end else + begin + FPrinterMarginLeftMirrored := FPrinterMarginLeft; + FPrinterMarginRightMirrored := FPrinterMarginRight; + end; + SaveIndex := SaveDC(FCanvas.Handle); + try + CanvasSetOffset(FCanvas, FPrinterMarginLeftMirrored, FPrinterMarginTop + FPrinterHeaderSpace); + if FPrintingMapped then + begin + // change the canvas mapping mode to scale the page outline + CanvasSetScale(FCanvas, Round(FPageWidth * FCurrentScale), Round(FPageHeight * FCurrentScale), + MulDiv(FPageWidth, FDesktopPixelsPerInchX, FPrinterPixelsPerInchX), + MulDiv(FPageHeight, FDesktopPixelsPerInchY, FPrinterPixelsPerInchY)); + end else + CanvasResetScale(FCanvas); + FControl.PaintPage; + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + SaveIndex := SaveDC(FCanvas.Handle); + try + CanvasResetScale(FCanvas); + PageRect := Rect(0, 0, FPageWidth, FPageHeight); + TranslateRectToDevice(FCanvas.Handle, PageRect); + SelectClipRect(FCanvas.Handle, PageRect); + FControl.PrintPaint; + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + SaveIndex := SaveDC(FCanvas.Handle); + try + CanvasResetScale(FCanvas); + PageRect := Rect(0, 0, FPageWidth, FPageHeight); + TranslateRectToDevice(FCanvas.Handle, PageRect); + SelectClipRect(FCanvas.Handle, PageRect); + PrintTitle; + PrintPageNumber(FCurrentPage); + finally + RestoreDC(FCanvas.Handle, SaveIndex); + end; + FControl.PrintNotify(epsNewPage, Result); + if ((FCurrentPage < FEndPage) or (FCurrentCopy < FCopies)) and not Result then + Printer.NewPage; + end; + +var + I, J: Integer; + AbortPrint: Boolean; +{ Orientation: TPrinterOrientation; + PaperSize: TPaperSize; + APageWidth, ApageHeight, APaperWidth, APaperHeight: Integer; + PrinterType: TPrinterType; + APaperRect: TPaperRect;} +begin + if UpdateUnlocked and Assigned(FControl) then + begin + UpdateSettings; + if FPageCount > 0 then + begin + AbortPrint := False; + FCanvas := Printer.Canvas; + Printer.Title := FTitle; + Printer.Copies := 1; +{ PrinterType := Printer.PrinterType; + APageWidth := Printer.PageWidth; + APageHeight := Printer.PageHeight; + APaperRect := Printer.PaperSize.PaperRect; + Orientation := Printer.Orientation;} + Printer.BeginDoc; + FActive := True; + try + FControl.PrintNotify(epsBegin, AbortPrint); +{ Printer.Canvas.Font.Name := 'Arial'; + Printer.Canvas.Font.color := clBlack; + Printer.Canvas.Font.height := 100; + Printer.Canvas.TextOut(200, 200, 'hello!');} + if not AbortPrint then + begin + if poCollate in FOptions then + for I := 1 to FCopies do + begin + FCurrentCopy := I; + for J := FStartPage to FEndPage do + begin + FCurrentPage := J; + AbortPrint := DoPrint; + if AbortPrint then Break; + end; + if AbortPrint then Break; + end + else + for J := FStartPage to FEndPage do + begin + FCurrentPage := J; + for I := 1 to FCopies do + begin + FCurrentCopy := I; + AbortPrint := DoPrint; + if AbortPrint then Break; + end; + if AbortPrint then Break; + end + end; + FCurrentPage := 0; + FCurrentCopy := 0; + FControl.PrintNotify(epsEnd, AbortPrint); + finally + FActive := False; + Printer.EndDoc; + FCanvas := nil; + end; + end; + end; +end; + +procedure TKPrintPageSetup.SetCopies(Value: Integer); +begin + if FActive then Exit; + if Value <> FCopies then + begin + FCopies := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetEndPage(Value: Integer); +begin + if FActive then Exit; + if Value <> FEndPage then + begin + FEndPage := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetFooterSpace(Value: Double); +begin + if FActive then Exit; + if Value <> FFooterSpace then + begin + FFooterSpace := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetHeaderSpace(Value: Double); +begin + if FActive then Exit; + if Value <> FHeaderSpace then + begin + FHeaderSpace := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetMarginBottom(Value: Double); +begin + if FActive then Exit; + if Value <> FMarginBottom then + begin + FMarginBottom := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetMarginLeft(Value: Double); +begin + if FActive then Exit; + if Value <> FMarginLeft then + begin + FMarginLeft := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetMarginRight(Value: Double); +begin + if FActive then Exit; + if Value <> FMarginRight then + begin + FMarginRight := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetMarginTop(Value: Double); +begin + if FActive then Exit; + if Value <> FMarginTop then + begin + FMarginTop := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetOptions(Value: TKPrintOptions); +begin + if FActive then Exit; + if Value <> FOptions then + begin + FOptions := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetPrinterName(const Value: string); +begin + if FActive then Exit; + if Value <> FPrinterName then + begin + FPrinterName := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetPrintingMapped(Value: Boolean); +begin + if FActive then Exit; + if Value <> FPrintingMapped then + begin + FPrintingMapped := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetRange(Value: TKPrintRange); +begin + if FActive then Exit; + if Value <> FRange then + begin + FRange := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetScale(Value: Integer); +begin + if FActive then Exit; + if Value <> FScale then + begin + FScale := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetStartPage(Value: Integer); +begin + if FActive then Exit; + if Value <> FStartPage then + begin + FStartPage := Value; + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.SetUnits(Value: TKPrintUnits); +begin + if FActive then Exit; + if Value <> FUnits then + begin + BeforeUnitsChange; + FUnits := Value; + AfterUnitsChange; + end; +end; + +procedure TKPrintPageSetup.UnlockUpdate; +begin + if FUpdateLock > 0 then + begin + Dec(FUpdateLock); + UpdateSettings; + end; +end; + +procedure TKPrintPageSetup.UpdateSettings; +var + I, PixelsPerInchX, PixelsPerInchY: Integer; + D: Double; + DC: HDC; + Info: TKPrintMeasureInfo; +begin + if UpdateUnlocked and not FActive and not FValidating then + begin + FValidating := True; + try + Printer.Refresh; + I := Printer.Printers.IndexOf(FPrinterName); + if I >= 0 then + Printer.PrinterIndex := I; + // limit copies and Scale + FCopies := MinMax(FCopies, cCopiesMin, cCopiesMax); + FScale := MinMax(FScale, cScaleMin, cScaleMax); + // get metrics for the desktop + DC := GetDC(0); + try + FDesktopPixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX); + FDesktopPixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY); + finally + ReleaseDC(0, DC); + end; + // get metrics for the printer + if Printer.Printers.Count > 0 then + begin + FPageWidth := Printer.PageWidth; + FPageHeight := Printer.PageHeight; + {$IFDEF FPC} + FPrinterPixelsPerInchX := Printer.XDPI; + FPrinterPixelsPerInchY := Printer.YDPI; + {$ELSE} + FPrinterPixelsPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); + FPrinterPixelsPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); + {$ENDIF} + end else + begin + // fake printer metrics if no printer is installed + FPageWidth := 2360; + FPageHeight := 3400; + FPrinterPixelsPerInchX := 300; + FPrinterPixelsPerInchY := 300; + end; + // decide how to outline extent + if FPrintingMapped then + begin + PixelsPerInchX := FDesktopPixelsPerInchX; + PixelsPerInchY := FDesktopPixelsPerInchY; + end else + begin + PixelsPerInchX := FPrinterPixelsPerInchX; + PixelsPerInchY := FPrinterPixelsPerInchY; + end; + // limit and convert margins + D := FPageWidth * 0.4; // 40% of the page + FPrinterMarginLeft := Round(MinMax(ValueToInches(FUnits, FMarginLeft) * FPrinterPixelsPerInchX, 0, D)); + FPrinterMarginLeftMirrored := FPrinterMarginLeft; + FMarginLeft := InchesToValue(FUnits, FPrinterMarginLeft / FPrinterPixelsPerInchX); + FPrinterMarginRight := Round(MinMax(ValueToInches(FUnits, FMarginRight) * FPrinterPixelsPerInchX, 0, D)); + FPrinterMarginRightMirrored := FPrinterMarginRight; + FMarginRight := InchesToValue(FUnits, FPrinterMarginRight / FPrinterPixelsPerInchX); + D := FPageHeight * 0.4; // 40% of the page + FPrinterMarginTop := Round(MinMax(ValueToInches(FUnits, FMarginTop) * FPrinterPixelsPerInchY, 0, D)); + FMarginTop := InchesToValue(FUnits, FPrinterMarginTop / FPrinterPixelsPerInchY); + FPrinterMarginBottom := Round(MinMax(ValueToInches(FUnits, FMarginBottom) * FPrinterPixelsPerInchY, 0, D)); + FMarginBottom := InchesToValue(FUnits, FPrinterMarginBottom / FPrinterPixelsPerInchY); + // limit and convert header and footer space + FPrinterHeaderSpace := Round(MinMax(ValueToInches(FUnits, Max(FHeaderSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginTop)); + FHeaderSpace := InchesToValue(FUnits, FPrinterHeaderSpace / FPrinterPixelsPerInchY); + FPrinterFooterSpace := Round(MinMax(ValueToInches(FUnits, Max(FFooterSpace, 0)) * FPrinterPixelsPerInchY, 0, D - FPrinterMarginBottom)); + FFooterSpace := InchesToValue(FUnits, FPrinterFooterSpace / FPrinterPixelsPerInchY); + // paint area extent + FPaintAreaHeight := MulDiv(FPageHeight - FPrinterMarginTop - FPrinterMarginBottom - FPrinterHeaderSpace - FPrinterFooterSpace, PixelsPerInchY, FPrinterPixelsPerInchY); + FPaintAreaWidth := MulDiv(FPageWidth - FPrinterMarginLeft - FPrinterMarginRight, PixelsPerInchX, FPrinterPixelsPerInchX); + // default horizontal scaling + FCurrentScale := FScale / 100; + // default page/copy info + FCurrentCopy := 0; + FCurrentPage := 0; + // measured data + if Assigned(FControl) then + begin + FillChar(Info, SizeOf(TKPrintMeasureInfo), 0); + FControl.MeasurePages(Info); + FOutlineWidth := Info.OutlineWidth; + FOutlineHeight := Info.OutlineHeight; + FHorzPageCount := Info.HorzPageCount; + FVertPageCount := Info.VertPageCount; + FPageCount := Info.PageCount; + if FPageCount > 0 then + begin + // update horizontal scaling + if (poFitToPage in FOptions) and (FOutlineWidth > 0) then + FCurrentScale := FPaintAreaWidth / FOutlineWidth; + // limit start and end page + case FRange of + prAll, prSelectedOnly: + begin + FStartPage := 1; + FEndPage := FPageCount; + end; + prRange: + begin + FEndPage := MinMax(FEndPage, 1, FPageCount); + FStartPage := MinMax(FStartPage, 1, FEndPage); + end; + end; + end; + // notify all previews/ force their repainting + FControl.NotifyPreviews; + end else + begin + FOutlineWidth := 0; + FOutlineHeight := 0; + FHorzPageCount := 0; + FVertPageCount := 0; + FPageCount := 0; + FEndPage := 0; + FStartPage := 0; + end; + FIsValid := True; + finally + FValidating := False; + end; + end; +end; + +function TKPrintPageSetup.UpdateUnlocked: Boolean; +begin + Result := FUpdateLock = 0; +end; + +procedure TKPrintPageSetup.Validate; +begin + if not FIsValid and not FValidating then + UpdateSettings; +end; + +function TKPrintPageSetup.VMap(Value: Integer): Integer; +begin + Result := MulDiv(Value, FPrinterPixelsPerInchY, FDesktopPixelsPerInchY); +end; + +{ TKPreviewColors } + +constructor TKPreviewColors.Create(APreview: TKPrintPreview); +begin + inherited Create; + FPreview := APreview; + Initialize; +end; + +procedure TKPreviewColors.Assign(Source: TPersistent); +begin + inherited; + if Source is TKPreviewColors then + begin + Colors := TKPreviewColors(Source).Colors; + FPreview.Invalidate; + end +end; + +function TKPreviewColors.GetColor(Index: TKPreviewColorIndex): TColor; +begin + Result := InternalGetColor(Index); +end; + +function TKPreviewColors.GetColorEx(Index: TKPreviewColorIndex): TColor; +begin + Result := FColors[Index]; +end; + +procedure TKPreviewColors.Initialize; +begin + SetLength(FColors, ciPreviewColorsMax + 1); + FColors[ciPaper] := cPaperDef; + FColors[ciBkGnd] := cBkGndDef; + FColors[ciBorder] := cBorderDef; + FColors[ciSelectedBorder] := cSelectedBorderDef; +end; + +function TKPreviewColors.InternalGetColor(Index: TKPreviewColorIndex): TColor; +begin + Result := FColors[Index]; +end; + +procedure TKPreviewColors.InternalSetColor(Index: TKPreviewColorIndex; Value: TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + if not (csLoading in FPreview.ComponentState) then + FPreview.Invalidate; + end; +end; + +procedure TKPreviewColors.SetColor(Index: TKPreviewColorIndex; Value: TColor); +begin + InternalSetColor(Index, Value); +end; + +procedure TKPreviewColors.SetColorEx(Index: TKPreviewColorIndex; Value: TColor); +begin + FColors[Index] := Value; +end; + +procedure TKPreviewColors.SetColors(const Value: TKColorArray); +var + I: Integer; +begin + for I := 0 to Min(Length(FColors), Length(Value)) - 1 do + FColors[I] := Value[I]; +end; + +{ TKPrintPreview } + +constructor TKPrintPreview.Create(AOwner: TComponent); +begin + inherited; + FColors := TKPreviewColors.Create(Self); + FControl := nil; + FMouseWheelAccumulator := 0; + FPage := 1; + FPageSize := Point(0, 0); + FScale := 100; + FScaleMode := smPageWidth; + FOnChanged := nil; + LoadCustomCursor(crDragHandFree, 'KPREVIEW_CURSOR_HAND_FREE'); + LoadCustomCursor(crDragHandGrip, 'KPREVIEW_CURSOR_HAND_GRIP'); + Width := 300; + Height := 200; +end; + +destructor TKPrintPreview.Destroy; +begin + if Assigned(FControl) then + FControl.RemovePreview(Self); + inherited; + FColors.Free; +end; + +procedure TKPrintPreview.BeginScrollWindow; +begin + FPageOld := FPage; + FScrollPosOld := FScrollPos; +end; + +procedure TKPrintPreview.CreateParams(var Params: TCreateParams); +begin + inherited; + with Params do + Style := Style or WS_HSCROLL or WS_VSCROLL; +end; + +function TKPrintPreview.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +const + cWheelDivisor = 120; +var + Delta, WheelClicks: Integer; +begin + Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); + if not Result then + begin + if ssCtrl in Shift then + begin + if FScaleMode = smWholePage then Delta := 10 else Delta := ClientHeight; + end else + if FScaleMode = smWholePage then Delta := 1 else Delta := ClientHeight div 10; + Inc(FMouseWheelAccumulator, WheelDelta); + WheelClicks := FMouseWheelAccumulator div cWheelDivisor; + FMouseWheelAccumulator := FMouseWheelAccumulator mod cWheelDivisor; + BeginScrollWindow; + ModifyScrollBar(SB_VERT, -1, -WheelClicks * Delta); + EndScrollWindow; + Result := True; + end; +end; + +procedure TKPrintPreview.EndScrollWindow; +begin + if (FPage <> FPageOld) then + Invalidate + else if (FScrollPos.X <> FScrollPosOld.X) or (FScrollPos.Y <> FScrollPosOld.Y) then + begin + ScrollWindowEx(Handle, FScrollPosOld.X - FScrollPos.X, FScrollPosOld.Y - FScrollPos.Y, + nil, nil, 0, nil, SW_INVALIDATE); + end; +end; + +procedure TKPrintPreview.FirstPage; +begin + Page := StartPage; +end; + +function TKPrintPreview.GetCurrentScale: Integer; +begin + if Assigned(FControl) then + Result := MulDiv(FPageSize.X, 100, MulDiv(FControl.PageSetup.PageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX)) + else + Result := FScale; +end; + +function TKPrintPreview.GetEndPage: Integer; +begin + if Assigned(FControl) then + begin + Result := FControl.PageSetup.EndPage; + if Result = 0 then + begin + FControl.PageSetup.UpdateSettings; + Result := FControl.PageSetup.EndPage + end; + end else + Result := 0; +end; + +function TKPrintPreview.GetPageRect: TRect; +begin + with Result do + begin + Left := FPageOffset.X - FScrollPos.X; + if FScaleMode = smWholePage then + Top := FPageOffset.Y + else + Top := FPageOffset.Y - FScrollPos.Y; + Right := Left + FPageSize.X; + Bottom := Top + FPageSize.Y; + end; +end; + +function TKPrintPreview.GetStartPage: Integer; +begin + if Assigned(FControl) then + begin + Result := FControl.PageSetup.StartPage; + if Result = 0 then + begin + FControl.PageSetup.UpdateSettings; + Result := FControl.PageSetup.StartPage + end; + end else + Result := 0; +end; + +procedure TKPrintPreview.KeyDown(var Key: Word; Shift: TShiftState); +var + DeltaX, DeltaY, LineX, PageY: Integer; + NoAlt, NoAltCtrl: Boolean; +begin + NoAlt := Shift * [ssAlt] = []; + NoAltCtrl := Shift * [ssAlt, ssCtrl] = []; + DeltaX := 0; + DeltaY := 0; + LineX := ClientWidth div 10; + PageY := ClientHeight; + case Key of + VK_UP: + if NoAltCtrl then + begin + if FScaleMode = smWholePage then + PreviousPage + else + DeltaY := -PageY div 10; + end; + VK_DOWN: + if NoAltCtrl then + begin + if FScaleMode = smWholePage then + NextPage + else + DeltaY := PageY div 10; + end; + VK_PRIOR: + if NoAltCtrl then + begin + if FScaleMode = smWholePage then + PreviousPage + else + DeltaY := -PageY; + end; + VK_NEXT: + if NoAltCtrl then + begin + if FScaleMode = smWholePage then + NextPage + else + DeltaY := PageY; + end; + VK_LEFT: if NoAltCtrl then DeltaX := -LineX; + VK_RIGHT: if NoAltCtrl then DeltaX := LineX; + VK_HOME: + if NoAlt then + begin + if ssCtrl in Shift then + FirstPage + else + DeltaX := -FScrollPos.X; + end; + VK_END: + if NoAlt then + begin + if ssCtrl in Shift then + LastPage + else + DeltaX := FScrollExtent.X - FScrollPos.X; + end; + end; + if (DeltaX <> 0) or (DeltaY <> 0) then + begin + BeginScrollWindow; + if DeltaX <> 0 then + ModifyScrollBar(SB_HORZ, -1, DeltaX); + if DeltaY <> 0 then + ModifyScrollBar(SB_VERT, -1, DeltaY); + EndScrollWindow; + end; +end; + +procedure TKPrintPreview.LastPage; +begin + Page := EndPage; +end; + +procedure TKPrintPreview.ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer); +var + I, AEndPage: Integer; + Divisor: Cardinal; + PPos, PExtent: PInteger; + SI: TScrollInfo; +begin + Divisor := 10; + if ScrollBar = SB_HORZ then + begin + PPos := @FScrollPos.X; + PExtent := @FScrollExtent.X; + end else + begin + if FScaleMode = smWholePage then + begin + PPos := @FPage; + AEndPage := EndPage; + PExtent := @AEndPage; + Divisor := 1; + end else + begin + PPos := @FScrollPos.Y; + PExtent := @FScrollExtent.Y; + end; + end; + if PExtent^ > 0 then + begin + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_RANGE or SIF_PAGE or SIF_TRACKPOS; + GetScrollInfo(Handle, ScrollBar, SI); + {$IF DEFINED(LCLGTK2)} + {.$WARNING "scrollbar arrows still not working properly on GTK2 in some cases!"} + SI.nTrackPos := Delta; + {$IFEND} + I := PPos^; + case ScrollCode of + SB_TOP: I := SI.nMin; + SB_BOTTOM: I := SI.nMax; // will be trimmed below + SB_LINEUP: Dec(I, SI.nPage div Divisor); + SB_LINEDOWN: Inc(I, SI.nPage div Divisor); + SB_PAGEUP: Dec(I, SI.nPage); + SB_PAGEDOWN: Inc(I, SI.nPage); + SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; + else + Inc(I, Delta) + end; + if FScaleMode = smWholePage then + I := MinMax(I, 1, PExtent^) + else + I := MinMax(I, 0, PExtent^); + PPos^ := I; + SI.nPos := I; + SI.fMask := SIF_POS; + SetScrollInfo(Handle, ScrollBar, SI, True); + end; +end; + +procedure TKPrintPreview.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + if ssLeft in Shift then + begin + SafeSetFocus; + if (FScaleMode <> smWholePage) and PtInRect(GetPageRect, Point(X, Y)) then + begin + FlagSet(cPF_Dragging); + FX := X; + FY := Y; + SetMouseCursor(X, Y); + end; + end; +end; + +procedure TKPrintPreview.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + if Flag(cPF_Dragging) and MouseCapture then + begin + BeginScrollWindow; + if (X > FX) and (FScrollPos.X > 0) or (X < FX) and (FScrollPos.X < FScrollExtent.X) then + begin + ModifyScrollBar(SB_HORZ, -1, FX - X); + FX := X; + end; + if (Y > FY) and (FScrollPos.Y > 0) or (Y < FY) and (FScrollPos.Y < FScrollExtent.Y) then + begin + ModifyScrollBar(SB_VERT, -1, FY - Y); + FY := Y; + end; + EndScrollWindow; + end; +end; + +procedure TKPrintPreview.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + FlagClear(cPF_Dragging); + SetMouseCursor(X, Y); +end; + +procedure TKPrintPreview.NextPage; +begin + Page := Page + 1; +end; + +procedure TKPrintPreview.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited; + if (Operation = opRemove) and (AComponent = FControl) then + begin + FControl := nil; + UpdatePreview; + end; +end; + +procedure TKPrintPreview.Paint; + + procedure DoPaint(IsBuffer: Boolean); + var + C: TColor; + R, RPaper, RPage: TRect; + RgnPaper: HRGN; + begin + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Mode := pmCopy; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + RPage := GetPageRect; + RPaper := RPage; + with RPaper do + begin + Inc(Right, cPreviewShadowSize); + Inc(Bottom, cPreviewShadowSize); + end; + if not IsBuffer then + RgnPaper := CreateRectRgnIndirect(RPaper) + else + RgnPaper := 0; + try + // paint background around paper, we don't want at least this to flicker + if IsBuffer or (ExtSelectClipRgn(Canvas.Handle, RgnPaper, RGN_DIFF) <> NULLREGION) then + begin + Canvas.Brush.Color := FColors.BkGnd; + Canvas.FillRect(ClientRect); + end; + if not IsBuffer then + SelectClipRgn(Canvas.Handle, RgnPaper); + finally + if not IsBuffer then + DeleteObject(rgnPaper); + end; + // paint paper outline + if Focused then + C := FColors.SelectedBorder + else + C := FColors.Border; + Canvas.Pen.Color := C; + Canvas.Brush.Color := FColors.Paper; + Canvas.Rectangle(RPage); + Canvas.Brush.Color := FColors.BkGnd; + R := Rect(RPage.Left, RPage.Bottom, RPage.Left + cPreviewShadowSize, RPage.Bottom + cPreviewShadowSize); + Canvas.FillRect(R); + R := Rect(RPage.Right, RPage.Top, RPage.Right + cPreviewShadowSize, RPage.Top + cPreviewShadowSize); + Canvas.FillRect(R); + Canvas.Brush.Color := C; + R := Rect(RPage.Left + cPreviewShadowSize, RPage.Bottom, RPaper.Right, RPaper.Bottom); + Canvas.FillRect(R); + R := Rect(RPage.Right, RPage.Top + cPreviewShadowSize, RPaper.Right, RPaper.Bottom); + Canvas.FillRect(R); + // paint page outline + InflateRect(RPage, -1, -1); + FControl.PageSetup.PaintPageToPreview(Self); + end; + +var + SaveIndex: Integer; + RClient: TRect; +{$IFDEF USE_WINAPI} + Org: TPoint; + MemBitmap, OldBitmap: HBITMAP; + DC: HDC; +{$ENDIF} +begin + RClient := ClientRect; + if Assigned(FControl) then + begin + SaveIndex := SaveDC(Canvas.Handle); + try + {$IFDEF USE_WINAPI} + if DoubleBuffered then + begin + // we must paint always the entire client because of canvas scaling + MemBitmap := CreateCompatibleBitmap(Canvas.Handle, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top); + try + OldBitmap := SelectObject(Canvas.Handle, MemBitmap); + try + SetWindowOrgEx(Canvas.Handle, 0, 0, @Org); + SelectClipRect(Canvas.Handle, Rect(0, 0, RClient.Right - RClient.Left, RClient.Bottom - RClient.Top)); + DoPaint(True); + finally + SelectObject(Canvas.Handle, OldBitmap); + SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil); + end; + // copy MemBitmap to original canvas + DC := CreateCompatibleDC(Canvas.Handle); + try + OldBitmap := SelectObject(DC, MemBitmap); + try + CopyBitmap(Canvas.Handle, RClient, DC, 0, 0); + finally + SelectObject(DC, OldBitmap); + end; + finally + DeleteDC(DC); + end; + finally + DeleteObject(MemBitmap); + end; + end else + {$ENDIF} + DoPaint(False); + finally + RestoreDC(Canvas.Handle, SaveIndex); + end; + end else + begin + Canvas.Brush.Color := FColors.BkGnd; + Canvas.FillRect(RClient); + end; +end; + +procedure TKPrintPreview.Changed; +begin + if Assigned(FOnChanged) then + FOnChanged(Self); +end; + +procedure TKPrintPreview.PreviousPage; +begin + Page := Page - 1; +end; + +procedure TKPrintPreview.SafeSetFocus; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if (Form <> nil) and Form.Visible and Form.Enabled and Visible and Enabled then + Form.ActiveControl := Self; +end; + +procedure TKPrintPreview.SetColors(const Value: TKPreviewColors); +begin + FColors.Assign(Value); +end; + +procedure TKPrintPreview.SetControl(Value: TKCustomControl); +begin + if (Value <> FControl) and (Value <> Self) and not (Value is TKPrintPreview) then + begin + if Assigned(FControl) then + FControl.RemovePreview(Self); + FControl := Value; + if Assigned(FControl) then + FControl.AddPreview(Self); + UpdatePreview; + end; +end; + +procedure TKPrintPreview.SetPage(Value: Integer); +begin + Value := MinMax(Value, StartPage, EndPage); + if Value <> FPage then + begin + BeginScrollWindow; + if FScaleMode = smWholePage then + ModifyScrollBar(SB_VERT, -1, Value - FPage) + else + FPage := Value; + EndScrollWindow; + Changed; + end; +end; + +procedure TKPrintPreview.SetScale(Value: Integer); +begin + Value := MinMax(Value, cScaleMin, cScaleMax); + if Value <> FScale then + begin + FScale := Value; + UpdatePreview; + end; +end; + +procedure TKPrintPreview.SetScaleMode(Value: TKPreviewScaleMode); +begin + if Value <> FScaleMode then + begin + FScaleMode := Value; + UpdatePreview; + end; +end; + +function TKPrintPreview.SetMouseCursor(X, Y: Integer): Boolean; +var + ACursor: TCursor; +begin + if PtInRect(GetPageRect, Point(X, Y)) and (FScaleMode <> smWholePage) then + begin + if MouseCapture then + ACursor := crDragHandGrip + else + ACursor := crDragHandFree; + end else + ACursor := crDefault; +{$IFDEF FPC} + FCursor := ACursor; + SetTempCursor(ACursor); +{$ELSE} + Windows.SetCursor(Screen.Cursors[ACursor]); +{$ENDIF} + Result := True; +end; + +procedure TKPrintPreview.UpdatePreview; +begin + Page := FPage; + UpdateScrollRange; + Changed; +end; + +procedure TKPrintPreview.UpdateScrollRange; +var + I: Integer; + PageWidth100Percent, PageHeight100Percent: Integer; + SI: TScrollInfo; +begin + if HandleAllocated and not Flag(cPF_UpdateRange) then + begin + FlagSet(cPF_UpdateRange); + try + if Assigned(FControl) then + begin + // get isotropic page size in 300 dpi + PageWidth100Percent := MulDiv(FControl.PageSetup.PageWidth, 300, FControl.PageSetup.PrinterPixelsPerInchX); + PageHeight100Percent := MulDiv(FControl.PageSetup.PageHeight, 300, FControl.PageSetup.PrinterPixelsPerInchY); + case FScaleMode of + smScale: + begin + FPageSize.X := MulDiv(PageWidth100Percent, FScale, 100); + FPageSize.Y := MulDiv(PageHeight100Percent, FScale, 100); + end; + smPageWidth: + begin + FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); + FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); + end; + smWholePage: + begin + FPageSize.X := Max(ClientWidth - 2 * cPreviewHorzBorder - cPreviewShadowSize, 40); + FPageSize.Y := Max(ClientHeight - 2 * cPreviewVertBorder - cPreviewShadowSize, 40); + I := MulDiv(FPageSize.Y, PageWidth100Percent, PageHeight100Percent); + if I < FPageSize.X then + FPageSize.X := I + else + FPageSize.Y := MulDiv(FPageSize.X, PageHeight100Percent, PageWidth100Percent); + end; + end; + FExtent.X := FPageSize.X + 2 * cPreviewHorzBorder + cPreviewShadowSize; + FExtent.Y := FPageSize.Y + 2 * cPreviewVertBorder + cPreviewShadowSize; + FPageOffset.X := cPreviewHorzBorder; + if (FExtent.X < ClientWidth) then + Inc(FPageOffset.X, (ClientWidth - FExtent.X) div 2); + FPageOffset.Y := cPreviewVertBorder; + if (FExtent.Y < ClientHeight) then + Inc(FPageOffset.Y, (ClientHeight - FExtent.Y) div 2); + // adjust horizontal scroll position + I := FScrollPos.X + ClientWidth - FExtent.X - 1; + if I > 0 then + Dec(FScrollPos.X, I); + FScrollPos.X := Max(FScrollPos.X, 0); + // adjust vertical scroll position + I := FScrollPos.Y + ClientHeight - FExtent.Y - 1; + if I > 0 then + Dec(FScrollPos.Y, I); + FScrollPos.Y := Max(FScrollPos.Y, 0); + // update scroll range + FScrollExtent.X := 0; + FScrollExtent.Y := 0; + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS or SIF_DISABLENOSCROLL {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; + SI.nMin := 0; + {$IFDEF UNIX} + SI.ntrackPos := SB_POLICY_CONTINUOUS; + {$ENDIF} + case FScaleMode of + smScale: + begin + ShowScrollbar(Handle, SB_HORZ, True); + ShowScrollbar(Handle, SB_VERT, True); + SI.nMax := FExtent.X{$IFDEF FPC}+ 1{$ENDIF}; + SI.nPage := ClientWidth; + SI.nPos := FScrollPos.X; + FScrollExtent.X := SI.nMax - Integer(SI.nPage); + SetScrollInfo(Handle, SB_HORZ, SI, True); + SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; + SI.nPage := ClientHeight; + SI.nPos := FScrollPos.Y; + FScrollExtent.Y := SI.nMax - Integer(SI.nPage); + SetScrollInfo(Handle, SB_VERT, SI, True); + end; + smPageWidth: + begin + ShowScrollbar(Handle, SB_HORZ, False); + ShowScrollbar(Handle, SB_VERT, True); + SI.nMax := FExtent.Y{$IFDEF FPC}+ 1{$ENDIF}; + SI.nPage := ClientHeight; + SI.nPos := FScrollPos.Y; + FScrollExtent.Y := SI.nMax - Integer(SI.nPage); + SetScrollInfo(Handle, SB_VERT, SI, True); + end; + smWholePage: + begin + // another mode for vertical scrollbar - page selection + ShowScrollbar(Handle, SB_HORZ, False); + ShowScrollbar(Handle, SB_VERT, True); + SI.nMin := StartPage; + SI.nMax := EndPage{$IFDEF FPC}+ 1{$ENDIF}; + SI.nPage := 1; + SI.nPos := FPage; + SetScrollInfo(Handle, SB_VERT, SI, True); + end; + end; + end else + begin + ShowScrollbar(Handle, SB_HORZ, False); + ShowScrollbar(Handle, SB_VERT, False); + end; + Invalidate; + finally + FlagClear(cPF_UpdateRange); + end; + end; +end; + +procedure TKPrintPreview.UpdateSize; +begin + inherited; + UpdatePreview; +end; + +procedure TKPrintPreview.WMEraseBkgnd(var Msg: TLMessage); +begin + Msg.Result := 1; +end; + +procedure TKPrintPreview.WMGetDlgCode(var Msg: TLMNoParams); +begin + Msg.Result := DLGC_WANTARROWS; +end; + +procedure TKPrintPreview.WMHScroll(var Msg: TLMHScroll); +begin + SafeSetFocus; + BeginScrollWindow; + ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos); + EndScrollWindow; +end; + +procedure TKPrintPreview.WMKillFocus(var Msg: TLMKillFocus); +begin + inherited; + Invalidate; +end; + +procedure TKPrintPreview.WMSetFocus(var Msg: TLMSetFocus); +begin + inherited; + Invalidate; +end; + +procedure TKPrintPreview.WMVScroll(var Msg: TLMVScroll); +begin + SafeSetFocus; + BeginScrollWindow; + ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos); + EndScrollWindow; +end; + +{$IFDEF FPC} +initialization + {$i kcontrols.lrs} +{$ELSE} + {$R kcontrols.res} +{$ENDIF} +end. diff --git a/components/kcontrols/source/kcontrols.res b/components/kcontrols/source/kcontrols.res new file mode 100755 index 000000000..8e0753778 Binary files /dev/null and b/components/kcontrols/source/kcontrols.res differ diff --git a/components/kcontrols/source/kcontrolslaz.lpk b/components/kcontrols/source/kcontrolslaz.lpk new file mode 100755 index 000000000..69e3c8f65 --- /dev/null +++ b/components/kcontrols/source/kcontrolslaz.lpk @@ -0,0 +1,130 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/kcontrols/source/kdbgrids.pas b/components/kcontrols/source/kdbgrids.pas new file mode 100755 index 000000000..65603df73 --- /dev/null +++ b/components/kcontrols/source/kdbgrids.pas @@ -0,0 +1,1495 @@ +{ @abstract(This unit contains the TKDBGrid component and all supporting classes) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(20 Sep 2009) + @lastmod(20 Jun 2010) + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + This unit provides a data aware control for TKGrid. + Note: I am still a newbie to Delphi/Lazarus database solutions. If anything + is totally wrong here please feel free to send a patch or hint to me. + + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. However, you may distribute only the original + package. The Author accepts no liability for any damage that may result + from using this code. } + +unit KDBGrids; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LCLProc, LResources, +{$ELSE} + Windows, Messages, +{$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, DB, DBCtrls, + KFunctions, KGraphics, KGrids; + +resourcestring + { @exclude } + SKDBGridIndex = 'Index'; + +type + { Declares possible values for the @link(TKCustomDBGrid.DBOptions) property. } + TKDBGridOption = ( + { Automatically moves current record to edited or selected row. } + dboAutoMoveRecord, + { Forces the cells with boolean fields to be automatically adjusted to checkbox frame size. } + dboAutoSizeBooleanCells, + { Forces the cells with image fields to be automatically adjusted to image size. } + dboAutoSizeImageCells, + { Forces the column names to be assigned to fixed cells in the first fixed row. } + dboColNamesToHeader, + { Does not clear fixed cell texts if table is closed. } + dboDontClearFixedCells, + { For all BLOB/image columns, images will be displayed in original size in the cell hint window. } + dboImageHint, + { Images loaded from database can be modified by user and thus will be + saved into database if this option is included. } + dboImagesWritable, + { Forces the row indexes to be assigned to fixed cells in the first fixed column. } + dboIndexFixedCol, + { Indicates the active record row. } + dboIndicateActiveRecord + ); + + { Set type for @link(TKDBGridOption) enumeration. } + TKDBGridOptions = set of TKDBGridOption; + +const + { Default value for the @link(TKCustomDBGrid.DBOptions) property. } + cDBOptionsDef = [dboAutoMoveRecord, dboAutoSizeBooleanCells, + dboColNamesToHeader, dboIndexFixedCol, dboIndicateActiveRecord]; + + { Default value for the @link(TKDBGridColors.ActiveRecord) property. } + cActiveRecordDef = clCream; + + { Used by default to distinguish image field type. } + cDefaultImageSet = [ftBlob, ftGraphic]; + + { Used by default to distinguish string field type. } + cDefaultStringSet = [ftString, ftSmallInt, ftInteger, ftWord, ftBoolean, ftFloat, + ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, ftAutoInc, ftMemo, ftFmtMemo, + ftFixedChar, ftWideString, ftLargeInt, ftGuid, ftTimeStamp, ftFmtBCD + {$IF DEFINED(FPC) OR DEFINED(COMPILER10_UP)} + , ftWideMemo + {$IFEND} + ]; + + { Index for the @link(TKDBGridColors.ActiveRecord) property. } + ciActiveRecord = TKGridColorIndex(ciGridColorsMax + 1); + { Maximum color array index } + ciDBGridColorsMax = ciActiveRecord; + + { This internal flag is set if grid is being updated. } + cGF_DBDataUpdating = $00010000; + { This internal flag is set if data record is being changed. } + cGF_DBInternalChanging = $00020000; + +type + TKCustomDBGrid = class; + + { @abstract(Data link override for TKCustomDBGrid) + This class overrides TDataLink to extend behavior for TKCustomDBGrid. } + TKDBGridDataLink = class(TDataLink) + private + FGrid: TKCustomDBGrid; + FModified: Boolean; + procedure SetModified(const Value: Boolean); + protected + { Called if data set has been opened or closed. } + procedure ActiveChanged; override; + { Called if data in the data set has been changed. } + procedure DataSetChanged; override; + { Called if current record has been moved. } + procedure DataSetScrolled(Distance: Integer); override; + { Called if data set layout has been modified. } + procedure LayoutChanged; override; + { Called if current record has been modified. } + procedure RecordChanged(Field: TField); override; + { Called if unsaved data is about to be saved into database. } + procedure UpdateData; override; + public + { Creates the instance. } + constructor Create(AGrid: TKCustomDBGrid); + { Specifies the TKCustomDBGrid instance assigned to this TKDBGridDataLink instance. } + property Grid: TKCustomDBGrid read FGrid; + { Determines if the current record has been modified. } + property Modified: Boolean read FModified write SetModified; + end; + +{$IFDEF TKDBGRIDCELL_IS_TKGRIDATTRTEXTCELL} + { @exclude } + TKDBGridCellAncestor = TKGridAttrTextCell; +{$ELSE} + { @exclude } + TKDBGridCellAncestor = TKGridTextCell; +{$ENDIF} + + { @abstract(Base cell class for TKDBGrid) + This is the base cell class. It has always a Text property. Descendants can + add other specific data, e.g. BLOB pointers etc. } + TKDBGridCell = class(TKDBGridCellAncestor) + private + FGraphic: TGraphic; + protected + { Calls @link(TKCustomDBGrid.BeforeCellUpdate). } + procedure BeforeUpdate; override; + { Loads appropriate image. } + function CreateImageByType(const Header: TKImageHeaderString): TGraphic; virtual; + { Assigns cell properties to field data. } + procedure FieldFromCell(AField: TField); virtual; + { Assigns field data to cell properties. } + procedure FieldToCell(AField: TField); virtual; + { Assigns AField buffer to Graphic property. } + procedure ImageFromField(AField: TField); + { Assigns Graphic property to AField buffer. } + procedure ImageToField(AField: TField); + { Initializes the cell data. } + procedure Initialize; override; + { Assigns AField buffer to Text property. } + procedure TextFromField(AField: TField); + { Assigns Text property to AField buffer. } + procedure TextToField(AField: TField); + public + { Creates the instance. } + constructor Create(AGrid: TKCustomGrid); override; + { Applies TKDBGridCell properties to the cell painter. } + procedure ApplyDrawProperties; override; + { Returns a pointer to the image read from database. } + property Graphic: TGraphic read FGraphic; + end; + + { @abstract(Column class for TKCustomDBGrid) + This column class implements some extra properties for TKCustomDBGrid. } + TKDBGridCol = class(TKGridCol) + private + FCurrencyFormat: TKCurrencyFormat; + FDataType: TFieldType; + FName: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + public + { Creates the instance. Do not create custom instances. All necessary + TKDBGridCol instances are created automatically by TKCustomDBGrid. } + constructor Create(AGrid: TKCustomGrid); override; + { Specifies the currency formatting settings if the column has currency data type. } + property CurrencyFormat: TKCurrencyFormat read FCurrencyFormat write FCurrencyFormat; + { Returns the field data type. It is assigned automatically + by the TKDGGrid's data source. } + property DataType: TFieldType read FDataType; + { Specifies the database column name. It is assigned automatically + by the TKDGGrid's data source. } + property Name: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read FName; + end; + + { @abstract(Metaclass for @link(TKDBGridCol)). } + TKDBGridColClass = class of TKDBGridCol; + + { @abstract(Cell painter class used by TKCustomDBGrid class) + Overrides some TKGridCellPainter methods for usage with TKCustomDBGrid. } + TKDBGridCellPainter = class(TKGridCellPainter) + public + { Low level method. Prepares default painting attributes. Applies + attributes specific for TKDBGrid. } + procedure DefaultAttributes; override; + end; + + { @abstract(Container for all colors used by TKCustomDBGrid class) + Adds some extra colors used by TKCustomDBGrid. } + TKDBGridColors = class(TKGridColors) + private + function GetColor(Index: TKGridColorIndex): TColor; + procedure SetColor(Index: TKGridColorIndex; Value: TColor); + protected + { Initializes the color array. } + procedure Initialize; override; + published + { Specifies the color used to indicate active record. } + property ActiveRecord: TColor index ciActiveRecord read GetColor write SetColor default cActiveRecordDef; + end; + + { @abstract(KGrid data aware base component) This is the class that you use as + the ancestor for your TKCustomDBGrid overrides. } + TKCustomDBGrid = class(TKCustomGrid) + private + FActiveRecord: Integer; + FDBOptions: TKDBGridOptions; + function GetDataSource: TDataSource; + procedure SetDataSource(Value: TDataSource); + procedure SetDBOptions(const Value: TKDBGridOptions); + protected + { This field represents the internal data link. } + FDataLink: TKDBGridDataLink; + { Does nothing. Row moving not supported. } + function BeginRowDrag(var Origin: Integer; const MousePt: TPoint): Boolean; override; + { Fills the grid with data from database and/or updates the grid. } + procedure DataChanged; dynamic; + { Called if current record has been moved. } + procedure DataSetScrolled; dynamic; + { Extends TKCustomGrid behavior. Sets the data set into edited state and + informs the data link about cell change. } + procedure Changed; override; + { Extends TKCustomGrid behavior. Updates the grid if column has been moved. } + procedure ColMoved(FromIndex, ToIndex: Integer); override; + { Extends TKCustomGrid behavior. Calls the event if data set is active etc. } + function CustomSortRows(ByCol: Integer; var SortMode: TKGridSortMode): Boolean; override; + { Extends TKCustomGrid behavior. Does not allow to edit if data set is writable + or closed etc. } + function EditorCreate(ACol, ARow: Integer): TWinControl; override; + { Moves to another record if initiated by the grid. } + procedure InternalSetActiveRecord(Value: Integer); dynamic; + { Used internally to set column count. } + procedure InternalSetColCount(Value: Integer); override; + { Used internally to set fixed column count. } + procedure InternalSetFixedCols(Value: Integer); override; + { Used internally to set fixed row count. } + procedure InternalSetFixedRows(Value: Integer); override; + { Used internally to set row count. } + procedure InternalSetRowCount(Value: Integer); override; + { Allows to decide whether the goVirtualGrid option can be modified. + Returns always False as no virtual grid possible in TKDBGrid. } + function InternalUpdateVirtualGrid: Boolean; override; + { Called if current record has been modified. } + procedure RecordChanged; dynamic; + { Extends TKCustomGrid behavior. Forces the previous modified record to be + written into database. } + function SelectCell(ACol, ARow: Integer): Boolean; override; + { Extends TKCustomGrid behavior. Updates the grid if top row or left column has + been changed. } + procedure TopLeftChanged; override; + { Called if unsaved data is about to be saved into database. } + procedure UpdateData; dynamic; + { Extends TKCustomGrid Behavior. Updates the grid if control size has + been changed. } + procedure UpdateSize; override; + public + { Creates the instance. Assigns default values to properties, allocates + default column, row and cell data, constucts a data link. } + constructor Create(AOwner: TComponent); override; + { Destroys the instance along with all allocated column, row and cell data, + destroys the data link. } + destructor Destroy; override; + { Notifies the grid that a cell has been modified. } + procedure BeforeCellUpdate(ACol, ARow: Integer); dynamic; + { Does nothing. Clearing entire column is not supported. } + procedure ClearCol(ACol: Integer); override; + { Does nothing. Clearing entire grid is not supported. } + procedure ClearGrid; override; + { Does nothing. Clearing entire row is not supported. } + procedure ClearRow(ARow: Integer); override; + { Writes any modified data in the current record into database. } + procedure Commit; dynamic; + { Provides default behavior for the @link(OnEditorCreate) event. } + procedure DefaultEditorCreate(ACol, ARow: Integer; + var AEditor: TWinControl); override; + { Provides default behavior for the @link(OnEditorDataFromGrid) event. } + procedure DefaultEditorDataFromGrid(AEditor: TWinControl; + ACol, ARow: Integer; var AssignText: Boolean); override; + { Provides default behavior for the @link(OnEditorDataToGrid) event. } + procedure DefaultEditorDataToGrid(AEditor: TWinControl; + ACol, ARow: Integer; var AssignText: Boolean); override; + { Provides default behavior for the @link(OnEditorResize) event. } + procedure DefaultEditorResize(AEditor: TWinControl; + ACol, ARow: Integer; var ARect: TRect); override; + { Provides default behavior for the @link(OnEditorSelect) event. } + procedure DefaultEditorSelect(AEditor: TWinControl; + ACol, ARow: Integer; SelectAll, CaretToLeft, SelectedByMouse: Boolean); override; + { Provides default cell hint behavior. } + procedure DefaultMouseCellHint(ACol, ARow: Integer; AShow: Boolean); override; + { Does nothing. Deleting columns not supported. } + procedure DeleteCols(At, Count: Integer); override; + { Forces the data set to delete record at location At. } + procedure DeleteRow(At: Integer); override; + { Does nothing. Deleting more rows not supported. } + procedure DeleteRows(At, Count: Integer); override; + { Does nothing. Inserting columns not supported. } + procedure InsertCols(At, Count: Integer); override; + { Forces the data set to insert new record at location At. } + procedure InsertRow(At: Integer); override; + { Does nothing. Inserting more rows not supported. } + procedure InsertRows(At, Count: Integer); override; + { Does nothing. Inserting sorted columns not supported. } + function InsertSortedCol(out ByRow, ACol: Integer): Boolean; override; + { Does nothing. Inserting sorted rows not supported. } + function InsertSortedRow(out ByCol, ARow: Integer): Boolean; override; + { Does nothing. Row moving not supported. } + procedure MoveRow(FromIndex, ToIndex: Integer); override; + { Specifies the data source. } + property DataSource: TDataSource read GetDataSource write SetDataSource; + { Specifies various display and behavioral properties of TKDGGrid. } + property DBOptions: TKDBGridOptions read FDBOptions write SetDBOptions default cDBOptionsDef; + end; + + { For backward compatibility. } + TKDBCustomGrid = TKCustomDBGrid; + + { @abstract(KDBGrid design-time component) This is the class you use both + on run-time and design-time. } + TKDBGrid = class(TKCustomDBGrid) + published + { Inherited property - see Delphi help. } + property Align; + { Inherited property - see Delphi help. } + property Anchors; + { See TKCustomGrid.@link(TKCustomControl.BorderStyle) for details. } + property BorderStyle; + { Inherited property - see Delphi help. } + property BorderWidth; + { See TKCustomDBGrid.@link(TKCustomDBGrid.DBOptions) for details. } + property DBOptions; + { See TKCustomGrid.@link(TKCustomGrid.ColCount) for details. } + property ColCount; + { See TKCustomGrid.@link(TKCustomGrid.Color) for details. } + property Color; + { See TKCustomGrid.@link(TKCustomGrid.Colors) for details. } + property Colors; + { Inherited property - see Delphi help. } + property Constraints; + {$IFDEF FPC} + { See TKCustomGrid.@link(TKCustomGrid.Flat) for details. } + property Flat; + {$ELSE} + { Inherited property - see Delphi help. } + property Ctl3D; + {$ENDIF} + { See TKCustomDBGrid.@link(TKCustomDBGrid.DataSource) for details. } + property DataSource; + { See TKCustomGrid.@link(TKCustomGrid.DefaultColWidth) for details. } + property DefaultColWidth; + { See TKCustomGrid.@link(TKCustomGrid.DefaultDrawing) for details. } + property DefaultDrawing; + { See TKCustomGrid.@link(TKCustomGrid.DefaultRowHeight) for details. } + property DefaultRowHeight; + { See TKCustomGrid.@link(TKCustomGrid.DisabledDrawStyle) for details. } + property DisabledDrawStyle; + { Inherited property - see Delphi help. } + property DragCursor; + { Inherited property - see Delphi help. } + property DragKind; + { Inherited property - see Delphi help. } + property DragMode; + { See TKCustomGrid.@link(TKCustomGrid.DragStyle) for details. } + property DragStyle; + { Inherited property - see Delphi help. } + property Enabled; + { See TKCustomGrid.@link(TKCustomGrid.FixedCols) for details. } + property FixedCols; + { See TKCustomGrid.@link(TKCustomGrid.FixedRows) for details. } + property FixedRows; + { Inherited property - see Delphi help. } + property Font; + { See TKCustomGrid.@link(TKCustomGrid.GridLineWidth) for details. } + property GridLineWidth; + { See TKCustomGrid.@link(TKCustomGrid.MinColWidth) for details. } + property MinColWidth; + { See TKCustomGrid.@link(TKCustomGrid.MinRowHeight) for details. } + property MinRowHeight; + { See TKCustomGrid.@link(TKCustomGrid.MouseCellHintTime) for details. } + property MouseCellHintTime; + { See TKCustomGrid.@link(TKCustomGrid.MoveDirection) for details. } + property MoveDirection; + { See TKCustomGrid.@link(TKCustomGrid.Options) for details. } + property Options; + { Inherited property - see Delphi help. } + property ParentColor; + { Inherited property - see Delphi help. } + property ParentFont; + { Inherited property - see Delphi help. } + property ParentShowHint; + { Inherited property - see Delphi help. } + property PopupMenu; + { See TKCustomGrid.@link(TKCustomGrid.RangeSelectStyle) for details. } + property RangeSelectStyle; + { See TKCustomGrid.@link(TKCustomGrid.RowCount) for details. } + property RowCount; + { See TKCustomGrid.@link(TKCustomGrid.ScrollBars) for details. } + property ScrollBars; + { See TKCustomGrid.@link(TKCustomGrid.ScrollModeHorz) for details. } + property ScrollModeHorz; + { See TKCustomGrid.@link(TKCustomGrid.ScrollModeVert) for details. } + property ScrollModeVert; + { See TKCustomGrid.@link(TKCustomGrid.ScrollSpeed) for details. } + property ScrollSpeed; + { Inherited property - see Delphi help. } + property ShowHint; + { See TKCustomGrid.@link(TKCustomGrid.SizingStyle) for details. } + property SizingStyle; + { See TKCustomGrid.@link(TKCustomGrid.SortStyle) for details. } + property SortStyle; + { Inherited property - see Delphi help. } + property TabOrder; + { Inherited property - see Delphi help. } + property TabStop default True; + { Inherited property - see Delphi help. } + property Visible; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginColDrag) for details. } + property OnBeginColDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginColSizing) for details. } + property OnBeginColSizing; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginRowSizing) for details. } + property OnBeginRowSizing; + { See TKCustomGrid.@link(TKCustomGrid.OnCellSpan) for details. } + property OnCellSpan; + { See TKCustomGrid.@link(TKCustomGrid.OnChanged) for details. } + property OnChanged; + { See TKCustomGrid.@link(TKCustomGrid.OnCheckColDrag) for details. } + property OnCheckColDrag; + { Inherited property - see Delphi help. } + property OnClick; + { See TKCustomGrid.@link(TKCustomGrid.OnColumnMoved) for details. } + property OnColumnMoved; + { See TKCustomGrid.@link(TKCustomGrid.OnColWidthsChanged) for details. } + property OnColWidthsChanged; + { Inherited property - see Delphi help. } + property OnContextPopup; + { See TKCustomGrid.@link(TKCustomGrid.OnCustomSortCols) for details. } + property OnCustomSortCols; + { See TKCustomGrid.@link(TKCustomGrid.OnCustomSortRows) for details. } + property OnCustomSortRows; + { Inherited property - see Delphi help. } + property OnDblClick; + { Inherited property - see Delphi help. } + property OnDockDrop; + { Inherited property - see Delphi help. } + property OnDockOver; + { Inherited property - see Delphi help. } + property OnDragDrop; + { Inherited property - see Delphi help. } + property OnDragOver; + { See TKCustomGrid.@link(TKCustomGrid.OnDrawCell) for details. } + property OnDrawCell; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorCreate) for details. } + property OnEditorCreate; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDataFromGrid) for details. } + property OnEditorDataFromGrid; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDataToGrid) for details. } + property OnEditorDataToGrid; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDestroy) for details. } + property OnEditorDestroy; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorKeyPreview) for details. } + property OnEditorKeyPreview; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorResize) for details. } + property OnEditorResize; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorSelect) for details. } + property OnEditorSelect; + { See TKCustomGrid.@link(TKCustomGrid.OnEndColDrag) for details. } + property OnEndColDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnEndColSizing) for details. } + property OnEndColSizing; + { Inherited property - see Delphi help. } + property OnEndDock; + { Inherited property - see Delphi help. } + property OnEndDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnEndRowSizing) for details. } + property OnEndRowSizing; + { Inherited property - see Delphi help. } + property OnEnter; + { Inherited property - see Delphi help. } + property OnExit; + { See TKCustomGrid.@link(TKCustomGrid.OnExchangeCols) for details. } + property OnExchangeCols; + { See TKCustomGrid.@link(TKCustomGrid.OnExchangeRows) for details. } + property OnExchangeRows; + { Inherited property - see Delphi help. } + property OnGetSiteInfo; + { Inherited property - see Delphi help. } + property OnKeyDown; + { Inherited property - see Delphi help. } + property OnKeyPress; + { Inherited property - see Delphi help. } + property OnKeyUp; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseCellHint) for details. } + property OnMouseCellHint; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseClickCell) for details. } + property OnMouseClickCell; + { Inherited property - see Delphi help. } + property OnMouseDown; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseEnterCell) for details. } + property OnMouseEnterCell; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseLeaveCell) for details. } + property OnMouseLeaveCell; + { Inherited property - see Delphi help. } + property OnMouseMove; + { Inherited property - see Delphi help. } + property OnMouseUp; + { Inherited property - see Delphi help. } + property OnMouseWheel; + { Inherited property - see Delphi help. } + property OnMouseWheelDown; + { Inherited property - see Delphi help. } + property OnMouseWheelUp; + { Inherited property - see Delphi help. } + property OnResize; + { See TKCustomGrid.@link(TKCustomGrid.OnRowHeightsChanged) for details. } + property OnRowHeightsChanged; + { See TKCustomGrid.@link(TKCustomGrid.OnSelectCell) for details. } + property OnSelectCell; + { See TKCustomGrid.@link(TKCustomGrid.OnSelectionExpand) for details. } + property OnSelectionExpand; + { See TKCustomGrid.@link(TKCustomGrid.OnSizeChanged) for details. } + property OnSizeChanged; + { Inherited property - see Delphi help. } + property OnStartDock; + { Inherited property - see Delphi help. } + property OnStartDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnTopLeftChanged) for details. } + property OnTopLeftChanged; + { Inherited property - see Delphi help. } + property OnUnDock; + end; + +implementation + +uses + Math, Types, ComCtrls, StdCtrls +{$IFDEF FPC} + , EditBtn +{$ENDIF} + ; + +{ TKDBGridDataLink } + +constructor TKDBGridDataLink.Create(AGrid: TKCustomDBGrid); +begin + inherited Create; + FGrid := AGrid; + FModified := False; + VisualControl := True; +end; + +procedure TKDBGridDataLink.ActiveChanged; +begin + inherited; + if Assigned(FGrid) then + FGrid.DataChanged; + FModified := False; +end; + +procedure TKDBGridDataLink.DataSetChanged; +begin + inherited; + if Assigned(FGrid) then + FGrid.DataChanged; + FModified := False; +end; + +procedure TKDBGridDataLink.DataSetScrolled(Distance: Integer); +begin + inherited; + if Assigned(FGrid) then + FGrid.DataSetScrolled; +end; + +procedure TKDBGridDataLink.LayoutChanged; +begin + inherited; + if Assigned(FGrid) then + FGrid.DataChanged; + FModified := False; +end; + +procedure TKDBGridDataLink.RecordChanged; +begin + inherited; + if Assigned(FGrid) and not FGrid.Flag(cGF_EditorUpdating or cGF_DBDataUpdating) then + begin + FGrid.RecordChanged; + FModified := False; + end; +end; + +procedure TKDBGridDataLink.SetModified(const Value: Boolean); +begin + FModified := FModified or Value; +end; + +procedure TKDBGridDataLink.UpdateData; +begin + if FModified and Assigned(FGrid) then + FGrid.UpdateData; + FModified := False; +end; + +{ TKGridDBCell } + +constructor TKDBGridCell.Create(AGrid: TKCustomGrid); +begin + FGraphic := nil; + inherited; +end; + +procedure TKDBGridCell.ApplyDrawProperties; +var + ACol: TKDBGridCol; +begin + inherited; + Grid.CellPainter.Graphic := FGraphic; + if not (gdFixed in Grid.CellPainter.State) and (Grid.Cols[Grid.CellPainter.Col] is TKDBGridCol) then + begin + ACol := TKDBGridCol(Grid.Cols[Grid.CellPainter.Col]); + case ACol.DataType of + ftBoolean: + Grid.CellPainter.Text := ''; + ftCurrency, ftBcd: + Grid.CellPainter.Text := FormatCurrency(StrToCurrDef(Grid.CellPainter.Text, 0), ACol.CurrencyFormat); + end; + end; +end; + +procedure TKDBGridCell.BeforeUpdate; +var + ACol, ARow: Integer; +begin + inherited; + if (Grid is TKDBGrid) and not Grid.Flag(cGF_EditorUpdating or cGF_DBDataUpdating) + and FindCell(ACol, ARow) then + TKDBGrid(Grid).BeforeCellUpdate(ACol, ARow); +end; + +function TKDBGridCell.CreateImageByType(const Header: TKImageHeaderString): TGraphic; +begin + Result := ImageByType(Header); +end; + +procedure TKDBGridCell.FieldFromCell(AField: TField); +begin + if AField <> nil then + begin + if AField.DataType in cDefaultStringSet then + TextToField(AField) + else if (AField.DataType in cDefaultImageSet) and + (dboImagesWritable in TKCustomDBGrid(Grid).DBOptions) then + ImageToField(AField); + // else - override TKDBGridCell + end; +end; + +procedure TKDBGridCell.FieldToCell(AField: TField); +begin + if AField <> nil then + begin + if AField.DataType in cDefaultStringSet then + begin + FreeAndNil(FGraphic); + TextFromField(AField); + end + else if AField.DataType in cDefaultImageSet then + begin + Text := ''; + ImageFromField(AField); + end; + // else - override TKDBGridCell + end; +end; + +procedure TKDBGridCell.ImageFromField(AField: TField); +var + MS: TMemoryStream; + S: AnsiString; +begin + if AField is TBlobField then + begin + FreeAndNil(FGraphic); + MS := TMemoryStream.Create; + try + TBlobField(AField).SaveToStream(MS); + if MS.Size > SizeOf(TKImageHeaderString) then + begin + MS.Seek(0, soFromBeginning); + SetLength(S, SizeOf(TKImageHeaderString)); + MS.Read(S[1], SizeOf(TKImageHeaderString)); + FGraphic := CreateImageByType(S); + if Assigned(FGraphic) then + begin + MS.Seek(0, soFromBeginning); + FGraphic.LoadFromStream(MS); + end; + end; + finally + MS.Free; + end; + end; +end; + +procedure TKDBGridCell.ImageToField(AField: TField); +var + MS: TMemoryStream; +begin + if (AField is TBlobField) and Assigned(FGraphic) then + begin + MS := TMemoryStream.Create; + try + FGraphic.SaveToStream(MS); + MS.Seek(0, soFromBeginning); + TBlobField(AField).LoadFromStream(MS); + finally + MS.Free; + end; + end; +end; + +procedure TKDBGridCell.Initialize; +begin + inherited; + FreeAndNil(FGraphic); +end; + +procedure TKDBGridCell.TextFromField(AField: TField); +begin +{$IFDEF STRING_IS_UNICODE} + Text := AField.AsString +{$ELSE} + {$IFDEF COMPILER10_UP} + Text := AField.AsWideString + {$ELSE} + Text := AField.AsString + {$ENDIF} +{$ENDIF} +end; + +procedure TKDBGridCell.TextToField(AField: TField); +begin + if not AField.ReadOnly then + try + {$IFDEF STRING_IS_UNICODE} + AField.AsString := Text + {$ELSE} + {$IFDEF COMPILER10_UP} + AField.AsWideString := Text + {$ELSE} + AField.AsString := Text + {$ENDIF} + {$ENDIF} + except + end +end; + +{ TKDBGridCol } + +constructor TKDBGridCol.Create(AGrid: TKCustomGrid); +begin + inherited; + FCurrencyFormat.CurrencyFormat := SysUtils.CurrencyFormat; + FCurrencyFormat.CurrencyDecimals := SysUtils.CurrencyDecimals; + FCurrencyFormat.CurrencyString := SysUtils.CurrencyString; + FCurrencyFormat.DecimalSep := SysUtils.DecimalSeparator; + FCurrencyFormat.ThousandSep := SysUtils.ThousandSeparator; + FCurrencyFormat.UseThousandSep := True; + FDataType := ftUnknown; + FName := ''; +end; + +{ TKDBGridCellPainter } + +procedure TKDBGridCellPainter.DefaultAttributes; +begin + inherited; + if Assigned(TKCustomDBGrid(Grid).FDataLink) then + begin + if (dboIndicateActiveRecord in TKCustomDBGrid(Grid).DBOptions) and + Assigned(TKCustomDBGrid(Grid).FDataLink.DataSet) and + (TKCustomDBGrid(Grid).FDataLink.ActiveRecord = Row - Grid.FixedRows) and + (State * [gdSelected, gdFocused] = []) then + Canvas.Brush.Color := TKDBGridColors(TKCustomDBGrid(Grid).Colors).ActiveRecord; + if (dboIndexFixedCol in TKCustomDBGrid(Grid).DBOptions) and (Col = 0) and (Grid.FixedCols > 0) then + HAlign := halRight; + if not (gdFixed in State) and (Grid.Cols[Col] is TKDBGridCol) then + case TKDBGridCol(Grid.Cols[Col]).DataType of + ftMemo + {$IF DEFINED(FPC) OR DEFINED(COMPILER10_UP)} + , ftWideMemo + {$IFEND} + : + Attributes := Attributes + [taLineBreak]; + ftCurrency, ftBCD, ftFmtBCD: + HAlign := halRight; + ftBoolean: + begin + CheckBox := True; + CheckBoxChecked := LowerCase(Grid.Cells[Col, Row]) = 'true'; + end; + end; + end; +end; + +{ TKDBGridColors } + +function TKDBGridColors.GetColor(Index: TKGridColorIndex): TColor; +begin + Result := InternalGetColor(Index); +end; + +procedure TKDBGridColors.Initialize; +begin + inherited; + SetLength(FColors, ciDBGridColorsMax + 1); + SetLength(FBrightColors, ciDBGridColorsMax + 1); + FColors[ciActiveRecord] := cActiveRecordDef; +end; + +procedure TKDBGridColors.SetColor(Index: TKGridColorIndex; Value: TColor); +begin + InternalSetColor(Index, Value); +end; + +{ TKCustomDBGrid } + +constructor TKCustomDBGrid.Create(AOwner: TComponent); +begin + FDataLink := TKDBGridDataLink.Create(Self); + inherited; + FActiveRecord := -1; + FDBOptions := cDBOptionsDef; + FColors.Free; + FColors := TKDBGridColors.Create(Self); + CellClass := TKDBGridCell; + CellPainterClass := TKDBGridCellPainter; + ColClass := TKDBGridCol; + RealizeColClass; +end; + +destructor TKCustomDBGrid.Destroy; +begin + inherited; + FDataLink.Free; +end; + +function TKCustomDBGrid.BeginRowDrag(var Origin: Integer; + const MousePt: TPoint): Boolean; +begin + // does nothing + Result := False; +end; + +procedure TKCustomDBGrid.BeforeCellUpdate(ACol, ARow: Integer); +begin + if FDataLink.Active and not FDataLink.ReadOnly then + begin + InternalSetActiveRecord(ARow - FixedRows); + FDataLink.Edit; + FDataLink.Modified := True; + end; +end; + +procedure TKCustomDBGrid.Changed; +begin + inherited; + FDataLink.Edit; + FDataLink.Modified := True; +end; + +procedure TKCustomDBGrid.ClearCol(ACol: Integer); +begin + // does nothing +end; + +procedure TKCustomDBGrid.ClearGrid; +begin + // does nothing +end; + +procedure TKCustomDBGrid.ClearRow(ARow: Integer); +begin + // does nothing +end; + +procedure TKCustomDBGrid.ColMoved(FromIndex, ToIndex: Integer); +begin + inherited; + DataChanged; +end; + +procedure TKCustomDBGrid.Commit; +begin + if Assigned(FDataLink.DataSet) and FDataLink.Modified then + FDataLink.DataSet.Post; +end; + +function TKCustomDBGrid.CustomSortRows(ByCol: Integer; var SortMode: TKGridSortMode): Boolean; +begin + if Assigned(FDataLink.DataSet) and FDataLink.Active then + begin + Commit; + Result := inherited CustomSortRows(ByCol, SortMode); + if Result then + ClearSortModeVert + else + SortMode := smNone; + end else + begin + ClearSortModeHorz; + Result := False; + end; +end; + +procedure TKCustomDBGrid.DataChanged; +var + I, Index, J, Tmp, LastRow: Integer; + S: WideString; + ADataType: TFieldType; + Cell: TKGridCell; +begin + if Assigned(FDataLink.DataSet) and not Flag(cGF_DBDataUpdating) then + begin + FlagSet(cGF_DBDataUpdating); + try + if FDataLink.Active then + begin + RowCount := FixedRows + FDataLink.DataSet.RecordCount; + if FixedCols + FDataLink.DataSet.FieldCount <> ColCount then + begin + ClearSortMode; + ColCount := FixedCols + FDataLink.DataSet.FieldCount; + for I := 0 to ColCount - 1 do + Cols[I].InitialPos := I; + end; + if FDataLink.DataSet.RecNo >= 1 then + begin + Tmp := FixedRows + FDataLink.DataSet.RecNo - 1; + if not Flag(cGF_DBInternalChanging) and (Row <> Tmp) then + begin + if dboAutoMoveRecord in FDBOptions then + Row := Tmp + else + EditorMode := False; + end; + end; + LastRow := Min(LastVisibleRow + 1, RowCount - 1); + // here memory only grows. I don't know if it is possible to make this more memory effective + FDataLink.BufferCount := Max(FDataLink.BufferCount, Max(LastRow, FDataLink.DataSet.RecNo - 1) + 1); + if (dboIndexFixedCol in FDBOptions) and (FixedCols > 0) then + begin + Cell := InternalGetCell(0, 0); + if Cell is TKDBGridCell then + TKDBGridCell(Cell).Text := SKDBGridIndex; + end; + Tmp := FDataLink.ActiveRecord; + try + for I := FixedCols to ColCount - 1 do + begin + Index := Cols[I].InitialPos; + if Index < ColCount then + begin + S := FDataLink.DataSet.FieldDefs[Index - FixedCols].Name; + ADataType := FDataLink.DataSet.FieldDefs[Index - FixedCols].DataType; + if Cols[I] is TKDBGridCol then + begin + TKDBGridCol(Cols[I]).FName := S; + TKDBGridCol(Cols[I]).FDataType := ADataType; + end; + if dboColNamesToHeader in FDBOptions then + begin + Cell := InternalGetCell(I, 0); + if Cell is TKDBGridCell then + TKDBGridCell(Cell).Text := S; + end; + if (dboAutoSizeBooleanCells in FDBOptions) and (ADataType = ftBoolean) then + begin + ColWidths[I] := cCheckBoxFrameSize + CellPainter.HPadding * 2; + Cols[I].CanResize := False; + end; + end; + end; + for J := TopRow to LastRow do + begin + FDataLink.ActiveRecord := J - FixedRows; + if (FDataLink.ActiveRecord <> Tmp) or not FDataLink.Modified then + for I := FixedCols to ColCount - 1 do + begin + Index := Cols[I].InitialPos; + if Index < ColCount then + begin + Cell := InternalGetCell(I, J); + if Cell is TKDBGridCell then + begin + TKDBGridCell(Cell).FieldToCell(FDataLink.DataSet.Fields[Index - FixedCols]); + if Assigned(TKDBGridCell(Cell).Graphic) then + begin + if dboAutoSizeImageCells in FDBOptions then + begin + if ColWidths[I] > 0 then + ColWidths[I] := Max(ColWidths[I], TKDBGridCell(Cell).Graphic.Width + CellPainter.GraphicHPadding * 2); + if RowHeights[J] > 0 then + RowHeights[J] := Max(RowHeights[J], TKDBGridCell(Cell).Graphic.Height + CellPainter.GraphicVPadding * 2); + end; + if dboImageHint in FDBOptions then + Cols[I].CellHint := True; + end; + end; + end; + end; + if (dboIndexFixedCol in FDBOptions) and (FixedCols > 0) then + begin + Cell := InternalGetCell(0, J); + if Cell is TKDBGridCell then + begin + TKDBGridCell(Cell).Text := IntToStr(J - FixedRows + 1); + if Cell is TKGridAttrTextCell then + TKGridAttrTextCell(Cell).HAlign := halRight; + end; + end; + end; + finally + FDataLink.ActiveRecord := Tmp; + end; + if dboIndicateActiveRecord in FDBOptions then + begin + if FDataLink.ActiveRecord <> FActiveRecord then + begin + if FActiveRecord >= 0 then + InvalidateRow(FActiveRecord + FixedRows); + FActiveRecord := FDataLink.ActiveRecord; + InvalidateRow(FActiveRecord + FixedRows); + end; + end; + end else + begin + RowCount := FixedRows + 1; + FMaxRow := FixedRows; + if dboDontClearFixedCells in FDBOptions then Tmp := FixedRows else Tmp := 0; + for I := 0 to ColCount - 1 do + begin + Cols[I].InitialPos := I; + if Cols[I] is TKDBGridCol then + begin + TKDBGridCol(Cols[I]).FName := ''; + TKDBGridCol(Cols[I]).FDataType := ftUnknown; + end; + if not (dboDontClearFixedCells in FDBOptions) or (I >= FixedCols) then + begin + for J := Tmp to RowCount - 1 do + begin + Cell := InternalGetCell(I, J); + if Cell is TKDBGridCell then + TKDBGridCell(Cell).Clear; + end; + end; + end; + ClearSortMode; + FActiveRecord := -1; + end; + finally + FlagClear(cGF_DBDataUpdating); + end; + end; +end; + +procedure TKCustomDBGrid.DataSetScrolled; +begin + DataChanged; +end; + +procedure TKCustomDBGrid.DefaultEditorCreate(ACol, ARow: Integer; var AEditor: TWinControl); +begin + // create custom editors according to table column type + if Cols[ACol] is TKDBGridCol then + case TKDBGridCol(Cols[ACol]).DataType of + ftString, ftWideString, ftInteger, ftSmallInt, ftWord, ftLargeInt, ftFloat, ftCurrency, ftBcd: + begin + AEditor := TEdit.Create(nil); + end; + ftMemo + {$IF DEFINED(FPC) OR DEFINED(COMPILER10_UP)} + , ftWideMemo + {$IFEND} + : + begin + AEditor := TMemo.Create(nil); + end; + ftDate, ftTime, ftDateTime: + begin + AEditor := {$IFDEF FPC}TDateEdit{$ELSE}TDateTimePicker{$ENDIF}.Create(nil); + end; + ftBoolean: + begin + AEditor := TCheckBox.Create(nil); + end; + else + AEditor := nil; + end + else + AEditor := nil; +end; + +procedure TKCustomDBGrid.DefaultEditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer; var AssignText: Boolean); +begin + if Cols[ACol] is TKDBGridCol then + case TKDBGridCol(Cols[ACol]).DataType of + ftDate, ftTime, ftDateTime: + if AEditor is {$IFDEF FPC}TDateEdit{$ELSE}TDateTimePicker{$ENDIF} then + begin + {$IFDEF FPC} + TDateEdit(AEditor).Date := + {$ELSE} + TDateTimePicker(AEditor).DateTime := + {$ENDIF} + StrToDateTime(Cells[ACol, ARow]); + AssignText := False; + end; + ftCurrency, ftBcd: + if AEditor is TEdit then + begin + TEdit(AEditor).Text := CurrToStrF(StrToCurrDef(Cells[ACol, ARow], 0), + ffFixed, TKDBGridCol(Cols[ACol]).CurrencyFormat.CurrencyDecimals); + AssignText := False; + end; + ftBoolean: + if AEditor is TCheckBox then + begin + TCheckBox(AEditor).Checked := LowerCase(Cells[ACol, ARow]) = 'true'; + AssignText := False; + end; + end; +end; + +procedure TKCustomDBGrid.DefaultEditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer; var AssignText: Boolean); +var + I: Int64; + ADataType: TFieldType; +begin + if Cols[ACol] is TKDBGridCol then + begin + ADataType := TKDBGridCol(Cols[ACol]).DataType; + case ADataType of + ftDate, ftTime, ftDateTime: + if AEditor is {$IFDEF FPC}TDateEdit{$ELSE}TDateTimePicker{$ENDIF} then + begin + Cells[ACol, ARow] := DateTimeToStr( + {$IFDEF FPC} + TDateEdit(AEditor).Date); + {$ELSE} + TDateTimePicker(AEditor).DateTime); + {$ENDIF} + AssignText := False; + end; + ftLargeInt, ftInteger, ftSmallInt, ftWord: + if AEditor is TEdit then + begin + I := StrToInt64Def(TEdit(AEditor).Text, 0); + case ADataType of + ftInteger: I := MinMax(I, -MaxInt - 1, MaxInt); + ftSmallInt: I := MinMax(I, -32768, 32767); + ftWord: I := MinMax(I, 0, 65535); + end; + Cells[ACol, ARow] := IntToStr(I); + AssignText := False; + end; + ftFloat: + if AEditor is TEdit then + begin + Cells[ACol, ARow] := FloatToStr(StrToFloatDef(TEdit(AEditor).Text, 0)); + AssignText := False; + end; + ftCurrency, ftBcd: + if AEditor is TEdit then + begin + Cells[ACol, ARow] := CurrToStrF(StrToCurrDef(TEdit(AEditor).Text, 0), + ffFixed, TKDBGridCol(Cols[ACol]).CurrencyFormat.CurrencyDecimals); + AssignText := False; + end; + ftBoolean: + if AEditor is TCheckBox then + begin + if TCheckBox(AEditor).Checked then + Cells[ACol, ARow] := 'True' + else + Cells[ACol, ARow] := 'False'; + AssignText := False; + end; + end; + end; +end; + +procedure TKCustomDBGrid.DefaultEditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); +begin + if Cols[ACol] is TKDBGridCol then + case TKDBGridCol(Cols[ACol]).DataType of + ftBoolean: + {$IFNDEF LCLGTK2} + if AEditor is TCheckBox then + Inc(ARect.Left, 2); + {$ENDIF} + end; +end; + +procedure TKCustomDBGrid.DefaultEditorSelect(AEditor: TWinControl; + ACol, ARow: Integer; SelectAll, CaretToLeft, SelectedByMouse: Boolean); +begin + inherited; + if Cols[ACol] is TKDBGridCol then + case TKDBGridCol(Cols[ACol]).DataType of + ftBoolean: + if (AEditor is TCheckBox) and SelectedByMouse then + ThroughClick := True; + end; +end; + +procedure TKCustomDBGrid.DefaultMouseCellHint(ACol, ARow: Integer; + AShow: Boolean); +var + R: TRect; + Extent: TPoint; + ACell: TKGridCell; + AGraphic: TGraphic; +begin + if ColValid(ACol) and Cols[ACol].CellHint then + begin + ACell := Cell[ACol, ARow]; + if ACell is TKDBGridCell then + begin + AGraphic := TKDBGridCell(ACell).Graphic; + if AGraphic <> nil then + begin + if AShow then + begin + if (ARow >= FixedRows) and ((ARow <> FEditorCell.Row) or (ACol <> FEditorCell.Col) or not EditorMode) and + CellRect(ACol, ARow, R, True) then + begin + Extent := MeasureCell(ACol, ARow, R, GetDrawState(ACol, ARow, HasFocus), mpCellExtent); + if (Extent.X > R.Right - R.Left) or (Extent.Y > R.Bottom - R.Top) then + begin + FreeAndNil(FHint); + FHint := TKGraphicHint.Create(nil); + TKGraphicHint(FHint).Graphic := AGraphic; + Inc(R.Left, 10); + Inc(R.Top, 10); + FHint.ShowAt(ClientToScreen(R.TopLeft)); + end; + end; + end else + FreeAndNil(FHint); + end else + inherited; + end else + inherited; + end else + FreeAndNil(FHint); +end; + +procedure TKCustomDBGrid.DeleteCols(At, Count: Integer); +begin + // does nothing +end; + +procedure TKCustomDBGrid.DeleteRow(At: Integer); +begin + if Assigned(FDataLink.DataSet) and RowValid(At) then + begin + InternalSetActiveRecord(At - FixedRows); + FDataLink.DataSet.Delete; + end; +end; + +procedure TKCustomDBGrid.DeleteRows(At, Count: Integer); +begin + // does nothing +end; + +function TKCustomDBGrid.EditorCreate(ACol, ARow: Integer): TWinControl; +begin + if Assigned(FDataLink.DataSet) and FDataLink.Active and + not FDataLink.ReadOnly and (FDataLink.ActiveRecord = ARow - FixedRows) then + Result := inherited EditorCreate(ACol, ARow) + else + Result := nil; +end; + +function TKCustomDBGrid.GetDataSource: TDataSource; +begin + Result := FDataLink.DataSource; +end; + +procedure TKCustomDBGrid.InsertCols(At, Count: Integer); +begin + // does nothing +end; + +procedure TKCustomDBGrid.InsertRow(At: Integer); +begin + if Assigned(FDataLink.DataSet) and RowValid(At) then + begin + InternalSetActiveRecord(At - FixedRows); + FDataLink.DataSet.Insert; + end; +end; + +procedure TKCustomDBGrid.InsertRows(At, Count: Integer); +begin + // does nothing +end; + +function TKCustomDBGrid.InsertSortedCol(out ByRow, ACol: Integer): Boolean; +begin + // does nothing + Result := False; +end; + +function TKCustomDBGrid.InsertSortedRow(out ByCol, ARow: Integer): Boolean; +begin + // does nothing + Result := False; +end; + +procedure TKCustomDBGrid.InternalSetActiveRecord(Value: Integer); +var + IsEditorMode, IsEditorModeActive: Boolean; +begin + if Assigned(FDataLink.DataSet) and (Value <> FDataLink.ActiveRecord) and + not Flag(cGF_EditorUpdating or cGF_DBInternalChanging) then + begin + FlagSet(cGF_DBInternalChanging); + try + IsEditorMode := EditorMode; + IsEditorModeActive := Flag(cGF_EditorModeActive); + EditorMode := False; + Commit; + FDataLink.MoveBy(Value - FDataLink.ActiveRecord); + EditorMode := IsEditorMode; + if IsEditorModeActive then FlagSet(cGF_EditorModeActive); + finally + FlagClear(cGF_DBInternalChanging); + end; + end; +end; + +procedure TKCustomDBGrid.InternalSetColCount(Value: Integer); +begin + if not FDataLink.Active or Flag(cGF_DBDataUpdating) then + inherited; +end; + +procedure TKCustomDBGrid.InternalSetFixedCols(Value: Integer); +begin + if not FDataLink.Active and not Flag(cGF_DBDataUpdating) then + begin + FlagSet(cGF_DBDataUpdating); + try + inherited; + finally + FlagClear(cGF_DBDataUpdating); + end; + end; +end; + +procedure TKCustomDBGrid.InternalSetFixedRows(Value: Integer); +begin + if not FDataLink.Active and not Flag(cGF_DBDataUpdating) then + begin + FlagSet(cGF_DBDataUpdating); + try + inherited; + finally + FlagClear(cGF_DBDataUpdating); + end; + end; +end; + +procedure TKCustomDBGrid.InternalSetRowCount(Value: Integer); +begin + if not FDataLink.Active or Flag(cGF_DBDataUpdating) then + inherited; +end; + +function TKCustomDBGrid.InternalUpdateVirtualGrid: Boolean; +begin + Result := False; +end; + +procedure TKCustomDBGrid.MoveRow(FromIndex, ToIndex: Integer); +begin + // does nothing +end; + +procedure TKCustomDBGrid.RecordChanged; +var + ARow, I, Index: Integer; + Cell: TKGridCell; +begin + if Assigned(FDataLink.DataSet) and not Flag(cGF_DBDataUpdating) then + begin + FlagSet(cGF_DBDataUpdating); + try + ARow := FDataLink.ActiveRecord + FixedRows; + if Assigned(FDataLink.DataSet) and (ARow < RowCount) then + begin + for I := FixedCols to ColCount - 1 do + begin + Index := Cols[I].InitialPos; + Cell := InternalGetCell(I, ARow); + if Cell is TKDBGridCell then + TKDBGridCell(Cell).FieldToCell(FDataLink.DataSet.Fields[Index - FixedCols]); + end; + end; + finally + FlagClear(cGF_DBDataUpdating); + end; + end; +end; + +function TKCustomDBGrid.SelectCell(ACol, ARow: Integer): Boolean; +begin + Result := inherited SelectCell(ACol, ARow); + if Result and (dboAutoMoveRecord in FDBOptions) then + InternalSetActiveRecord(ARow - FixedRows); +end; + +procedure TKCustomDBGrid.SetDataSource(Value: TDataSource); +begin + if Assigned(FDataLink.DataSource) then FDataLink.DataSource.FreeNotification(Self); + FDataLink.DataSource := Value; +end; + +procedure TKCustomDBGrid.SetDBOptions(const Value: TKDBGridOptions); +begin + if Value <> FDBOptions then + begin + FDBOptions := Value; + DataChanged; + end; +end; + +procedure TKCustomDBGrid.TopLeftChanged; +begin + inherited; + DataChanged; +end; + +procedure TKCustomDBGrid.UpdateData; +var + ARow, I, Index: Integer; + Cell: TKGridCell; +begin + if Assigned(FDataLink.DataSet) and FDataLink.Modified and not Flag(cGF_DBDataUpdating) then + begin + FlagSet(cGF_DBDataUpdating); + try + ARow := FDataLink.ActiveRecord + FixedRows; + for I := FixedCols to ColCount - 1 do + begin + Index := Cols[I].InitialPos; + Cell := InternalGetCell(I, ARow); + if Cell is TKDBGridCell then + TKDBGridCell(Cell).FieldFromCell(FDataLink.DataSet.Fields[Index - FixedCols]); + end; + finally + FlagClear(cGF_DBDataUpdating); + end; + end; +end; + +procedure TKCustomDBGrid.UpdateSize; +begin + inherited; + DataChanged; +end; + +end. diff --git a/components/kcontrols/source/kdialogs.pas b/components/kcontrols/source/kdialogs.pas new file mode 100755 index 000000000..af95bbbe1 --- /dev/null +++ b/components/kcontrols/source/kdialogs.pas @@ -0,0 +1,131 @@ +{ @abstract(This unit contains all dialogs supplied with KControls.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(18 Sep 2009) + @lastmod(14 Oct 2009) + + This unit implements all dialogs supplied with KControls Development Suite. + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KDialogs; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses + Classes, Controls, Forms, KControls, KPrintPreview, KPrintSetup; + +type + { @abstract(Encapsulates the print preview dialog) } + TKPrintPreviewDialog = class(TComponent) + private + FControl: TKCustomControl; + FPrintPreviewForm: TKPrintPreviewForm; + function GetPrintPreviewForm: TKPrintPreviewForm; + public + { Creates the instance. Assigns default values to properties. } + constructor Create(AOwner: TComponent); override; + { Shows the dialog. } + procedure Show; + { Shows the dialog as modal dialog. } + function Execute: Boolean; + { Specifies the associated preview form. } + property PrintPreviewForm: TKPrintPreviewForm read GetPrintPreviewForm; + published + { Specifies the associated control. } + property Control: TKCustomControl read FControl write FControl; + end; + + { @abstract(Encapsulates the print preview dialog) } + TKPrintSetupDialog = class(TComponent) + private + FControl: TKCustomControl; + FPrintSetupForm: TKPrintSetupForm; + FPreviewDialog: TKPrintPreviewDialog; + FSelAvail: Boolean; + public + { Creates the instance. Assigns default values to properties. } + constructor Create(AOwner: TComponent); override; + { Shows the dialog as modal dialog. } + function Execute: Boolean; + published + { Specifies the associated control. } + property Control: TKCustomControl read FControl write FControl; + { Specifies the preview dialog for the Preview... button. + If not specified, the print setup dialog creates a new one. } + property PreviewDialog: TKPrintPreviewDialog read FPreviewDialog write FPreviewDialog; + { If True, the Selection Only option will be checked (if selection is available + for the control). } + property SelAvail: Boolean read FSelAvail write FSelAvail default True; + end; + +implementation + +{ TKPrintPreviewDialog } + +constructor TKPrintPreviewDialog.Create(AOwner: TComponent); +begin + inherited; + FPrintPreviewForm := nil; + FControl := nil; +end; + +function TKPrintPreviewDialog.Execute; +begin + PrintPreviewForm.Preview.Control := FControl; + PrintPreviewForm.ShowModal; + Result := True; +end; + +function TKPrintPreviewDialog.GetPrintPreviewForm: TKPrintPreviewForm; +begin + if not Assigned(FPrintPreviewForm) then + FPrintPreviewForm := TKPrintPreviewForm.Create(Self); + Result := FPrintPreviewForm; +end; + +procedure TKPrintPreviewDialog.Show; +begin + PrintPreviewForm.Preview.Control := FControl; + PrintPreviewForm.Show; +end; + +{ TKPrintSetupDialog } + +constructor TKPrintSetupDialog.Create(AOwner: TComponent); +begin + inherited; + FControl := nil; + FPrintSetupForm := nil; + FPreviewDialog := nil; + FSelAvail := True; +end; + +function TKPrintSetupDialog.Execute: Boolean; +begin + if Assigned(FControl) then + begin + if not Assigned(FPrintSetupForm) then + FPrintSetupForm := TKPrintSetupForm.Create(Self); + FPrintSetupForm.PageSetup := FControl.PageSetup; + if Assigned(FPreviewDialog) then + FPrintSetupForm.PreviewForm := FPreviewDialog.PrintPreviewForm; + FPrintSetupForm.SelAvail := FSelAvail; + Result := FPrintSetupForm.ShowModal = mrOk; + end else + Result := False; +end; + +end. diff --git a/components/kcontrols/source/keditcommon.pas b/components/kcontrols/source/keditcommon.pas new file mode 100755 index 000000000..b0a64d939 --- /dev/null +++ b/components/kcontrols/source/keditcommon.pas @@ -0,0 +1,413 @@ +{ @abstract(This unit contains the common declarations for all edit controls.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(18 Sep 2009) + @lastmod(20 Jun 2010) + + This unit defines common types and functions for all edit controls. + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KEditCommon; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LCLProc, LResources, +{$ELSE} + Windows, Messages, +{$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms; + +type + { Declares possible values for the edit control commands. } + TKEditCommand = ( + { Move caret left one char } + ecLeft, + { Move caret right one char } + ecRight, + { Move caret up one line } + ecUp, + { Move caret down one line } + ecDown, + { Move caret to beginning of line } + ecLineStart, + { Move caret to end of line } + ecLineEnd, + { Move caret up one page } + ecPageUp, + { Move caret down one page } + ecPageDown, + { Move caret left one page } + ecPageLeft, + { Move caret right one page } + ecPageRight, + { Move caret to top of page } + ecPageTop, + { Move caret to bottom of page } + ecPageBottom, + { Move caret to absolute beginning } + ecEditorTop, + { Move caret to absolute end } + ecEditorBottom, + { Move caret to specific coordinates, Data = ^TPoint } + ecGotoXY, + { Move caret left one char } + ecSelLeft, + { Move caret right one char, affecting selection } + ecSelRight, + { Move caret up one line, affecting selection } + ecSelUp, + { Move caret down one line, affecting selection } + ecSelDown, + { Move caret to beginning of line, affecting selection } + ecSelLineStart, + { Move caret to end of line, affecting selection } + ecSelLineEnd, + { Move caret up one page, affecting selection } + ecSelPageUp, + { Move caret down one page, affecting selection } + ecSelPageDown, + { Move caret left one page, affecting selection } + ecSelPageLeft, + { Move caret right one page, affecting selection } + ecSelPageRight, + { Move caret to top of page, affecting selection } + ecSelPageTop, + { Move caret to bottom of page, affecting selection } + ecSelPageBottom, + { Move caret to absolute beginning, affecting selection } + ecSelEditorTop, + { Move caret to absolute end, affecting selection } + ecSelEditorBottom, + { Move caret to specific coordinates, affecting selection, Data = ^TPoint } + ecSelGotoXY, + { Scroll up one line leaving caret position unchanged } + ecScrollUp, + { Scroll down one line leaving caret position unchanged } + ecScrollDown, + { Scroll left one char leaving caret position unchanged } + ecScrollLeft, + { Scroll right one char leaving caret position unchanged } + ecScrollRight, + { Scroll to center the caret position within client area } + ecScrollCenter, + { Undo previous action } + ecUndo, + { Redo last undone action } + ecRedo, + { Copy selection to clipboard } + ecCopy, + { Cut selection to clipboard } + ecCut, + { Paste clipboard to current position } + ecPaste, + { Insert character at current position, Data = ^Char } + ecInsertChar, + { Insert digits (digit string) at current position, Data = ^string + (must contain digits only), TKCustomHexEditor only } + ecInsertDigits, + { Insert string (multiple characters) at current position, Data = ^string } + ecInsertString, + { Delete last character (i.e. backspace key) } + ecDeleteLastChar, + { Delete character at caret (i.e. delete key) } + ecDeleteChar, + { Delete from caret to beginning of line } + ecDeleteBOL, + { Delete from caret to end of line } + ecDeleteEOL, + { Delete current line } + ecDeleteLine, + { Select everything } + ecSelectAll, + { Delete everything } + ecClearAll, + { Delete selection (no digit selection), TKCustomHexEditor only } + ecClearIndexSelection, + { Delete selection (digit selection as well) } + ecClearSelection, + { Search for text/digits } + ecSearch, + { Replace text/digits } + ecReplace, + { Set insert mode } + ecInsertMode, + { Set overwrite mode } + ecOverwriteMode, + { Toggle insert/overwrite mode } + ecToggleMode, + { Adjust editor when getting input focus } + ecGotFocus, + { Adjust editor when losing input focus } + ecLostFocus + ); + + { @abstract(Declares the keystroke information structure for the Key member + of the @link(TKEditCommandAssignment) structure) + + } + TKEditKey = record + Key: Word; + Shift: TShiftState; + end; + + { @abstract(Declares the @link(TKEditKeyMapping) array item) + + } + TKEditCommandAssignment = record + Command: TKEditCommand; + Key: TKEditKey; + end; + + { @abstract(Declares OnDropFiles event handler) + + } + TKEditDropFilesEvent = procedure(Sender: TObject; X, Y: integer; + Files: TStrings) of object; + + { Declares key mapping array for the KeyMapping property } + TKEditKeyMapping = array of TKEditCommandAssignment; + + { Declares character mapping array for the @link(TKCustomHexEditor.CharMapping) property } + TKEditCharMapping = array of AnsiChar; + + { Pointer to @link(TKHexEditorCharMapping) } + PKEditCharMapping = ^TKEditCharMapping; + + { Declares options - possible values for the @link(TKCustomEdit.Options) property } + TKEditOption = ( + { The editor will receive dropped files } + eoDropFiles, + { All undo/redo operations of the same kind will be grouped together } + eoGroupUndo, + { The editor allows undo/redo operations after the @link(TKCustomEdit.Modified) property + has been set to False } + eoUndoAfterSave + ); + + { Options can be arbitrary combined } + TKEditOptions = set of TKEditOption; + + { Declares possible values for the Action parameter in the @link(TKEditReplaceTextEvent) event } + TKEditReplaceAction = ( + { Quit replace sequence } + eraCancel, + { Replace this occurence } + eraYes, + { Don't replace this occurence } + eraNo, + { Replace all following occurences without prompting } + eraAll + ); + + { @abstract(Declares OnReplaceText event handler) + + } + TKEditReplaceTextEvent = procedure(Sender: TObject; const TextToFind, TextToReplace: + string; var Action: TKEditReplaceAction) of object; + + { Declares possible values for the ErrorReason member of the @link(TKEditSearchData) structure } + TKEditSearchError = ( + { No error occured } + eseOk, + { There is a character in the search string that cannot be interpreted as hexadecimal digits} + eseNoDigitsFind, + { There is a character in the replace string that cannot be interpreted as hexadecimal digits} + eseNoDigitsReplace, + { No other search string found } + eseNoMatch + ); + + { Declares search options - possible values for the Options member of the @link(TKEditSearchData) structure } + TKEditSearchOption = ( + { Replace all occurences } + esoAll, + { Search backwards } + esoBackwards, + { Search entire scope instead from current caret position } + esoEntireScope, + { Include to identify search - this element will be automatically cleared + to provide the @link(TKEditSearchData) structure for additional search } + esoFirstSearch, + { Match case when a binary search should be executed } + esoMatchCase, + { Prompt user before a string is about to be replaced. This assumes @link(OnReplaceText) + is assigned } + esoPrompt, + { Search the current selection only } + esoSelectedOnly, + { Treat the supplied search and/or replace strings as hexadecimal sequence. + When the search string contains a character that cannot be interpreted as + hexadecimal digit, the execution stops and @link(eseNoDigits) error will + be returned. Similarly, @link(eseNoDigitsReplace) errors will be returned + on invalid replace string } + esoTreatAsDigits, + { Internal option - don't modify } + esoWereDigits + ); + + { Search options can be arbitrary combined } + TKEditSearchOptions = set of TKEditSearchOption; + + { @abstract(Declares the search/replace description structure for the @link(ecSearch) + and @link(ecReplace) commands) + + } + TKEditSearchData = record + ErrorReason: TKEditSearchError; + Options: TKEditSearchOptions; + SelStart, + SelEnd: Integer; + TextToFind, + TextToReplace: string; + end; + + { Pointer to @link(TKEditSearchData) } + PKEditSearchData = ^TKEditSearchData; + +{ Returns default key mapping structure } +function CreateDefaultKeyMapping: TKEditKeyMapping; + +{ Returns default char mapping structure } +function DefaultCharMapping: TKEditCharMapping; + +{ Returns default search data structure } +function DefaultSearchData: TKEditSearchData; + +implementation + +function CreateDefaultKeyMapping: TKEditKeyMapping; + + procedure AddKey(Command: TKEditCommand; Key: Word; Shift: TShiftState); + var + I: Integer; + begin + I := Length(Result); + SetLength(Result, I + 1); + Result[I].Command := Command; + Result[I].Key.Key := Key; + Result[I].Key.Shift := Shift; + end; + +begin + AddKey(ecLeft, VK_LEFT, []); + AddKey(ecRight, VK_RIGHT, []); + AddKey(ecRight, VK_RETURN, []); + AddKey(ecUp, VK_UP, []); + AddKey(ecDown, VK_DOWN, []); + AddKey(ecLineStart, VK_HOME, []); + AddKey(ecLineEnd, VK_END, []); + AddKey(ecPageUp, VK_PRIOR, []); + AddKey(ecPageDown, VK_NEXT, []); + AddKey(ecPageLeft, VK_LEFT, [ssCtrl, ssAlt]); + AddKey(ecPageRight, VK_RIGHT, [ssCtrl, ssAlt]); + AddKey(ecPageTop, VK_PRIOR, [ssCtrl]); + AddKey(ecPageBottom, VK_NEXT, [ssCtrl]); + AddKey(ecEditorTop, VK_HOME, [ssCtrl]); + AddKey(ecEditorBottom, VK_END, [ssCtrl]); + AddKey(ecSelLeft, VK_LEFT, [ssShift]); + AddKey(ecSelRight, VK_RIGHT, [ssShift]); + AddKey(ecSelUp, VK_UP, [ssShift]); + AddKey(ecSelDown, VK_DOWN, [ssShift]); + AddKey(ecSelLineStart, VK_HOME, [ssShift]); + AddKey(ecSelLineEnd, VK_END, [ssShift]); + AddKey(ecSelPageUp, VK_PRIOR, [ssShift]); + AddKey(ecSelPageDown, VK_NEXT, [ssShift]); + AddKey(ecSelPageLeft, VK_LEFT, [ssShift, ssCtrl, ssAlt]); + AddKey(ecSelPageRight, VK_RIGHT, [ssShift, ssCtrl, ssAlt]); + AddKey(ecSelPageTop, VK_PRIOR, [ssShift, ssCtrl]); + AddKey(ecSelPageBottom, VK_NEXT, [ssShift, ssCtrl]); + AddKey(ecSelEditorTop, VK_HOME, [ssShift, ssCtrl]); + AddKey(ecSelEditorBottom, VK_END, [ssShift, ssCtrl]); + AddKey(ecScrollUp, VK_UP, [ssCtrl]); + AddKey(ecScrollDown, VK_DOWN, [ssCtrl]); + AddKey(ecScrollLeft, VK_LEFT, [ssCtrl]); + AddKey(ecScrollRight, VK_RIGHT, [ssCtrl]); + AddKey(ecScrollCenter, VK_RETURN, [ssCtrl]); + AddKey(ecUndo, ord('Z'), [ssCtrl]); + AddKey(ecUndo, VK_BACK, [ssAlt]); + AddKey(ecRedo, ord('Z'), [ssShift, ssCtrl]); + AddKey(ecRedo, VK_BACK, [ssShift, ssAlt]); + AddKey(ecCopy, ord('C'), [ssCtrl]); + AddKey(ecCopy, VK_INSERT, [ssCtrl]); + AddKey(ecCut, ord('X'), [ssCtrl]); + AddKey(ecCut, VK_DELETE, [ssShift]); + AddKey(ecPaste, ord('V'), [ssCtrl]); + AddKey(ecPaste, VK_INSERT, [ssShift]); + AddKey(ecDeleteLastChar, VK_BACK, []); + AddKey(ecDeleteLastChar, VK_BACK, [ssShift]); + AddKey(ecDeleteChar, VK_DELETE, []); + AddKey(ecDeleteEOL, ord('Y'), [ssCtrl,ssShift]); + AddKey(ecDeleteLine, ord('Y'), [ssCtrl]); + AddKey(ecSelectAll, ord('A'), [ssCtrl]); + AddKey(ecToggleMode, VK_INSERT, []); +end; + +function DefaultCharMapping: TKEditCharMapping; +var + I: Integer; +begin + SetLength(Result, 256); + for I := 0 to Length(Result) - 1 do + if (I < $20) or (I >= $80) then + Result[I] := '.' + else + Result[I] := AnsiChar(I); +end; + +function DefaultSearchData: TKEditSearchData; +begin + with Result do + begin + ErrorReason := eseOk; + Options := [esoAll, esoFirstSearch, esoPrompt, esoTreatAsDigits]; + SelStart := 0; + SelEnd := 0; + TextToFind := ''; + TextToReplace := ''; + end; +end; + +end. diff --git a/components/kcontrols/source/kfunctions.pas b/components/kcontrols/source/kfunctions.pas new file mode 100755 index 000000000..8fc6ea2e8 --- /dev/null +++ b/components/kcontrols/source/kfunctions.pas @@ -0,0 +1,1365 @@ +{ @abstract(This unit contains miscellaneous supporting functions) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(20 Oct 2001) + @lastmod(20 Jun 2010) + + Copyright © 2001 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KFunctions; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + // use the LCL interface support whenever possible + {$IFDEF USE_WINAPI} + Windows, + {$ENDIF} + LCLType, LCLIntf, LMessages, LCLProc, LCLVersion, +{$ELSE} + Windows, Messages, +{$ENDIF} + Classes, Controls, ComCtrls, Graphics; + +const +{$IFNDEF FPC} + { @exclude } + KM_MOUSELEAVE = WM_MOUSELEAVE; + { @exclude } + LM_USER = WM_USER; + { @exclude } + LM_CANCELMODE = WM_CANCELMODE; + { @exclude } + LM_CHAR = WM_CHAR; + { @exclude } + LM_DROPFILES = WM_DROPFILES; + { @exclude } + LM_ERASEBKGND = WM_ERASEBKGND; + { @exclude } + LM_GETDLGCODE = WM_GETDLGCODE; + { @exclude } + LM_HSCROLL = WM_HSCROLL; + { @exclude } + LM_KEYDOWN = WM_KEYDOWN; + { @exclude } + LM_KILLFOCUS = WM_KILLFOCUS; + { @exclude } + LM_LBUTTONDOWN = WM_LBUTTONDOWN; + { @exclude } + LM_LBUTTONUP = WM_LBUTTONUP; + { @exclude } + LM_MOUSEMOVE = WM_MOUSEMOVE; + { @exclude } + LM_SETFOCUS = WM_SETFOCUS; + { @exclude } + LM_SIZE = WM_SIZE; + { @exclude } + LM_VSCROLL = WM_VSCROLL; + { @exclude } + LCL_MAJOR = 0; + { @exclude } + LCL_MINOR = 0; + { @exclude } + LCL_RELEASE = 0; + +{$ELSE} + // hope this is correct about WM_MOUSELEAVE otherwise adapt it as you wish + {$IFDEF LCLWin32} + {$IF ((LCL_MAJOR=0) AND (LCL_MINOR=9) AND (LCL_RELEASE<27))} + { @exclude } + KM_MOUSELEAVE = LM_LEAVE; // LCL 0.9.26.2- + {$ELSE} + { @exclude } + KM_MOUSELEAVE = LM_MOUSELEAVE; // LCL 0.9.27+ + {$IFEND} + {$ELSE} + {$IFDEF LCLWinCE} + { @exclude } + KM_MOUSELEAVE = LM_LEAVE; + {$ELSE} + { @exclude } + KM_MOUSELEAVE = LM_MOUSELEAVE; + {$ENDIF} + {$ENDIF} + { @exclude } + //WM_CTLCOLORBTN = Messages.WM_CTLCOLORBTN; + { @exclude } + //WM_CTLCOLORSTATIC = Messages.WM_CTLCOLORSTATIC; +{$ENDIF} + +{$IFDEF USE_WINAPI} + { @exclude } + SHFolderDll = 'SHFolder.dll'; +{$ENDIF} + + { Base for custom messages used by KControls suite. } + KM_BASE = LM_USER + 1024; + + { Custom message. } + KM_LATEUPDATE = KM_BASE + 1; + + { Constant for horizontal resize cursor. } + crHResize = TCursor(101); + { Constant for vertical resize cursor. } + crVResize = TCursor(102); + { Constant for uncaptured dragging cursor. } + crDragHandFree = TCursor(103); + { Constant for captured dragging cursor. } + crDragHandGrip = TCursor(104); + + { Checkbox frame size in logical screen units. } + cCheckBoxFrameSize = 13; + + { Set of word break characters. } + cWordBreaks = [#0, #9, #32]; + { Set of line break characters. } + cLineBreaks = [#10, #13]; + { Carriage return character. } + cCR = #10; + { Line feed character. } + cLF = #13; + { Text ellipsis string. } + cEllipsis = '...'; + +type +{$IFNDEF FPC} + { @exclude } + TLMessage = TMessage; + { @exclude } + TLMMouse = TWMMouse; + { @exclude } + TLMNoParams = TWMNoParams; + { @exclude } + TLMKey = TWMKey; + { @exclude } + TLMChar = TWMChar; + { @exclude } + TLMEraseBkGnd = TWMEraseBkGnd; + { @exclude } + TLMHScroll = TWMHScroll; + { @exclude } + TLMKillFocus = TWMKillFocus; + { @exclude } + TLMSetFocus = TWMSetFocus; + { @exclude } + TLMSize = TWMSize; + { @exclude } + TLMVScroll = TWMVScroll; +{$ENDIF} + + //PInteger = ^Integer; defined by System.pas + { Static array for Integer. } + TIntegers = array[0..MaxInt div SizeOf(Integer) - 1] of Integer; + { Pointer for TIntegers. } + PIntegers = ^TIntegers; + { Dynamic array for Integer. } + TDynIntegers = array of Integer; + + //PCardinal = ^Cardinal; defined by System.pas + { Static array for Cardinal. } + TCardinals = array[0..MaxInt div SizeOf(Cardinal) - 1] of Cardinal; + { Pointer for TCardinals. } + PCardinals = ^TCardinals; + { Dynamic array for Cardinal. } + TDynCardinals = array of Cardinal; + + //PShortInt = ^ShortInt; defined by System.pas + { Static array for ShortInt. } + TShortInts = array[0..MaxInt div SizeOf(ShortInt) - 1] of ShortInt; + { Pointer for TShortInts. } + PShortInts = ^TShortInts; + { Dynamic array for ShortInt. } + TDynShortInts = array of ShortInt; + + //PSmallInt = ^SmallInt; defined by System.pas + { Static array for SmallInt. } + TSmallInts = array[0..MaxInt div SizeOf(SmallInt) - 1] of SmallInt; + { Pointer for TSmallInts. } + PSmallInts = ^TSmallInts; + { Dynamic array for SmallInt. } + TDynSmallInts = array of SmallInt; + + //PLongInt = ^LongInt; defined by System.pas + { Static array for LongInt. } + TLongInts = array[0..MaxInt div SizeOf(LongInt) - 1] of LongInt; + { Pointer for TLongInts. } + PLongInts = ^TLongInts; + { Dynamic array for LongInt. } + TDynLongInts = array of LongInt; + + //PInt64 = ^Int64; defined by System.pas + { Static array for Int64. } + TInt64s = array[0..MaxInt div SizeOf(Int64) - 1] of Int64; + { Pointer for TInt64s. } + PInt64s = ^TInt64s; + { Dynamic array for Int64. } + TDynInt64s = array of Int64; + + //PByte = ^Byte; defined by System.pas + { Static array for Byte. } + TBytes = array[0..MaxInt div SizeOf(Byte) - 1] of Byte; + { Pointer for TBytes. } + PBytes = ^TBytes; + { Dynamic array for Byte. } + TDynBytes = array of Byte; + + //PWord = ^Word; defined by System.pas + { Static array for Word. } + TWords = array[0..MaxInt div SizeOf(Word) - 1] of Word; + { Pointer for TWords. } + PWords = ^TWords; + { Dynamic array for Word. } + TDynWords = array of Word; + + //PLongWord = ^LongWord; defined by System.pas + { Static array for LongWord. } + TLongWords = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord; + { Pointer for TLongWords. } + PLongWords = ^TLongWords; + { Dynamic array for LongWord. } + TDynLongWords = array of LongWord; + +{$IFDEF COMPILER10_UP} + { Static array for UInt64. } + TUInt64s = array[0..MaxInt div SizeOf(UInt64) - 1] of UInt64; + { Pointer for TUInt64s. } + PUInt64s = ^TUInt64s; + { Dynamic array for UInt64. } + TDynUInt64s = array of UInt64; +{$ENDIF} + + //PSingle = ^Single; defined by System.pas + { Static array for Single. } + TSingles = array[0..MaxInt div SizeOf(Single) - 1] of Single; + { Pointer for TSingles. } + PSingles = ^TSingles; + { Dynamic array for Single. } + TDynSingles = array of Single; + + //PDouble = ^Double; defined by System.pas + { Static array for Double. } + TDoubles = array[0..MaxInt div SizeOf(Double) - 1] of Double; + { Pointer for TDoubles. } + PDoubles = ^TDoubles; + { Dynamic array for Double. } + TDynDoubles = array of Double; + +{$IFNDEF FPC} + //PExtended = ^Extended; defined by System.pas + { Static array for Extended. } + TExtendeds = array[0..MaxInt div SizeOf(Extended) - 1] of Extended; + { Pointer for TExtendeds. } + PExtendeds = ^TExtendeds; + { Dynamic array for Extended. } + TDynExtendeds = array of Extended; +{$ENDIF} + + //PChar is special type + { Static array for Char. } + TChars = array[0..MaxInt div SizeOf(Char) - 1] of Char; + { Pointer for TChars. } + PChars = ^TChars; + { Dynamic array for Char. } + TDynChars = array of Char; + + { Useful structure to handle general data and size as a single item } + TDataSize = record + Data: Pointer; + Size: Integer; + end; + { Pointer for TDataSize } + PDataSize = ^TDataSize; + + { Set type for @link(CharInSetEx). } + TKSysCharSet = set of AnsiChar; + + { Defines a currency format settings for @link(FormatCurrency). } + TKCurrencyFormat = record + CurrencyFormat, + CurrencyDecimals: Byte; + CurrencyString: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + DecimalSep: Char; + ThousandSep: Char; + UseThousandSep: Boolean; + end; + +{ Replaces possible decimal separators in S with DecimalSeparator variable.} +function AdjustDecimalSeparator(const S: string): string; + +{$IFNDEF FPC} +{ Converts an AnsiString into a PWideChar string. If CodePage is not set + the current system code page for ANSI-UTFx translations will be used. } +function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal = CP_ACP): PWideChar; +{$ENDIF} + +{ Under Windows this function calls the WinAPI TrackMouseEvent. Under other OSes + the implementation is still missing. } +procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); + +{ Compiler independent Delphi2009-like CharInSet function for ANSI characters. } +function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; overload; + +{ Compiler independent Delphi2009-like CharInSet function for Unicode characters. } +function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; overload; + +{ Compares two Integers. Returns 1 if I1 > I2, -1 if I1 < I2 and 0 if I1 = I2. } +function CompareIntegers(I1, I2: Integer): Integer; + +{ Compares two PWideChar strings. Returns 1 if W1 > W2, -1 if W1 < W2 and + 0 if W1 = W2. The strings will be compared using the default user locale + unless another locale has been specified in Locale. } +function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; + +{$IFDEF STRING_IS_UNICODE} +{ Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, + -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default + user locale unless another locale has been specified in Locale. } +function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; +{$ENDIF} + +{ Compares two WideString strings. Returns 1 if W1 > W2, -1 if W1 < W2 and + 0 if W1 = W2. The strings will be compared using the default user locale + unless another locale has been specified in Locale. } +function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; + +{$IFDEF STRING_IS_UNICODE} +{ Compares two Unicode strings (Lazarus, Delphi 2009 and better). Returns 1 if S1 > S2, + -1 if S1 < S2 and 0 if S1 = S2. The strings will be compared using the default + user locale unless another locale has been specified in Locale. } +function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal = LOCALE_USER_DEFAULT{$ENDIF}): Integer; +{$ENDIF} + +{ Performs integer division. If there is a nonzero remainder, + the result will be incremented. } +function DivUp(Dividend, Divisor: Integer): Integer; + +{ Performs integer division. If there is a nonzero remainder, + the result will be decremented. } +function DivDown(Dividend, Divisor: Integer): Integer; + +{ Raises a general exception with associated message Msg. } +procedure Error(const Msg: string); + +{ Swaps values of two SmallInt variables. } +procedure Exchange(var Value1, Value2: SmallInt); overload; +{ Swaps values of two ShortInt variables. } +procedure Exchange(var Value1, Value2: ShortInt); overload; +{ Swaps values of two Integer variables. } +procedure Exchange(var Value1, Value2: Integer); overload; +{ Swaps values of two Int64 variables. } +procedure Exchange(var Value1, Value2: Int64); overload; +{ Swaps values of two Byte variables. } +procedure Exchange(var Value1, Value2: Byte); overload; +{ Swaps values of two Word variables. } +procedure Exchange(var Value1, Value2: Word); overload; +{ Swaps values of two Cardinal variables. } +procedure Exchange(var Value1, Value2: Cardinal); overload; +{$IFDEF COMPILER10_UP } +{ Swaps values of two UInt64 variables. } +procedure Exchange(var Value1, Value2: UInt64); overload; +{$ENDIF} +{ Swaps values of two Single variables. } +procedure Exchange(var Value1, Value2: Single); overload; +{ Swaps values of two Double variables. } +procedure Exchange(var Value1, Value2: Double); overload; +{$IFNDEF FPC} +{ Swaps values of two Extended variables. } +procedure Exchange(var Value1, Value2: Extended); overload; +{$ENDIF} +{ Swaps values of two Char variables. } +procedure Exchange(var Value1, Value2: Char); overload; + +{ Fills the message record. } +function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; + +{ Formats the given currency value with to specified parameters. Not thread safe. } +function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + +{ Returns the module version for given module. Works under WinX only. } +function GetAppVersion(const ALibName: string; var MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; + +{ Returns the Text property of any TWinControl instance as WideString (up to Delphi 2007) + or string (Delphi 2009, Lazarus). } +function GetControlText(Value: TWinControl): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + +{ Returns current status of Shift, Alt and Ctrl keys. } +function GetShiftState: TShiftState; + +{ Converts an integer into binary string with custom alignment + (given by Digits). } +function IntToAscii(Value: Int64; Digits: Integer): string; +{ Converts an integer into binary digit string with custom alignment + (given by Digits) and suffix. } +function IntToBinStr(Value: Int64; Digits: Byte; const Suffix: string): string; +{ Converts an integer value into BCD number. } +function IntToBCD(Value: Cardinal): Cardinal; +{ Converts an integer into decimal digit string. Equals to IntToStr. } +function IntToDecStr(Value: Int64): string; +{ Converts an integer into hexadecimal digit string with custom alignment + (given by Digits), prefix and suffix. Digits represented by alphabetical + characters can be either in lower or upper case. } +function IntToHexStr(Value: Int64; Digits: Byte; const Prefix, Suffix: string; + UseLowerCase: Boolean): string; + +function IntPowerInt(Value: Int64; Exponent: Integer): Int64; + +{ Converts a binary string into integer with custom alignment (given by Digits). } +function AsciiToInt(S: string; Digits: Integer): Int64; +{ Converts a BCD number into integer value. } +function BCDToInt(Value: Cardinal): Cardinal; +{ Converts a binary digit string into integer with custom alignment + (given by Digits) and sign of a value represented by the string (given by Signed). + Code returns either zero for a successful conversion or the position of + first bad character. } +function BinStrToInt(S: string; Digits: Byte; Signed: Boolean; + var Code: Integer): Int64; +{ Converts a decimal digit string into integer. Code returns either zero for + a successful conversion or the position of first bad character. Equals to Val. } +function DecStrToInt(S: string; var Code: Integer): Int64; +{ Converts a hexadecimal digit string into integer with custom alignment + (given by Digits) and sign of a value represented by the string (given by Signed). + Code returns either zero for a successful conversion or the position of + first bad character. } +function HexStrToInt(S: string; Digits: Byte; Signed: Boolean; + var Code: Integer): Int64; + +{ Returns a clipped ShortInt value so that it lies between Min and Max } +function MinMax(Value, Min, Max: ShortInt): ShortInt; overload; +{ Returns a clipped SmallInt value so that it lies between Min and Max } +function MinMax(Value, Min, Max: SmallInt): SmallInt; overload; +{ Returns a clipped Integer value so that it lies between Min and Max } +function MinMax(Value, Min, Max: Integer): Integer; overload; +{ Returns a clipped Int64 value so that it lies between Min and Max } +function MinMax(Value, Min, Max: Int64): Int64; overload; +{ Returns a clipped Single value so that it lies between Min and Max } +function MinMax(Value, Min, Max: Single): Single; overload; +{ Returns a clipped Double value so that it lies between Min and Max } +function MinMax(Value, Min, Max: Double): Double; overload; +{$IFNDEF FPC} +{ Returns a clipped Extended value so that it lies between Min and Max } +function MinMax(Value, Min, Max: Extended): Extended; overload; +{$ENDIF} + +{ Under Windows this function calls the WinAPI SetWindowRgn. Under other OSes + the implementation is still missing. } +procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); + +{ Modifies the Text property of any TWinControl instance. The value is given as + WideString (up to Delphi 2007) or string (Delphi 2009, Lazarus). } +procedure SetControlText(Value: TWinControl; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + +{ Returns next character index for given null terminated string and character index. + Takes MBCS (UTF8 in Lazarus) into account. } +function StrNextCharIndex(AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; Index: Integer): Integer; + +{ Returns the index for given string where character at given index begins. + Takes MBCS (UTF8 in Lazarus) into account. } +function StringCharBegin(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; Index: Integer): Integer; + +{ Returns the number of characters in a string. Under Delphi it equals Length, + under Lazarus it equals UTF8Length. } +function StringLength(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}): Integer; + +{ Returns next character index for given string and character index. + Takes MBCS (UTF8 in Lazarus) into account. } +function StringNextCharIndex(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; Index: Integer): Integer; + +{ Trims characters specified by ASet from the beginning and end of AText. + New text length is returned by ALen. } +procedure TrimWhiteSpaces(var AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; var ALen: Integer; const ASet: TKSysCharSet); overload; + +{ Trims characters specified by ASet from the beginning and end of AText. } +procedure TrimWhiteSpaces(var AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; const ASet: TKSysCharSet); overload; + +{$IFNDEF FPC} +{ Converts a PWideChar string into AnsiString. If CodePage is not set + the current system code page for ANSI-UTFx translations will be used. } +function WideCharToAnsiString(Text: PWideChar; CodePage: Cardinal = CP_ACP): AnsiString; +{$ENDIF} + +{$IFDEF USE_WINAPI} +function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; +{$ENDIF} + +implementation + +uses + Forms, Math, SysUtils, TypInfo +{$IFDEF USE_WINAPI} + , ShlObj +{$ENDIF} +{$IFDEF USE_WIDEWINPROCS} + , KWideWinProcs +{$ENDIF} +; + +function AdjustDecimalSeparator(const S: string): string; +var + I: Integer; +begin + Result := S; + for I := 1 to Length(Result) do + if CharInSetEx(Result[I], [',', '.']) then + Result[I] := DecimalSeparator; +end; + +{$IFNDEF FPC} +function AnsiStringToWideChar(const Text: AnsiString; CodePage: Cardinal): PWideChar; +var + Len: Integer; +begin + Len := MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, nil, 0); + GetMem(Result, Len shl 1); + MultiByteToWideChar(CodePage, 0, PAnsiChar(Text), -1, Result, Len); +end; +{$ENDIF} + +procedure CallTrackMouseEvent(Control: TWinControl; var Status: Boolean); +{$IFDEF USE_WINAPI} +var + TE: TTrackMouseEvent; +begin + if not Status then + begin + TE.cbSize := SizeOf(TE); + TE.dwFlags := TME_LEAVE; + TE.hwndTrack := Control.Handle; + TE.dwHoverTime := HOVER_DEFAULT; + TrackMouseEvent(TE); + Status := True; + end; +end; +{$ELSE} +begin + // This is a TODO for Lazarus team. +end; +{$ENDIF} + +function CharInSetEx(AChar: AnsiChar; const ASet: TKSysCharSet): Boolean; +begin + Result := AChar in ASet; +end; + +function CharInSetEx(AChar: WideChar; const ASet: TKSysCharSet): Boolean; +begin + Result := (Ord(AChar) < $100) and + {$IFDEF COMPILER12_UP} + CharInSet(AChar, ASet); + {$ELSE} + (AnsiChar(AChar) in ASet); + {$ENDIF} +end; + +function CompareIntegers(I1, I2: Integer): Integer; +begin + if I1 > I2 then Result := 1 + else if I1 < I2 then Result := -1 + else Result := 0; +end; + +function CompareWideChars(W1, W2: PWideChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; +begin + if (W1 = nil) or (W2 = nil) then + begin + if W1 <> nil then Result := 1 + else if W2 <> nil then Result := -1 + else Result := 0; + end else + begin + {$IFDEF USE_WIDEWINPROCS} + Result := WideWinProcs.CompareString(Locale, 0, W1, -1, W2, -1); + Dec(Result, 2); + {$ELSE} + Result := WideCompareStr(WideString(W1), WideString(W2)); + {$ENDIF} + end; +end; + +{$IFDEF STRING_IS_UNICODE} +function CompareChars(S1, S2: PChar{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; +begin + if (S1 = nil) or (S2 = nil) then + begin + if S1 <> nil then Result := 1 + else if S2 <> nil then Result := -1 + else Result := 0; + end else + begin + {$IFDEF USE_WIDEWINPROCS} + Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); + Dec(Result, 2); + {$ELSE} + Result := CompareStr(string(S1), string(S2)); + {$ENDIF} + end; +end; +{$ENDIF} + +function CompareWideStrings(W1, W2: WideString{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; +begin +{$IFDEF USE_WIDEWINPROCS} + Result := WideWinProcs.CompareString(Locale, 0, PWideChar(W1), -1, PWideChar(W2), -1); + Dec(Result, 2); +{$ELSE} + Result := WideCompareStr(W1, W2); +{$ENDIF} +end; + +{$IFDEF STRING_IS_UNICODE} +function CompareStrings(S1, S2: string{$IFDEF USE_WIDEWINPROCS}; Locale: Cardinal{$ENDIF}): Integer; +begin +{$IFDEF USE_WIDEWINPROCS} + Result := WideWinProcs.CompareString(Locale, 0, PWideChar(S1), -1, PWideChar(S2), -1); + Dec(Result, 2); +{$ELSE} + Result := CompareStr(S1, S2); +{$ENDIF} +end; +{$ENDIF} + +function DivUp(Dividend, Divisor: Integer): Integer; +begin + if Divisor = 0 then + Result := 0 + else if Dividend mod Divisor > 0 then + Result := Dividend div Divisor + 1 + else + Result := Dividend div Divisor; +end; + +function DivDown(Dividend, Divisor: Integer): Integer; +begin + if Divisor = 0 then + Result := 0 + else if Dividend mod Divisor < 0 then + Result := Dividend div Divisor - 1 + else + Result := Dividend div Divisor; +end; + +procedure Exchange(var Value1, Value2: ShortInt); +var + Tmp: ShortInt; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: SmallInt); +var + Tmp: SmallInt; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Integer); +var + Tmp: Integer; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Int64); +var + Tmp: Int64; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Byte); +var + Tmp: Byte; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Word); +var + Tmp: Word; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Cardinal); +var + Tmp: Cardinal; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +{$IFDEF COMPILER10_UP } +procedure Exchange(var Value1, Value2: UINT64); +var + Tmp: UINT64; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; +{$ENDIF} + +procedure Exchange(var Value1, Value2: Single); +var + Tmp: Single; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Exchange(var Value1, Value2: Double); +var + Tmp: Double; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +{$IFNDEF FPC} +procedure Exchange(var Value1, Value2: Extended); +var + Tmp: Extended; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; +{$ENDIF} + +procedure Exchange(var Value1, Value2: Char); +var + Tmp: Char; +begin + Tmp := Value1; + Value1 := Value2; + Value2 := Tmp; +end; + +procedure Error(const Msg: string); +begin + raise Exception.Create(Msg); +end; + +function FillMessage(Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): TLMessage; +begin + Result.Msg := Msg; + Result.LParam := LParam; + Result.WParam := WParam; + Result.Result := 0; +end; + +function FormatCurrency(Value: Currency; const AFormat: TKCurrencyFormat): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; +var + OldDecimalSep, OldThousandSep: Char; + Fmt: string; +begin + OldThousandSep := ThousandSeparator; + if AFormat.UseThousandSep then + begin + ThousandSeparator := AFormat.ThousandSep; + Fmt := '%.*n'; + end else + Fmt := '%.*f'; + OldDecimalSep := DecimalSeparator; + DecimalSeparator := AFormat.DecimalSep; + try + case AFormat.CurrencyFormat of + 0: Result := {$IFDEF STRING_IS_UNICODE}Format{$ELSE}WideFormat{$ENDIF}( + '%s' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value]); + 1: Result := {$IFDEF STRING_IS_UNICODE}Format{$ELSE}WideFormat{$ENDIF}( + Fmt + '%s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString]); + 2: Result := {$IFDEF STRING_IS_UNICODE}Format{$ELSE}WideFormat{$ENDIF}( + '%s ' + Fmt, [AFormat.CurrencyString, AFormat.CurrencyDecimals, Value]); + else + Result := {$IFDEF STRING_IS_UNICODE}Format{$ELSE}WideFormat{$ENDIF}( + Fmt + ' %s', [AFormat.CurrencyDecimals, Value, AFormat.CurrencyString]); + end; + finally + DecimalSeparator := OldDecimalSep; + if AFormat.UseThousandSep then + ThousandSeparator := OldThousandSep; + end; +end; + +function GetAppVersion(const ALibName: string; var MajorVersion, MinorVersion, BuildNumber, RevisionNumber: Word): Boolean; +{$IFDEF USE_WINAPI} +var + dwHandle, dwLen: DWORD; + BufLen: Cardinal; + lpData: LPTSTR; + pFileInfo: ^VS_FIXEDFILEINFO; +{$ENDIF} +begin + Result := False; +{$IFDEF USE_WINAPI} + dwLen := GetFileVersionInfoSize(PChar(ALibName), dwHandle); + if dwLen <> 0 then + begin + GetMem(lpData, dwLen); + try + if GetFileVersionInfo(PChar(ALibName), dwHandle, dwLen, lpData) then + begin + if VerQueryValue(lpData, '\\', Pointer(pFileInfo), BufLen) then + begin + MajorVersion := HIWORD(pFileInfo.dwFileVersionMS); + MinorVersion := LOWORD(pFileInfo.dwFileVersionMS); + BuildNumber := HIWORD(pFileInfo.dwFileVersionLS); + RevisionNumber := LOWORD(pFileInfo.dwFileVersionLS); + Result := True; + end; + end; + finally + FreeMem(lpData); + end; + end; +{$ENDIF} +end; + +function GetControlText(Value: TWinControl): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + + function GetTextBuffer(Value: TWinControl): string; + begin + SetLength(Result, Value.GetTextLen); + Value.GetTextBuf(PChar(Result), Length(Result) + 1); + end; + +begin +{$IFDEF FPC} + Result := GetTextBuffer(Value); // conversion from UTF8 forced anyway +{$ELSE} + {$IFDEF STRING_IS_UNICODE} + Result := GetTextBuffer(Value); + {$ELSE} + if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported + begin + SetLength(Result, GetWindowTextLengthW(Value.Handle)); + GetWindowTextW(Value.Handle, PWideChar(Result), Length(Result) + 1); + end else + Result := GetTextBuffer(Value); + {$ENDIF} +{$ENDIF} +end; + +function GetShiftState: TShiftState; +begin + Result := []; + if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); + if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); + if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); +end; + +function IntToAscii(Value: Int64; Digits: Integer): string; +var + I: Integer; +begin + Result := ''; + I := 0; + while I < Digits do + begin + Result := Result + Chr(Value and $FF); + Value := Value shr 8; + Inc(I); + end; +end; + +function IntToBCD(Value: Cardinal): Cardinal; +var + Exp: Cardinal; +begin + Result := 0; + Exp := 1; + while (Value > 0) and (Exp > 0) do + begin + Result := Result + Value mod 10 * Exp; + Value := Value div 10; + Exp := Exp * 16; + end; +end; + +function IntToBinStr(Value: Int64; Digits: Byte; const Suffix: string): string; +var + B: Byte; + C: Char; +begin + Result := ''; + if Digits <> 0 then + Digits := MinMax(Digits, 1, 64); + repeat + B := Byte(Value and $1); + Value := Value shr 1; + C := Chr(Ord('0') + B); + Result := C + Result; + until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); + while Length(Result) < Digits do + Result := '0' + Result; + Result := Result + Suffix; +end; + +function IntToDecStr(Value: Int64): string; +var + B: Byte; + C: Char; +begin + Result := ''; + repeat + B := Byte(Value mod 10); + Value := Value div 10; + C := Chr(Ord('0') + B); + Result := C + Result; + until Value = 0; +end; + +function IntToHexStr(Value: Int64; Digits: Byte; const Prefix, Suffix: string; UseLowerCase: Boolean): string; +var + B: Byte; + C: Char; +begin + Result := ''; + if Digits <> 0 then + Digits := MinMax(Digits, 1, 16); + repeat + B := Byte(Value and $F); + Value := Value shr 4; + if B < 10 then + C := Chr(Ord('0') + B) else + if UseLowerCase then + C := Chr(Ord('a') + B - 10) + else + C := Chr(Ord('A') + B - 10); + Result := C + Result; + until (Value = 0) or ((Digits <> 0) and (Length(Result) = Digits)); + while Length(Result) < Digits do + Result := '0' + Result; + Result := Prefix + Result + Suffix; +end; + +function IntPowerInt(Value: Int64; Exponent: Integer): Int64; +begin + Result := Value; + while Exponent > 1 do + begin + Result := Result * Value; + Dec(Exponent); + end; +end; + +function AsciiToInt(S: string; Digits: Integer): Int64; +var + I: Integer; +begin + Result := 0; + I := Min(Length(S), Digits); + while I > 0 do + begin + Result := Result shl 8; + Result := Ord(S[I]) + Result; + Dec(I); + end; +end; + +function BCDToInt(Value: Cardinal): Cardinal; +var + Exp: Cardinal; +begin + Result := 0; + Exp := 1; + while Value > 0 do + begin + Result := Result + Min(Value and 15, 9) * Exp; + Value := Value shr 4; + Exp := Exp * 10; + end; +end; + +function BinStrToInt(S: string; Digits: Byte; Signed: Boolean; var Code: Integer): Int64; +var + I, L, Len: Integer; + N: Byte; + C: Char; + M: Int64; +begin + Result := 0; + Code := 0; + L := 0; + Len := Length(S); + if (Digits = 0) or (Digits > 64) then + Digits := 64; + if (Len >= 1) and CharInSetEx(S[Len], ['b', 'B']) then + begin + Delete(S, Len, 1); + Dec(Len); + end; + I := 1; + while I <= Len do + begin + C := S[I]; + N := 255; + if (C >= '0') and (C <= '1') then N := Ord(C) - Ord('0'); + if N > 1 then + begin + Code := I; + Break; + end + else if (N > 0) or (Result <> 0) then + begin + if L >= Digits then + begin + Code := I; + Break; + end; + Result := Result shl 1; + Inc(Result, N); + Inc(L); + end; + Inc(I); + end; + if Signed and (Digits < 64) then + begin + M := Int64(1) shl Digits; + if Result >= M shr 1 - 1 then + Dec(Result, M); + end; +end; + +function DecStrToInt(S: string; var Code: Integer): Int64; +var + I, Len: Integer; + N: Byte; + C: Char; + Minus: Boolean; +begin + Result := 0; + Code := 0; + Len := Length(S); + Minus := S[1] = '-'; + if Minus then I := 2 else I := 1; + while I <= Len do + begin + C := S[I]; + N := 255; + if (C >= '0') and (C <= '9') then N := Ord(C) - Ord('0'); + if N > 9 then + begin + Code := I; + Break; + end + else if (N > 0) or (Result <> 0) then + begin + Result := Result * 10; + Inc(Result, N); + end; + Inc(I); + end; + if Minus then Result := -Result; +end; + +function HexStrToInt(S: string; Digits: Byte; Signed: Boolean; var Code: Integer): Int64; +var + I, L, Len: Integer; + N: Byte; + C: Char; + M: Int64; +begin + Result := 0; + Code := 0; + L := 0; + Len := Length(S); + if (Digits = 0) or (Digits > 16) then + Digits := 16; + if (Len >= 2) and (AnsiChar(S[1]) = '0') and CharInSetEx(S[2], ['x', 'X']) then + I := 3 + else if (Len >= 1) and CharInSetEx(S[1], ['x', 'X', '$']) then + I := 2 + else + I := 1; + while I <= Len do + begin + C := S[I]; + N := 255; + if (C >= '0') and (C <= '9') then N := Ord(C) - Ord('0') + else if (C >= 'a') and (C <= 'f') then N := Ord(C) - Ord('a') + 10 + else if (C >= 'A') and (C <= 'F') then N := Ord(C) - Ord('A') + 10; + if N > 15 then + begin + if CharInSetEx(C, ['h', 'H']) then + begin + if Len > I then Code := I + 1; + end else + Code := I; + Break; + end + else if (N > 0) or (Result <> 0) then + begin + if L >= Digits then + begin + Code := I; + Break; + end; + Result := Result shl 4; + Inc(Result, N); + Inc(L); + end; + Inc(I); + end; + if Signed and (Digits < 16) then + begin + M := Int64(1) shl (Digits shl 2); + if Result >= M shr 1 - 1 then + Dec(Result, M); + end; +end; + +function MinMax(Value, Min, Max: ShortInt): ShortInt; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +function MinMax(Value, Min, Max: SmallInt): SmallInt; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +function MinMax(Value, Min, Max: Integer): Integer; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +function MinMax(Value, Min, Max: Int64): Int64; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +function MinMax(Value, Min, Max: Single): Single; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +function MinMax(Value, Min, Max: Double): Double; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; + +{$IFNDEF FPC} +function MinMax(Value, Min, Max: Extended): Extended; +begin + if Max < Min then + Exchange(Min, Max); + if Value <= Max then + if Value >= Min then + Result := Value + else + Result := Min + else + Result := Max; +end; +{$ENDIF} + +procedure SetControlClipRect(AControl: TWinControl; const ARect: TRect); +begin + if AControl.HandleAllocated then + begin + {$IFDEF USE_WINAPI} + SetWindowRgn(AControl.Handle, CreateRectRgn(0, 0, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top), True); + {$ELSE} + //how to do that? + {$ENDIF} + end; +end; + +procedure SetControlText(Value: TWinControl; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + + procedure SetTextBuffer(Value: TWinControl; const Text: string); + begin + Value.SetTextBuf(PChar(Text)); + end; + +begin +{$IFDEF FPC} + SetTextBuffer(Value, Text); // conversion to UTF8 forced anyway +{$ELSE} + {$IFDEF STRING_IS_UNICODE} + SetTextBuffer(Value, Text); + {$ELSE} + if Value.HandleAllocated and (Win32Platform = VER_PLATFORM_WIN32_NT) then // unicode fully supported + SetWindowTextW(Value.Handle, PWideChar(Text)) + else + SetTextBuffer(Value, Text); + {$ENDIF} +{$ENDIF} +end; + +function StrNextCharIndex(AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; Index: Integer): Integer; +begin +{$IFDEF FPC} + Result := Index + UTF8CharacterLength(@AText[Index]); +{$ELSE} + Result := Index + 1; // neglecting surrogate pairs +{$ENDIF} +end; + +function StringCharBegin(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; Index: Integer): Integer; +begin +{$IFDEF FPC} + Result := UTF8CharToByteIndex(PChar(AText), Length(AText), Index) +{$ELSE} + Result := Index // neglecting surrogate pairs +{$ENDIF} +end; + +function StringLength(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}): Integer; +begin +{$IFDEF FPC} + Result := UTF8Length(AText) +{$ELSE} + Result := Length(AText) // neglecting surrogate pairs +{$ENDIF} +end; + +function StringNextCharIndex(const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; Index: Integer): Integer; +begin +{$IFDEF FPC} + Result := Index + UTF8CharacterLength(@AText[Index]); +{$ELSE} + Result := Index + 1; // neglecting surrogate pairs +{$ENDIF} +end; + +procedure TrimWhiteSpaces(var AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; var ALen: Integer; const ASet: TKSysCharSet); +begin + while (ALen > 0) and CharInSetEx(AText[0], ASet) do + begin + AText := @AText[1]; + Dec(ALen) + end; + while (ALen > 0) and CharInSetEx(AText[ALen - 1], ASet) do + Dec(ALen); +end; + +procedure TrimWhiteSpaces(var AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; const ASet: TKSysCharSet); +begin + while (Length(AText) > 0) and CharInSetEx(AText[1], ASet) do + Delete(AText, 1, 1); + while (Length(AText) > 0) and CharInSetEx(AText[Length(AText)], ASet) do + Delete(AText, Length(AText), 1); +end; + +{$IFNDEF FPC} +function WideCharToAnsiString(Text: PWideChar; CodePage: Cardinal): AnsiString; +var + Len: Integer; +begin + Len := WideCharToMultiByte(CodePage, 0, Text, -1, nil, 0, nil, nil); + SetLength(Result, Len); + WideCharToMultiByte(CodePage, 0, Text, -1, PAnsiChar(Result), Len, nil, nil); +end; +{$ENDIF} + +{$IFDEF USE_WINAPI} +function GetWindowsFolder(CSIDL: Cardinal; var APath: string): Boolean; +type + TSHGetFolderPathProc = function(hWnd: HWND; CSIDL: Integer; hToken: THandle; + dwFlags: DWORD; pszPath: PAnsiChar): HResult; stdcall; +var + SHFolderHandle: HMODULE; + SHGetFolderPathProc: TSHGetFolderPathProc; + Buffer: PAnsiChar; +begin + Result := False; + APath := ''; + SHFolderHandle := GetModuleHandle(SHFolderDll); + if SHFolderHandle <> 0 then + begin + SHGetFolderPathProc := GetProcAddress(SHFolderHandle, 'SHGetFolderPathA'); + if Assigned(SHGetFolderPathProc) then + begin + GetMem(Buffer, MAX_PATH); + try + if Succeeded(SHGetFolderPathProc(0, CSIDL, 0, 0, Buffer)) then + begin + APath := string(Buffer); + Result := True; + end + finally + FreeMem(Buffer); + end; + end; + end; +end; +{$ENDIF} + +end. diff --git a/components/kcontrols/source/kgraphics.pas b/components/kcontrols/source/kgraphics.pas new file mode 100755 index 000000000..a34402e3f --- /dev/null +++ b/components/kcontrols/source/kgraphics.pas @@ -0,0 +1,2145 @@ +{ @abstract(This unit contains advanced graphic functions used by KControls suite.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(5 May 2004) + @lastmod(20 Jun 2010) + + Copyright © 2004 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KGraphics; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + // use the LCL interface support whenever possible + {$IFDEF USE_WINAPI} + Windows, + {$ENDIF} + GraphType, IntfGraphics, LCLType, LCLIntf, LMessages, LResources, +{$ELSE} + Windows, Messages, + {$IFDEF USE_PNG_SUPPORT} + PngImage, + {$ENDIF} +{$ENDIF} + Classes, Forms, Graphics, Controls, KFunctions; + +resourcestring + { @exclude } + SGDIError = 'GDI object could not be created.'; + +const + { PNG Support } + PNGHeader = #137'PNG'#13#10#26#10; + MNGHeader = #138'MNG'#13#10#26#10; + +type + { Declares possible values for the Style parameter of the @link(BrightColor) function. } + TKBrightMode = ( + { The Color will be brightened with Percent of its entire luminosity range. } + bsAbsolute, + { The Color will be brightened with Percent of its current luminosity value. } + bsOfBottom, + { The Color will be brightened with Percent of the difference of its entire + luminosity range and current luminosity value. } + bsOfTop + ); + + { Declares RGB + Alpha channel color description allowing both to + access single channels and the whole color item. } + TKColorRec = packed record + case Integer of + 0: (R, G, B, A: Byte); + 1: (Value: Cardinal); + end; + + { Pointer to TKColorRec. } + PKColorRec = ^TKColorRec; + + { Dynamic array for TKColorRec. } + TKColorRecs = array[0..MaxInt div SizeOf(TKColorRec) - 1] of TKColorRec; + { Dynamic array for TKColorRecs. } + PKColorRecs = ^TKColorRecs; + { Dynamic array for TKColorRec. } + TKDynColorRecs = array of TKColorRec; + + { String type for @link(ImageByType) function. } + TKImageHeaderString = string[10]; + +{$IFDEF USE_PNG_SUPPORT} + {$IFDEF FPC} + { @exclude } + TKPngImage = TPortableNetworkGraphic; + {$ELSE} + {$IFDEF COMPILER12_UP} + { @exclude } + TKPngImage = TPngImage; + {$ELSE} + { @exclude } + TKPngImage = TPngObject; + {$ENDIF} + {$ENDIF} +{$ENDIF} + + { Declares possible values for the Attributes parameter in the @link(DrawAlignedText) function. } + TKTextAttribute = ( + { Bounding rectangle is calculated. No text is drawn. } + taCalcRect, + { Text will be clipped within the given rectangle. } + taClip, + { Text will be drawn with end ellipsis if it does not fit within given width. } + taEndEllipsis, + { Given rectangle will be filled. } + taFillRect, + { Only yhe text within given rectangle will be filled. } + taFillText, + { Text will be drawn as multi-line text if it contains carriage returns and line feeds. } + taLineBreak, + { Text will be drawn with path ellipsis if it does not fit within given width. } + taPathEllipsis, + { Text line(s) will be broken between words if they don't fit within given width. } + taWordBreak, + { Text line(s) will be broken if they don't fit within col width. } + taWrapText, //JR:20091229 + { No white spaces will be trimmed at the beginning or end of text lines. } + taTrimWhiteSpaces + ); + + { Set type for @link(TKTextAttribute) enumeration. } + TKTextAttributes = set of TKTextAttribute; + + { Declares possible values for the HAlign parameter in the @link(DrawAlignedText) function. } + TKHAlign = ( + { Text is aligned to the left border of a cell rectangle. } + halLeft, + { Text is horizontally centered within the cell rectangle. } + halCenter, + { Text is aligned to the right border of a cell rectangle. } + halRight + ); + + { Declares possible values for the StretchMode parameter in the @link(ExcludeShapeFromBaseRect) function. } + TKStretchMode = ( + { Shape is not stretched. } + stmNone, + { Shape is zoomed out. } + stmZoomOutOnly, + { Shape is zoomed in. } + stmZoomInOnly, + { Shape is zoomed arbitrary. } + stmZoom + ); + + { For backward compatibility. } + TKTextHAlign = TKHAlign; + + { Declares possible values for the VAlign parameter in the @link(DrawAlignedText) function. } + TKVAlign = ( + { Text is aligned to the upper border of a cell rectangle. } + valTop, + { Text is vertically centered within the cell rectangle. } + valCenter, + { Text is aligned to the lower border of a cell rectangle. } + valBottom + ); + + { For backward compatibility. } + TKTextVAlign = TKVAlign; + + { A simple platform independent encapsulation for a 32bpp bitmap with + alpha channel with the ability to modify it's pixels directly. } + TKAlphaBitmap = class(TGraphic) + private + FCanvas: TCanvas; + FDirectCopy: Boolean; + FHandle: HBITMAP; + FHeight: Integer; + {$IFNDEF USE_WINAPI} + FImage: TLazIntfImage; // Lazarus only + FMaskHandle: HBITMAP; + {$ENDIF} + FOldBitmap: HBITMAP; + FPixels: PKColorRecs; + FPixelsChanged: Boolean; + FWidth: Integer; + function GetScanLine(Index: Integer): PKColorRecs; + function GetHandle: HBITMAP; + function GetPixel(X, Y: Integer): TKColorRec; + procedure SetPixel(X, Y: Integer; Value: TKColorRec); + protected + { Paints itself to ACanvas at location ARect. } + procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; + { Returns True if bitmap is empty. } + function GetEmpty: Boolean; override; + { Returns the bitmap height. } + function GetHeight: Integer; override; + { Returns True. Treat alpha bitmap as transparent because of the + possible alpha channel. } + function GetTransparent: Boolean; override; + { Returns the bitmap width. } + function GetWidth: Integer; override; + { Specifies new bitmap height. } + procedure SetHeight(Value: Integer); override; + { Specifies new bitmap width. } + procedure SetWidth(Value: Integer); override; + { Does nothing. Bitmap is never transparent. } + procedure SetTransparent(Value: Boolean); override; + { Updates the bitmap handle from bitmap pixels. } + procedure UpdateHandle; dynamic; + { Updates the pixels from bitmap handle. } + procedure UpdatePixels; dynamic; + public + { Creates the instance. } + constructor Create; override; + { Creates the instance from application resources. For Lazarus 'BMP' type is + taken, for Delphi RT_RCDATA is taken. } + constructor CreateFromRes(const ResName: string); + { Destroys the instance. } + destructor Destroy; override; + { Paints alpha bitmap onto Canvas at position given by X, Y. The alpha bitmap + is combined with the background already drawn on Canvas using alpha channel + stored in the alpha bitmap. } + procedure AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); + { Paints alpha bitmap onto Canvas at position given by ARect. The alpha bitmap + is combined with the background already drawn on Canvas using alpha channel + stored in the alpha bitmap. } + procedure AlphaStretchDrawTo(ACanvas: TCanvas; const ARect: TRect); + { Fills the alpha channel with Alpha. If the optional IfEmpty parameter is True, + the alpha channel won't be modified unless it has zero value for all pixels. } + procedure AlphaFill(Alpha: Byte; IfEmpty: Boolean = False); overload; + { Fills the alpha channel according to given parameters. Currently it is used + internally by @link(TKDragWindow). } + procedure AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); overload; + { Combines the pixel at given location with the given color. } + procedure CombinePixel(X, Y: Integer; Color: TKColorRec); + { Takes dimensions and pixels from ABitmap. } + procedure CopyFrom(ABitmap: TKAlphaBitmap); + { Takes 90°-rotated dimensions and pixels from ABitmap. } + procedure CopyFromRotated(ABitmap: TKAlphaBitmap); + { Copies a location specified by ARect from ACanvas to bitmap. } + procedure DrawFrom(ACanvas: TCanvas; const ARect: TRect); + { Calls @link(TKAlphaBitmap.Draw). } + procedure DrawTo(ACanvas: TCanvas; const ARect: TRect); + {$IFNDEF FPC} + { Does nothing. } + procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; + APalette: HPALETTE); override; + {$ENDIF} + { Loads the bitmap from a stream. } + procedure LoadFromStream(Stream: TStream); override; + { Mirrors the bitmap pixels horizontally. } + procedure MirrorHorz; + { Mirrors the bitmap pixels vertically. } + procedure MirrorVert; + {$IFNDEF FPC} + { Does nothing. } + procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; + var APalette: HPALETTE); override; + {$ENDIF} + { Saves the bitmap to a stream. } + procedure SaveToStream(Stream: TStream); override; + { Specifies the bitmap size. } + procedure SetSize(AWidth, AHeight: Integer); {$IFNDEF FPC} reintroduce;{$ENDIF} + { Returns the bitmap memory canvas. } + property Canvas: TCanvas read FCanvas; + { Temporary flag. Use when copying data directly from another TGraphic to TKAlphaBitmap. } + property DirectCopy: Boolean read FDirectCopy write FDirectCopy; + { Returns the bitmap handle. } + property Handle: HBITMAP read GetHandle; + { Specifies the pixel color. Does range checking. } + property Pixel[X, Y: Integer]: TKColorRec read GetPixel write SetPixel; + { Returns the pointer to bitmap pixels. } + property Pixels: PKColorRecs read FPixels; + { Set this property to True if you have modified the bitmap pixels. } + property PixelsChanged: Boolean read FPixelsChanged write FPixelsChanged; + { Returns the pointer to a bitmap scan line. } + property ScanLine[Index: Integer]: PKColorRecs read GetScanLine; + end; + +{$IFDEF USE_WINAPI} + TUpdateLayeredWindowProc = function(Handle: THandle; hdcDest: HDC; pptDst: PPoint; + _psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; + dwFlags: DWORD): Boolean; stdcall; +{$ENDIF} + + { @abstract(Encapsulates the drag window) + Drag window is top level window used for dragging with mouse. It displays + some portion of associated control. It can be translucent under Windows. } + TKDragWindow = class(TObject) + private + FActive: Boolean; + FAlphaEffects: Boolean; + FBitmap: TKAlphaBitmap; + FBitmapFilled: Boolean; + FControl: TCustomControl; + FGradient: Boolean; + FInitialPos: TPoint; + FLayered: Boolean; + FMasterAlpha: Byte; + {$IFDEF USE_WINAPI} + FBlend: TBlendFunction; + FUpdateLayeredWindow: TUpdateLayeredWindowProc; + FWindow: HWND; + {$ELSE} + FDragForm: TCustomForm; + {$ENDIF} + public + { Creates the instance. } + constructor Create; + { Destroys the instance. } + destructor Destroy; override; + { Shows the drag window on screen. Takes a rectangular part as set by ARect from + IniCtrl's Canvas and displays it at position InitialPos. MasterAlpha and + Gradient are used to premaster the copied image with a specific fading effect. } + procedure Show(IniCtrl: TCustomControl; const ARect: TRect; const InitialPos, + CurrentPos: TPoint; MasterAlpha: Byte; Gradient: Boolean); + { Moves the drag window to a new location. } + procedure Move(const NewPos: TPoint); + { Hides the drag window. } + procedure Hide; + { Returns True if the drag window is shown. } + property Active: Boolean read FActive; + { Returns the pointer to the bitmap that holds the copied control image. } + property Bitmap: TKAlphaBitmap read FBitmap; + { Returns True if the control already copied itself to the bitmap. } + property BitmapFilled: Boolean read FBitmapFilled; + end; + + { @abstract(Base class for KControls hints) + This class extends the standard THintWindow class. It adds functionality + common to all hints used in KControls. } + TKHintWindow = class(THintWindow) + private + FExtent: TPoint; + procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; + public + { Creates the instance. } + constructor Create(AOwner: TComponent); override; + { Shows the hint at given position. This is an IDE independent implementation. } + procedure ShowAt(const Origin: TPoint); + { Returns the extent of the hint. } + property Extent: TPoint read FExtent; + end; + + { @abstract(Hint window to display formatted text) + This class implements the textual hint window. The text is displayed . } + TKTextHint = class(TKHintWindow) + private + FText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + procedure SetText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + protected + { Overriden method. Paints the hint. } + procedure Paint; override; + public + { Creates the instance. } + constructor Create(AOwner: TComponent); override; + { } + property Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read FText write SetText; + end; + + TKGraphicHint = class(TKHintWindow) + private + FGraphic: TGraphic; + procedure SetGraphic(const Value: TGraphic); + protected + { Overriden method. Paints the hint. } + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + property Graphic: TGraphic read FGraphic write SetGraphic; + end; + +{ Draws Src to Dest with per pixel weighting by alpha channel saved in Src. } +procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); + +{ Calculates a brighter color of given color based on the HSL color space. + } +function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode = bsAbsolute): TColor; + +{ Returns current canvas window/wiewport scaling. } +procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); + +{ Selects the default window/wiewport scaling to given canvas for both axes. } +procedure CanvasResetScale(ACanvas: TCanvas); + +{ Returns True if the ACanvas's device context has been mapped to anything else + than MM_TEXT. } +function CanvasScaled(ACanvas: TCanvas): Boolean; + +{ Selects the window/wiewport scaling to given canvas for both axes. } +procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); + +{ Selects the wiewport offset to given canvas for both axes. } +procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); + +{ Makes a grayscale representation of the given color. } +function ColorToGrayScale(Color: TColor): TColor; + +{ Calls BitBlt. } +procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); + +{ Creates an empty rectangular region. } +function CreateEmptyRgn: HRGN; + +{ Draws Text to the Canvas at location given by ARect. + HAlign and VAlign specify horizontal resp. vertical alignment of the text + within ARect. HPadding and VPadding specify horizontal (both on left and right side) + and vertical (both on top and bottom side) padding of the Text from ARect. + BackColor specifies the fill color for brush gaps if a non solid Brush + is defined in Canvas. Attributes specift various text output attributes. } +procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; + HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; + const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + BackColor: TColor = clWhite; Attributes: TKTextAttributes = []); + +{ Simulates WinAPI DrawEdge with customizable colors. } +procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, + ShadowColor: TColor; Flags: Cardinal); + +{ Draws a rectangle to Canvas. The rectangle coordinates are given by Rect. + The rectangle is filled by Brush. If Brush is not solid, its gaps are filled + with BackColor. If BackColor is clNone these gaps are not filled and the Brush + appears transparent. } +procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; + BackColor: TColor); + +{ This helper function excludes a rectangular area occupied by a shape from + BaseRect and calculates the shape area rectangles Bounds and Interior. + The shape area is specified by the shape extent (ShapeWidth and ShapeHeight), + padding (HPadding and VPadding) and stretching mode (StretchMode). + The returned Bounds includes (possibly stretched) shape + padding, + and Interior includes only the (possibly stretched) shape. + HAlign specifies the horizontal alignment of shape area within BaseRect. + VAlign specifies the vertical alignment of shape area within BaseRect. + The shape area is always excluded horizontally from BaseRect, as needed by cell + data calculations in KGrid. } +procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; + HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; + StretchMode: TKStretchMode; out Bounds, Interior: TRect); + +{ Selects ARect into device context. Returns previous clipping region. } +function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; out PrevRgn: HRGN): Boolean; + +{ Selects ARect into device context. Combines with CurRgn and + returns previous clipping region. Both regions have to be created first. } +function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; + +{ Fills the area specified by the difference Boundary - Interior on ACanvas with current Brush. + If Brush is not solid, its gaps are filled with BackColor. If BackColor is + clNone these gaps are not filled and the Brush appears transparent. } +procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); + +{ Selects the region into given device context and deletes the region. } +procedure FinalizePrevRgn(DC: HDC; ARgn: HRGN); + +{ Determine the height (ascent + descent) of the font currently selected into given DC. } +function GetFontHeight(DC: HDC): Integer; + +{ Raises an exception if GDI resource has not been created. } +function GDICheck(Value: Integer): Integer; + +{ Creates a TGraphic instance according to the image file header. + Currently supported images are BMP, PNG, MNG, JPG, ICO. } +function ImageByType(const Header: TKImageHeaderString): TGraphic; + +{ Calls the IntersectClipRect function. } +function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; + +{ Determines if given color has lightness > 0.5. } +function IsBrightColor(Color: TColor): Boolean; + +{ Loads a custom mouse cursor. } +procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); + +{ Builds a TKColorRec structure. } +function MakeColorRec(R, G, B, A: Byte): TKColorRec; + +{ Returns a pixel format that matches Bpp. } +function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; + +{ In Lazarus this WinAPI function is missing. } +function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; + +{ Paints an image so that it fits in ARect. Performs double buffering and fills + the background with current brush for mapped device contexts. } +procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor = clWhite); + +{ Selects ARect as new clipping region into the device context. } +procedure SelectClipRect(DC: HDC; const ARect: TRect); + +{ Calls StretchBlt. } +procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); + +{ Swaps the color format from RGB to BGR and vice versa. } +function SwitchRGBToBGR(Value: TColor): TColor; + +{ Subtracts the current device context offset to ARect. } +procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); + +implementation + +uses + Math, SysUtils, Types, KControls +{$IFDEF FPC} + , FPImage +{$ELSE} + , JPeg +{$ENDIF} + ; + +procedure BlendLine(Src, Dest: PKColorRecs; Count: Integer); +var + I: Integer; + R, G, B, A1, A2: Integer; +begin + // without assembler + for I := 0 to Count - 1 do + begin + A1 := Src[I].A; + A2 := 255 - A1; + Inc(A1); + Inc(A2); + R := Src[I].R * A1 + Dest[I].R * A2; + G := Src[I].G * A1 + Dest[I].G * A2; + B := Src[I].B * A1 + Dest[I].B * A2; + Dest[I].R := R shr 8; + Dest[I].G := G shr 8; + Dest[I].B := B shr 8; + end; +end; + +function CalcLightness(Color: TColor): Single; +var + X: TKColorRec; +begin + X.Value := ColorToRGB(Color); + Result := (X.R + X.G + X.B) / (3 * 256); +end; + +function BrightColor(Color: TColor; Percent: Single; Mode: TKBrightMode): TColor; +var + L, Tmp: Single; + + function Func1(Value: Single): Single; + begin + Result := Value * (L + Percent) / L; + end; + + function Func2(Value: Single): Single; + begin + Result := 1 - (0.5 - Tmp) * (1 - Value) / (1 - L); + { this is the shorter form of + Value := 1 - 0.5 * (1 - Value) / (1 - L) ; // get color with L = 0.5 + Result := 1 - (0.5 - Tmp) * (1 - Value) / 0.5; // get corresponding color + } + end; + + function Rd(Value: Single): Byte; + begin + Result := Min(Integer(Round(Value * 255)), 512); + end; + +var + R, G, B, Cmax, Cmin: Single; + X: TKColorRec; +begin + X.Value := ColorToRGB(Color); + R := X.R / 255; + G := X.G / 255; + B := X.B / 255; + Cmax := Max(R, Max(G, B)); + Cmin := Min(R, Min(G, B)); + L := (Cmax + Cmin) / 2; + if L < 1 then + begin + case Mode of + bsOfBottom: Percent := L * Percent; + bsOfTop: Percent := (1 - L) * Percent; + end; + Percent := Min(Percent, 1 - L); + if L = 0 then + begin + // zero length singularity + R := R + Percent; G := G + Percent; B := B + Percent; + end else + begin + Tmp := L + Percent - 0.5; + // lumination below 0.5 + if L < 0.5 then + begin + // if L + Percent is >= 0.5, get color with L = 0.5 + Percent := Min(Percent, 0.5 - L); + R := Func1(R); G := Func1(G); B := Func1(B); + L := 0.5; + end; + // lumination above 0.5 + if Tmp > 0 then + begin + R := Func2(R); G := Func2(G); B := Func2(B); + end; + end; + X.R := Rd(R); + X.G := Rd(G); + X.B := Rd(B); + end; + Result := X.Value; +end; + +procedure CanvasGetScale(ACanvas: TCanvas; out MulX, MulY, DivX, DivY: Integer); +{$IFDEF USE_DC_MAPPING} +var + WindowExt, ViewPortExt: TSize; +{$ENDIF} +begin +{$IFDEF USE_DC_MAPPING} + if Boolean(GetWindowExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}WindowExt)) and + Boolean(GetViewPortExtEx(ACanvas.Handle, {$IFDEF FPC}@{$ENDIF}ViewPortExt)) then + begin + DivX := WindowExt.cx; DivY := WindowExt.cy; + MulX := ViewPortExt.cx; MulY := ViewPortExt.cy; + end else +{$ENDIF} + begin + MulX := 1; DivX := 1; + MulY := 1; DivY := 1; + end; +end; + +procedure CanvasResetScale(ACanvas: TCanvas); +begin +{$IFDEF USE_DC_MAPPING} + SetMapMode(ACanvas.Handle, MM_TEXT); +{$ENDIF} +end; + +function CanvasScaled(ACanvas: TCanvas): Boolean; +begin +{$IFDEF USE_DC_MAPPING} + Result := not (GetMapMode(ACanvas.Handle) in [0, MM_TEXT]); +{$ELSE} + Result := False; +{$ENDIF} +end; + +procedure CanvasSetScale(ACanvas: TCanvas; MulX, MulY, DivX, DivY: Integer); +begin +{$IFDEF USE_DC_MAPPING} + SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); + SetWindowExtEx(ACanvas.Handle, DivX, DivY, nil); + SetViewPortExtEx(ACanvas.Handle, MulX, MulY, nil); +{$ELSE} + {$WARNING 'Device context window/viewport transformations not working!'} +{$ENDIF} +end; + +procedure CanvasSetOffset(ACanvas: TCanvas; OfsX, OfsY: Integer); +begin +{$IFDEF USE_DC_MAPPING} + SetMapMode(ACanvas.Handle, MM_ANISOTROPIC); + SetViewPortOrgEx(ACanvas.Handle, OfsX, OfsY, nil); +{$ENDIF} +end; + +function ColorToGrayScale(Color: TColor): TColor; +var + GreyValue: Integer; + X: TKColorRec; +begin + X.Value := ColorToRGB(Color); + GreyValue := (X.R + X.G + X.B) div 3; + X.R := GreyValue; + X.G := GreyValue; + X.B := GreyValue; + Result := X.Value; +end; + +procedure CopyBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcX, SrcY: Integer); +begin + {$IFDEF USE_WINAPI}Windows.{$ENDIF}BitBlt(DestDC, + DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, + SrcDC, 0, 0, SRCCOPY); +end; + +function CreateEmptyRgn: HRGN; +begin + Result := CreateRectRgn(0,0,0,0); +end; + +procedure DrawAlignedText(Canvas: TCanvas; var ARect: TRect; + HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; + const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + BackColor: TColor; Attributes: TKTextAttributes); +var + DC: HDC; + FontHeight: Integer; + ClipRect: TRect; + + function MeasureOrOutput(Y: Integer; Output: Boolean): TSize; + var + EndEllipsis, PathEllipsis: Boolean; + Width, EllipsisWidth: Integer; + + function TextExtent(AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; ALen: Integer; Trim: Boolean = False): TSize; + begin + if Trim then + begin + if taLineBreak in Attributes then + TrimWhiteSpaces(AText, ALen, cLineBreaks); + if taTrimWhiteSpaces in Attributes then + TrimWhiteSpaces(AText, ALen, cWordBreaks); + end; + {$IFDEF STRING_IS_UNICODE} + {$IFDEF FPC} + {$IFDEF USE_CANVAS_METHODS} + Result := Canvas.TextExtent(Copy(AText, 0, ALen)); // little slower but more secure in Lazarus + {$ELSE} + GetTextExtentPoint32(DC, AText, ALen, Result); + {$ENDIF} + {$ELSE} + GetTextExtentPoint32(DC, AText, ALen, Result); + {$ENDIF} + {$ELSE} + GetTextExtentPoint32W(DC, AText, ALen, Result); + {$ENDIF} + end; + + procedure FmtTextOut(Y: Integer; AText: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}; ALen: Integer); + var + DrawEllipsis, DrawFileName: Boolean; + AWidth, Index, NewIndex,SlashPos, FileNameLen, EllipsisMaxX, X: Integer; + S: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + begin + DrawEllipsis := False; + DrawFileName := False; + SlashPos := 0; + FileNameLen := 0; + if taLineBreak in Attributes then + TrimWhiteSpaces(AText, ALen, cLineBreaks); + if taTrimWhiteSpaces in Attributes then + TrimWhiteSpaces(AText, ALen, cWordBreaks); + if (EndEllipsis or PathEllipsis) and (ALen > 1) then + begin + AWidth := TextExtent(AText, ALen).cx; + if AWidth > Width then + begin + AWidth := 0; + Index := 0; + if EndEllipsis then + begin + EllipsisMaxX := Width - EllipsisWidth; + while (Index < ALen) do + begin + NewIndex := StrNextCharIndex(AText, Index); + Inc(AWidth, TextExtent(@AText[Index], NewIndex - Index).cx); + if (AWidth > EllipsisMaxX) and (Index > 0) then + Break + else + Index := NewIndex; + end; + ALen := Index; + DrawEllipsis := True; + end + else if PathEllipsis then + begin + SlashPos := ALen; + while (SlashPos > 0) and not CharInSetEx(AText[SlashPos], ['/', '\']) do + Dec(SlashPos); + if SlashPos > 0 then + begin + DrawEllipsis := True; + DrawFileName := True; + FileNameLen := ALen - SlashPos; + EllipsisMaxX := Width - TextExtent(@AText[SlashPos], FileNameLen).cx - EllipsisWidth; + while (Index < SlashPos) do + begin + NewIndex := StrNextCharIndex(AText, Index); + Inc(AWidth, TextExtent(@AText[Index], NewIndex - Index).cx); + if AWidth > EllipsisMaxX then + Break + else + Index := NewIndex; + end; + ALen := Index; + end; + end; + end; + end; + if DrawEllipsis then + begin + if DrawFileName then + begin + S := Copy(AText, 0, ALen) + cEllipsis + Copy(AText, SlashPos + 1, FileNameLen); + end else + S := Copy(AText, 0, ALen) + cEllipsis; + AText := {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF}(S); + ALen := Length(S); + end; + case HAlign of + halCenter: + X := Max(ClipRect.Left, (ClipRect.Left + ClipRect.Right - TextExtent(AText, ALen).cx) div 2); + halRight: + X := ClipRect.Right - TextExtent(AText, ALen).cx; + else + X := ClipRect.Left; + end; + {$IFDEF STRING_IS_UNICODE} + {$IFDEF FPC} + {$IFDEF USE_CANVAS_METHODS} + Canvas.TextOut(X, Y, Copy(AText, 0, ALen)); // little slower but more secure in Lazarus + {$ELSE} + TextOut(DC, X, Y, AText, ALen); + {$ENDIF} + {$ELSE} + TextOut(DC, X, Y, AText, ALen); + {$ENDIF} + {$ELSE} + TextOutW(DC, X, Y, AText, ALen); + {$ENDIF} + end; + + var + I, Index, TextLen, LineBegin, LineBreaks, Vert: Integer; + CalcRect, WordBreak, LineBreak, WhiteSpace, PrevWhiteSpace, FirstWord, + WrapText: Boolean; + Size: TSize; + begin + Result.cx := 0; + Vert := Y; + if AText <> '' then + begin + LineBegin := 1; + LineBreaks := 0; + TextLen := Length(AText); + Width := ClipRect.Right - ClipRect.Left; + CalcRect := taCalcRect in Attributes; + WordBreak := taWordBreak in Attributes; + LineBreak := taLineBreak in Attributes; + WrapText := taWrapText in Attributes; //JR:20091229 + if Output then + begin + EndEllipsis := taEndEllipsis in Attributes; + PathEllipsis := taPathEllipsis in Attributes; + EllipsisWidth := TextExtent(cEllipsis, Length(cEllipsis)).cx; + end; + if WordBreak or LineBreak then + begin + I := LineBegin; + Index := LineBegin; + WhiteSpace := True; + FirstWord := True; + while I <= TextLen + 1 do + begin + PrevWhiteSpace := WhiteSpace; + WhiteSpace := CharInSetEx(AText[I], cWordBreaks + cLineBreaks); + if (not PrevWhiteSpace and WhiteSpace and (I > LineBegin)) + or (not PrevWhiteSpace and WrapText and (I > LineBegin)) then //JR:20091229 + begin + if (WordBreak or WrapText) and (LineBreaks = 0) and not FirstWord then + begin + Size := TextExtent(@AText[LineBegin], I - LineBegin, True); + if Size.cx > Width then + Inc(LineBreaks); + end; + if LineBreaks > 0 then + begin + if Index > LineBegin then + begin + if Output and (Vert >= ClipRect.Top - FontHeight) and (Vert <= ClipRect.Bottom) then + FmtTextOut(Vert, @AText[LineBegin], Index - LineBegin) + else if CalcRect then + Result.cx := Max(Result.cx, TextExtent(@AText[LineBegin], Index - LineBegin, True).cx); + LineBegin := Index; + end; + Inc(Vert, FontHeight * LineBreaks); + LineBreaks := 0; + end; + Index := I; + FirstWord := False; + end; + if LineBreak and (AText[I] = cCR) then + Inc(LineBreaks); + Inc(I); + end; + end; + if LineBegin <= TextLen then + begin + if Output and (Vert >= ClipRect.Top - FontHeight) and (Vert <= ClipRect.Bottom) then + FmtTextOut(Vert, @AText[LineBegin], TextLen - LineBegin + 1) + else if CalcRect then + Result.cx := Max(Result.cx, TextExtent(@AText[LineBegin], TextLen - LineBegin + 1, True).cx); + Inc(Vert, FontHeight * (1 + LineBreaks)); + end; + end; + Result.cy := Vert - Y; + end; + + procedure Initialize; + begin + ClipRect := ARect; + InflateRect(ClipRect, -HPadding, -VPadding); + DC := Canvas.Handle; + FontHeight := GetFontHeight(DC); + end; + +var + Y: Integer; + TmpRect: TRect; + Extent: TSize; + PrevRgn: HRGN; +begin + if taCalcRect in Attributes then + begin + Initialize; + Extent := MeasureOrOutput(0, False); + ARect.Right := ARect.Left + Extent.cx; + ARect.Bottom := ARect.Top + Extent.cy; + end + else if not IsRectEmpty(ARect) then + begin + if taFillRect in Attributes then + DrawFilledRectangle(Canvas, ARect, BackColor); + if AText <> '' then + begin + Initialize; + if not IsRectEmpty(ClipRect) then + begin + case VAlign of + valCenter: + Y := Max(ClipRect.Top, (ClipRect.Bottom + ClipRect.Top - MeasureOrOutput(0, False).cy) div 2); + valBottom: + Y := ClipRect.Bottom - MeasureOrOutput(0, False).cy; + else + Y := ClipRect.Top; + end; + TmpRect := ClipRect; + if taClip in Attributes then + begin + TranslateRectToDevice(DC, TmpRect); + if ExtSelectClipRect(DC, TmpRect, RGN_AND, PrevRgn) then + try + if not (taFillText in Attributes) then + SetBkMode(DC, TRANSPARENT); + MeasureOrOutput(Y, True); + finally + FinalizePrevRgn(DC, PrevRgn); + end; + end else + begin + if not (taFillText in Attributes) then + SetBkMode(DC, TRANSPARENT); + MeasureOrOutput(Y, True); + end; + end; + end; + end; +end; + +procedure DrawEdges(Canvas: TCanvas; const R: TRect; HighlightColor, + ShadowColor: TColor; Flags: Cardinal); +begin + with Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := HighlightColor; + if Flags and BF_LEFT <> 0 then + FillRect(Rect(R.Left, R.Top + 1, R.Left + 1, R.Bottom)); + if Flags and BF_TOP <> 0 then + FillRect(Rect(R.Left, R.Top, R.Right, R.Top + 1)); + Brush.Color := ShadowColor; + if Flags and BF_RIGHT <> 0 then + FillRect(Rect(R.Right - 1, R.Top + 1, R.Right, R.Bottom)); + if Flags and BF_BOTTOM <> 0 then + FillRect(Rect(R.Left + 1, R.Bottom - 1, R.Right - 1, R.Bottom)); + end; +end; + +procedure DrawFilledRectangle(Canvas: TCanvas; const ARect: TRect; BackColor: TColor); +var + DC: HDC; +begin + DC := Canvas.Handle; + SetBkMode(DC, OPAQUE); + SetBkColor(DC, ColorToRGB(BackColor)); + FillRect(DC, ARect, Canvas.Brush.Handle); +end; + +procedure ExcludeShapeFromBaseRect(var BaseRect: TRect; ShapeWidth, ShapeHeight: Integer; + HAlign: TKHAlign; VAlign: TKVAlign; HPadding, VPadding: Integer; + StretchMode: TKStretchMode; out Bounds, Interior: TRect); +var + MaxHeight, MaxWidth, StretchHeight, StretchWidth: Integer; + RatioX, RatioY: Single; +begin + MaxHeight := BaseRect.Bottom - BaseRect.Top - 2 * VPadding; + MaxWidth := BaseRect.Right - BaseRect.Left - HPadding; + if ((MaxWidth <> ShapeWidth) or (MaxHeight <> ShapeHeight)) and ( + (StretchMode = stmZoom) or + (StretchMode = stmZoomInOnly) and (MaxWidth >= ShapeWidth) and (MaxHeight >= ShapeHeight) or + (StretchMode = stmZoomOutOnly) and ((MaxWidth < ShapeWidth) or (MaxHeight < ShapeHeight)) + ) then + begin + RatioX := MaxWidth / ShapeWidth; + RatioY := MaxHeight / ShapeHeight; + if RatioY >= RatioX then + begin + StretchWidth := MaxWidth; + StretchHeight := ShapeHeight * StretchWidth div ShapeWidth; + end else + begin + StretchHeight := MaxHeight; + StretchWidth := ShapeWidth * StretchHeight div ShapeHeight; + end; + end else + begin + StretchHeight := ShapeHeight; + StretchWidth := ShapeWidth; + end; + Bounds := BaseRect; + Interior := BaseRect; + case HAlign of + halLeft: + begin + Inc(BaseRect.Left, StretchWidth + HPadding); + // Bounds.Left remains unchanged + Bounds.Right := BaseRect.Left; + Inc(Interior.Left, HPadding); + end; + halCenter: + begin + BaseRect.Right := BaseRect.Left; // BaseRect empty, no space for next item! + // Bounds remains unchanged + Inc(Interior.Left, HPadding + (MaxWidth - StretchWidth) div 2); + end; + halRight: + begin + Dec(BaseRect.Right, StretchWidth + HPadding); + Bounds.Left := BaseRect.Right; + // Bounds.Right remains unchanged + Interior.Left := BaseRect.Right; + end; + end; + Interior.Right := Interior.Left + StretchWidth; + case VAlign of + valTop: Inc(Interior.Top, VPadding); + valCenter: Inc(Interior.Top, VPadding + (MaxHeight - StretchHeight) div 2); + valBottom: Interior.Top := BaseRect.Bottom - VPadding - StretchHeight; + end; + Interior.Bottom := Interior.Top + StretchHeight; +end; + +function ExtSelectClipRect(DC: HDC; ARect: TRect; Mode: Integer; out PrevRgn: HRGN): Boolean; +var + TmpRgn: HRGN; +begin + PrevRgn := CreateEmptyRgn; + GetClipRgn(DC, PrevRgn); + TmpRgn := CreateEmptyRgn; + try + Result := ExtSelectClipRectEx(DC, ARect, Mode, TmpRgn, PrevRgn) + finally + DeleteObject(TmpRgn); + end; +end; + +function ExtSelectClipRectEx(DC: HDC; ARect: TRect; Mode: Integer; CurRgn, PrevRgn: HRGN): Boolean; +var + RectRgn: HRGN; +begin + RectRgn := CreateRectRgnIndirect(ARect); + try + Result := CombineRgn(CurRgn, PrevRgn, RectRgn, Mode) <> NULLREGION; + if Result then + SelectClipRgn(DC, CurRgn); + finally + DeleteObject(RectRgn); + end; +end; + +procedure FillAroundRect(ACanvas: TCanvas; const Boundary, Interior: TRect; BackColor: TColor); +var + R: TRect; +begin + R := Rect(Boundary.Left, Boundary.Top, Boundary.Right, Interior.Top); + if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); + R := Rect(Boundary.Left, Interior.Top, Interior.Left, Interior.Bottom); + if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); + R := Rect(Interior.Right, Interior.Top, Boundary.Right, Interior.Bottom); + if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); + R := Rect(Boundary.Left, Interior.Bottom, Boundary.Right, Boundary.Bottom); + if not IsRectEmpty(R) then DrawFilledRectangle(ACanvas, R, BackColor); +end; + +procedure FinalizePrevRgn(DC: HDC; ARgn: HRGN); +begin + SelectClipRgn(DC, ARgn); + DeleteObject(ARgn); +end; + +function GetFontHeight(DC: HDC): Integer; +var + TM: TTextMetric; +begin + FillChar(TM, SizeOf(TTextMetric), 0); + GetTextMetrics(DC, TM); + Result := TM.tmHeight; +end; + +function GDICheck(Value: Integer): Integer; +begin + if Value = 0 then + raise EOutOfResources.Create(SGDIError); + Result := Value; +end; + +function ImageByType(const Header: TKImageHeaderString): TGraphic; +begin + if Pos('BM', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1 then + Result := TBitmap.Create +{$IFDEF USE_PNG_SUPPORT } + else if (Pos(#137'PNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) or + (Pos(#138'MNG', {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then + Result := TKPngImage.Create +{$ENDIF } + else if (Pos(#$FF#$D8, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then + Result := TJPegImage.Create + else if (Pos(#$FF#$D8, {$IFDEF COMPILER12_UP}string{$ENDIF}(Header)) = 1) then + Result := TIcon.Create + else + Result := nil; +end; + +function IntersectClipRectIndirect(DC: HDC; ARect: TRect): Boolean; +begin + with ARect do + Result := IntersectClipRect(DC, Left, Top, Right, Bottom) <> NULLREGION; +end; + +function IsBrightColor(Color: TColor): Boolean; +begin + Result := CalcLightness(Color) > 0.5; +end; + +function MakeColorRec(R, G, B, A: Byte): TKColorRec; +begin + Result.R := R; + Result.G := G; + Result.B := B; + Result.A := A; +end; + +procedure LoadCustomCursor(Cursor: TCursor; const ResName: string); +begin + Screen.Cursors[Cursor] := + {$IFDEF FPC} + LoadCursorFromLazarusResource(ResName); + {$ELSE} + LoadCursor(HInstance, PChar(ResName)); + {$ENDIF} +end; + +function PixelFormatFromBpp(Bpp: Cardinal): TPixelFormat; +begin + case Bpp of + 1: Result := pf1bit; + 2..4: Result := pf4bit; + 5..8: Result := pf8bit; + 9..16: Result := pf16bit; + else + Result := pf32bit; + end; +end; + +function RectInRegion(Rgn: HRGN; ARect: TRect): Boolean; +{$IFDEF FPC} +var + RectRgn, TmpRgn: HRGN; +{$ENDIF} +begin +{$IFDEF FPC} + RectRgn := CreateRectRgnIndirect(ARect); + try + TmpRgn := CreateEmptyRgn; + try + Result := CombineRgn(TmpRgn, RectRgn, Rgn, RGN_AND) <> NULLREGION; + finally + DeleteObject(TmpRgn); + end; + finally + DeleteObject(RectRgn); + end; +{$ELSE} + Result := Windows.RectInRegion(Rgn, ARect); +{$ENDIF} +end; + +procedure SafeStretchDraw(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic; ABackColor: TColor); +{$IFDEF USE_WINAPI} +var + BM: TBitmap; + W, H, MulX, MulY, DivX, DivY: Integer; + R: TRect; +{$ENDIF} +begin +{$IFDEF USE_WINAPI} + if AGraphic.Transparent then + begin + // WinAPI StretchBlt function does not read properly from screen buffer + // so we have to append double buffering + CanvasGetScale(ACanvas, MulX, MulY, DivX, DivY); + W := MulDiv(ARect.Right - ARect.Left, MulX, DivX); + H := MulDiv(ARect.Bottom - ARect.Top, MulY, DivY); + BM := TBitmap.Create; + try + BM.Width := W; + BM.Height := H; + BM.Canvas.Brush := ACanvas.Brush; + R := Rect(0, 0, W, H); + DrawFilledRectangle(BM.Canvas, R, ABackColor); + BM.Canvas.StretchDraw(R, AGraphic); + ACanvas.StretchDraw(ARect, BM); + finally + BM.Free; + end; + end else +{$ENDIF} + ACanvas.StretchDraw(ARect, AGraphic); +end; + +procedure SelectClipRect(DC: HDC; const ARect: TRect); +var + Rgn: HRGN; +begin + Rgn := CreateRectRgnIndirect(ARect); + try + SelectClipRgn(DC, Rgn); + finally + DeleteObject(Rgn); + end; +end; + +procedure StretchBitmap(DestDC: HDC; DestRect: TRect; SrcDC: HDC; SrcRect: TRect); +begin + {$IFDEF USE_WINAPI}Windows.{$ENDIF}StretchBlt(DestDC, + DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, + SrcDC, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, + SRCCOPY); +end; + +procedure SwapBR(var ColorRec: TKColorRec); +var + Tmp: Byte; +begin + Tmp := ColorRec.R; + ColorRec.R := ColorRec.B; + ColorRec.B := Tmp; +end; + +function SwitchRGBToBGR(Value: TColor): TColor; +var + B: Byte; +begin + Result := Value; + B := PKColorRec(@Value).B; + PKColorRec(@Result).B := PKColorRec(@Result).R; + PKColorRec(@Result).R := B; +end; + +procedure TranslateRectToDevice(DC: HDC; var ARect: TRect); +var + P: TPoint; +{$IFDEF USE_DC_MAPPING} + {$IFNDEF LCLQT} + WindowExt, ViewportExt: TSize; + {$ENDIF} +{$ENDIF} +begin +{$IFDEF USE_DC_MAPPING} + {$IFNDEF LCLQT} + if not (GetMapMode(DC) in [0, MM_TEXT]) and + Boolean(GetWindowExtEx(DC, {$IFDEF FPC}@{$ENDIF}WindowExt)) and + Boolean(GetViewportExtEx(DC, {$IFDEF FPC}@{$ENDIF}ViewportExt)) then + begin + ARect.Left := MulDiv(ARect.Left, ViewportExt.cx, WindowExt.cx); + ARect.Right := MulDiv(ARect.Right, ViewportExt.cx, WindowExt.cx); + ARect.Top := MulDiv(ARect.Top, ViewportExt.cy, WindowExt.cy); + ARect.Bottom := MulDiv(ARect.Bottom, ViewportExt.cy, WindowExt.cy); + end; + if Boolean(GetViewPortOrgEx(DC, {$IFDEF FPC}@{$ENDIF}P)) then + OffsetRect(ARect, P.X, P.Y); + {$ENDIF} +{$ENDIF} + if Boolean(GetWindowOrgEx(DC, {$IFDEF FPC}@{$ENDIF}P)) then + OffsetRect(ARect, -P.X, -P.Y); +end; + +{ TKAlphaBitmap } + +constructor TKAlphaBitmap.Create; +begin + inherited; + FCanvas := TCanvas.Create; + FCanvas.Handle := CreateCompatibleDC(0); + FDirectCopy := False; + FHandle := 0; +{$IFNDEF USE_WINAPI} + FImage := TLazIntfImage.Create(0, 0); +{$ENDIF} + FHeight := 0; + FOldBitmap := 0; + FPixels := nil; + FWidth := 0; +end; + +constructor TKAlphaBitmap.CreateFromRes(const ResName: string); +var + Stream: {$IFDEF FPC}TLazarusResourceStream{$ELSE}TResourceStream{$ENDIF}; +begin + Create; + try + {$IFDEF FPC} + Stream := TLazarusResourceStream.Create(LowerCase(ResName), 'BMP'); + {$ELSE} + Stream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); + {$ENDIF} + try + LoadFromStream(Stream); + finally + Stream.Free; + end; + except + end; +end; + +destructor TKAlphaBitmap.Destroy; +var + DC: HDC; +begin + inherited; + SetSize(0, 0); +{$IFNDEF USE_WINAPI} + FImage.Free; +{$ENDIF} + DC := FCanvas.Handle; + FCanvas.Handle := 0; + DeleteDC(DC); + FCanvas.Free; +end; + +procedure TKAlphaBitmap.AlphaDrawTo(ACanvas: TCanvas; X, Y: Integer); +begin + AlphaStretchDrawTo(ACanvas, Rect(X, Y, X + FWidth, Y + FHeight)); +end; + +procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; IfEmpty: Boolean); +var + I: Integer; + HasAlpha: Boolean; +begin + HasAlpha := False; + if IfEmpty then + for I := 0 to FWidth * FHeight - 1 do + if FPixels[I].A <> 0 then + begin + HasAlpha := True; + Break; + end; + if not HasAlpha then + for I := 0 to FWidth * FHeight - 1 do + FPixels[I].A := Alpha; +end; + +procedure TKAlphaBitmap.AlphaFill(Alpha: Byte; BlendColor: TColor; Gradient, Translucent: Boolean); +var + I, J, A1, A2, AR, AG, AB, HAlpha: Integer; + HStep, HSum, VStep, VSum: Single; + Scan: PKColorRecs; + CS: TKColorRec; +begin + VSum := 0; VStep := 0; + HSum := 0; HStep := 0; + if Gradient then + begin + VStep := Alpha / FHeight; + VSum := Alpha; + end; + CS.Value := ColorToRGB(BlendColor); +{$IFNDEF USE_WINAPI} + for I := 0 to FHeight - 1 do +{$ELSE} + for I := FHeight - 1 downto 0 do +{$ENDIF} + begin + Scan := ScanLine[I]; + HAlpha := Alpha; + if Gradient then + begin + HStep := HAlpha / FWidth; + HSum := HAlpha; + end; + for J := 0 to FWidth - 1 do with Scan[J] do + begin + A1 := HAlpha; + A2 := 255 - HAlpha; + AR := R * A1 + CS.R * A2; + AG := G * A1 + CS.G * A2; + AB := B * A1 + CS.B * A2; + R := AR shr 8; + G := AG shr 8; + B := AB shr 8; + if Translucent then + A := HAlpha + else + A := 255; + if Gradient then + begin + HAlpha := Round(HSum); + HSum := HSum - HStep; + end; + end; + if Gradient then + begin + Alpha := Round(VSum); + VSum := VSum - VStep; + end; + end; + FPixelsChanged := True; +end; + +procedure TKAlphaBitmap.AlphaStretchDrawTo(ACanvas: TCanvas; + const ARect: TRect); +{$IFDEF USE_WINAPI} +var + I: Integer; + Tmp: TKAlphaBitmap; + Ps, Pd: PKColorRecs; +{$ENDIF} +begin +{$IFNDEF USE_WINAPI} + DrawTo(ACanvas, ARect); +{$ELSE} + Tmp := TKAlphaBitmap.Create; + try + Tmp.SetSize(FWidth, FHeight); + Tmp.DrawFrom(ACanvas, ARect); + for I := 0 to FHeight - 1 do + begin + Ps := ScanLine[I]; + Pd := Tmp.ScanLine[I]; + BlendLine(Ps, Pd, FWidth); + end; + Tmp.PixelsChanged := True; + Tmp.DrawTo(ACanvas, ARect); + finally + Tmp.Free; + end; +{$ENDIF} +end; + +procedure TKAlphaBitmap.CombinePixel(X, Y: Integer; Color: TKColorRec); +var + Index, A1, A2, AR, AG, AB: Integer; +begin + if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then + begin + SwapBR(Color); + {$IFDEF USE_WINAPI} + Index := (FHeight - Y - 1) * FWidth + X; + {$ELSE} + Index := Y * FWidth + X; + {$ENDIF} + A2 := Color.A; + if A2 = 255 then + FPixels[Index] := Color + else if A2 <> 0 then + begin + A1 := 255 - Color.A; + AR := FPixels[Index].R * A1 + Color.R * A2; + AG := FPixels[Index].G * A1 + Color.G * A2; + AB := FPixels[Index].B * A1 + Color.B * A2; + FPixels[Index].R := AR shr 8; + FPixels[Index].G := AG shr 8; + FPixels[Index].B := AB shr 8; + FPixels[Index].A := 255; + end; + FPixelsChanged := True; + end; +end; + +procedure TKAlphaBitmap.CopyFrom(ABitmap: TKAlphaBitmap); +var + I, Size: Integer; +begin + SetSize(ABitmap.Width, ABitmap.Height); + Size := FWidth * SizeOf(TKColorRec); + for I := 0 to FHeight - 1 do + Move(ABitmap.ScanLine[I]^, ScanLine[I]^, Size); + FPixelsChanged := True; +end; + +procedure TKAlphaBitmap.CopyFromRotated(ABitmap: TKAlphaBitmap); +var + I, J: Integer; + SrcScan, DstScan: PKColorRecs; +begin + SetSize(ABitmap.Height, ABitmap.Width); + for J := 0 to ABitmap.Height - 1 do + begin + SrcScan := ABitmap.ScanLine[J]; + for I := 0 to ABitmap.Width - 1 do + begin + DstScan := ScanLine[ABitmap.Width - I - 1]; + DstScan[J] := SrcScan[I]; + end; + end; + FPixelsChanged := True; +end; + +procedure TKAlphaBitmap.Draw(ACanvas: TCanvas; const ARect: TRect); +begin + if FDirectCopy then + DrawTo(ACanvas, ARect) + else + AlphaStretchDrawTo(ACanvas, ARect); +end; + +procedure TKAlphaBitmap.DrawFrom(ACanvas: TCanvas; const ARect: TRect); +begin + if not Empty then + begin + if not CanvasScaled(ACanvas) then + StretchBitmap(FCanvas.Handle, Rect(0, 0, FWidth, FHeight), ACanvas.Handle, ARect) + else + begin + FCanvas.Brush := ACanvas.Brush; + DrawFilledRectangle(FCanvas, Rect(0, 0, FWidth, FHeight), + {$IFDEF USE_WINAPI}GetBkColor(ACanvas.Handle){$ELSE}clWindow{$ENDIF}); + end; + UpdatePixels; + end; +end; + +procedure TKAlphaBitmap.DrawTo(ACanvas: TCanvas; const ARect: TRect); +begin + if not Empty then + begin + UpdateHandle; + StretchBitmap(ACanvas.Handle, ARect, FCanvas.Handle, Rect(0, 0, FWidth, FHeight)) + end; +end; + +function TKAlphaBitmap.GetEmpty: Boolean; +begin + Result := (FWidth = 0) and (FHeight = 0); +end; + +function TKAlphaBitmap.GetHeight: Integer; +begin + Result := FHeight; +end; + +function TKAlphaBitmap.GetPixel(X, Y: Integer): TKColorRec; +begin + if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then + begin + {$IFDEF USE_WINAPI} + Result := FPixels[(FHeight - Y - 1) * FWidth + X]; + {$ELSE} + Result := FPixels[Y * FWidth + X]; + {$ENDIF} + SwapBR(Result); + end else + Result := MakeColorRec(0,0,0,0); +end; + +function TKAlphaBitmap.GetTransparent: Boolean; +begin + Result := True; +end; + +function TKAlphaBitmap.GetScanLine(Index: Integer): PKColorRecs; +begin + // no checks here + Result := @FPixels[Index * FWidth]; +end; + +function TKAlphaBitmap.GetHandle: HBITMAP; +begin + Result := FHandle; +end; + +function TKAlphaBitmap.GetWidth: Integer; +begin + Result := FWidth; +end; + +{$IFNDEF FPC} +procedure TKAlphaBitmap.LoadFromClipboardFormat(AFormat: Word; AData: THandle; + APalette: HPALETTE); +begin + // does nothing +end; +{$ENDIF} + +procedure TKAlphaBitmap.LoadFromStream(Stream: TStream); +var + BF: TBitmapFileHeader; + BI: TBitmapInfoHeader; +begin + SetSize(0, 0); + Stream.Read(BF, SizeOf(TBitmapFileHeader)); + Stream.Read(BI, SizeOf(TBitmapInfoHeader)); + if BI.biBitCount = 32 then + begin + SetSize(BI.biWidth, BI.biHeight); + Stream.Read(FPixels^, BI.biSizeImage); + // if bitmap has no alpha channel, create full opacity + AlphaFill($FF, True); + end; + FPixelsChanged := True; +end; + +procedure TKAlphaBitmap.MirrorHorz; +var + I, J, Index: Integer; + SrcScan: PKColorRecs; + Buf: TKColorRec; +begin + for I := 0 to FHeight - 1 do + begin + SrcScan := ScanLine[I]; + Index := FWidth - 1; + for J := 0 to (FWidth shr 1) - 1 do + begin + Buf := SrcScan[Index]; + SrcScan[Index] := SrcScan[J]; + SrcScan[J] := Buf; + Dec(Index); + end; + end; + FPixelsChanged := True; +end; + +procedure TKAlphaBitmap.MirrorVert; +var + I, Size, Index: Integer; + SrcScan, DstScan: PKColorRecs; + Buf: PKColorRec; +begin + Size:= FWidth * SizeOf(TKColorRec); + Index := FHeight - 1; + GetMem(Buf, Size); + try + for I := 0 to (FHeight shr 1) - 1 do + begin + SrcScan := ScanLine[I]; + DstScan := ScanLine[Index]; + Move(SrcScan^, Buf^, Size); + Move(DstScan^, SrcScan^, Size); + Move(Buf^, DstScan^, Size); + Dec(Index); + end; + finally + FreeMem(Buf); + end; + FPixelsChanged := True; +end; + +{$IFNDEF FPC} +procedure TKAlphaBitmap.SaveToClipboardFormat(var AFormat: Word; + var AData: THandle; var APalette: HPALETTE); +begin + // does nothing +end; +{$ENDIF} + +procedure TKAlphaBitmap.SaveToStream(Stream: TStream); +var + Size: Integer; + BF: TBitmapFileHeader; + BI: TBitmapInfoHeader; +begin + Size := FWidth * FHeight * 4; + FillChar(BF, SizeOf(TBitmapFileHeader), 0); + BF.bfType := $4D42; + BF.bfSize := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader) + Size; + BF.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader); + Stream.Write(BF, SizeOf(TBitmapFileHeader)); + FillChar(BI, SizeOf(TBitmapInfoHeader), 0); + BI.biSize := SizeOf(TBitmapInfoHeader); + BI.biWidth := FWidth; + BI.biHeight := FHeight; + BI.biPlanes := 1; + BI.biBitCount := 32; + BI.biCompression := BI_RGB; + BI.biSizeImage := Size; + Stream.Write(BI, SizeOf(TBitmapInfoHeader)); + Stream.Write(FPixels^, Size); +end; + +procedure TKAlphaBitmap.SetHeight(Value: Integer); +begin + SetSize(FWidth, Value); +end; + +procedure TKAlphaBitmap.SetPixel(X, Y: Integer; Value: TKColorRec); +begin + if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then + begin + SwapBR(Value); + {$IFDEF USE_WINAPI} + FPixels[(FHeight - Y - 1) * FWidth + X] := Value; + {$ELSE} + FPixels[Y * FWidth + X] := Value; + {$ENDIF} + FPixelsChanged := True; + end; +end; + +procedure TKAlphaBitmap.SetSize(AWidth, AHeight: Integer); +var +{$IFNDEF USE_WINAPI} + ImgFormatDescription: TRawImageDescription; +{$ELSE} + BI: TBitmapInfoHeader; +{$ENDIF} +begin + AWidth := Max(AWidth, 0); + AHeight := Max(AHeight, 0); + if (AWidth <> FWidth) or (AHeight <> FHeight) then + begin + FWidth := AWidth; + FHeight := AHeight; + if FHandle <> 0 then + begin + SelectObject(FCanvas.Handle, FOldBitmap); + DeleteObject(FHandle); + FHandle := 0; + {$IFNDEF USE_WINAPI} + DeleteObject(FMaskHandle); + FMaskHandle := 0; + {$ENDIF} + end; + {$IFNDEF USE_WINAPI} + FImage.SetSize(0, 0); + {$ENDIF} + FPixels := nil; + if (FWidth <> 0) and (FHeight <> 0) then + begin + {$IFNDEF USE_WINAPI} + ImgFormatDescription.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth,FHeight); + FImage.DataDescription := ImgFormatDescription; + FPixelsChanged := True; + UpdateHandle; + {$ELSE} + FillChar(BI, SizeOf(TBitmapInfoHeader), 0); + BI.biSize := SizeOf(TBitmapInfoHeader); + BI.biWidth := FWidth; + BI.biHeight := FHeight; + BI.biPlanes := 1; + BI.biBitCount := 32; + BI.biCompression := BI_RGB; + FHandle := GDICheck(CreateDIBSection(FCanvas.Handle, PBitmapInfo(@BI)^, DIB_RGB_COLORS, Pointer(FPixels), 0, 0)); + FOldBitmap := SelectObject(FCanvas.Handle, FHandle); + {$ENDIF} + end; + end; +end; + +procedure TKAlphaBitmap.SetWidth(Value: Integer); +begin + SetSize(Value, FWidth); +end; + +procedure TKAlphaBitmap.SetTransparent(Value: Boolean); +begin + // does nothing +end; + +procedure TKAlphaBitmap.UpdateHandle; +begin +{$IFNDEF USE_WINAPI} + if FPixelsChanged then + begin + PixelsChanged := False; + if FHandle <> 0 then + begin + DeleteObject(FMaskHandle); + DeleteObject(SelectObject(FCanvas.Handle, FOldBitmap)); + end; + FImage.CreateBitmaps(FHandle, FMaskHandle, False); + FOldBitmap := SelectObject(FCanvas.Handle, FHandle); + FPixels := PKColorRecs(FImage.PixelData); + end; +{$ENDIF} +end; + +procedure TKAlphaBitmap.UpdatePixels; +begin +{$IFNDEF USE_WINAPI} + FImage.LoadFromDevice(FCanvas.Handle); + FPixelsChanged := True; + UpdateHandle; +{$ENDIF} +end; + +{$IFDEF USE_WINAPI} +const + cLayeredWndClass = 'KControls drag window'; + +function DragWndProc(Window: HWnd; Msg, WParam, LParam: Longint): Longint; stdcall; +var + DC: HDC; + PS: TPaintStruct; + AWindow: TKDragWindow; +begin + case Msg of + WM_PAINT: + begin + AWindow := TKDragWindow(GetWindowLong(Window, GWL_USERDATA)); + if (AWindow <> nil) and AWindow.BitmapFilled then + begin + if wParam = 0 then + DC := BeginPaint(Window, PS) + else + DC := wParam; + try + BitBlt(DC, 0, 0, AWindow.Bitmap.Width, AWindow.Bitmap.Height, + AWindow.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); + finally + if wParam = 0 then EndPaint(Window, PS); + end; + end; + Result := 1; + end; + else + Result := DefWindowProc(Window, Msg, WParam, LParam); + end; +end; + +{$ELSE} + +type + + { TKDragForm } + + TKDragForm = class(THintWindow) + private + FWindow: TKDragWindow; + procedure WMEraseBkGnd(var Msg: TLMessage); message LM_ERASEBKGND; + protected + procedure Paint; override; + public + constructor CreateDragForm(AWindow: TKDragWindow); + end; + +{ TKDragForm } + +constructor TKDragForm.CreateDragForm(AWindow: TKDragWindow); +begin + inherited Create(nil); + FWindow := AWindow; + ShowInTaskBar := stNever; +end; + +procedure TKDragForm.Paint; +begin + if FWindow.Active and FWindow.BitmapFilled then + Canvas.Draw(0, 0, FWindow.FBitmap); +end; + +procedure TKDragForm.WMEraseBkGnd(var Msg: TLMessage); +begin + Msg.Result := 1; +end; + +{$ENDIF} + +constructor TKDragWindow.Create; +{$IFDEF USE_WINAPI} +var + Cls: Windows.TWndClass; + ExStyle: Cardinal; +{$ENDIF} +begin + inherited; + FActive := False; + FBitmap := TKAlphaBitmap.Create; + FInitialPos := Point(0, 0); +{$IFDEF USE_WINAPI} + FUpdateLayeredWindow := GetProcAddress(GetModuleHandle('user32.dll'), 'UpdateLayeredWindow'); + FLayered := Assigned(FUpdateLayeredWindow); + Cls.style := CS_SAVEBITS; + Cls.lpfnWndProc := @DragWndProc; + Cls.cbClsExtra := 0; + Cls.cbWndExtra := 0; + Cls.hInstance := HInstance; + Cls.hIcon := 0; + Cls.hCursor := 0; + Cls.hbrBackground := 0; + Cls.lpszMenuName := nil; + Cls.lpszClassName := cLayeredWndClass; + Windows.RegisterClass(Cls); + ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST; + if FLayered then + ExStyle := ExStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT; + FWindow := CreateWindowEx(ExStyle, cLayeredWndClass, '', WS_POPUP, + Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), + Integer(CW_USEDEFAULT), 0, 0, HInstance, nil); + Windows.SetWindowLong(FWindow, GWL_USERDATA, Integer(Self)); +{$ELSE} + FDragForm := TKDragForm.CreateDragForm(Self); + FLayered := False; +{$ENDIF} +end; + +destructor TKDragWindow.Destroy; +begin + inherited; + Hide; +{$IFDEF USE_WINAPI} + DestroyWindow(FWindow); + Windows.UnregisterClass(cLayeredWndClass, HInstance); +{$ELSE} + FDragForm.Free; +{$ENDIF} + FBitmap.Free; +end; + +procedure TKDragWindow.Hide; +begin + if FActive then + begin + {$IFDEF USE_WINAPI} + ShowWindow(FWindow, SW_HIDE); + {$ELSE} + FDragForm.Hide; + {$ENDIF} + FActive := False; + end; +end; + +procedure TKDragWindow.Show(IniCtrl: TCustomControl; const ARect: TRect; + const InitialPos, CurrentPos: TPoint; MasterAlpha: Byte; Gradient: Boolean); +var + Org: TPoint; + W, H: Integer; + ScreenDC: HDC; +begin + if not (IniCtrl is TKCustomControl) then Exit; + if not FActive then + begin + FActive := True; + FBitmapFilled := False; + FControl := IniCtrl; + FMasterAlpha := MasterAlpha; + FGradient := Gradient; + FInitialPos := InitialPos; + W := ARect.Right - ARect.Left; + H := ARect.Bottom - ARect.Top; + FBitmap.SetSize(W, H); + Org := IniCtrl.ClientToScreen(ARect.TopLeft); + ScreenDC := GetDC(0); + try + FAlphaEffects := GetDeviceCaps(ScreenDC, BITSPIXEL) >= 15; + // because alpha blending is not nice elsewhere + finally + ReleaseDC(0, ScreenDC); + end; + // to be compatible with all LCL widgetsets we must copy the control's part + // while painting in TKCustomControl.Paint! + TKCustomControl(FControl).MemoryCanvas := FBitmap.Canvas; + TKCustomControl(FControl).MemoryCanvasRect := ARect; + TKCustomControl(FControl).Repaint; + {$IFDEF USE_WINAPI} + if FLayered then with FBlend do + begin + BlendOp := AC_SRC_OVER; + BlendFlags := 0; + SourceConstantAlpha := 255; + if FAlphaEffects then + AlphaFormat := AC_SRC_ALPHA + else + AlphaFormat := 0; + end; + SetWindowPos(FWindow, 0, Org.X, Org.Y, W, H, + SWP_NOACTIVATE or SWP_NOZORDER); + {$ELSE} + FDragForm.SetBounds(Org.X, Org.Y, W, H); + {$ENDIF} + Move(CurrentPos); + end; +end; + +procedure TKDragWindow.Move(const NewPos: TPoint); +var + R: TRect; + DX, DY: Integer; + BlendColor: TColor; +{$IFDEF USE_WINAPI} + ScreenDC: HDC; + CanvasOrigin: TPoint; +{$ENDIF} +begin + if FActive then + begin + if (TKCustomControl(FControl).MemoryCanvas = nil) and not FBitmapFilled then + begin + FBitmapFilled := True; + FBitmap.UpdatePixels; + if FAlphaEffects then + begin + if FLayered then + BlendColor := clBlack + else + BlendColor := clWhite; + FBitmap.AlphaFill(FMasterAlpha, BlendColor, FGradient, FLayered); + FBitmap.UpdateHandle; + end; + end; + DX := NewPos.X - FInitialPos.X; + DY := NewPos.Y - FInitialPos.Y; + if (DX <> 0) or (DY <> 0) then + begin + FInitialPos := NewPos; + {$IFDEF USE_WINAPI} + GetWindowRect(FWindow, R); + OffsetRect(R, DX, DY); + if FLayered then + begin + R.Right := FBitmap.Width; + R.Bottom := FBitmap.Height; + CanvasOrigin := Point(0, 0); + ScreenDC := GetDC(0); + try + if FUpdateLayeredWindow(FWindow, ScreenDC, @R.TopLeft, PSize(@R.BottomRight), + FBitmap.Canvas.Handle, @CanvasOrigin, clNone, @FBlend, ULW_ALPHA) then + if FBitmapFilled then + ShowWindow(FWindow, SW_SHOWNOACTIVATE); + finally + ReleaseDC(0, ScreenDC); + end; + end + else if FBitmapFilled then + SetWindowPos(FWindow, 0, R.Left, R.Top, 0, 0, + SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER or SWP_SHOWWINDOW); + {$ELSE} + R := FDragForm.BoundsRect; + OffsetRect(R, DX, DY); + FDragForm.BoundsRect := R; + if FBitmapFilled then + begin + FDragForm.Visible := True; + SetCaptureControl(FControl); + end; + {$ENDIF} + end; + end; +end; + +{ TKHintWindow } + +constructor TKHintWindow.Create(AOwner: TComponent); +begin + inherited; +{$IFDEF FPC} + ShowInTaskBar := stNever; +{$ENDIF} + DoubleBuffered := True; +end; + +procedure TKHintWindow.ShowAt(const Origin: TPoint); +begin + ActivateHint(Rect(Origin.X, Origin.Y, Origin.X + FExtent.X + 10, Origin.Y + FExtent.Y + 10), ''); +end; + +procedure TKHintWindow.WMEraseBkGnd(var Msg: TLMessage); +begin + Msg.Result := 1; +end; + +{ TKTextHint } + +constructor TKTextHint.Create(AOwner: TComponent); +begin + inherited; + FText := ''; +end; + +procedure TKTextHint.Paint; +var + R: TRect; +begin + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := clInfoBk; + Canvas.FillRect(ClientRect); + Canvas.Brush.Style := bsClear; + R := Rect(0, 0, FExtent.X + 10, FExtent.Y + 10); + DrawAlignedText(Canvas, R, halLeft, valCenter, + 5, 5, FText, clInfoBk, [taEndEllipsis, taWordBreak, taLineBreak]) +end; + +procedure TKTextHint.SetText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +var + R: TRect; +begin + if Value <> FText then + begin + FText := Value; + R := Rect(0, 0, 300, 0); + DrawAlignedText(Canvas, R, halLeft, valCenter, + 0, 0, FText, clInfoBk, [taCalcRect, taWordBreak, taLineBreak]); + FExtent.X := R.Right - R.Left; + FExtent.Y := R.Bottom - R.Top; + end; +end; + +{ TKGraphicHint } + +constructor TKGraphicHint.Create(AOwner: TComponent); +begin + inherited; + FGraphic := nil; +{$IFDEF FPC} + ShowInTaskBar := stNever; +{$ENDIF} + DoubleBuffered := True; +end; + +procedure TKGraphicHint.Paint; +begin + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := clInfoBk; + Canvas.FillRect(ClientRect); + if Assigned(FGraphic) then + Canvas.Draw(5, 5, FGraphic) +end; + +procedure TKGraphicHint.SetGraphic(const Value: TGraphic); +begin + if Value <> FGraphic then + begin + FGraphic := Value; + FExtent.X := FGraphic.Width; + FExtent.Y := FGraphic.Height; + end; +end; + +end. diff --git a/components/kcontrols/source/kgrids.lrs b/components/kcontrols/source/kgrids.lrs new file mode 100755 index 000000000..5cc3f79ae --- /dev/null +++ b/components/kcontrols/source/kgrids.lrs @@ -0,0 +1,101 @@ +LazarusResources.Add('kgrid_hci_hbegin','BMP',[ + 'BMZ'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#3#0#0#0#3#0#0#0#1#0' '#0#0#0#0#0'$'#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#231#5#0#0#252#6#0'-'#255'2'#0#0#209#5#0 + +#0#229#5#0#0#245#6#0#0#200#5#0#0#209#5#0#0#218#5#0 +]); +LazarusResources.Add('kgrid_hci_hcenter','BMP',[ + 'BMN'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#2#0#0#0#3#0#0#0#1#0' '#0#0#0#0#0#24#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0':'#255'?'#0':'#255'?'#0#0#249#6#0#0#249#6 + +#0#0#221#5#0#0#221#5#0 +]); +LazarusResources.Add('kgrid_hci_hend','BMP',[ + 'BMZ'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#3#0#0#0#3#0#0#0#1#0' '#0#0#0#0#0'$'#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'F'#255'J'#0'm'#255'p'#0#151#255#153#0#0 + +#253#6#0'.'#255'3'#0'o'#255'r'#0#0#225#5#0#0#239#6#0#21#255#27#0 +]); +LazarusResources.Add('kgrid_hci_vbegin','BMP',[ + 'BMZ'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#3#0#0#0#3#0#0#0#1#0' '#0#0#0#0#0'$'#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#218#5#0#0#245#6#0'-'#255'2'#0#0#209#5#0 + +#0#229#5#0#0#252#6#0#0#200#5#0#0#209#5#0#0#231#5#0 +]); +LazarusResources.Add('kgrid_hci_vcenter','BMP',[ + 'BMN'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#3#0#0#0#2#0#0#0#1#0' '#0#0#0#0#0#24#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#221#5#0#0#249#6#0':'#255'?'#0#0#221#5#0 + +#0#249#6#0':'#255'?'#0 +]); +LazarusResources.Add('kgrid_hci_vend','BMP',[ + 'BMZ'#0#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#3#0#0#0#3#0#0#0#1#0' '#0#0#0#0#0'$'#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'F'#255'J'#0'm'#255'p'#0#151#255#153#0#0 + +#253#6#0'.'#255'3'#0'o'#255'r'#0#0#225#5#0#0#239#6#0#21#255#27#0 +]); +LazarusResources.Add('kgrid_drag_arrow','BMP',[ + 'BM'#26#2#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0' '#0#0#0#0#0#228 + +#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +'5'#0#0#0#179#0#0#0'5'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0'5'#0#0#0#179#8#175#8#255#0#0#0#179#0#0#0'5'#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0'5'#0#0#0#179#15#200#15#255'/'#227'/'#255'E'#204'E'#255 + +#0#0#0#179#0#0#0'5'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'5'#0#0#0#179#9#199#9#255',' + +#226','#255'l'#236'l'#255#153#240#153#255#131#222#131#255#0#0#0#179#0#0#0'5' + +#0#0#0#0#0#0#0'5'#0#0#0#179#1#201#1#255#15#223#15#255'C'#229'C'#255#147#240 + +#147#255#191#247#191#255#175#244#175#255']'#202']'#255#0#0#0#179#0#0#0'5'#0#0 + +#0#179#0#0#0#255#0#0#0#255#0#0#0#255'A'#231'A'#255#147#240#147#255#191#247 + +#191#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#179#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#255'4'#228'4'#255#130#238#130#255#179#245#179#255#0#0#0#255#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255''''#226''''#255'l'#235'l'#255 + +#156#242#156#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#255#21#223#21#255'A'#230'A'#255'a'#234'a'#255#0#0#0#255#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#7#222#7#255#21#223#21#255'!'#225 + +'!'#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0 +]); +LazarusResources.Add('kgrid_sort_arrow','BMP',[ + 'BMf'#2#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#14#0#0#0#10#0#0#0#1#0' '#0#0#0#0#0'0'#2 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'Z'#0#0#0'Z'#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0'Z'#0#0#0#255#0#0#0#255#0#0#0'Z'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'Z'#0#0#0#255'q'#255'q'#255'y'#255'y' + +#255#0#0#0#255#0#0#0'Z'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0'Z'#0#0#0#255#153#255#153#255#180#255#180#255#195#255#195#255#189#255 + +#189#255#0#0#0#255#0#0#0'Z'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'Z' + +#0#0#0#255#138#255#138#255#172#255#172#255#208#255#208#255#241#255#241#255 + +#225#255#225#255#189#255#189#255#0#0#0#255#0#0#0'Z'#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0'Z'#0#0#0#255'O'#255'O'#255'n'#255'n'#255#136#255#136#255#158#255#158#255 + +#169#255#169#255#165#255#165#255#147#255#147#255'|'#255'|'#255#0#0#0#255#0#0 + +#0'Z'#0#0#0#0#0#0#0'Z'#0#0#0#255#6#255#6#255'!'#255'!'#255'9'#255'9'#255'K' + +#255'K'#255'Y'#255'Y'#255'_'#255'_'#255']'#255']'#255'R'#255'R'#255'B'#255'B' + +#255','#255','#255#0#0#0#255#0#0#0'Z'#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +]); +LazarusResources.Add('kgrid_cursor_hresize','CUR',[ + #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 + +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#3#192#0#0#2'@'#0 + +#0#2'@'#0#0#2'@'#0#0#2'@'#0#0'2L'#0#0'RJ'#0#0#158'y'#0#1#0#0#128#1#0#0#128#0 + +#158'y'#0#0'RJ'#0#0'2L'#0#0#2'@'#0#0#2'@'#0#0#2'@'#0#0#2'@'#0#0#3#192#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#252'?'#255#255#252'?'#255#255#252'?'#255#255#252'?'#255#255 + +#252'?'#255#255#204'3'#255#255#140'1'#255#255#0#0#255#254#0#0#127#254#0#0#127 + +#255#0#0#255#255#140'1'#255#255#204'3'#255#255#252'?'#255#255#252'?'#255#255 + +#252'?'#255#255#252'?'#255#255#252'?'#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 +]); +LazarusResources.Add('kgrid_cursor_vresize','CUR',[ + #0#0#2#0#1#0' '#0#0#15#0#15#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1 + +#0#1#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#1#128#0#0#2'@'#0 + +#0#4' '#0#0#8#16#0#0#14'p'#0#0#2'@'#0#0#2'@'#0#1#254#127#128#1#0#0#128#1#0#0 + +#128#1#254#127#128#0#2'@'#0#0#2'@'#0#0#14'p'#0#0#8#16#0#0#4' '#0#0#2'@'#0#0#1 + +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#254#127#255#255#252'?'#255#255#248#31#255#255 + +#240#15#255#255#240#15#255#255#252'?'#255#255#252'?'#255#254#0#0#127#254#0#0 + +#127#254#0#0#127#254#0#0#127#255#252'?'#255#255#252'?'#255#255#240#15#255#255 + +#240#15#255#255#248#31#255#255#252'?'#255#255#254#127#255#255#255#255#255#255 + +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#255#255#255#255 +]); diff --git a/components/kcontrols/source/kgrids.pas b/components/kcontrols/source/kgrids.pas new file mode 100755 index 000000000..46cec9edb --- /dev/null +++ b/components/kcontrols/source/kgrids.pas @@ -0,0 +1,12827 @@ + { @abstract(This unit contains the TKGrid component and all supporting classes) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(15 Oct 2006) + @lastmod(07 Dec 2010) + + Copyright © 2006 Tomas Krysl (tk@@tkweb.eu)

+ + This unit provides an enhanced replacement for components contained + in Grids.pas. Major features: + + + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KGrids; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LMessages, LCLProc, LResources, +{$ELSE} + Windows, Messages, +{$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls, + KFunctions, KGraphics, KControls, Types +{$IFDEF TKGRID_USE_JCL} + , JclUnicode +{$ENDIF} + ; + +type + { Declares possible values for the Mask parameter in the @link(TKCustomGrid.GetAxisInfoHorz) + or @link(TKCustomGrid.GetAxisInfoVert) functions. } + TKGridAxisInfoMaskMembers = ( + { The FixedBoundary field in the @link(TKGridAxisInfo) structure will be evaluated. } + aiFixedParams, + { The GridExtent field in the @link(TKGridAxisInfo) structure will be evaluated. } + aiGridExtent, + { The GridBoundary and GridCells fields in the @link(TKGridAxisInfo) structure will be evaluated. } + aiGridBoundary, + { The FullVisBoundary and FullVisCells fields in the @link(TKGridAxisInfo) structure will be evaluated. } + aiFullVisBoundary + ); + + { Set type for @link(TKGridAxisInfoMaskMembers) enumeration. } + TKGridAxisInfoMask = set of TKGridAxisInfoMaskMembers; + + { Method type for the CellExtent field in the @link(TKGridAxisInfo) structure. } + TKGridGetExtentFunc = function(Index: Integer): Integer of object; + + { Method type for the CanResize field in the @link(TKGridAxisInfo) structure. } + TKGridCanResizeFunc = function(var Index, Pos: Integer): Boolean of object; + + { @abstract(Declares a structure returned by the @link(TKCustomGrid.GetAxisInfoHorz) + or @link(TKCustomGrid.GetAxisInfoVert) functions) + This structure contains information either about columns or rows, depending on what + function returned the structure. + } + TKGridAxisInfo = record + InfoMask: TKGridAxisInfoMask; + // col/row independent parameters + AlignLastCell: Boolean; + FixedSelectable: Boolean; + CanResize: TKGridCanResizeFunc; + CellExtent: TKGridGetExtentFunc; + EffectiveSpacing: TKGridGetExtentFunc; + FixedCellCount: Integer; + FirstGridCell: Integer; + FirstGridCellExtent: Integer; + ClientExtent: Integer; + MinCellExtent: TKGridGetExtentFunc; + MaxCellExtent: TKGridGetExtentFunc; + TotalCellCount: Integer; + ScrollOffset: Integer; + // calculated parameters + FixedBoundary: Integer; + GridBoundary: Integer; + GridCells: Integer; + FullVisBoundary: Integer; + FullVisCells: Integer; + GridExtent: Int64; + end; + + { @abstract(Declares a structure returned by the + @link(TKCustomGrid.GetAxisInfoBoth) function) + } + TKGridAxisInfoBoth = record + Horz, Vert: TKGridAxisInfo; + end; + + { Declares possible values for the Flags parameter in the + @link(TKCustomGrid.UpdateAxes) method. } + TKGridAxisUpdateFlag = ( + { Forces the @link(TKCustomGrid.OnColWidthsChanged) and/or + @link(TKCustomGrid.OnRowHeightsChanged) to be called even if no column width/ + row height has been modified by this call of UpdateAxes. } + afCallEvent, + { Ensures all columns/rows have at least the minimum width/height as specified + by @link(TKCustomGrid.MinColWidth)/@link(TKCustomGrid.MinRowHeight). } + afCheckMinExtent + ); + + { Set type for @link(TKGridAxisUpdateFlags) enumeration. } + TKGridAxisUpdateFlags = set of TKGridAxisUpdateFlag; + + { Declares possible values for the State parameter in the + @link(TKCustomGrid.SuggestDrag) or @link(TKCustomGrid.SuggestSizing) + functions. } + TKGridCaptureState = ( + { Suggestion is about to start - e.g. user clicked the movable column by mouse. } + csStart, + { Suggestion is about to temporarily hide - e.g. user drags a column by mouse + and the grid needs to be updated. } + csHide, + { Suggestion is about to show again - e.g. user drags a column by mouse + and the grid was updated. } + csShow, + { Suggestion is about to stop - e.g. user released the mouse button + and the dragged column need to be actually moved. } + csStop + ); + + { @abstract(Declares a structure that holds both column and row span of a cell) + } + TKGridCellSpan = record + ColSpan: Integer; + RowSpan: Integer; + end; + + { @abstract(Declares a structure that hold both column and row index of a cell) + } + TKGridCoord = record + Col: Integer; + Row: Integer; + end; + + { Declares possible indexes e.g. for the @link(TKGridColors.Color) property. } + TKGridColorIndex = Integer; + + { Declares possible values for the @link(TKGridColors.ColorScheme) property. } + TKGridColorScheme = ( + { GetColor returns normal color currently defined for each item. } + csNormal, + { GetColor returns gray for text. } + csGrayed, + { GetColor returns brighter version of normal color. } + csBright, + { GetColor returns grayscaled color versions. } + csGrayScale + ); + + { Method type for the Compare parameter e.g. in the + @link(TKCustomGrid.InternalQuickSortNR) method. } + TKGridCompareProc = function(ByIndex, Index1, Index2: Integer): Integer of object; + + { Declares possible values for the @link(TKCustomGrid.DisabledDrawStyle) property. } + TKGridDisabledDrawStyle = ( + { The lines will be painted with brighter colors when control is disabled. } + ddBright, + { The lines will be painted with gray text and white background when control is disabled. } + ddGrayed, + { The lines will be painted normally when control is disabled. } + ddNormal + ); + + { Declares possible values for the @link(TKCustomGrid.DragStyle) property. } + TKGridDragStyle = ( + { The moved column or row is displayed beneath mouse cursor in a layered window (Win2k+) + or white window (other OS) with fading opacity. } + dsLayeredConst, + { The moved column or row is displayed beneath mouse cursor in a layered window (Win2k+) + or white window (other OS) with constant opacity. } + dsLayeredFaded, + { The moved column or row is not displayed, behavior of original TCustomGrid + but line has red color. } + dsLine, + { The moved column or row is not displayed, behavior of original TCustomGrid. } + dsXORLine + ); + + { Declares possible values for the State parameter in the + @link(TKGridDrawCellEvent) event handler or @link(TKGridCell.DrawCell) method. } + TKGridDrawStateMembers = ( + { The cell has input focus and is currently edited. This is always 1 cell + that correspond to @link(TKCustomGrid.Col) and @link(TKCustomGrid.Row) + properties. Painting of the cell is automatically invoked to allow e.g. + background filling for inplace editors that don't fill the entire cell area. } + gdEdited, + { The cell is in the fixed region of the grid. } + gdFixed, + { The cell has input focus. This is always 1 cell that correspond to + @link(TKCustomGrid.Col) and @link(TKCustomGrid.Row) properties. } + gdFocused, + { Left mouse button is pressed. Cell repainting + is automatically invoked when mouse cursor is over the cell and the left + button is pressed. The cell is repainter if mouse button is released, either. } + gdMouseDown, + { Mouse cursor is over the cell in @link(goMouseOverCells) mode. Cell repainting + is automatically invoked when mouse cursor enters or leaves the cell. + Furthermore, if @link(TKCustomGrid.EditorMode) is True, the inplace editor will + be invalidated to allow proper editor underpainting, either. } + gdMouseOver, + { The cell is currently selected. This includes all cells that appear with + different default background color in either @link(goRangeSelect) or + @link(goRowSelect) mode. } + gdSelected, + { The cell belongs to the sorted column or row. } + gdSorted, + { Applies to the left most fixed column (if any). + The cell should paint visual shape like arrow to indicate that the + columns are sorted from lowest to highest value, like 'A' to 'Z'. } + gdColsSortedUp, + { Applies to the left most fixed column (if any). + The cell should paint visual shape like arrow to indicate that the + columns are sorted from highest to lowest value, like 'Z' to 'A'. } + gdColsSortedDown, + { Applies to the top most fixed row (if any). + The cell should paint visual shape like arrow to indicate that the + rows are sorted from lowest to highest value, like 'A' to 'Z'. } + gdRowsSortedUp, + { Applies to the top most fixed row (if any). + The cell should paint visual shape like arrow to indicate that the + rows are sorted from highest to lowest value, like 'Z' to 'A'. } + gdRowsSortedDown + ); + + { Set type for @link(TKGridDrawStateMembers) enumeration. } + TKGridDrawState = set of TKGridDrawStateMembers; + + { Declares possible values for the @link(TKCustomGrid.EditorTransparency) property. } + TKGridEditorTransparency = ( + { The grid decides which inplace editor should be treated as a transparent + control. This method works for all standard VCL controls. } + etDefault, + { Current inplace editor should be treated as opaque, i.e. not transparent. } + etNormal, + { Current inplace editor should be treated as transparent. } + etTransparent + ); + + { Method type for the Exchange parameter e.g. in the + @link(TKCustomGrid.InternalQuickSortNR) method. } + TKGridExchangeProc = procedure(Index1, Index2: Integer) of object; + + { Declares possible values for the InvisibleCells parameter in the + @link(TKCustomGrid.PointToCell) method. } + TKGridInvisibleCells = ( + { No invisible cells will be taken into account. Invisible cells are those + that are hidden (non-fixed) to the left or top. } + icNone, + { Invisible cells to the left will be taken into account at the expense of + the (possible) fixed cells. } + icFixedCols, + { Invisible cells to the top will be taken into account at the expense of + the (possible) fixed cells. } + icFixedRows, + { All invisible cells will be taken into account at the expense of + the (possible) fixed cells. } + icCells + ); + + { Declares a structure for hidden cell indicator glyphs. } + TKGridHCIBitmaps = record + HBegin, HCenter, HEnd, + VBegin, VCenter, VEnd: TKAlphaBitmap; + end; + + { Declares possible values for the @link(TKCustomGrid.Options) property. } + TKGridOption = ( + { Tries to put all columns to the visible area of the grid and omit free space + to the right of the last cell. No horizontal scrollbar appears. } + goAlignLastCol, + { Tries to put all rows to the visible area of the grid and omit free space + below the last cell. No vertical scrollbar appears. } + goAlignLastRow, + { The grid is locked into edit mode. The user does not need to use Enter or F2 + to turn on EditorMode everytime he moves to another cell. The behavior is + slightly different as in TCustomGrid. } + goAlwaysShowEditor, + { Enables the WM_ERASEBKGND message to be handled if True. This can be used + to avoid grid flickering for the case the grid is placed into a container + that requires repainting itself and all of its children after resizing. + This behavior is typical for nested TPanels. If you don't use these you + can set this option True to erase the background. The grid does not need + the background to be erased as it fills the entire client area through + WM_PAINT. But some users might need to erase the background due to the + strange behavior when activating an application by clicking the main form's + title bar. } + goEraseBackground, + { No painting is allowed beyond the cell outline. } + goClippedCells, + { Scrollable columns can be moved using the mouse. } + goColMoving, + { Scrollable columns can be individually resized. } + goColSizing, + { Scrollable columns can be sorted by mouse click at the first fixed row. The + sorted column is visually indicated by arrow at the first fixed row. } + goColSorting, + { Instructs the cell painter to draw each cell with double buffering to + avoid cell flickering. } + goDoubleBufferedCells, + { Selected cells are drawn with with a focus rectangle if the grid (not the + inplace editor) has the input focus. The behavior is slightly different + as in TCustomGrid. } + goDrawFocusSelected, + { Users can edit the contents of cells. No another limitation applicable. } + goEditing, + { If included, Enter does not turn on EditorMode, but causes another cell to + be focused. What cell it is depends on @link(TKCustomGrid.MoveDirection). } + goEnterMoves, + { Horizontal lines are drawn to separate the fixed (nonscrolling) rows + in the grid. } + goFixedHorzLine, + { Vertical lines are drawn to separate the fixed (nonscrolling) columns + in the grid. If @link(TKCustomGrid.ThemedCells) is True, these are not + drawn for fixed rows by default, as these are meant as a grid header. } + goFixedVertLine, + { Draws cells in the first fixed row in standard Win-API header style. } + goHeader, + { Terminates the first fixed row drawn in standard Win-API header style + by drawing a standard Win-API header terminator in an area not occupied by cells. } + goHeaderAlignment, + { Horizontal lines are drawn to separate the scrollable rows in the grid. } + goHorzLine, + { Hidden columns or rows are indicated in fixed cell area. } + goIndicateHiddenCells, + { Selection is indicated in the fixed cells by a specific color. } + goIndicateSelection, + { Columns or rows can be hidden with the mouse while being resized. Set to + False to enforce KGrid 1.2 behavior. } + goMouseCanHideCells, + { If included, then if the mouse enters or leaves a cell, these cells + will be invalidated and the cell under the mouse pointer gets a + @link(gdMouseOver) state. } + goMouseOverCells, + { If included, no text will be selected in the inplace editor upon its creation. + This applies only to inplace editors having a selectable text, of course. + The default behavior works only for editors responding to EM_SETSEL message. + For another editors, the behavior can be maintained by the + @link(TKCustomGrid.OnEditorSelect) event handler. } + goNoSelEditText, + { Users can select ranges of cells at one time. No another limitation applicable. } + goRangeSelect, + { Scrollable rows can be moved using the mouse. } + goRowMoving, + { Entire rows are selected rather than individual cells. No another limitation applicable. } + goRowSelect, + { Scrollable rows can be individually resized. Caution: Some inplace editors + cannot be resized in height - for example TComboBox. } + goRowSizing, + { Scrollable rows can be sorted by mouse click at the first fixed column. The + sorted row is visually indicated by arrow at the first fixed column. } + goRowSorting, + { Users can navigate through the cells in the grid using Tab and Shift+Tab. } + goTabs, + { Enables OS themes for both non-client and cells. } + goThemes, + { Enables OS themes for cells. } + goThemedCells, + { Vertical lines are drawn to separate the scrollable columns in the grid. } + goVertLine, + { If included, the grid becomes virtual grid. In this mode, data for the cells + must be supplied externally. No cell class instances are allocated. + @link(TKCustomGrid.Cell) property cannot be set and returns always nil. + @link(TKCustomGrid.Cells) property cannot be set and returns always empty string. + @link(TKCustomGrid.FCells) field is always nil - no grid structure is allocated. + Column and Row structures (@link(TKCustomGrid.FCols) and + @link(TKCustomGrid.FRows)) remain always allocated. } + goVirtualGrid + ); + + { Set type for @link(TKGridOption) enumeration. } + TKGridOptions = set of TKGridOption; + + { Declares possible values for the @link(TKCustomGrid.OptionsEx) property. } + TKGridOptionEx = ( + { When Inplace editor has horizontal constraint it will be horizontally centered. } + gxEditorHCenter, + { When Inplace editor has vertical constraint it will be vertically centered. } + gxEditorVCenter, + { Pressing Enter at the last cell appends a row. } + gxEnterAppendsRow, + { Pressing Enter wraps selection to next column/row. } + gxEnterWraps, + { Clicking fixed cells together with Shift key selects/unselects respective columns/rows. } + gxFixedCellClickSelect, + { All fixed cells will be painted with header theme (looks bad e.g. with classic WinXP). } + gxFixedThemedCells, + { Pressing TAB at the last cell appends a row. } + gxTabAppendsRow, + { Pressing TAB wraps selection to next column/row. } + gxTabWraps, + // aki: + { Allow edit fixed rows} + gxEditFixedRows, + { Allow edit fixed cols} + gxEditFixedCols + ); + + { Set type for @link(TKGridOptionEx) enumeration. } + TKGridOptionsEx = set of TKGridOptionEx; + + { Declares possible values for the Priority parameter in the @link(TKCustomGrid.MeasureCell) method. } + TKGridMeasureCellPriority = ( + { Row height stays, column width is adjusted. } + mpColWidth, + { Column width stays, row height is adjusted. } + mpRowHeight, + { Default cell extent adjustment. } + mpCellExtent + ); + + { Declares possible values for the Command parameter in the @link(TKCustomGrid.InternalMove) method. } + TKGridMoveCommand = ( + { No command. } + mcNone, + { Move to last row. } + mcBottom, + { Move to next row. } + mcDown, + { Move to last column. } + mcEnd, + { Move to first column. } + mcHome, + { Move to previous column. } + mcLeft, + { Move to bottom row on current page. } + mcMoveDown, + { Move to top row on current page. } + mcMoveUp, + { Move to next vertical page. } + mcPageDown, + { Move to next horizontal page. } + mcPageLeft, + { Move to previous horizontal page. } + mcPageRight, + { Move to previous vertical page. } + mcPageUp, + { Move to next column. } + mcRight, + { Move to first row. } + mcTop, + { Move to previous row. } + mcUp + ); + + { Declares possible values for the @link(TKCustomGrid.MoveDirection) property. } + TKGridMoveDirection = ( + { By pressing Enter, the cell below the currently focused cell will be focused. } + mdDown, + { By pressing Enter, the cell to the left of the currently focused cell will be focused. } + mdLeft, + { By pressing Enter, the cell to the right of the currently focused cell will be focused. } + mdRight, + { By pressing Enter, the cell above the currently focused cell will be focused. } + mdUp + ); + + { Declares possible values for the @link(TKCustomGrid.RangeSelectStyle) property. } + TKGridRangeSelectStyle = ( + { The focused cell is not the base cell and expands the selection. } + rsDefault, + { The focused cell is the base cell and does not expand the selection. } + rsMS_Excel + ); + + { @abstract(Declares the type e.g. for the @link(TKCustomGrid.Selection) property) + Declares the type for grid rectangle. A grid rectangle is a structure of + two independent grid points. + } + TKGridRect = record + case Integer of + 0: (Col1, Row1, Col2, Row2: Integer); + 1: (Cell1, Cell2: TKGridCoord); + end; + + { Declares possible values for the @link(TKCustomGrid.ScrollModeHorz) and @link(TKCustomGrid.ScrollModeVert) properties. } + TKGridScrollMode = ( + { The trackbar scrolls per pixel. } + smSmooth, + { The trackbar scrolls per cell. } + smCell + ); + + { Declares possible values for the Stage parameter in the @link(TKGridSelectionExpandEvent) + event handler or @link(TKCustomGrid.SelectionMove) method. } + TKGridSelectionStage = ( + { The selection moves entirely - the selection base cell changes. } + ssInit, + { The selection expands - the selection base cell remains unchanged. } + ssExpand + ); + + { Declares possible values for the Flags parameter in the + @link(TKCustomGrid.SelectionMove) method. } + TKGridSelectionFlag = ( + { Do not call the @link(TKCustomGrid.SelectCell) method. } + sfDontCallSelectCell, + { Force invalidation of the old and new selection. } + sfMustUpdate, + { Force calling of the @link(TKCustomGrid.ClampInView) method. } + sfClampInView, + { Do not set @link(TKCustomGrid.FMemCol) and @link(TKCustomGrid.FMemRow) fields. } + sfNoMemPos + ); + + { Set type for @link(TKGridSelectionFlag) enumeration. } + TKGridSelectionFlags = set of TKGridSelectionFlag; + + { Declares possible values for the Change parameter in the + @link(TKGridSizeChangedEvent) event handler. } + TKGridSizeChange = ( + { Columns have been deleted. } + scColDeleted, + { Columns have been inserted. } + scColInserted, + { Rows have been deleted. } + scRowDeleted, + { Rows have been inserted. } + scRowInserted + ); + + { Declares possible values for the @link(TKCustomGrid.SizingStyle) property. } + TKGridSizingStyle = ( + { Column widths or row heights update after the mouse button is released. + Old TCustomGrid behavior but line has red color. } + ssLine, + { Column widths or row heights update immediately. } + ssUpdate, + { Column widths or row heights update after the mouse button is released. + Old TCustomGrid behavior. } + ssXORLine + ); + + { Declares possible values for the @link(TKGridAxisItem.SortMode) property. } + TKGridSortMode = ( + { Corresponding column or row is not sorted. } + smNone, + { Corresponding column or row is sorted from lowest to highest value. } + smDown, + { Corresponding column or row is sorted from highest to lowest value. } + smUp + ); + + { Declares possible values for the @link(TKCustomGrid.SortStyle) property. } + TKGridSortStyle = ( + { First click sorts from lowest to highest value, second click sorts from highest to lowest value. } + ssDownUp, + { First click sorts from lowest to highest value, second click sorts from highest to lowest value, third click turns sorting off. } + ssDownUpNone, + { First click sorts from highest to lowest value, second click sorts from lowest to highest value, third click turns sorting off. } + ssUpDownNone + ); + + { Declares possible values for the @link(TKCustomGrid.FGridState) field. } + TKGridState = ( + { The mouse button has been pressed on a fixed cell that triggers + mouse click event. } + gsClickWaiting, + { The mouse button has been pressed on a fixed cell that triggers + column dragging. } + gsColMoveWaiting, + { The user is dragging a column to a new position. } + gsColMoving, + { The user is changing the width of a column. } + gsColSizing, + { The mouse button has been pressed on a fixed cell that triggers + column sorting. } + gsColSortWaiting, + { The grid layout is not changing. } + gsNormal, + { The mouse button has been pressed on a fixed cell that triggers + row dragging. } + gsRowMoveWaiting, + { The user is dragging a row to a new position. } + gsRowMoving, + { The user is changing the height of a row. } + gsRowSizing, + { The mouse button has been pressed on a fixed cell that triggers + row sorting. } + gsRowSortWaiting, + { The user is selecting a cell or row. } + gsSelecting + ); + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnBeginColDrag) event) + } + TKGridBeginDragEvent = procedure(Sender: TObject; var Origin: Integer; + const MousePt: TPoint; var CanBeginDrag: Boolean) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnBeginColSizing) event) + } + TKGridBeginSizingEvent = procedure(Sender: TObject; var Index, Pos: Integer; + var CanBeginSizing: Boolean) of object; + + { @abstract(Declares event handler for any cell notification events) + } + TKGridCellEvent = procedure(Sender: TObject; ACol, ARow: Integer) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnMouseCellHint) event) + } + TKGridCellHintEvent = procedure(Sender: TObject; ACol, ARow: Integer; AShow: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnCellSpan) event) + } + TKGridCellSpanEvent = procedure(Sender: TObject; ACol, ARow: Integer; var Span: TKGridCellSpan) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnCheckColDrag) event) + } + TKGridCheckDragEvent = procedure(Sender: TObject; Origin: Integer; + var Destination: Integer; const MousePt: TPoint; var CanDrop: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnCompareCells)) + + } + TKGridCompareCellsEvent = function(Sender: TObject; Col1, Row1, Col2, Row2: Integer): + Integer of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnCustomSortCols) or + @link(TKCustomGrid.OnCustomSortRows) events) + } + TKGridCustomSortEvent = procedure(Sender: TObject; ByIndex: Integer; + SortMode: TKGridSortMode; var Sorted: Boolean) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnDrawCell) event) + } + TKGridDrawCellEvent = procedure(Sender: TObject; ACol, ARow: Integer; + R: TRect; State: TKGridDrawState) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorCreate) event) + } + TKGridEditorCreateEvent = procedure(Sender: TObject; ACol, ARow: Integer; + var AEditor: TWinControl) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorDataFromGrid) + or @link(TKCustomGrid.OnEditorDataToGrid) events) + } + TKGridEditorDataEvent = procedure(Sender: TObject; AEditor: TWinControl; + ACol, ARow: Integer; var AssignText: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorDestroy) event) + } + TKGridEditorDestroyEvent = procedure(Sender: TObject; var AEditor: TWinControl; + ACol, ARow: Integer) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorKeyPreview) event) + } + TKGridEditorKeyPreviewEvent = procedure(Sender: TObject; AEditor: TWinControl; + ACol, ARow: Integer; var Key: Word; Shift: TShiftState; var IsGridKey: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorResize) event) + } + TKGridEditorResizeEvent = procedure(Sender: TObject; AEditor: TWinControl; + ACol, ARow: Integer; var ARect: TRect) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnEditorSelect) event) + } + TKGridEditorSelectEvent = procedure(Sender: TObject; AEditor: TWinControl; + ACol, ARow: Integer; SelectAll, CaretToLeft, SelectedByMouse: Boolean) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnEndColDrag) event) + } + TKGridEndDragEvent = procedure(Sender: TObject; Origin: Integer; + Destination: Integer; const MousePt: TPoint; var CanEndDrag: Boolean) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnEndColSizing) event) + } + TKGridEndSizingEvent = procedure(Sender: TObject; Index, Pos: Integer; + var CanEndSizing: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnExchangeCols) or + @link(TKCustomGrid.OnExchangeRows) event) + } + TKGridExchangeEvent = procedure(Sender: TObject; + Index1, Index2: Integer) of object; + + { @abstract(Declares event handler for any cell extent notification events) + } + TKGridExtentEvent = procedure(Sender: TObject; AIndex: Integer) of object; + + { @abstract(Declares event handler e.g. for the @link(TKCustomGrid.OnMeasureCell) event) + } + TKGridMeasureCellEvent = procedure(Sender: TObject; ACol, ARow: Integer; + R: TRect; State: TKGridDrawState; Priority: TKGridMeasureCellPriority; + var Extent: TPoint) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnColumnMoved) or + @link(TKCustomGrid.OnRowMoved) events) + } + TKGridMovedEvent = procedure(Sender: TObject; FromIndex, ToIndex: Integer) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnSizeChanged) event) + } + TKGridSizeChangedEvent = procedure(Sender: TObject; + Change: TKGridSizeChange; At, Count: Integer) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnSelectCell) event) + } + TKGridSelectCellEvent = procedure(Sender: TObject; ACol, ARow: Integer; + var CanSelect: Boolean) of object; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnSelectCell) event) + } + TKGridSelectionExpandEvent = procedure(Sender: TObject; ACol, ARow: Integer; + var CanExpand: Boolean) of object; + +const + { Constant for invalid column or row indexes. Currently, it is used internally. + Functions @link(TKCustomGrid.InitialCol) and @link(TKCustomGrid.InitialRow) + return this value in case of invalid parameters. } + cInvalidIndex = -1; + + { This constant can be passed into the FirstCol or FirstRow parameter of the + @link(TKCustomGrid.UpdateAxes) method. } + cAll = -1; + + { Default value for the @link(TKCustomGrid.ColCount) property. } + cColCountDef = 5; + + { Default value for the @link(TKCustomGrid.DefaultColWidth) property. } + cDefaultColWidthDef = 64; + + { Default value for the @link(TKCustomGrid.DefaultRowHeight) property. } + cDefaultRowHeightDef = 21; + + { Default value for the @link(TKCustomGrid.DisabledDrawStyle) property. } + cDisabledDrawStyleDef = ddBright; + + { Default value for the @link(TKCustomGrid.DragStyle) property. } + cDragStyleDef = dsLayeredFaded; + + { Default value for the @link(TKCustomGrid.EditorTransparency) property. } + cEditorTransparencyDef = etDefault; + + { Default value for the @link(TKCustomGrid.FixedCols) property. } + cFixedColsDef = 1; + + { Default value for the @link(TKCustomGrid.FixedRows) property. } + cFixedRowsDef = 1; + + { Default value for the @link(TKCustomGrid.GridLineWidth) property. } + cGridLineWidthDef = 1; + + { Minimum value for the @link(TKCustomGrid.MinColWidth) property. } + cMinColWidthMin = 5; + { Default value for the @link(TKCustomGrid.MinColWidth) property. } + cMinColWidthDef = 10; + + { Minimum value for the @link(TKCustomGrid.MinRowHeight) property. } + cMinRowHeightMin = 5; + { Default value for the @link(TKCustomGrid.MinRowHeight) property. } + cMinRowHeightDef = 10; + + { Minimum value for the @link(TKCustomGrid.MouseCellHintTime) property. } + cMouseCellHintTimeMin = 100; + { Maximum value for the @link(TKCustomGrid.MouseCellHintTime) property. } + cMouseCellHintTimeMax = 10000; + { Default value for the @link(TKCustomGrid.MouseCellHintTime) property. } + cMouseCellHintTimeDef = 800; + + { Default value for the @link(TKCustomGrid.MoveDirection) property. } + cMoveDirectionDef = mdRight; + + { Default value for the @link(TKCustomGrid.Options) property. } + cOptionsDef = [goAlwaysShowEditor, goDrawFocusSelected, + goEnterMoves, goFixedVertLine, goFixedHorzLine, goIndicateHiddenCells, + goHeader, goHeaderAlignment, goHorzLine, goMouseCanHideCells, + goMouseOverCells, goRangeSelect, goThemes, goThemedCells, goVertLine]; + + { Default value for the @link(TKCustomGrid.OptionsEx) property. } + cOptionsExDef = [gxEnterWraps, gxTABWraps]; + + { Default value for the @link(TKCustomGrid.RangeSelectStyle) property. } + cRangeSelectStyleDef = rsDefault; + + { Default value for the @link(TKCustomGrid.RowCount) property. } + cRowCountDef = 5; + + { Default value for the @link(TKCustomGrid.ScrollBars) property. } + cScrollBarsDef = ssBoth; + + { Minimum value for the @link(TKCustomGrid.ScrollSpeed) property. } + cScrollSpeedMin = 50; + { Maximum value for the @link(TKCustomGrid.ScrollSpeed) property. } + cScrollSpeedMax = 1000; + { Default value for the @link(TKCustomGrid.ScrollSpeed) property. } + cScrollSpeedDef = 100; + + { Default value for the @link(TKCustomGrid.ScrollModeHorz) and @link(TKCustomGrid.ScrollModeVert) properties. } + cScrollModeDef = smSmooth; + + { Default value for the @link(TKCustomGrid.SizingStyle) property. } + cSizingStyleDef = ssUpdate; + + { Default value for the @link(TKCustomGrid.SortStyle) property. } + cSortStyleDef = ssDownUp; + + { Default value for the @link(TKGridColors.CellBkGnd) color property. } + cCellBkGndDef = clWindow; + { Default value for the @link(TKGridColors.CellLines) color property. } + cCellLinesDef = clBtnFace; + { Default value for the @link(TKGridColors.CellText) color property. } + cCellTextDef = clWindowText; + { Default value for the @link(TKGridColors.DragSuggestionBkGnd) color property. } + cDragSuggestionBkGndDef = clLime; + { Default value for the @link(TKGridColors.DragSuggestionLine) color property. } + cDragSuggestionLineDef = clBlack; + { Default value for the @link(TKGridColors.FixedCellBkGnd) color property. } + cFixedCellBkGndDef = clBtnFace; + { Default value for the @link(TKGridColors.FixedCellIndication) color property. } + cFixedCellIndicationDef = clCream; + { Default value for the @link(TKGridColors.FixedCellLines) color property. } + cFixedCellLinesDef = clWindowText; + { Default value for the @link(TKGridColors.FixedCellText) color property. } + cFixedCellTextDef = clBtnText; + { Default value for the @link(TKGridColors.FixedThemedCellLines) color property. } + cFixedThemedCellLinesDef = {$IFDEF USE_WINAPI}clBtnShadow{$ELSE}clWindowText{$ENDIF}; + { Default value for the @link(TKGridColors.FixedThemedCellHighlight) color property. } + cFixedThemedCellHighlightDef = clBtnHighlight; + { Default value for the @link(TKGridColors.FixedThemedCellShadow) color property. } + cFixedThemedCellShadowDef = clBtnFace; + { Default value for the @link(TKGridColors.FocusedCellBkGnd) color property. } + cFocusedCellBkGndDef = clHighlight; + { Default value for the @link(TKGridColors.FocusedCellText) color property. } + cFocusedCellTextDef = clHighlightText; + { Default value for the @link(TKGridColors.FocusedRangeBkgnd) color property. } + cFocusedRangeBkGndDef = clHighlight; // to be brigtened + { Default value for the @link(TKGridColors.FocusedRangeText) color property. } + cFocusedRangeTextDef = clHighlightText; + { Default value for the @link(TKGridColors.SelectedCellBkGnd) color property. } + cSelectedCellBkGndDef = clBtnFace; + { Default value for the @link(TKGridColors.SelectedCellText) color property. } + cSelectedCellTextDef = clBtnText; + { Default value for the @link(TKGridColors.SelectedRangeBkGnd) color property. } + cSelectedRangeBkGndDef = clBtnFace; // to be brigtened + { Default value for the @link(TKGridColors.SelectedRangeText) color property. } + cSelectedRangeTextDef = clBtnText; + // aki: + { Default value for then @link(TKGridColors.SelectedFixedCell) color property. } + cSelectedFixedCellBkGndDef = clCream; + { Index for the @link(TKGridColors.CellBkGnd) property. } + ciCellBkGnd = TKGridColorIndex(0); + { Index for the @link(TKGridColors.CellLines) property. } + ciCellLines = TKGridColorIndex(1); + { Index for the @link(TKGridColors.CellText) property. } + ciCellText = TKGridColorIndex(2); + { Index for the @link(TKGridColors.DragSuggestionBkGnd) property. } + ciDragSuggestionBkGnd = TKGridColorIndex(3); + { Index for the @link(TKGridColors.DragSuggestionLine) property. } + ciDragSuggestionLine = TKGridColorIndex(4); + { Index for the @link(TKGridColors.FixedCellBkGnd) property. } + ciFixedCellBkGnd = TKGridColorIndex(5); + { Index for the @link(TKGridColors.FixedCellIndication) property. } + ciFixedCellIndication = TKGridColorIndex(6); + { Index for the @link(TKGridColors.FixedCellLines) property. } + ciFixedCellLines = TKGridColorIndex(7); + { Index for the @link(TKGridColors.FixedCellText) property. } + ciFixedCellText = TKGridColorIndex(8); + { Index for the @link(TKGridColors.FixedThemedCellLines) property. } + ciFixedThemedCellLines = TKGridColorIndex(9); + { Index for the @link(TKGridColors.FixedThemedCellHighlight) property. } + ciFixedThemedCellHighlight = TKGridColorIndex(10); + { Index for the @link(TKGridColors.FixedThemedCellShadow) property. } + ciFixedThemedCellShadow = TKGridColorIndex(11); + { Index for the @link(TKGridColors.FocusedCellBkGnd) property. } + ciFocusedCellBkGnd = TKGridColorIndex(12); + { Index for the @link(TKGridColors.FocusedCellText) property. } + ciFocusedCellText = TKGridColorIndex(13); + { Index for the @link(TKGridColors.FocusedRangeBkGnd) property. } + ciFocusedRangeBkGnd = TKGridColorIndex(14); + { Index for the @link(TKGridColors.FocusedRangeText) property. } + ciFocusedRangeText = TKGridColorIndex(15); + { Index for the @link(TKGridColors.SelectedCellBkGnd) property. } + ciSelectedCellBkGnd = TKGridColorIndex(16); + { Index for the @link(TKGridColors.SelectedCellText) property. } + ciSelectedCellText = TKGridColorIndex(17); + { Index for the @link(TKGridColors.SelectedRangeBkGnd) property. } + ciSelectedRangeBkGnd = TKGridColorIndex(18); + { Index for the @link(TKGridColors.SelectedRangeText) property. } + ciSelectedRangeText = TKGridColorIndex(19); + // aki: + { Index for the @link(TKGridColors.SelectedFixedCell) property. } + ciSelectedFixedCellBkGnd = TKGridColorIndex(20); + // aki: + { Maximum color array index } + ciGridColorsMax = ciSelectedFixedCellBkGnd; + + { This internal flag is set if caret should be moved to the left side of the inplace editor. } + cGF_CaretToLeft = $00000001; + { This internal flag is set if the Set.. methods in @link(TKGridAxisItem) and + @link(TKGridCell) and their descendants must not call any grid methods that + could cause infinite recursion. } + cGF_GridUpdates = $00000002; + { This internal flag is set to allow column or row sizing at design time. } + cGF_DesignHitTest = $00000004; + { This internal flag is set to prevent recursive calls while inplace editor is being updated. } + cGF_EditorUpdating = $00000008; + { This internal flag is set to remember inplace editor state if the grid + has no input focus. } + cGF_EditorModeActive = $00000010; + { This internal flag is set if a cell is selected by mouse click. } + cGF_SelectedByMouse = $00000020; + { This internal flag is set if a cell is 'through-clicked'. } + cGF_ThroughClick = $00000040; + { This internal flag is set if a selectable grid area contains at least 1 merged cell. } + cGF_SelCellsMerged = $00000080; + { This internal flag is set if enter key has been pressed and handled by the grid. } + cGF_EnterPressed = $00000100; + +type + TKCustomGrid = class; + TKGridCell = class; + + { @abstract(Declares event handler for the @link(TKCustomGrid.OnCompareCellInstances)) + + } + TKGridCompareCellInstancesEvent = function(Sender: TObject; Cell1, Cell2: TKGridCell): + Integer of object; + + { @abstract(Base class to store column or row properties) + This is the base class for storing column or row properties. + It implements properties and methods that are common for columns and rows. } + TKGridAxisItem = class(TObject) + private + FCanResize: Boolean; + FExtent: Integer; + FGrid: TKCustomGrid; + FInitialPos: Integer; + FMaxExtent: Integer; + FMinExtent: Integer; + FSortArrowIndex: Integer; + FSortMode: TKGridSortMode; + FTag: TObject; + procedure SetMaxExtent(AValue: Integer); + procedure SetMinExtent(AValue: Integer); + protected + FBackExtent: Integer; + { Cell class aware version of @link(TKCustomGrid.OnBeginColDrag) or @link(TKCustomGrid.OnBeginRowDrag) + events. See the @link(TKGridBeginDragEvent) type for parameter interpretation. } + procedure BeginDrag(var Origin: Integer; const MousePt: TPoint; + var CanBeginDrag: Boolean); virtual; + { Cell class aware version of @link(TKCustomGrid.OnCheckColDrag) or @link(TKCustomGrid.OnCheckRowDrag) + events. See the @link(TKGridCheckDragEvent) type for parameter interpretation. } + procedure CheckDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint; var CanDrop: Boolean); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEndColDrag) or @link(TKCustomGrid.OnEndRowDrag) + events. See the @link(TKGridEndDragEvent) type for parameter interpretation. } + procedure EndDrag(Origin, Destination: Integer; const MousePt: TPoint; + var CanEndDrag: Boolean); virtual; + { Read method for the @link(TKGridAxisItem.Objects) property. Without implementation. } + function GetObjects(Index: Integer): TObject; virtual; abstract; + { Read method for the @link(TKGridAxisItem.Strings) property. Without implementation. } + function GetStrings(Index: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; virtual; abstract; + { Read method for the @link(TKGridAxisItem.Visible) property. Without implementation. } + function GetVisible: Boolean; virtual; + { Write method for the @link(TKGridAxisItem.Extent) property. Without implementation. } + procedure SetExtent(const Value: Integer); virtual; abstract; + { Write method for the @link(TKGridAxisItem.Objects) property. Without implementation. } + procedure SetObjects(Index: Integer; const Value: TObject); virtual; abstract; + { Write method for the @link(TKGridAxisItem.SortArrowIndex) property. Without implementation. } + procedure SetSortArrowIndex(Value: Integer); virtual; abstract; + { Write method for the @link(TKGridAxisItem.SortMode) property. Without implementation. } + procedure SetSortMode(const Value: TKGridSortMode); virtual; abstract; + { Write method for the @link(TKGridAxisItem.Strings) property. Without implementation. } + procedure SetStrings(Index: Integer; const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); virtual; abstract; + { Write method for the @link(TKGridAxisItem.Visible) property. Without implementation. } + procedure SetVisible(Value: Boolean); virtual; abstract; + public + { Creates the instance. Do not create custom instances. All necessary + TKGridAxisItem instances are created automatically by TKCustomGrid. } + constructor Create(AGrid: TKCustomGrid); virtual; + { Copies shareable properties of another TKGridAxisItem instances into this + TKGridAxisItem instance. } + procedure Assign(Source: TKGridAxisItem); overload; virtual; + { Makes it possible to assign a list of strings contained in TStrings + to the grid. This method is provided to retain compatibility with + TStringGrid. It behaves exactly the same way as the corresponding method + in TStringGrid. Without implementation. } + procedure Assign(Source: TStrings); overload; virtual; abstract; +{$IFDEF TKGRID_USE_JCL} + { Makes it possible to assign a list of strings contained in TWideStrings + to the grid. Without implementation. } + procedure Assign(Source: TWideStrings); overload; virtual; abstract; +{$ENDIF} + { Abstract prototype. Sets text of all cells corresponding to this column or row to empty string. } + procedure Clear; virtual; abstract; + { Returns True if shareable properties of this TKGridAxisItem instance have + the same value as those in Item. } + function {$ifdef COMPILER12_UP}EqualProperties{$ELSE}Equals{$ENDIF}(Item: TKGridAxisItem): Boolean; virtual; + { Shareable property. Determines if this column or row can be resized. + This property virtually covers the @link(TKCustomGrid.OnBeginColSizing) or + @link(TKCustomGrid.OnBeginRowSizing) events. } + property CanResize: Boolean read FCanResize write FCanResize; + { Shareable property. Determines the column width or row height. + Do not write this property unless you write a TKCustomGrid descendant. } + property Extent: Integer read FExtent write SetExtent; + { Pointer to the grid. You will probably need it when implementing application + specific behavior. } + property Grid: TKCustomgrid read FGrid; + { Non-shareable property. Determines the initial column or row position + just after it was inserted into the grid. Do not write this property + unless you write a TKCustomGrid descendant. } + property InitialPos: Integer read FInitialPos write FInitialPos; + { Specifies the maximum extent of this column or row. Set zero to disable check. + Does not work (cannot work) in goAlignLast... mode. } + property MaxExtent: Integer read FMaxExtent write SetMaxExtent; + { Specifies the minimum extent of this column or row. Set zero to disable check. + This setting overrides the @link(TKCustomGrid.MinColWidth) or + @link(TKCustomGrid.MinRowHeight) setting. } + property MinExtent: Integer read FMinExtent write SetMinExtent; + { Provides access to the object cell instances corresponding to the column or + row referred by this TKGridAxisItem instance. Provided to retain compatibility + with TStringGrid. } + property Objects[Index: Integer]: TObject read GetObjects write SetObjects; + { Specifies the index of the fixed column or row where the sorting can be + initiated/changed by mouse click and where the sorting arrow will be displayed. + This applies only for multiline column or row headers, i.e. if there are + two or more fixed columns or rows defined. } + property SortArrowIndex: Integer read FSortArrowIndex write SetSortArrowIndex; + { Makes it possible to sort column or row referred by this TKGridAxisItem + instance. } + property SortMode: TKGridSortMode read FSortMode write SetSortMode; + { Provides access to the obj cell instances corresponding to the column or + row referred by this TKGridAxisItem instance. } + property Strings[Index: Integer]: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read GetStrings write SetStrings; default; + { Shareable property. Determines if the column or row is visible. } + property Visible: Boolean read GetVisible write SetVisible; + { Provides access to custom object for Row } + property Tag: TObject read FTag write FTag; + end; + + { @abstract(Metaclass for @link(TKGridAxisItem)) This type is used internally. } + TKGridAxisItemClass = class of TKGridAxisItem; + + { @abstract(Dynamic array type to store @link(TKGridAxisItem) instances) + There are always two arrays of this type in TKCustomGrid. First of them + stores column properties - @link(TKCustomGrid.FCols) - and the second stores + row properties - @link(TKCustomGrid.FRows). } + TKGridAxisItems = array of TKGridAxisItem; + + { @abstract(Class to store column properties) + This class implements properties and methods specific to columns. } + TKGridCol = class(TKGridAxisItem) + private + FCellHint: Boolean; + FTabStop: Boolean; + function FindCol(out Index: Integer): Boolean; + protected + { Read method for the @link(TKGridAxisItem.Objects) property. Implementation for columns. } + function GetObjects(Index: Integer): TObject; override; + { Read method for the @link(TKGridAxisItem.Strings) property. Implementation for columns. } + function GetStrings(Index: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; override; + { Write method for the @link(TKGridAxisItem.Extent) property. Implementation for columns. } + procedure SetExtent(const Value: Integer); override; + { Write method for the @link(TKGridAxisItem.Objects) property. Implementation for columns. } + procedure SetObjects(Index: Integer; const Value: TObject); override; + { Write method for the @link(TKGridAxisItem.SortArrowIndex) property. Implementation for columns. } + procedure SetSortArrowIndex(Value: Integer); override; + { Write method for the @link(TKGridAxisItem.SortMode) property. Implementation for columns. } + procedure SetSortMode(const Value: TKGridSortMode); override; + { Write method for the @link(TKGridAxisItem.Strings) property. Implementation for columns. } + procedure SetStrings(Index: Integer; const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); override; + { Write method for the @link(TKGridAxisItem.Visible) property. Implementation for columns. } + procedure SetVisible(Value: Boolean); override; + public + { Creates the instance. Do not create custom instances. All necessary + TKGridCol instances are created automatically by TKCustomGrid. } + constructor Create(AGrid: TKCustomGrid); override; + { Copies the properties of another TKGridAxisItem instances into this + TKGridCol instance. } + procedure Assign(Source: TKGridAxisItem); override; + { Makes it possible to assign a list of strings contained in TStrings + to the grid. It behaves exactly the same way as the corresponding method + in TStringGrid. Implementation for columns, i.e. the strings contained + in Source are copied to the text cells corresponding to the column + referred by this TKGridCol instance. } + procedure Assign(Source: TStrings); override; +{$IFDEF TKGRID_USE_JCL} + { Makes it possible to assign a list of strings contained in TWideStrings + to the grid. Implementation for columns, i.e. the strings contained + in Source are copied to the text cells corresponding to the column + referred by this TKGridCol instance. } + procedure Assign(Source: TWideStrings); override; +{$ENDIF} + { Sets text of all cells corresponding to this column to empty string. } + procedure Clear; override; + { Returns True if shareable properties of this TKGridAxisItem instance have + the same value as those in Item. } + function {$ifdef COMPILER12_UP}EqualProperties{$ELSE}Equals{$ENDIF}(Item: TKGridAxisItem): Boolean; override; + { Shareable property. Determines if cell hint is enabled for this column. } + property CellHint: Boolean read FCellHint write FCellHint; + { Shareable property. Determines if pressing the TAB or Shift+TAB key can + move the input focus at a cell that belongs to this column. This property + has effect only if goTabs is present under @link(TKCustomGrid.Options). } + property TabStop: Boolean read FTabStop write FTabStop; + end; + + { @abstract(Metaclass for @link(TKGridCol)) This type is used in + @link(TKCustomGrid.ColClass) property. } + TKGridColClass = class of TKGridCol; + + { @abstract(Class to store row properties) + This class implements properties and methods specific to rows. } + TKGridRow = class(TKGridAxisItem) + private + function FindRow(out Index: Integer): Boolean; + protected + { Read method for the @link(TKGridAxisItem.Objects) property. Implementation for rows. } + function GetObjects(Index: Integer): TObject; override; + { Read method for the @link(TKGridAxisItem.Strings) property. Implementation for rows. } + function GetStrings(Index: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; override; + { Write method for the @link(TKGridAxisItem.Extent) property. Implementation for rows. } + procedure SetExtent(const Value: Integer); override; + { Write method for the @link(TKGridAxisItem.Objects) property. Implementation for rows. } + procedure SetObjects(Index: Integer; const Value: TObject); override; + { Write method for the @link(TKGridAxisItem.SortArrowIndex) property. Implementation for rows. } + procedure SetSortArrowIndex(Value: Integer); override; + { Write method for the @link(TKGridAxisItem.SortMode) property. Implementation for rows. } + procedure SetSortMode(const Value: TKGridSortMode); override; + { Write method for the @link(TKGridAxisItem.Strings) property. Implementation for rows. } + procedure SetStrings(Index: Integer; const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); override; + { Write method for the @link(TKGridAxisItem.Visible) property. Implementation for rows. } + procedure SetVisible(Value: Boolean); override; + public + { Creates the instance. Do not create custom instances. All necessary + TKGridRow instances are created automatically by TKCustomGrid. } + constructor Create(AGrid: TKCustomGrid); override; + { Sets text of all cells corresponding to this row to empty string. } + procedure Clear; override; + { Makes it possible to assign a list of strings contained in TStrings + to the grid. It behaves exactly the same way as the corresponding method + in TStringGrid. Implementation for rows, i.e. the strings contained + in Source are copied to the text cells corresponding to the row + referred by this TKGridRow instance. } + procedure Assign(Source: TStrings); override; +{$IFDEF TKGRID_USE_JCL} + { Makes it possible to assign a list of strings contained in TWideStrings + to the grid. Implementation for rows, i.e. the strings contained + in Source are copied to the text cells corresponding to the row + referred by this TKGridRow instance. } + procedure Assign(Source: TWideStrings); override; +{$ENDIF} + end; + + { @abstract(Metaclass for @link(TKGridRow)) This type is used in + @link(TKCustomGrid.RowClass) property. } + TKGridRowClass = class of TKGridRow; + + { @abstract(Base class to store cell properties) + This class implements properties and methods common to all cell classes. } + TKGridCell = class(TObject) + private + FGrid: TKCustomGrid; + FSpan: TKGridCellSpan; + procedure SetColSpan(const Value: Integer); + procedure SetRowSpan(const Value: Integer); + procedure SetSpan(const Value: TKGridCellSpan); + protected + { Called after specific property has been updated. Default behavioor: + Searches the cell in the parent grid and invalidates the cell. You can + override this method to extend behavior. } + procedure AfterUpdate; virtual; // formerly UpdateCell + { Called before specific property is to be updated. } + procedure BeforeUpdate; virtual; + { Cell class aware version of @link(TKCustomGrid.OnDrawCell). + Fills ARect with predefined Brush. } + procedure DrawCell(ACol, ARow: Integer; const ARect: TRect; + State: TKGridDrawState); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorCreate). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorCreate). } + procedure EditorCreate(ACol, ARow: Integer; var AEditor: TWinControl); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorDataFromGrid). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorDataFromGrid). } + procedure EditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorDataToGrid). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorDataToGrid). } + procedure EditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorDestroy). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorDestroy). } + procedure EditorDestroy(var AEditor: TWinControl; ACol, ARow: Integer); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorKeyPreview). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorKeyPreview). } + procedure EditorKeyPreview(AEditor: TWinControl; ACol, ARow: Integer; + var Key: Word; Shift: TShiftState; var IsGridKey: Boolean); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorResize). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorResize). } + procedure EditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorSelect). + The TKGridCell's implementation calls @link(TKCustomGrid.DefaultEditorSelect). } + procedure EditorSelect(AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); virtual; + { Searches the cell in the parent grid. } + function FindCell(out ACol, ARow: Integer): Boolean; virtual; + { Initializes the cell data. } + procedure Initialize; virtual; + { Cell class aware version of @link(TKCustomGrid.OnMeasureCell). } + procedure MeasureCell(ACol, ARow: Integer; const ARect: TRect; + State: TKGridDrawState; Priority: TKGridMeasureCellPriority; + var Extent: TPoint); virtual; + { Cell class aware version of @link(TKCustomGrid.OnSelectCell). + The TKGridCell's implementation does nothing. } + procedure SelectCell(ACol, ARow: Integer; var ACanSelect: Boolean); + virtual; + { Cell class aware version of @link(TKCustomGrid.OnSelectionExpand). + The TKGridCell's implementation does nothing. } + procedure SelectionExpand(ACol, ARow: Integer; var ACanExpand: Boolean); virtual; + public + { Creates the instance. You can create a custom instance and pass it + e.g. to a @link(TKCustomGrid.Cell) property. The AGrid parameter has no meaning + in this case and you may set it to nil. } + constructor Create(AGrid: TKCustomGrid); virtual; + { Applies TKGridCell properties to the cell painter. + The TKGridCell's implementation does nothing. } + procedure ApplyDrawProperties; virtual; + { Copies the properties of another TKGridCell instances into this + TKGridCell instance. } + procedure Assign(Source: TKGridCell); virtual; + { Clears the cell data. } + procedure Clear; + { Specifies the number of columns the cell should be spanned to. } + property ColSpan: Integer read FSpan.ColSpan write SetColSpan; + { Pointer to the grid. You will probably need it when implementing application + specific behavior. } + property Grid: TKCustomgrid read FGrid; + { Specifies the number of rows the cell should be spanned to. } + property RowSpan: Integer read FSpan.RowSpan write SetRowSpan; + { Specifies both cell span parameters. } + property Span: TKGridCellSpan read FSpan write SetSpan; + end; + + { @abstract(Metaclass for @link(TKGridCell)) This type is used in the + @link(TKCustomGrid.CellClass) property. } + TKGridCellClass = class of TKGridCell; + + { @abstract(Dynamic array type to store row of @link(TKGridCell) instances) + This one-dimensional array stores cell properties. } + TKGridCellRow = array of TKGridCell; + + { @abstract(Dynamic array type to store the entire grid of @link(TKGridCell) instances) + This two-dimensional array stores cell properties - @link(TKCustomGrid.FCells). } + TKGridCells = array of TKGridCellRow; + + { @abstract(Class for simple textual cell) + This cell class implements properties and methods needed to display/edit a cell + with simple text. } + TKGridTextCell = class(TKGridCell) + private + {$IFDEF STRING_IS_UNICODE} + FText: string; + function GetTextPtr: PChar; + {$ELSE} + FText: PWideChar; // WideString is slow as storage here + function GetText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + {$ENDIF} + procedure SetText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + protected + { Assigns a new text string into this TKGridTextCell instance. The new + string will be assigned by a grow on demand method, i.e. the memory + allocated for the string can only grow within each assignment. It continues + to grow until the TKGridTextCell instance is destroyed. } + procedure AssignText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); virtual; + { Cell class aware version of @link(TKCustomGrid.OnEditorCreate). + Creates a TEdit inplace editor. } + procedure EditorCreate(ACol, ARow: Integer; var AEditor: TWinControl); override; + { Initializes the cell data. } + procedure Initialize; override; + public + { Creates the instance. See @link(TKGridCell.Create) for details. } + constructor Create(AGrid: TKCustomGrid); override; + { Destroys the instance. See TObject.Destroy in Delphi help. } + destructor Destroy; override; + { Applies TKGridTextCell properties to the cell painter. } + procedure ApplyDrawProperties; override; + { Copies shareable properties of another instance that inherits from + TKGridCell into this TKGridTextCell instance. } + procedure Assign(Source: TKGridCell); override; + { Readonly property. This is the editable text that appears in the cell - + published as pointer for fast read operations like sorting. } + property TextPtr: {$IFDEF STRING_IS_UNICODE}PChar{$ELSE}PWideChar{$ENDIF} read {$IFDEF STRING_IS_UNICODE}GetTextPtr{$ELSE}FText{$ENDIF}; + { Shareable property. This is the editable text that appears in the cell. } + property Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read {$IFDEF STRING_IS_UNICODE}FText{$ELSE}GetText{$ENDIF} write SetText; + end; + + { @abstract(Class for a textual cell with custom appearance) + This cell class implements properties and methods needed to display/edit + a textual cell with custom appearance. } + TKGridAttrTextCell = class(TKGridTextCell) + private + FAttributes: TKTextAttributes; + FBackColor: TColor; + FBrush: TBrush; + FBrushChanged: Boolean; + FFont: TFont; + FFontChanged: Boolean; + FHAlign: TKHAlign; + FHPadding: Integer; + FVAlign: TKVAlign; + FVPadding: Integer; + procedure SetAttributes(const AValue: TKTextAttributes); + procedure SetFHAlign(const Value: TKHAlign); + procedure SetFHPadding(const Value: Integer); + procedure SetFVAlign(const Value: TKVAlign); + procedure SetFVPadding(const Value: Integer); + procedure SetBackColor(const Value: TColor); + protected + { Called from FFont.OnChange. Sets FontChanged to True. } + procedure FontChange(Sender: TObject); + { Called from FBrush.OnChange. Sets BrushChanged to True. } + procedure BrushChange(Sender: TObject); + { Initializes the cell data. } + procedure Initialize; override; + public + { Creates the instance. See @link(TKGridCell.Create) for details. } + constructor Create(AGrid: TKCustomGrid); override; + { Destroys the instance. See TObject.Destroy in Delphi help. } + destructor Destroy; override; + { Applies TKGridAttrTextCell properties to the cell painter. } + procedure ApplyDrawProperties; override; + { Copies shareable properties of another instance that inherits from + TKGridCell into this TKGridAttrTextCell instance. } + procedure Assign(Source: TKGridCell); override; + { Shareable property. These are the text attributes to render the text. } + property Attributes: TKTextAttributes read FAttributes write SetAttributes; + { Shareable property. This is the color used to fill the gaps between + a non solid @link(TKGridAttrTextCell.Brush). } + property BackColor: TColor read FBackColor write SetBackColor; + { Shareable property. This is the brush that will be used to fill the cell background. } + property Brush: TBrush read FBrush; + { Non-shareable property. Returns True if Brush.OnChange occured. } + property BrushChanged: Boolean read FBrushChanged; + { Shareable property. This is the font that will be used to render the text. } + property Font: TFont read FFont; + { Non-shareable property. Returns True if Font.OnChange occured. } + property FontChanged: Boolean read FFontChanged; + { Shareable property. This is the horizontal alignment + that will be used to place the text within the cell rectangle. } + property HAlign: TKHAlign read FHAlign write SetFHAlign; + { Shareable property. This is the horizontal padding + of the text from the cell rectangle. } + property HPadding: Integer read FHPadding write SetFHPadding; + { Shareable property. This is the vertical alignment + that will be used to place the text within the cell rectangle. } + property VAlign: TKVAlign read FVAlign write SetFVAlign; + { Shareable property. This is the vertical padding + of the text from the cell rectangle. } + property VPadding: Integer read FVPadding write SetFVPadding; + end; + +{$IFDEF TKGRIDOBJECTCELL_IS_TKGRIDATTRTEXTCELL} + { @exclude } + TKGridObjectCellAncestor = TKGridAttrTextCell; +{$ELSE} + {$IFDEF TKGRIDOBJECTCELL_IS_TKGRIDTEXTCELL} + { @exclude } + TKGridObjectCellAncestor = TKGridTextCell; + {$ELSE} + { @exclude } + TKGridObjectCellAncestor = TKGridCell; + {$ENDIF} +{$ENDIF} + + { @abstract(Class for an object cell) + This cell class implements properties and methods needed to store a custom + object in a cell. This class is implemented for backward compatibility + with TStringGrid. You can implement different cell classes to store any user + defined data. } + TKGridObjectCell = class(TKGridObjectCellAncestor) + private + FCellObject: TObject; + procedure SetCellObject(Value: TObject); + protected + { Initializes the cell data. } + procedure Initialize; override; + public + { Creates the instance. See @link(TKGridCell.Create) for details. } + constructor Create(AGrid: TKCustomGrid); override; + { Destroys the instance. See TObject.Destroy in Delphi help. } + destructor Destroy; override; + { Copies shareable properties of another instance that inherits from + TKGridCell into this TKGridObjectCell instance. } + procedure Assign(Source: TKGridCell); override; + { Shareable property. This is the object stored within the cell class. + A single object instance passed to CellObject cannot be shared among multiple + cell class instances. The reason is that TObject instances do not support + Assign method, more convenient it would be to store TPersistents. } + property CellObject: TObject read FCellObject write SetCellObject; + end; + + { @abstract(Wrapper for a versatile and easily extensible cell painting engine) + Properties and methods of this class provide standard cell painting. + To adapt cell painting, you can use combinations of elementary painting + methods in the @link(TKCustomGrid.OnDrawCell) event handler or + override and adapt some high level methods of TKGridCellPainter. } + TKGridCellPainter = class(TObject) + private + FAttributes: TKTextAttributes; + FBackColor: TColor; + FBlockRect: TRect; + FButton: Boolean; + FButtonPressed: Boolean; + FCanvas: TCanvas; + FCheckBox: Boolean; + FCheckBoxHAlign: TKHAlign; + FCheckBoxHPadding: Integer; + FCheckboxState: TCheckBoxState; + FCheckBoxVAlign: TKVAlign; + FCheckBoxVPadding: Integer; + FCellPos: TPoint; + FCellRect: TRect; + FClipLock: Integer; + FCol: Integer; + FGraphic: TGraphic; + FGraphicDrawText: Boolean; + FGraphicHAlign: TKHAlign; + FGraphicHPadding: Integer; + FGraphicStretchMode: TKStretchMode; + FGraphicVAlign: TKVAlign; + FGraphicVPadding: Integer; + FGrid: TKCustomGrid; + FHotFrameOnly: Boolean; + FHAlign: TKHAlign; + FHPadding: Integer; + FRgn: HRGN; + FRow: Integer; + FSortArrow: TKAlphaBitmap; + FSortArrowHAlign: TKHAlign; + FSortArrowHPadding: Integer; + FState: TKGridDrawState; + FText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + FValidClipping: Boolean; + FVAlign: TKVAlign; + FVPadding: Integer; + function GetCheckBoxChecked: Boolean; + procedure SetCheckBox(AValue: Boolean); + procedure SetCheckBoxChecked(const Value: Boolean); + protected + { Returns True if the grid is being printed out. } + FPrinting: Boolean; + { High level method. Provides default behavior needed to initialize painting + of a cell. It is called automatically in @link(TKCustomGrid.PaintCell). } + procedure BeginDraw; virtual; + { High level method. Provides default behavior needed to finalize painting + of a cell. It is called automatically in @link(TKCustomGrid.PaintCell). } + procedure EndDraw; virtual; + { Read method for the @link(TKGridCellPainter.SortArrowWidth) property. } + function GetSortArrowWidth: Integer; virtual; + { Initializes all canvas independent attributes to default values. Called + from DefaultAttributes just before cell painting. } + procedure Initialize; virtual; + public + { Creates the instance. Do not create custom instances. All necessary + TKGridCellPainter instances are created automatically by TKCustomGrid. } + constructor Create(AGrid: TKCustomGrid); + { Destroys the instance. See TObject.Destroy in Delphi help. } + destructor Destroy; override; + { Forces the drawing output to be clipped within @link(TKGridCellPainter.CellRect). + This behavior must be cancelled by @link(TKGridCellPainter.EndClip) when + no longer needed. You don't need to call BeginClip if the @link(TKCustomGrid.Options) + property already contains goClippedCells. } + function BeginClip: Boolean; virtual; + { Calculates the checkbox position within BaseRect, if any. The position + is stored in Bounds (checkbox with padding) and Interior (checkbox without + padding). Bounds are excluded from BaseRect. } + function CellCheckBoxRect(var BaseRect: TRect; out Bounds, Interior: TRect; StretchMode: TKStretchMode): Boolean; + { Calculates the graphic position within BaseRect, if any. The position + is stored in Bounds (graphic with padding) and Interior (graphic without + padding). Bounds are excluded from BaseRect. } + function CellGraphicRect(var BaseRect: TRect; out Bounds, Interior: TRect; StretchMode: TKStretchMode): Boolean; + { Calculates the sorting arrow position within BaseRect, if any. The position + is stored in Bounds (sorting arrow with padding) and Interior (sorting arrow + without padding). Bounds are excluded from BaseRect. } + function CellSortArrowRect(var BaseRect: TRect; out Bounds, Interior: TRect): Boolean; + { Calculates the cell text horizontal and vertical extent, if any. } + function CellTextExtent(const BaseRect: TRect; out Extent: TPoint): Boolean; + { Calculates the text position within BaseRect, if any. The position + is stored in Bounds (text with padding) and Interior (text without padding). + Bounds are excluded from BaseRect. } + function CellTextRect(var BaseRect: TRect; out Bounds, Interior: TRect): Boolean; + { Low level method. Prepares default painting attributes. Under current + implementation, DefaultAttributes applies default colors to the + @link(TKGridCellPainter.Canvas)'s Brush and Font properties. } + procedure DefaultAttributes; virtual; + { Highest level method. Provides default painting of any cell. You should call + DefaultDraw when implementing the @link(TKCustomGrid.OnDrawCell) event handler + unless any specific cell painting is required. This method supersedes + the obsolete @link(DefaultDrawCell) function. } + procedure DefaultDraw; virtual; + { Returns the combination of edge masks (BF_...) to paint a fixed cell + correctly in old TCustomGrid style or if no OS themes are available. } + function DefaultEdges: Cardinal; virtual; + { Highest level method. Provides default cell extent calculation. } + function DefaultMeasure(Priority: TKGridMeasureCellPriority): TPoint; virtual; + { Low level method. Paints common parts of a themed and non-themed cell. } + procedure DrawCellCommon; virtual; + { Low level method. Paints button frame. } + procedure DrawCellButton(Bounds: TRect); + { Low level method. Paints checkbox frame. } + procedure DrawCellCheckBox(const Bounds, Interior: TRect); + { Low level method. Paints the graphic (if any) within the rectangle specified by Interior. + Fills the rectangle specified by Bounds with current brush. } + procedure DrawCellGraphic(const Bounds, Interior: TRect); + { Low level method. Paints the sort arrow within the rectangle specified by Interior. + Fills the rectangle specified by Bounds with current brush. } + procedure DrawCellSortArrow(const Bounds, Interior: TRect); + { Low level method. Paints a button frame. } + procedure DrawButtonFrame(const ARect: TRect); virtual; + { Low level method. Paints a check box frame. } + procedure DrawCheckBoxFrame(const ARect: TRect); virtual; + { Low level method. Paints cell text. } + procedure DrawCellText(var ARect: TRect); virtual; + { Low level method. Paints a standard focus rectangle around the focused + cell. } + procedure DrawCellFocus(const ARect: TRect; SkipTest: Boolean = False); virtual; + { High level method. Paints an empty cell, i.e. only fills the cell background. } + procedure DrawEmptyCell; virtual; + { High level method. Paints a non themed fixed cell. } + procedure DrawFixedCell; virtual; + { Low level method. Paints fixed cell background. } + procedure DrawFixedCellBackground(const ARect: TRect); virtual; + { Low level method. Paints non-themed fixed cell background. } + procedure DrawFixedCellNonThemedBackground(const ARect: TRect); virtual; + { High level method. Paints a fixed cell in Windows Header style. } + procedure DrawHeaderCell; virtual; + { Low level method. Paints header background. } + procedure DrawHeaderCellBackground(const ARect: TRect); + { Low level method. Paints selection background frame. } + procedure DrawNormalCellBackground(const ARect: TRect); virtual; + { High level method. Paints a selectable cell. } + procedure DrawSelectableCell; virtual; + { Low level method. Paints selection background frame. } + procedure DrawSelectedCellBackground(const ARect: TRect; RClip: PRect = nil); virtual; + { High level method. Paints a themed fixed cell. } + procedure DrawThemedFixedCell; virtual; + { High level method. Paints a themed fixed cell in Windows Header style. } + procedure DrawThemedHeaderCell; virtual; + { Restores normal drawing output after previous + @link(TKGridCellPainter.BeginClip) call. } + procedure EndClip; virtual; + { Specifies the text attributes used to render the cell text. } + property Attributes: TKTextAttributes read FAttributes write FAttributes; + { Specifies the color used to fill the gaps if the Brush + referred by @link(TKGridCellPainter.Canvas) is not solid brush. } + property BackColor: TColor read FBackColor write FBackColor; + { Specifies the bounding rectangle of block of cells. This value can be given + either in TKCustomGrid's client coordinates or, in @link(goDoubleBufferedCells) + mode, relative to @link(TKGridCellPainter.CellPos). } + property BlockRect: TRect read FBlockRect write FBlockRect; + { Determines if a standard button frame should be painted for a selectable + cell. To paint a button frame, you need to implement the @link(OnDrawCell) + event handler, set Button to True and call @link(TKGridCellPainter.DefaultDraw), + which ensures correct painting of a button frame. } + property Button: Boolean read FButton write FButton; + { Specifies if the button frame should be painted in pressed or released (normal) + state. This property has no effect unless @link(TKGridCellPainter.Button) + is True. } + property ButtonChecked: Boolean read FButtonPressed write FButtonPressed; + { Identifies the Canvas where the cell will be painted to. The value of this + property is either equal to TKCustomGrid.@link(TKCustomGrid.Canvas) or, in + @link(goDoubleBufferedCells) mode, equal to a memory device context whose + dimensions correspond to the size of the cell. When implementing the + @link(OnDrawCell) event handler, you can paint to TKCustomGrid.Canvas as + usual in TStringGrid. However, if you wish to use goDoubleBufferedCells, + you must paint to TKGridCellPainter.Canvas. } + property Canvas: TCanvas read FCanvas write FCanvas; + { Determines if a standard check box frame should be painted for a selectable + cell. To paint a check box frame, you need to implement the @link(OnDrawCell) + event handler, set CheckBox to True and call @link(TKGridCellPainter.DefaultDraw), + which ensures correct painting of a check box frame. } + property CheckBox: Boolean read FCheckBox write SetCheckBox; + { Specifies if the check box frame should be painted in checked or unchecked + state. This property is for backward compatibility and has no effect unless + @link(TKGridCellPainter.CheckBox) is True. For new designs use the CheckBoxState property. } + property CheckBoxChecked: Boolean read GetCheckBoxChecked write SetCheckBoxChecked; + { Specifies the horizontal padding for the sorting arrow. } + property CheckBoxHAlign: TKHAlign read FCheckBoxHAlign write FCheckBoxHAlign; + { Specifies the horizontal padding for the sorting arrow. } + property CheckBoxHPadding: Integer read FCheckBoxHPadding write FCheckBoxHPadding; + { Specifies if the check box frame should be painted in checked, grayed + or unchecked state. This property has no effect unless + @link(TKGridCellPainter.CheckBox) is True. Added by Karol Schmidt } + property CheckboxState: TCheckBoxState read FCheckboxState write FCheckboxState; + { Specifies the vertical padding for the sorting arrow. } + property CheckBoxVAlign: TKVAlign read FCheckBoxVAlign write FCheckBoxVAlign; + { Specifies the vertical padding for the sorting arrow. } + property CheckBoxVPadding: Integer read FCheckBoxVPadding write FCheckBoxVPadding; + { Specifies the left and top position/origin of the cell in TKCustomGrid's client + coordinates. } + property CellPos: TPoint read FCellPos write FCellPos; + { Specifies the bounding rectangle of the cell. This value can be given + either in TKCustomGrid's client coordinates or, in @link(goDoubleBufferedCells) + mode, relative to @link(TKGridCellPainter.CellPos). } + property CellRect: TRect read FCellRect write FCellRect; + { Specifies the column index of the cell. } + property Col: Integer read FCol write FCol; + { Specifies the image that should be drawn in the cell. } + property Graphic: TGraphic read FGraphic write FGraphic; + { Specifies if the text should appear next to the image. } + property GraphicDrawText: Boolean read FGraphicDrawText write FGraphicDrawText; + { Specifies the horizontal alignment for the image. } + property GraphicHAlign: TKHAlign read FGraphicHAlign write FGraphicHAlign; + { Specifies the horizontal padding for the image. } + property GraphicHPadding: Integer read FGraphicHPadding write FGraphicHPadding; + { Specifies if the the image should be stretched within the cell (aspect ratio is preserved). } + property GraphicStretchMode: TKStretchMode read FGraphicStretchMode write FGraphicStretchMode; + { Specifies the vertical alignment for the image. } + property GraphicVAlign: TKVAlign read FGraphicVAlign write FGraphicVAlign; + { Specifies the vertical padding for the image. } + property GraphicVPadding: Integer read FGraphicVPadding write FGraphicVPadding; + { Specifies the calling grid. } + property Grid: TKCustomGrid read FGrid; + { This is the default horizontal alignment that will be used to place the text + within the cell rectangle. } + property HAlign: TKHAlign read FHAlign write FHAlign; + { When true, a check box frame etc. is only painted "hot" when mouse cursor is + over that frame. When false, it is painted "hot" when mouse cursor is over + entire cell. } + property HotFrameOnly: Boolean read FHotFrameOnly write FHotFrameOnly; + { This is the default horizontal padding for the text. } + property HPadding: Integer read FHPadding write FHPadding; + { Returns True if the grid is being printed out. Needed e.g. for font height + adjstment while printing. } + property Printing: Boolean read FPrinting; + { Specifies the row index of the cell. } + property Row: Integer read FRow write FRow; + { Returns the width of the sorting arrow glyph. This value can be either zero + if no sorting arrow should be drawn for the cell (most cases), or a width + of the glyph for column/row sorting. } + property SortArrowWidth: Integer read GetSortArrowWidth; + { Specifies the horizontal padding for the check box. } + property SortArrowHAlign: TKHAlign read FSortArrowHAlign write FSortArrowHAlign; + { Specifies the horizontal padding for the sorting arrow. } + property SortArrowHPadding: Integer read FSortArrowHPadding write FSortArrowHPadding; + { Specifies the draw state of the cell. } + property State: TKGridDrawState read FState write FState; + { Specifies the text that appears in the cell. } + property Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read FText write FText; + { This is the default vertical alignment that will be used to place the text + within the cell rectangle. } + property VAlign: TKVAlign read FVAlign write FVAlign; + { This is the default vertical padding for the text. } + property VPadding: Integer read FVPadding write FVPadding; + end; + + { @abstract(Metaclass for @link(TKGridCellPainter)) This type is used in the + @link(TKCustomGrid.CellPainterClass) property. } + TKGridCellPainterClass = class of TKGridCellPainter; + + { @abstract(Container for all colors used by @link(TKCustomGrid) class) + This container allows to group many colors into one item in object inspector. + Colors are accessible via published properties or several public Color* + properties. } + TKGridColors = class(TPersistent) + private + FGrid: TKCustomGrid; + FBrightRangeBkGnd: Boolean; + FColorScheme: TKGridColorScheme; + function GetColor(Index: TKGridColorIndex): TColor; + function GetColorEx(Index: TKGridColorIndex): TColor; + procedure SetColor(Index: TKGridColorIndex; Value: TColor); + procedure SetColorEx(Index: TKGridColorIndex; Value: TColor); + procedure SetColors(const Value: TKColorArray); + protected + FBrightColors: TKColorArray; + FColors: TKColorArray; + { Initializes the color array. } + procedure Initialize; virtual; + { Returns the specific color according to ColorScheme. } + function InternalGetColor(Index: TKGridColorIndex): TColor; virtual; + { Replaces the specific color. } + procedure InternalSetColor(Index: TKGridColorIndex; Value: TColor); virtual; + public + { Creates the instance. You can create a custom instance and pass it + e.g. to a @link(TKCustomGrid.Colors) property. The AGrid parameter has no meaning + in this case and you may set it to nil. } + constructor Create(AGrid: TKCustomGrid); + { Copies the properties of another instance that inherits from + TPersistent into this TKGridColors instance. } + procedure Assign(Source: TPersistent); override; + { Ensures cell range background colors will be brightened if specified by + @link(TKGridColors.BrightRangeBkGnd). } + procedure BrightRangeBkGnds; + { Clears cached brighter colors. } + procedure ClearBrightColors; + { Specifies color scheme for reading of published properties - see GetColor in source code} + property ColorScheme: TKGridColorScheme read FColorScheme write FColorScheme; + { Returns always normal color - regardless of the ColorScheme setting. } + property Color[Index: TKGridColorIndex]: TColor read GetColorEx write SetColorEx; + { Returns array of normal colors. } + property Colors: TKColorArray read FColors write SetColors; + published + { Specifies if cell range colors should be brightened from focused cell colors. } + property BrightRangeBkGnd: Boolean read FBrightRangeBkGnd write FBrightRangeBkGnd default True; + { Background color for non-fixed cells. } + property CellBkGnd: TColor index ciCellBkGnd read GetColor write SetColor default cCellBkGndDef; + { Color for lines around non-fixed cells. } + property CellLines: TColor index ciCellLines read GetColor write SetColor default cCellLinesDef; + { Text color for non-fixed cells. } + property CellText: TColor index ciCellText read GetColor write SetColor default cCellTextDef; + { Background color for drag suggestion stroke. } + property DragSuggestionBkGnd: TColor index ciDragSuggestionBkGnd read GetColor write SetColor default cDragSuggestionBkGndDef; + { Line color for drag suggestion stroke. } + property DragSuggestionLine: TColor index ciDragSuggestionLine read GetColor write SetColor default cDragSuggestionLineDef; + { Background color for fixed cells. } + property FixedCellBkGnd: TColor index ciFixedCellBkGnd read GetColor write SetColor default cFixedCellBkGndDef; + { Background color for fixed cells that currently indicate selection. } + property FixedCellIndication: TColor index ciFixedCellIndication read GetColor write SetColor default cFixedCellIndicationDef; + { Color for lines around fixed cells. } + property FixedCellLines: TColor index ciFixedCellLines read GetColor write SetColor default cFixedCellLinesDef; + { Text color for fixed cells. } + property FixedCellText: TColor index ciFixedCellText read GetColor write SetColor default cFixedCellTextDef; + { Color for lines around fixed cells if goThemedCells is True} + property FixedThemedCellLines: TColor index ciFixedThemedCellLines read GetColor write SetColor default cFixedThemedCellLinesDef; + { Color for 3D highlight effects for fixed cells if goThemedCells is True} + property FixedThemedCellHighlight: TColor index ciFixedThemedCellHighlight read GetColor write SetColor default cFixedThemedCellHighlightDef; + { Color for 3D shadow effects for fixed cells if goThemedCells is True} + property FixedThemedCellShadow: TColor index ciFixedThemedCellShadow read GetColor write SetColor default cFixedThemedCellShadowDef; + { Background color for focused cell defined by Selection.Cell1. } + property FocusedCellBkGnd: TColor index ciFocusedCellBkGnd read GetColor write SetColor default cFocusedCellBkGndDef; + { Text color for focused cell defined by Selection.Cell1. } + property FocusedCellText: TColor index ciFocusedCellText read GetColor write SetColor default cFocusedCellTextDef; + { Background color for another focused cells within the range or full row selection. } + property FocusedRangeBkGnd: TColor index ciFocusedRangeBkGnd read GetColor write SetColor default cFocusedRangeBkGndDef; + { Text color for another focused cells within the range or full row selection. } + property FocusedRangeText: TColor index ciFocusedRangeText read GetColor write SetColor default cFocusedRangeTextDef; + { Background color for selected cells defined by Selection.Cell1. } + property SelectedCellBkGnd: TColor index ciSelectedCellBkGnd read GetColor write SetColor default cSelectedCellBkGndDef; + { Text color for selected cells defined by Selection.Cell1. } + property SelectedCellText: TColor index ciSelectedCellText read GetColor write SetColor default cSelectedCellTextDef; + { Background color for another selected cells within the range or full row selection. } + property SelectedRangeBkGnd: TColor index ciSelectedRangeBkGnd read GetColor write SetColor default cSelectedRangeBkGndDef; + { Text color for another selected cells within the range or full row selection. } + property SelectedRangeText: TColor index ciSelectedRangeText read GetColor write SetColor default cSelectedRangeTextDef; + // aki: + { Background color for selected cells defined by Selection.Cell1. } + property SelectedFixedCellBkGnd: TColor index ciSelectedFixedCellBkGnd read GetColor write SetColor default cSelectedFixedCellBkGndDef; + end; + + { @abstract(KGrid base component) This is the class that you use + as the ancestor for your TKCustomGrid overrides. } + TKCustomGrid = class(TKCustomControl) + private + {$IFDEF FPC} + FFlat: Boolean; + {$ENDIF} + FCellClass: TKGridCellClass; + FCellPainter: TKGridCellPainter; + FCellPainterClass: TKGridCellPainterClass; + FColClass: TKGridColClass; + FColCount: Integer; + FDefaultColWidth: Integer; + FDefaultRowHeight: Integer; + FDisabledDrawStyle: TKGridDisabledDrawStyle; + FDragDest: Integer; + FDragOrigin: Integer; + FDragStyle: TKGridDragStyle; + FEditorTransparency: TKGridEditorTransparency; + FFixedCols: Integer; + FFixedRows: Integer; + FGridLineWidth: Integer; + FMinColWidth: Integer; + FMinRowHeight: Integer; + FMouseCellHintTime: Cardinal; + FMoveDirection: TKGridMoveDirection; + FOptions: TKGridOptions; + FOptionsEx: TKGridOptionsEx; + FRowClass: TKGridRowClass; + FRowCount: Integer; + FRangeSelectStyle: TKGridRangeSelectStyle; + FScrollBars: TScrollStyle; + FScrollModeVert: TKGridScrollMode; + FScrollModeHorz: TKGridScrollMode; + FScrollSpeed: Cardinal; + FScrollTimer: TTimer; + FSizingIndex: Integer; + FSizingDest: Integer; + FSizingStyle: TKGridSizingStyle; + FSortModeLock: Integer; + FSortStyle: TKGridSortStyle; + FThroughClick: Boolean; + FTopLeft: TKGridCoord; + FTopLeftExtent: TKGridCoord; + FOnBeginColDrag: TKGridBeginDragEvent; + FOnBeginColSizing: TKGridBeginSizingEvent; + FOnBeginRowDrag: TKGridBeginDragEvent; + FOnBeginRowSizing: TKGridBeginSizingEvent; + FOnCellSpan: TKGridCellSpanEvent; + FOnChanged: TKGridCellEvent; + FOnCheckColDrag: TKGridCheckDragEvent; + FOnCheckRowDrag: TKGridCheckDragEvent; + FOnColMoved: TKGridMovedEvent; + FOnColWidthsChanged: TNotifyEvent; + FOnColWidthsChangedEx: TKGridExtentEvent; + FOnCompareCellInstances: TKGridCompareCellInstancesEvent; + FOnCompareCells: TKGridCompareCellsEvent; + FOnCustomSortCols: TKGridCustomSortEvent; + FOnCustomSortRows: TKGridCustomSortEvent; + FOnDrawCell: TKGridDrawCellEvent; + FOnEditorCreate: TKGridEditorCreateEvent; + FOnEditorDataFromGrid: TKGridEditorDataEvent; + FOnEditorDataToGrid: TKGridEditorDataEvent; + FOnEditorDestroy: TKGridEditorDestroyEvent; + FOnEditorKeyPreview: TKGridEditorKeyPreviewEvent; + FOnEditorResize: TKGridEditorResizeEvent; + FOnEditorSelect: TKGridEditorSelectEvent; + FOnEndColDrag: TKGridEndDragEvent; + FOnEndColSizing: TKGridEndSizingEvent; + FOnEndRowDrag: TKGridEndDragEvent; + FOnEndRowSizing: TKGridEndSizingEvent; + FOnExchangeCols: TKGridExchangeEvent; + FOnExchangeRows: TKGridExchangeEvent; + FOnMeasureCell: TKGridMeasureCellEvent; + FOnMouseCellHint: TKGridCellHintEvent; + FOnMouseClickCell: TKGridCellEvent; + FOnMouseDblClickCell: TKGridCellEvent; + FOnMouseEnterCell: TKGridCellEvent; + FOnMouseLeaveCell: TKGridCellEvent; + FOnRowMoved: TKGridMovedEvent; + FOnRowHeightsChanged: TNotifyEvent; + FOnRowHeightsChangedEx: TKGridExtentEvent; + FOnSelectCell: TKGridSelectCellEvent; + FOnSelectionExpand: TKGridSelectionExpandEvent; + FOnSizeChanged: TKGridSizeChangedEvent; + FOnTopLeftChanged: TNotifyEvent; + function GetAllCellsSelected: Boolean; + function GetAllRowsSelected: Boolean; + function GetAllColsSelected: Boolean; + function GetCell(ACol, ARow: Integer): TKGridCell; + function GetCells(ACol, ARow: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; + function GetCellSpan(ACol, ARow: Integer): TKGridCellSpan; + function GetCols(Index: Integer): TKGridCol; + function GetColWidths(Index: Integer): Integer; + function GetDefaultDrawing: Boolean; + function GetEditorMode: Boolean; + function GetEffectiveColSpacing(ACol: Integer): Integer; + function GetEffectiveRowSpacing(ARow: Integer): Integer; + function GetEntireColSelected(Index: Integer): Boolean; + function GetEntireSelectedColCount: Integer; + function GetEntireRowSelected(Index: Integer): Boolean; + function GetEntireSelectedRowCount: Integer; + function GetGridHeight: Integer; + function GetGridWidth: Integer; + function GetLastVisibleCol: Integer; + function GetLastVisibleRow: Integer; + function GetMoreCellsSelected: Boolean; + function GetObjects(ACol, ARow: Integer): TObject; + function GetRowHeights(Index: Integer): Integer; + function GetRows(Index: Integer): TKGridRow; + function GetSelection: TKGridRect; + function GetSelectionCount: Integer; + function GetSelectionRect: TRect; + function GetSelections(Index: Integer): TKGridRect; + function GetSortCol: Integer; + function GetSortRow: Integer; + function GetTabStops(Index: Integer): Boolean; + function GetThemedCells: Boolean; + function GetThemes: Boolean; + function GetVisibleColCount: Integer; + function GetVisibleGridRect: TKGridRect; + function GetVisibleRowCount: Integer; + procedure ReadColWidths(Reader: TReader); + procedure ReadRowHeights(Reader: TReader); + {$IFDEF FPC} + procedure SetFlat(Value: Boolean); + {$ENDIF} + procedure SetCell(ACol, ARow: Integer; Value: TKGridCell); + procedure SetCellPainterClass(Value: TKGridCellPainterClass); + procedure SetCells(ACol, ARow: Integer; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + procedure SetCellSpan(ACol, ARow: Integer; Value: TKGridCellSpan); + procedure SetCol(Value: Integer); + procedure SetColCount(Value: Integer); + procedure SetColors(Value: TKGridColors); + procedure SetColWidths(Index: Integer; Value: Integer); + procedure SetDefaultColWidth(Value: Integer); + procedure SetDefaultDrawing(Value: Boolean); + procedure SetDefaultRowHeight(Value: Integer); + procedure SetDisabledDrawStyle(Value: TKGridDisabledDrawStyle); + procedure SetDragStyle(Value: TKGridDragStyle); + procedure SetEditorMode(Value: Boolean); + procedure SetEditorTransparency(Value: TKGridEditorTransparency); + procedure SetFixedCols(Value: Integer); + procedure SetFixedRows(Value: Integer); + procedure SetGridLineWidth(Value: Integer); + procedure SetLeftCol(Value: Integer); + procedure SetMinColWidth(Value: Integer); + procedure SetMinRowHeight(Value: Integer); + procedure SetMouseCellHintTime(const AValue: Cardinal); + procedure SetObjects(ACol, ARow: Integer; Value: TObject); + procedure SetOptions(Value: TKGridOptions); + procedure SetOptionsEx(Value: TKGridOptionsEx); + procedure SetRow(Value: Integer); + procedure SetRowCount(Value: Integer); + procedure SetRowHeights(Index: Integer; Value: Integer); + procedure SetScrollBars(Value: TScrollStyle); + procedure SetScrollModeHorz(const Value: TKGridScrollMode); + procedure SetScrollModeVert(const Value: TKGridScrollMode); + procedure SetScrollSpeed(Value: Cardinal); + procedure SetSelection(const Value: TKGridRect); + procedure SetSelections(Index: Integer; const Value: TKGridRect); + procedure SetSizingStyle(Value: TKGridSizingStyle); + procedure SetTabStops(Index: Integer; Value: Boolean); + procedure SetTopRow(Value: Integer); + procedure WriteColWidths(Writer: TWriter); + procedure WriteRowHeights(Writer: TWriter); + procedure CMDesignHitTest(var Msg: TLMMouse); message CM_DESIGNHITTEST; + procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; + procedure CMShowingChanged(var Msg: TLMessage); message CM_SHOWINGCHANGED; + procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; + procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; + procedure CMWantSpecialKey(var Msg: TLMKey); message CM_WANTSPECIALKEY; + procedure WMChar(var Msg: TLMChar); message LM_CHAR; + procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND; + procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; + procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; + procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; + procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; + procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; + protected + { Gains access to the cell hint timer. } + FCellHintTimer: TTimer; + { Two-dimensional dynamic array to store cell instances. Different cell + classes can be used for cell instances. } + FCells: TKGridCells; + { Provides direct access to the color class for TKCustomGrid descendants } + FColors: TKGridColors; + { Dynamic array to store column instances. Different column classes can + be used for column instances. } + FCols: TKGridAxisItems; + { Icon for column/row moving suggestion arrow. } + FDragArrow: TKAlphaBitmap; + { Wrapper for the window used to visually indicate a dragged column or row. + Under Win2K or later system, this is a layered window. Under Win98SE or older + system, it is a normal popup window. } + FDragWindow: TKDragWindow; + { Copy of the cell being currently edited. } + FEditedCell: TKGridCell; + { Provides direct access to the inplace editor instance for TKCustomGrid descendants. } + FEditor: TWinControl; + { Specifies the current bounding rectangle of inplace editor. } + FEditorRect: TRect; + { Specifies the current position of inplace editor. If @link(TKCustomGrid.Selection).Cell1 + is different from FEditorCell, the editor needs to be updated immediatelly + to make these two values equal again. } + FEditorCell: TKGridCoord; + { Pointer to the original WindowProc property of the inplace editor. } + FEditorWindowProc: TWndMethod; + { Holds the mutually exclusive grid state. } + FGridState: TKGridState; + { Glyphs for hidden cell indicators. } + FHCI: TKGridHCIBitmaps; + { Specifies the cell hint window. } + FHint: TKHintWindow; + { Specifies the cell where hint timer has been started. } + FHintCell: TKGridCoord; + { Specifies the cell where left mouse button has been pressed. } + FHitCell: TKGridCoord; + { Specifies the point where left mouse button has been pressed. } + FHitPos: TPoint; + { Field for @link(TKCustomGrid.MaxCol) property. Descendants can modify it. } + FMaxCol: Integer; + { Field for @link(TKCustomGrid.MaxRow) property. Descendants can modify it. } + FMaxRow: Integer; + { Field to remember current column position for keyboard commands. } + FMemCol: Integer; + { Field to remember current row position for keyboard commands. } + FMemRow: Integer; + { Specifies the cell where mouse is over. FMouseOver is valid if goMouseOverCells + is included in @link(TKCustomGrid.Options). } + FMouseOver: TKGridCoord; + { Dynamic array to store row instances. Different row classes can + be used for row instances. } + FRows: TKGridAxisItems; + { Specifies current(topmost) selection not affected by @link(goRowSelect) as + @link(TKCustomGrid.Selection). } + FSelection: TKGridRect; + { Specifies all selections except FSelection. This separation is done for + backward compatibility. } + FSelections: array of TKGridRect; + { Current scrolling position in pixels (bound to cell boundary). } + FScrollPos: TPoint; + { Current scrolling offset in pixels for smSmooth mode (relative to cell boundary). } + FScrollOffset: TPoint; + { Auxilliary bitmap for various tasks. } + FTmpBitmap: TBitmap; + {$IFDEF FPC} + { Temporary mouse cursor. } + FTmpCursor: TCursor; + {$ENDIF} + { Adjusts the page setup. Ensures the PrintingMapped property is always True. } + procedure AdjustPageSetup; override; + { Adjusts any selection rectangle specified by ASelection to be valid + selection in @link(goRowSelect) mode, i.e. makes ASelection to span + the entire row(s). } + function AdjustSelection(const ASelection: TKGridRect): TKGridRect; virtual; + { Calls @link(TKCustomGrid.OnBeginColDrag) event handler or column class aware equivalent. + See the @link(TKGridBeginDragEvent) type for parameter interpretation. } + function BeginColDrag(var Origin: Integer; const MousePt: TPoint): Boolean; virtual; + { Calls @link(TKCustomGrid.OnBeginColSizing) event handler or checks the + @link(TKGridAxisItem.CanResize) property to decide whether the column can + be resized. See the @link(TKGridBeginSizingEvent) type for parameter interpretation. } + function BeginColSizing(var Index, Pos: Integer): Boolean; virtual; + { Calls @link(TKCustomGrid.OnBeginRowDrag) event handler or row class aware equivalent. + See the @link(TKGridBeginDragEvent) type for parameter interpretation. } + function BeginRowDrag(var Origin: Integer; const MousePt: TPoint): Boolean; virtual; + { Calls @link(TKCustomGrid.OnBeginRowSizing) event handler or checks the + @link(TKGridAxisItem.CanResize) property to decide whether the row can + be resized. See the @link(TKGridBeginSizingEvent) type for parameter interpretation. } + function BeginRowSizing(var Index, Pos: Integer): Boolean; virtual; + { Cancels any dragging or resizing operations performed by mouse. } + procedure CancelMode; override; + { This method is called periodically from the cell hint timer. } + procedure CellHintTimerHandler(Sender: TObject); virtual; + { In a non virtual grid, this method is called after @link(TKCustomGrid.OnEditorDestroy) + if the cell content has been modified. Changed calls @link(TKCustomGrid.OnChanged) + event handler. } + procedure Changed; virtual; + { Modifies the size of @link(FCols), @link(FRows) and @link(FCells). Updates + @link(TKCustomGrid.FixedCols), @link(TKCustomGrid.ColCount), @link(TKCustomGrid.MaxCol), + @link(TKCustomGrid.FixedRows), @link(TKCustomGrid.RowCount), @link(TKCustomGrid.MaxRow). } + procedure ChangeDataSize(ColInsert: Boolean; ColAt, ColCnt: Integer; + RowInsert: Boolean; RowAt, RowCnt: Integer); virtual; + { Calls @link(TKCustomGrid.OnCheckColDrag) event handler or column class aware equivalent. + See the @link(TKGridCheckDragEvent) type for parameter interpretation. } + function CheckColDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint): Boolean; virtual; + { Calls @link(TKCustomGrid.OnCheckRowDrag) event handler or row class aware equivalent. + See the @link(TKGridCheckDragEvent) type for parameter interpretation. } + function CheckRowDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint): Boolean; virtual; + { Forces the scrollable cell specified by ACol and ARow to become visible. } + function ClampInView(ACol, ARow: Integer): Boolean; + { Calls @link(TKCustomGrid.OnColumnMoved) event handler. + See the @link(TKGridMovedEvent) type for parameter interpretation. } + procedure ColMoved(FromIndex, ToIndex: Integer); virtual; + { Calls @link(TKCustomGrid.OnColWidthsChanged) event handler. } + procedure ColWidthsChanged(ACol: Integer); virtual; + { Calls @link(TKCustomGrid.OnCompareCells) event handler for the given two cell instances. } + function CompareCellInstances(ACell1, ACell2: TKGridCell): Integer; virtual; + { Calls @link(TKCustomGrid.OnCompareCells) event handler for the given two cells. } + function CompareCells(ACol1, ARow1, ACol2, ARow2: Integer): Integer; virtual; + { Calls @link(TKCustomGrid.OnCompareCells) event handler for two cells + belonging to the same row identified by ARow. ACol1 and ACol2 are column + indexes of these two cells. Method is used to compare grid rows. } + function CompareCols(ARow, ACol1, ACol2: Integer): Integer; virtual; + { Calls @link(TKCustomGrid.OnCompareCells) event handler for two cells + belonging to the same column identified by ACol. ARow1 and ARow2 are row + indexes of these two cells. Method is used to compare grid columns. } + function CompareRows(ACol, ARow1, ARow2: Integer): Integer; virtual; + { Overriden method - see Delphi help. CreateParams defines additional styles + for the KGrid window (scrollbars etc.)} + procedure CreateParams(var Params: TCreateParams); override; + { Calls @link(TKCustomGrid.OnCustomSortCols) event handler. + See the @link(TKGridCustomSortEvent) type for parameter interpretation. } + function CustomSortCols(ByRow: Integer; var SortMode: TKGridSortMode): Boolean; virtual; + { Calls @link(TKCustomGrid.OnCustomSortRows) event handler. + See the @link(TKGridCustomSortEvent) type for parameter interpretation. } + function CustomSortRows(ByCol: Integer; var SortMode: TKGridSortMode): Boolean; virtual; + { Clears all user defined column widths. } + procedure DefaultColWidthChanged; virtual; + { Clears all user defined row heights. } + procedure DefaultRowHeightChanged; virtual; + { Provides default behavior for an inplace editor if it's caret should be + positioned to the left side. } + procedure DefaultSetCaretToLeft(Key: Word; ShiftState: TShiftState); virtual; + { Defines the custom properties for *.dfm streaming. } + procedure DefineProperties(Filer: TFiler); override; + { Overriden method - see Delphi help. Responds to mouse wheel events. } + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + { Overriden method - see Delphi help. Responds to mouse wheel events. } + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + { Updates column/row dragging state if mouse is moved or scrolling is initiated by mouse. + Called from @link(TKCustomGrid.MouseMove) and @link(TKCustomGrid.ScrollTimerHandler). } + procedure DragMove(ACol, ARow: Integer; MousePt: TPoint); + { Calls @link(TKCustomGrid.OnDrawCell) event handler or cell class aware equivalent. + See the @link(TKGridDrawCellEvent) type for parameter interpretation. } + function DrawCell(ACol, ARow: Integer; ARect: TRect; + AState: TKGridDrawState): Boolean; virtual; + { Calls @link(TKCustomGrid.OnEditorCreate) event handler or cell class aware equivalent. + See the @link(TKGridEditorCreateEvent) type for parameter interpretation. } + function EditorCreate(ACol, ARow: Integer): TWinControl; virtual; + { Calls @link(TKCustomGrid.OnEditorDataFromGrid) event handler or cell class aware equivalent. + See the @link(TKGridEditorDataEvent) type for parameter interpretation. } + procedure EditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer); virtual; + { Calls @link(TKCustomGrid.OnEditorDataToGrid) event handler or cell class aware equivalent. + See the @link(TKGridEditorDataEvent) type for parameter interpretation. } + procedure EditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer); virtual; + { Calls @link(TKCustomGrid.OnEditorDestroy) event handler or cell class aware equivalent. + See the @link(TKGridEditorDestroyEvent) type for parameter interpretation. } + procedure EditorDestroy(var AEditor: TWinControl; ACol, ARow: Integer); virtual; + { Determines if the current inplace editor should be treated as transparent + control from the grid's point of view. @link(TKCustomGrid.EditorTransparency) + has higher priority than the default behavior implemented by this method. } + function EditorIsTransparent: Boolean; virtual; + { Calls @link(TKCustomGrid.OnEditorKeyPreview) event handler or cell class aware equivalent. + See the @link(TKGridEditorDataEvent) type for parameter interpretation. } + function EditorKeyPreview(AEditor: TWinControl; ACol, ARow: Integer; + var Key: Word; Shift: TShiftState): Boolean; virtual; + { Calls @link(TKCustomGrid.OnEditorResize) event handler or cell class aware equivalent. + See the @link(TKGridEditorResizeEvent) type for parameter interpretation. } + procedure EditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); virtual; + { Calls @link(TKCustomGrid.OnEditorSelect) event handler or cell class aware equivalent. + See the @link(TKGridEditorSelectEvent) type for parameter interpretation. } + procedure EditorSelect(AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); virtual; + { EditorWindowProc is the subclassed window procedure for inplace editor. } + procedure EditorWindowProc(var Msg: TLMessage); virtual; + { Calls @link(TKCustomGrid.OnEndColDrag) event handler or column class aware equivalent. + See the @link(TKGridEndDragEvent) type for parameter interpretation. } + function EndColDrag(Origin, Destination: Integer; + const MousePt: TPoint): Boolean; virtual; + { Calls @link(TKCustomGrid.OnEndColSizing) event handler. + See the @link(TKGridEndSizingEvent) type for parameter interpretation. } + function EndColSizing(var Index, Pos: Integer): Boolean; virtual; + { Calls @link(TKCustomGrid.OnEndRowDrag) event handler or row class aware equivalent. + See the @link(TKGridEndDragEvent) type for parameter interpretation. } + function EndRowDrag(Origin, Destination: Integer; + const MousePt: TPoint): Boolean; virtual; + { Calls @link(TKCustomGrid.OnEndRowSizing) event handler. + See the @link(TKGridEndSizingEvent) type for parameter interpretation. } + function EndRowSizing(var Index, Pos: Integer): Boolean; virtual; + { Destroys all column, row and cell instances. } + procedure FreeData; + { Returns information structure for column or row axis. Some fields of the + Info structure must be already defined before calling this function. + See @link(TKGridAxisInfo) for details. } + procedure GetAxisInfo(var Info: TKGridAxisInfo); virtual; + { Returns bounding rectangle where dragged column or row should appear. } + function GetDragRect(Info: TKGridAxisInfoBoth; out DragRect: TRect): Boolean; virtual; + { Returns the combination of invisible cells that must be taken into account + for the state indicated by GridState. } + function GridStateToInvisibleCells: TKGridInvisibleCells; + { Determines if the grid can have a horizontal scrollbar. } + function HasHorzScrollBar: Boolean; virtual; + { Determines if the grid can have a vertical scrollbar. } + function HasVertScrollBar: Boolean; virtual; + { Used internally to physically exchange two distinct columns. } + procedure InternalExchangeCols(Index1, Index2: Integer); virtual; + { Used internally to physically exchange two distinct rows. } + procedure InternalExchangeRows(Index1, Index2: Integer); virtual; + { Used internally to check if the given grid rectangle contains any merged cell areas + and if so, then expand it so that the result encloses all respective merged cells. } + function InternalExpandGridRect(const GridRect: TKGridRect): TKGridRect; virtual; + { Retrieves the base cell if the cell given by ACol and ARow belongs to a merged cell + or returns ACol and ARow if it is a non-merged cell. } + procedure InternalFindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); virtual; + { Used internally to reverse the order of previously sorted rows or columns + in a fast manner, without cell comparisons. } + procedure InternalFlip(Left, Right: Integer; Exchange: TKGridExchangeProc); virtual; + { Used internally. Returns a cell instance for the cell identified by ACol and ARow. If the + cell instance is nil, creates a new instance for the cell using + @link(TKCustomGrid.CellClass). } + function InternalGetCell(ACol, ARow: Integer): TKGridCell; virtual; + { Returns the column span and row span for given cell. Does not perform cell validity check. } + function InternalGetCellSpan(ACol, ARow: Integer): TKGridCellSpan; virtual; + { Returns the column width. Does not perform column validity check. } + function InternalGetColWidths(Index: Integer): Integer; virtual; + { Returns the effective column spacing. Does not perform column validity check. } + function InternalGetEffectiveColSpacing(ACol: Integer): Integer; virtual; + { Returns the effective row spacing. Does not perform row validity check. } + function InternalGetEffectiveRowSpacing(ARow: Integer): Integer; virtual; + { Returns width and spacing for several cells according to given parameters. } + procedure InternalGetHExtent(AIndex, AColSpan: Integer; + out DestExtent, DestSpacing: Integer); virtual; + { Returns the maximum column width. Does not perform column validity check. } + function InternalGetMaxColWidth(Index: Integer): Integer; virtual; + { Returns the maximum row height. Does not perform row validity check. } + function InternalGetMaxRowHeight(Index: Integer): Integer; virtual; + { Returns the minimum column width. Does not perform column validity check. } + function InternalGetMinColWidth(Index: Integer): Integer; virtual; + { Returns the minimum row height. Does not perform row validity check. } + function InternalGetMinRowHeight(Index: Integer): Integer; virtual; + { Returns the row height. Does not perform row validity check. } + function InternalGetRowHeights(Index: Integer): Integer; virtual; + { Returns always True. } + function InternalGetSelAvail: Boolean; override; + { Returns height and spacing for several cells according to given parameters. } + procedure InternalGetVExtent(AIndex, ARowSpan: Integer; + out DestExtent, DestSpacing: Integer); virtual; + { Used internally by e.g. @link(TKCustomGrid.InsertSortedRow) to insert + a new row/column into previously sorted rows/column in a fast manner, + using a binary tree search. } + function InternalInsertNR(ByIndex, Left, Right: Integer; + SortedUp: Boolean; Compare: TKGridCompareProc): Integer; virtual; + { Used internally by @link(TKCustomGrid.KeyDown) or other methods. + Modifies ACol and ARow according to Command. } + function InternalMove(var ACol, ARow: Integer; Command: TKGridMoveCommand; + Wrap, Expanding: Boolean): Boolean; virtual; + { Used internally by @link(TKCustomGrid.UpdateSortMode) to place a modified + cell into a correct location in a sorted row or column. This is performed + in a fast manner using a binary tree search. } + function InternalInsertIfCellModifiedNR(ByIndex, Index, Left, + Right: Integer; SortedUp: Boolean; Compare: TKGridCompareProc): Integer; + { Paints a cell identified by ACol and ARow. The cell will be painted to + ACanvas according to the draw state specified by AState into a position + specified by ARect. If ADoubleBufferedCells is True, ACanvas must be + a memory device context. PaintCell ensures the correct memory bitmap for + cell double buffering will be selected to this device context. } + procedure InternalPaintCell(ACol, ARow: Integer; AState: TKGridDrawState; + const ARect, ABlockRect: TRect; ACanvas: TCanvas; Clip, Printing: Boolean); virtual; + { Used internally by e.g. @link(TKCustomGrid.SortRows) to sort rows or columns + using a non recursive quick sort algorithm. } + procedure InternalQuickSortNR(ByIndex, Left, Right: Integer; + SortedDown: Boolean; Compare: TKGridCompareProc; Exchange: TKGridExchangeProc); virtual; + { Used internally to assign new cell value. } + procedure InternalSetCell(ACol, ARow: Integer; Value: TKGridCell); virtual; + { Used internally to assign new text to a cell. } + procedure InternalSetCells(ACol, ARow: Integer; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); virtual; + { Sets the cell span paramters according to given parameters. Automatically + splits any existing overlapping areas. Returns a grid rectangle that can + be used to update all affected cells. } + function InternalSetCellSpan(ACol, ARow: Integer; + const Value: TKGridCellSpan): TKGridRect; virtual; + { Used internally to set column count. } + procedure InternalSetColCount(Value: Integer); virtual; + { Used internally to set fixed column count. } + procedure InternalSetFixedCols(Value: Integer); virtual; + { Used internally to set fixed row count. } + procedure InternalSetFixedRows(Value: Integer); virtual; + { Used internally to set row count. } + procedure InternalSetRowCount(Value: Integer); virtual; + { Allows the descendant to decide whether the goVirtualGrid option can be modified. } + function InternalUpdateVirtualGrid: Boolean; virtual; + { Allows the changes to be reflected. } + procedure InternalUnlockUpdate; override; + { Determines if control can be painted with OS themes. } + function IsThemed: Boolean; override; + { Overriden method - see Delphi help. Responds to keyboard events. Implements + TCustomGrid specific behavior when the user presses a key. } + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { Overriden method - performs late update. } + procedure LateUpdate(var Msg: TLMessage); override; + { Overriden method - see Delphi help. Updates grid colors. } + procedure Loaded; override; + { Calls @link(TKCustomGrid.OnMeasureCell) event handler or cell class aware equivalent. + See the @link(TKGridMeasureCellEvent) type for parameter interpretation. } + function MeasureCell(ACol, ARow: Integer; const ARect: TRect; + AState: TKGridDrawState; Priority: TKGridMeasureCellPriority): TPoint; virtual; + { Measures the grid and updates information about printed shape. } + procedure MeasurePages(var Info: TKPrintMeasureInfo); override; + { Calls @link(TKCustomGrid.OnMouseCellHint) event handler. + See the @link(TKGridCellEvent) type for parameter interpretation. } + procedure MouseCellHint(ACol, ARow: Integer; AShow: Boolean); virtual; + { Calls @link(TKCustomGrid.OnMouseClickCell) event handler. + See the @link(TKGridCellEvent) type for parameter interpretation. } + procedure MouseClickCell(ACol, ARow: Integer); virtual; + { Calls @link(TKCustomGrid.OnMouseDblClickCell) event handler. + See the @link(TKGridCellEvent) type for parameter interpretation. } + procedure MouseDblClickCell(ACol, ARow: Integer); virtual; + { Overriden method - see Delphi help. Responds to mouse events. Implements + TCustomGrid specific behavior when the user presses a mouse button. } + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + { Calls @link(TKCustomGrid.OnMouseEnterCell) event handler. + See the @link(TKGridCellEvent) type for parameter interpretation. } + procedure MouseEnterCell(ACol, ARow: Integer); virtual; + { Overriden method. Responds to WM_MOUSELEAVE message. } + procedure MouseFormLeave; override; + { Calls @link(TKCustomGrid.OnMouseLeaveCell) event handler. + See the @link(TKGridCellEvent) type for parameter interpretation. } + procedure MouseLeaveCell(ACol, ARow: Integer); virtual; + { Overriden method - see Delphi help. Responds to mouse events. Implements + TCustomGrid specific behavior when the user moves the mouse cursor. } + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + { Implements default behavior to visually indicate that the mouse cursor + enters or leaves the cell if goMouseOverCells is included in @link(TKCustomGrid.Options). } + procedure MouseOverCells; virtual; + { Overriden method - see Delphi help. Responds to mouse events. Implements + TCustomGrid specific behavior when the user releases a mouse button. } + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + { Returns the amount of rows in current page, minimum is 1. } + function PageHeight: Integer; virtual; + { Returns the amount of columns in current page, minimum is 1. } + function PageWidth: Integer; virtual; + { Paints a range of cells. } + function PaintCells(ACanvas: TCanvas; CellBitmap: TBitmap; + MainClipRgn: HRGN; FirstCol, LastCol, FirstRow, LastRow, X, Y, MaxX, + MaxY: Integer; Printing, PaintSelection: Boolean; const ABlockRect: TRect): TPoint; + { Paints the suggestion for drop target when dragging a column or row. } + procedure PaintDragSuggestion(ACanvas: TCanvas); virtual; + { Paints a header terminating rectangle to align the header with the right + client area edge. } + procedure PaintHeaderAlignment(ACanvas: TCanvas; ARect: TRect); virtual; + { Paints a page to a printer/preview canvas. } + procedure PaintPage; override; + { Paints the suggestion for new width/height of a column/row being resized. } + procedure PaintSizingSuggestion(ACanvas: TCanvas); virtual; + { Determines which cell lies at client coordinates specified by Point. + Set OutSide to True to evaluate a cell that does not actually lie at Point + but is the closest. Such a cell always lies at the boundary of scrollable + cell area. This is used for scrolling by mouse. InvisibleCells specifies + if some invisible cells should be considered in some cases. Currently, this + is used for scrolling by mouse, either. This function returns True if the + corresponding cell has been found. In this case, ACol and ARow contain + column and row indexes of the returned cell. } + function PointToCell(Point: TPoint; OutSide: Boolean; InvisibleCells: TKGridInvisibleCells; + out HitCol, HitRow, SelCol, SelRow: Integer): Boolean; virtual; + { Determines the possible column or row sizing state along with default sizing + parameters for client coordinates specified by Point. The possible sizing + state is returned in State and sizing parameters in Index and Pos. This + function returns True if Point is in an area where sizing of a column or + row can begin. } + function PointToSizing(Point: TPoint; var State: TKGridState; + var Index, Pos: Integer): Boolean; virtual; + { Updates drag object's (layered) window used to visually indicate the dragged + column or row. This window is updated according to mouse cursor coordinates + in MousePt, column or row index specified by Index. The Hide parameter forces + the window to hide and thus visually indicate that column or row dragging has ended. } + procedure ProcessDragWindow(const PtIni, PtCur: TPoint; Index: Integer; ColDrag, Hide: Boolean); virtual; + { Resets the @link(TKCustomGrid.LeftCol) and @link(TKCustomGrid.TopRow) property + after the @link(TKCustomGrid.FixedCols) or @link(TKCustomGrid.FixedRows) + properties have changed. } + procedure ResetTopLeft; virtual; + { Calls @link(TKCustomGrid.OnRowMoved) event handler. + See the @link(TKGridMovedEvent) type for parameter interpretation. } + procedure RowMoved(FromIndex, ToIndex: Integer); virtual; + { Calls @link(TKCustomGrid.OnRowHeightsChanged) event handler. } + procedure RowHeightsChanged(ARow: Integer); virtual; + { Tries to set input focus to the grid if @link(TKCustomGrid.EditorMode) + is False or to the inplace editor if EditorMode is True. } + procedure SafeSetFocus; virtual; + { Scrolls the scrollable cells either horizontally by DeltaHorz or vertically + by DeltaVert or in both directions. CodeHorz and CodeVert are the codes + coming from WM_HSCROLL or WM_VSCROLL messages. Set CallUpdateEditor to True + to call @link(TKCustomGrid.UpdateEditor) within this method to scroll + the inplace editor, either. Set CallUpdateEditor to False if you don't want + to scroll the inplace editor and update it by some other means, such as + @link(TKCustomgrid.SelectionMove). This method avoids inplace editor flickering + when scrolling with EditorMode = True. } + procedure Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; + CallUpdateEditor: Boolean); virtual; + { This method is called periodically from the timer used to automatically + scroll the scrollable cells while the mouse pointer is captured and + held outside the grid client area. } + procedure ScrollTimerHandler(Sender: TObject); virtual; + { Calls @link(TKCustomGrid.OnSelectCell) event handler or cell class aware equivalent + See the @link(TKGridSelectCellEvent) type for parameter interpretation. } + function SelectCell(ACol, ARow: Integer): Boolean; virtual; + procedure SelectionChanged(NewSelection: TKGridRect; + Flags: TKGridSelectionFlags); + { Calls @link(TKCustomGrid.OnSelectionExpand) event handler or cell class aware equivalent + See the @link(TKGridSelectionExpandEvent) type for parameter interpretation. } + function SelectionExpand(ACol, ARow: Integer): Boolean; virtual; + { Adjusts the grid rectangle identified by Sel and makes it valid. This method + is intended to adjust FSelection or a rectangle assumed to be assigned + to FSelection later. } + procedure SelectionFix(var Sel: TKGridRect); virtual; + { Initializes or expands the current selection and performs all necessary adjustments. + ACol and ARow are the indexes used to initialize or expand the selection. + Stage determines, if the selection should be initialized or expanded. + Flags forces various adjustments to be performed after the selection has been + initialized or expanded. Returns True if the selection could be changed or + would not be modified, either. } + function SelectionMove(ACol, ARow: Integer; Stage: TKGridSelectionStage; + Flags: TKGridSelectionFlags): Boolean; virtual; + { Assigns new selection and performs all necessary adjustments. } + function SelectionSet(const NewSelection: TKGridRect): Boolean; + {$IFDEF FPC} + { Overriden LCL method. This allows a custom mouse cursor to be assigned for the grid. } + procedure SetCursor(Value: TCursor); override; + {$ENDIF} + { Updates mouse cursor according to the grid state determined from current mouse + position. Returns True if cursor has been changed. } + function SetMouseCursor(X, Y: Integer): Boolean; override; + { Calls @link(TKCustomGrid.OnSizeChanged) event handler. + See the @link(TKGridSizeChangedEvent) type for parameter interpretation. } + procedure SizeChanged(Change: TKGridSizeChange; Index, Count: Integer); virtual; + { Forces the column/row dragging suggestion to be created, destroyed or + temporarilly hidden and shown, depending on the State parameter. } + procedure SuggestDrag(State: TKGridCaptureState); virtual; + { Forces the column/row sizing suggestion to be created, destroyed or + temporarilly hidden and shown, depending on the State parameter. } + procedure SuggestSizing(State: TKGridCaptureState); virtual; + { Calls @link(TKCustomGrid.OnTopLeftChanged) event handler. } + procedure TopLeftChanged; virtual; + { Updates the column axis if Horz is True and/or row axis if Vert is True. + Adjusts column widths/row heights if goAlignLastCol/goAlignLastRow + is included in @link(TKCustomGrid.Options). Adjusts scrolling range - + calls @link(TKCustomgrid.UpdateScrollRange). Invalidates columns/rows + as needed or starting by column/row index given by FirstCol/FirstRow. + Specify @link(cAll) as FirstCol/FirstRow to invalidate all columns/rows. + Performs additional actions as specified by Flags. } + procedure UpdateAxes(Horz: Boolean; FirstCol: Integer; Vert: Boolean; + FirstRow: Integer; Flags: TKGridAxisUpdateFlags); virtual; + { Updates/re-calculates the column/row span paramteres of all cells + if necessary. Fixes all broken or incomplete merged cell areas, e.g. upon + column or row moving or grid resizing. } + procedure UpdateCellSpan; virtual; + { Updates the grid size. } + procedure UpdateSize; override; + { Updates the Delphi form designer if @link(TKCustomGrid.ColWidths) or + @link(TKCustomGrid.RowHeights) have been changed. } + procedure UpdateDesigner; virtual; + { Updates the inplace editor state. Set Show to True to create and display + the inplace editor. Set Show to False to hide and destroy the inplace editor. } + procedure UpdateEditor(Show: Boolean); virtual; + { Updates the scrolling range of the column axis if Horz is True and/or row + axis if Vert is True. Set UpdateNeeded to True to force the invalidation + of respective grid areas. Set UpdateNeeded to False to let UpdateScrollRange + decide whether these need to be invalidated. } + procedure UpdateScrollRange(Horz, Vert, UpdateNeeded: Boolean); virtual; + {$IFNDEF FPC} + { Inherited method. Used to ensure correct painting for transparent inplace + editors. } + procedure WndProc(var Msg: TMessage); override; + {$ENDIF} + public + { Creates the instance. Assigns default values to properties, allocates + default column, row and cell data. } + constructor Create(AOwner: TComponent); override; + { Destroys the instance along with all allocated column, row and cell data. } + destructor Destroy; override; + { Resizes the column automatically so that the cell contents fit horizontally. + Does include merged cell areas with their base cells located in this column. + Set FixedCells to True to include fixed cells into autosizing. } + procedure AutoSizeCol(ACol: Integer; FixedCells: Boolean = True); + { Resizes the entire grid automatically so that the cell contents fit both + horizontally and vertically. Set FixedCells to True to include fixed cells + into autosizing. } + procedure AutoSizeGrid(Priority: TKGridMeasureCellPriority; FixedCells: Boolean = True); + { Resizes the row automatically so that the cell contents fit vertically. + Does include merged cell areas with their base cells located in this row. + Set FixedCells to True to include fixed cells into autosizing. } + procedure AutoSizeRow(ARow: Integer; FixedCells: Boolean = True); + { Determines if a cell specified by ACol and ARow is selected. } + function CellSelected(ACol, ARow: Integer): Boolean; virtual; + { Returns the bounding rectangle of a cell specified by ACol and ARow without the + column and row spacing areas defined by @link(TKCustomGrid.GridLineWidth). + The function returns False if the cell indexes are invalid. } + function CellRect(ACol, ARow: Integer; out R: TRect; VisibleOnly: Boolean = False): Boolean; + { Returns the left and top coordinates of a cell specified by ACol and ARow. + The function returns False if the cell indexes are invalid. } + function CellToPoint(ACol, ARow: Integer; var Point: TPoint; + VisibleOnly: Boolean = False): Boolean; virtual; + { Determines if a cell specified by ACol and ARow is visible. } + function CellVisible(ACol, ARow: Integer): Boolean; virtual; + { Clears all cells in a column identified by ACol. } + procedure ClearCol(ACol: Integer); virtual; + { Clears all cells. } + procedure ClearGrid; virtual; + { Clears all cells in a row identified by ARow. } + procedure ClearRow(ARow: Integer); virtual; + { Clears sorting mode of both rows and columns if grid sorting mode is not locked + by @link(TKCustomGrid.LockSortMode). } + procedure ClearSortMode; + { Clears sorting mode of rows if grid sorting mode is not locked + by @link(TKCustomGrid.LockSortMode). Ensures that every column has it's + @link(TKGridAxisItem.SortMode) equal to smNone. } + procedure ClearSortModeHorz; virtual; + { Clears sorting mode of columns if grid sorting mode is not locked + by @link(TKCustomGrid.LockSortMode). Ensures that every row has it's + @link(TKGridAxisItem.SortMode) equal to smNone. } + procedure ClearSortModeVert; virtual; + { Determines if a column specified by ACol can be selected, + i.e. lies in non-fixed area. } + function ColSelectable(ACol: Integer): Boolean; virtual; + { Determines if current selection includes a column specified by ACol. } + function ColSelected(ACol: Integer): Boolean; virtual; + { Determines if a column specified by ACol is valid column. } + function ColValid(ACol: Integer): Boolean; virtual; + { Decides whether a key stroke should be handled by inplace editor identified by + AEditor or by the grid. AEditor must be a descendant of + TCustomComboBox. See @link(TKGridEditorKeyPreviewEvent) for interpretation of + another parameters. } + procedure DefaultComboKeyPreview(AEditor: TComboBox; ACol, ARow: Integer; + var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); virtual; + { This function allows you to correctly set the caret position within + inplace editor identified by AEditor. AEditor must be a descendant of TCustomComboBox. + See @link(TKGridEditorSelectEvent) for interpretation of another parameters. } + procedure DefaultComboSelect(AEditor: TComboBox; SelectAll, CaretToLeft: Boolean); virtual; + { Provides default behavior while comparing two cells identified by + ACell1 and ACell2. Under current implementation, only text strings will be + compared if if any of the cells inherits @link(TKGridTextCell). } + function DefaultCompareCells(ACell1, ACell2: TKGridCell): Integer; virtual; + { Decides whether a key stroke should be handled by inplace editor identified by + AEditor or by the grid. AEditor must be a descendant of + TCustomEdit. See @link(TKGridEditorKeyPreviewEvent) for interpretation of + another parameters. } + procedure DefaultEditKeyPreview(AEditor: TCustomEdit; ACol, ARow: Integer; + var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); virtual; + { Provides default behavior for the @link(OnEditorCreate) event. } + procedure DefaultEditorCreate(ACol, ARow: Integer; + var AEditor: TWinControl); virtual; + { Provides default behavior for the @link(OnEditorDataFromGrid) event. } + procedure DefaultEditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); virtual; + { Provides default behavior for the @link(OnEditorDataToGrid) event. } + procedure DefaultEditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); virtual; + { Provides default behavior for the @link(OnEditorCreate) event. } + procedure DefaultEditorDestroy(AEditor: TWinControl; ACol, ARow: Integer); virtual; + { Decides whether a key stroke should be handled by inplace editor identified by + AEditor or by the grid. Calls all implemented DefaultxxKeyPreview methods + or nothing if no ancestor is found for given AEditor. + See @link(TKGridEditorKeyPreviewEvent) for interpretation of another parameters. } + procedure DefaultEditorKeyPreview(AEditor: TWinControl; ACol, ARow: Integer; + var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); virtual; + { Provides default behavior for the @link(OnEditorResize) event. } + procedure DefaultEditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); virtual; + { This function allows you to correctly set the caret position within + inplace editor identified by AEditor. Calls all implemented DefaultxxSelect methods + or nothing if no ancestor is found for given AEditor. + See @link(TKGridEditorSelectEvent) for interpretation of another parameters. } + procedure DefaultEditorSelect(AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); virtual; + { This function allows you to correctly set the caret position within + inplace editor identified by AEditor. AEditor must be a descendant of TCustomEdit. + See @link(TKGridEditorSelectEvent) for interpretation of another parameters. } + procedure DefaultEditSelect(AEditor: TCustomEdit; SelectAll, CaretToLeft: Boolean); virtual; + { Provides default cell hint behavior. } + procedure DefaultMouseCellHint(ACol, ARow: Integer; AShow: Boolean); virtual; + { Decides whether a key stroke should be handled by inplace editor identified by + AEditor or by the grid. AEditor must be a descendant of + TScrollBar. See @link(TKGridEditorKeyPreviewEvent) for interpretation of + another parameters. } + procedure DefaultScrollBarKeyPreview(AEditor: TScrollBar; ACol, ARow: Integer; + var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); + { Deletes a column specified by At. At must be valid column index and + @link(TKCustomGrid.ColCount) must be > 1. Otherwise, nothing happens. } + procedure DeleteCol(At: Integer); virtual; + { Deletes Count columns starting at index At. At must be valid column index + and @link(TKCustomGrid.ColCount) must be > 1. Otherwise, nothing happens. + Count will be adapted so that no more but available columns will be deleted. } + procedure DeleteCols(At, Count: Integer); virtual; + { Deletes a row specified by At. At must be valid row index and + @link(TKCustomGrid.RowCount) must be > 1. Otherwise, nothing happens. } + procedure DeleteRow(At: Integer); virtual; + { Deletes Count rows starting at index At. At must be valid row index + and @link(TKCustomGrid.RowCount) must be > 1. Otherwise, nothing happens. + Count will be adapted so that no more but available rows will be deleted. } + procedure DeleteRows(At, Count: Integer); virtual; + { Retrieves the base cell if the cell given by ACol and ARow belongs to a merged cell + or returns ACol and ARow if it is a non-merged cell. } + procedure FindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); virtual; + { Selects a cell specified by ACol and ARow. If the grid has input focus, + this cell becomes it automatically. } + procedure FocusCell(ACol, ARow: Integer); + { Returns miscellaneous information about both grid axes, i.e. column axis and row axis. } + function GetAxisInfoBoth(Mask: TKGridAxisInfoMask): TKGridAxisInfoBoth; + { Returns miscellaneous information about column axis. } + function GetAxisInfoHorz(Mask: TKGridAxisInfoMask): TKGridAxisInfo; virtual; + { Returns miscellaneous information about row axis. } + function GetAxisInfoVert(Mask: TKGridAxisInfoMask): TKGridAxisInfo; virtual; + { Returns default draw state for a cell identified by ACol and ARow. + Called by Paint - override to implement specific behavior. } + function GetDrawState(ACol, ARow: Integer; AFocused: Boolean): TKGridDrawState; virtual; + { Determines if the entire grid rectangle lies within the non-fixed and thus + selectable area. } + function GridRectSelectable(const GridRect: TKGridRect): Boolean; virtual; + { Converts a grid rectangle into client coordinates. Set VisibleOnly to True + to take only the visible part of the rectangle. Indexes in GridRect will be + automatically trimmed either to non-fixed area or to a fixed area depending + on top-left cell specified in GridRect. Set Merged to True to expand the grid + rectangle by possible merged cell areas. The returned coordinates include + column and row spacing areas defined by @link(TKCustomGrid.GridLineWidth). } + function GridRectToRect(GridRect: TKGridRect; var R: TRect; + VisibleOnly: Boolean = False; Merged: Boolean = True): Boolean; virtual; + { Determines if all indexes in GridRect are valid column or row indexes. } + function GridRectValid(const GridRect: TKGridRect): Boolean; virtual; + { Forces the cell hint to hide. } + procedure HideCellHint; + { Determines the initial index of a column identified by ACol. This function + is a part of index mapping mechanism. Initial index is assigned to a column + immediately after it is inserted into the grid either by changing + @link(TKCustomGrid.ColCount) or @link(TKCustomGrid.InsertCols). } + function InitialCol(ACol: Integer): Integer; virtual; + { Determines the current column index from initial column position given by ACol. + This function is a part of index mapping mechanism. } + function InitialColInv(ACol: Integer): Integer; virtual; + { Determines the initial index of a row identified by ARow. This function + is a part of index mapping mechanism. Initial index is assigned to a row + immediately after it is inserted into the grid either by changing + @link(TKCustomGrid.RowCount) or @link(TKCustomGrid.InsertRows). } + function InitialRow(ARow: Integer): Integer; virtual; + { Determines the current row index from initial row position given by ARow. + This function is a part of index mapping mechanism. } + function InitialRowInv(ARow: Integer): Integer; virtual; + { Inserts a new column into the grid. The new column will be inserted before + the column identified by At. You can set this parameter greater or equal + @link(TKCustomGrid.ColCount) to insert a new column behind the last column. } + procedure InsertCol(At: Integer); virtual; + { Inserts multiple new columns into the grid. The new columns will be inserted + before the column identified by At. You can set this parameter greater or equal + @link(TKCustomGrid.ColCount) to insert these after the last column. } + procedure InsertCols(At, Count: Integer); virtual; + { Inserts a new row into the grid. The new row will be inserted before + the row identified by At. You can set this parameter greater or equal + @link(TKCustomGrid.RowCount) to insert a new row behind the last row. } + procedure InsertRow(At: Integer); virtual; + { Inserts multiple new rows into the grid. The new rows will be inserted + before the row identified by At. You can set this parameter greater or equal + @link(TKCustomGrid.RowCount) to insert these after the last row. } + procedure InsertRows(At, Count: Integer); virtual; + { Inserts an empty column at the corresponding position. If columns are not sorted + at this point, InsertSortedCol does nothing and returns False. During + InsertSortedCol, a non recursive binary tree search is performed and + the @link(TKCustomGrid.OnCompareCells) event handler is called several times + with slightly different parameters than e.g. during @link(TKCustomGrid.SortCols), + i.e. the ACol1 is always @link(cInvalidIndex). You can detect it to perform + custom comparisons with the new value. } + function InsertSortedCol(out ByRow, ACol: Integer): Boolean; virtual; + { Inserts an empty row at the corresponding position. If rows are not sorted + at this point, InsertSortedRow does nothing and returns False. During + InsertSortedRow, a non recursive binary tree search is performed and + the @link(TKCustomGrid.OnCompareCells) event handler is called several times + with slightly different parameters than e.g. during @link(TKCustomGrid.SortRows), + i.e. the ARow1 is always @link(cInvalidIndex). You can detect it to perform + custom comparisons with the new value. } + function InsertSortedRow(out ByCol, ARow: Integer): Boolean; virtual; + { Invalidates the cell specified by ACol and ARow if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateCell(ACol, ARow: Integer); + { Invalidates the entire column specified by ACol if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateCol(ACol: Integer); virtual; + { Invalidates all columns starting with FirstCol if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateCols(FirstCol: Integer); virtual; + { Invalidates the current selection including the fixed cells in + @link(goIndicateSelection) mode if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateCurrentSelection; virtual; + { Invalidates the grid rectangle specified by GridRect if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateGridRect(const GR: TKGridRect; Merged: Boolean = True); virtual; + { Invalidates the entire row specified by ARow if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateRow(ARow: Integer); virtual; + { Invalidates all rows starting with FirstRow if grid updating is not locked + by @link(TKCustomControl.LockUpdate). } + procedure InvalidateRows(FirstRow: Integer); virtual; + { Invalidates any custom grid rectangle that should be treated as grid selection, + including the fixed cells in @link(goIndicateSelection) mode, + if grid updating is not locked by @link(TKCustomControl.LockUpdate). } + procedure InvalidateSelection(ASelection: TKGridRect); virtual; + { Returns True either if the DoubleBuffered property is True + or if @link(goDoubleBufferedCells) is included in grid's @link(TKCustomGrid.Options).} + function IsDoubleBuffered: Boolean; virtual; + { Locks sort mode updating so that all changes made to the cell data + will not affect the current sort status of any column or row. Every LockSortMode + call must have a corresponding @link(TKCustomGrid.UnlockSortMode) call, please use a + try-finally section. } + procedure LockSortMode; virtual; + { Determines the cell that contains client area coordinates X and Y. + If there is such a cell, the function returns True and corresponding cell + indexes are returned in ACol and ARow. Otherwise, the function returns False. } + function MouseToCell(X, Y: Integer; var ACol, ARow: Integer): Boolean; + { Moves a column from a position specified by FromIndex to a new + position specified by ToIndex. Both column indexes must be valid and + FromIndex must not equal to ToIndex. Otherwise, nothing happens. } + procedure MoveCol(FromIndex, ToIndex: Integer); virtual; + { Moves a row from a position specified by FromIndex to a new + position specified by ToIndex. Both row indexes must be valid and + FromIndex must not equal to ToIndex. Otherwise, nothing happens. } + procedure MoveRow(FromIndex, ToIndex: Integer); virtual; + { Forces to move the input focus to the next cell according to + @link(TKCustomGrid.MoveDirection) and calls OnClick event if that succeeds. } + procedure MoveToNextCell; virtual; + { Paints a cell identified by ACol and ARow to ACanvas. + This is faster way than InvalidateCell but won't work under Qt. + Set ACanvas to nil to paint to grid's Canvas. Otherwise, set AX and AY + to specify painting origin on custom ACanvas. } + procedure PaintCell(ACanvas: TCanvas; ACol, ARow: Integer; + AX: Integer = 0; AY: Integer = 0; APrinting: Boolean = False; + ABlockRect: PRect = nil); virtual; + { Paints the control to the specified canvas. } + procedure PaintToCanvas(ACanvas: TCanvas); override; + { Forces the cell class specified by @link(TKCustomGrid.CellClass) to replace + all other cell classes that do not inherit from it. Call this method to + ensure that all the cells in the grid contain instances of CellClass or those + inherited from CellClass. All possible cell class properties are copied by + the @link(TKGridCell.Assign) method. } + procedure RealizeCellClass; + { Forces the column class specified by @link(TKCustomGrid.ColClass) to replace + all other column classes that do not inherit from it. Call this method to + ensure that the entire horizontal grid axis contains instances of ColClass + or those inherited from ColClass. All possible column class properties are + copied by the @link(TKGridAxisItem.Assign) method. } + procedure RealizeColClass; + { Forces the row class specified by @link(TKCustomGrid.RowClass) to replace + all other row classes that do not inherit from it. Call this method to + ensure that the entire vertical grid axis contains instances of RowClass + or those inherited from RowClass. All possible row class properties are + copied by the @link(TKGridAxisItem.Assign) method. } + procedure RealizeRowClass; + { Determines if a row specified by ARow can be selected, + i.e. lies in non-fixed area. } + function RowSelectable(ARow: Integer): Boolean; virtual; + { Determines if current selection includes a row specified by ARow. } + function RowSelected(ARow: Integer): Boolean; virtual; + { Determines if a row specified by ARow is valid row. } + function RowValid(ARow: Integer): Boolean; virtual; + { Scrolls the non-fixed cells horizontally by AColCount cells or vertically + by ARowCount cells. If the cells cannot be scrolled, nothing happens. } + procedure ScrollBy(AColCount, ARowCount: Integer); + { Retrieves the amount of pixels corresponding to the amount of cells + specified by ADelta, relative from @link(TKCustomGrid.LeftCol) and + @link(TKCustomGrid.TopRow). } + function ScrollDeltaFromDelta(const Info: TKGridAxisInfo; ADelta: Integer): Integer; virtual; + { Determines if a cell specified by ACol and ARow should be scrolled, i.e. is + not fully visible. } + function ScrollNeeded(ACol, ARow: Integer; out DeltaHorz, DeltaVert: Integer): Boolean; virtual; + { Selects all cells. } + procedure SelectAll; + { Selects a column. } + procedure SelectCol(ACol: Integer); + { Select more columns. } + procedure SelectCols(FirstCol, Count: Integer); + { Normalize current selection. } + procedure SelectionNormalize; + { Selects a row. } + procedure SelectRow(ARow: Integer); + { Selects more rows. } + procedure SelectRows(FirstRow, Count: Integer); + { Forces the cell hint to show on screen. } + procedure ShowCellHint; + { Sorts columns by values of a row if grid sorting mode is not locked + by @link(TKCustomGrid.LockSortMode). } + procedure SortCols(ByRow: Integer; SortMode: TKGridSortMode); virtual; + { Returns True if sort mode updating is not locked, i.e. there is no open + LockSortMode and UnlockSortMode pair. } + function SortModeUnlocked: Boolean; virtual; + { Sorts rows by values of a column if grid sorting mode is not locked + by @link(TKCustomGrid.LockSortMode). } + procedure SortRows(ByCol: Integer; SortMode: TKGridSortMode); virtual; + { Unlocks sort mode updating so that all changes made to the cell data + will clear the current sort status of any column or row. } + procedure UnlockSortMode; virtual; + { Unselects range of cells. } + procedure UnselectRange; + { Updates column and row sorting mode (if there is one) if data has been + modified in a single cell. Must be called explicitly each time a cell data + has been modified if sorting interface is used. } + procedure UpdateSortMode(ACol, ARow: Integer); virtual; + { Provides fast read only access to the cell array @link(TKCustomGrid.FCells). + Any cell can be directly accessed through ArrayOfCells[RowIndex, ColIndex]. + In contrast with the @link(TKCustomGrid.Cell) property, row index + comes BEFORE column index here. It has been designed to speed up operations + with rows because most grids usually contain much more rows than colums. } + property ArrayOfCells: TKGridCells read FCells; + { Provides fast read only access to column array @link(TKCustomGrid.FCols). } + property ArrayOfCols: TKGridAxisItems read FCols; + { Provides fast read only access to row array @link(TKCustomGrid.FRows). } + property ArrayOfRows: TKGridAxisItems read FRows; + {$IFDEF FPC} + { Specifies the same as Ctl3D in Delphi. } + property Flat: Boolean read FFlat write SetFlat default False; + {$ENDIF} + { Determines if all cells are selected. } + property AllCellsSelected: Boolean read GetAllCellsSelected; + { Determines if all columns are selected. } + property AllRowsSelected: Boolean read GetAllRowsSelected; + { Determines if all columns are selected. } + property AllColsSelected: Boolean read GetAllColsSelected; + { Inherited property - see Delphi help. } + property Canvas; + { Gains access to the cell instances. New cell instances are always created + on demand by utilizing @link(TKCustomGrid.CellClass). To replace all other + cell instances with CellClass, call @link(TKCustomGrid.RealizeCellClass). } + property Cell[ACol, ARow: Integer]: TKGridCell read GetCell write SetCell; + { Cell class used to create new cell instances. Cell instances are always + created on demand. } + property CellClass: TKGridCellClass read FCellClass write FCellClass; + { Gains access to the active cell painter. } + property CellPainter: TKGridCellPainter read FCellPainter; + { Specifies the cell painter class used to create new @link(TKCustomGrid.CellPainter). + The new cell painter instance will be created immediately. } + property CellPainterClass: TKGridCellPainterClass read FCellPainterClass write SetCellPainterClass; + { Gains simplified access to the probably most used property of an textual + cell instance. If the cell instance at the position specified by ACol and ARow + does not inherit from a textual cell class @link(TKGridTextCell), it will be + created for this cell regardless of the current CellClass assignment. } + property Cells[ACol, ARow: Integer]: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF} read GetCells write SetCells; + { Specifies the column span and row span for given cell. Always specify positive + values. Reading this property may return zero or negative values, which + are used internally to find base cell of the respective merged area. } + property CellSpan[ACol, ARow: Integer]: TKGridCellSpan read GetCellSpan write SetCellSpan; + { Gains access to selection base cell. Setting Col discards the current selection + and moves focus to a new base cell in the current row that is in the new column. + The first column has an index of 0, the second column an index of 1, and so on. + If the index denotes a column that is not selectable, nothing happens. } + property Col: Integer read FSelection.Col1 write SetCol; + { Column class used to create new column instances. Column instances are always + created when @link(TKCustomGrid.ColCount) grows. } + property ColClass: TKGridColClass read FColClass write FColClass; + { Specifies the number of columns in the grid. Set ColCount to add or delete + columns at the righthand side of the grid. The value of ColCount includes + any fixed columns at the left of the grid as well as the scrollable columns + in the body of the grid. } + property ColCount: Integer read FColCount write SetColCount default cColCountDef; + { Inherited property - see Delphi help. Specifies the default background color + for client area erasing and for parts of client area not occupied by cells. } + property Color default clWindow; + { Specifies all colors used by TKCustomGrid's default painting. } + property Colors: TKGridColors read FColors write SetColors; + { Gains access to the column instances. Column instances are always + created by utilizing @link(TKCustomGrid.ColClass) when @link(TKCustomGrid.ColCount) + grows. To replace all other column instances with ColClass, call + @link(TKCustomGrid.RealizeColClass). } + property Cols[Index: Integer]: TKGridCol read GetCols; + { Indicates the width (in pixels) of all the columns in the grid. Set ColWidths + at runtime to change the width of an individual column. If the width of + a column has not been set explicitly by resizing with the mouse, or by using + the ColWidths property, its width is @link(TKCustomGrid.DefaultColWidth). } + property ColWidths[Index: Integer]: Integer read GetColWidths write SetColWidths; + { Determines the width (in pixels) of all columns that have not been explicitly + resized. Set DefaultColWidth to change the size of all columns in the grid. + When DefaultColWidth is set, columns that have been resized using the mouse + or by setting the @link(TKCustomGrid.ColWidths) property are given the DefaultColWidth + as well. When new columns are added to the grid, they are created with + a width of DefaultColWidth. } + property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default cDefaultColWidthDef; + { Dummy property - introduced for backward compatibility with TCustomGrid. } + property DefaultDrawing: Boolean read GetDefaultDrawing write SetDefaultDrawing default False; + { Determines the height (in pixels) of all rows that have not been explicitly + resized. Set DefaultRowHeight to change the size of all rows in the grid. + When DefaultRowHeight is set, rows that have been resized using the mouse + or by setting the @link(TKCustomGrid.RowHeights) property are given the DefaultRowHeight + as well. When new rows are added to the grid, they are created with + a height of DefaultRowHeight. } + property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default cDefaultRowHeightDef; + { Specifies the style how the control is drawn while not enabled. } + property DisabledDrawStyle: TKGridDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cDisabledDrawStyleDef; + { Specifies how a column or row appears while being moved by mouse. } + property DragStyle: TKGridDragStyle read FDragStyle write SetDragStyle default cDragStyleDef; + { Returns reference to current inplace editor instance. } + property Editor: TWinControl read FEditor; + { Determines if inplace editor is active. Set EditorMode to true, at runtime, + to put the grid in edit mode. When EditorMode is true, the user can edit cells + in the grid. When the user presses F2, EditorMode is set to true. When the + user presses Enter, the value of EditorMode is toggled or, depending on + @link(goEnterMoves) and @link(TKCustomGrid.MoveDirection) configuration, + another cell is focused. Inplace editor can be activated only if goEditing + is included in @link(TKCustomGrid.Options). } + property EditorMode: Boolean read GetEditorMode write SetEditorMode; + { Determines if current inplace editor should be treated as a transparent + control from the grid's point of view. If a transparent inplace editor + needs to be painted, the cell background is painted + first to the inplace editor's Canvas/device context. Typically, check boxes + or radio buttons should appear as transparent controls in TKCustomGrid. + Unfortunatelly we must use a custom decision mechanism as there is no standard + VCL/LCL-based mechanism to design a control fully transparent in all cases. + The algorithm used to paint the cell background should work for a wide range + of controls either with or without OS themes. } + property EditorTransparency: TKGridEditorTransparency read FEditorTransparency write SetEditorTransparency default cEditorTransparencyDef; + { Returns the effective spacing between columns. This is nonzero, + if goFixedVertLine or goVertLine is included in @link(TKCustomGrid.Options). } + property EffectiveColSpacing[Index: Integer]: Integer read GetEffectiveColSpacing; + { Returns the effective spacing between rows. This is nonzero, + if goFixedHorzLine or goHorzLine is included in @link(TKCustomGrid.Options). } + property EffectiveRowSpacing[Index: Integer]: Integer read GetEffectiveRowSpacing; + { Determines if an entire column is selected. } + property EntireColSelected[Index: Integer]: Boolean read GetEntireColSelected; + { Determines number of entirely selected columns. } + property EntireSelectedColCount: Integer read GetEntireSelectedColCount; + { Determines if an entire row is selected. } + property EntireRowSelected[Index: Integer]: Boolean read GetEntireRowSelected; + { Determines number of entirely selected rows. } + property EntireSelectedRowCount: Integer read GetEntireSelectedRowCount; + { Specifies the number of columns on the left of the grid that cannot be scrolled. + Set FixedCols to create or get rid of nonscrolling columns. Nonscrolling + columns appear at the left of the grid, and are always visible, even when + the user scrolls the other columns in the grid. Use nonscrolling columns + for displaying row titles or row numbers, or to implement a scroll lock that + the user can set. } + property FixedCols: Integer read FFixedCols write SetFixedCols default cFixedColsDef; + { Specifies the number of rows on the top of the grid that cannot be scrolled. + Set FixedRows to create or get rid of nonscrolling rows. Nonscrolling rows + appear at the top of the grid, and are always visible, even when the user + scrolls the other rows in the grid. Use nonscrolling rows for displaying + column titles or column numbers. } + property FixedRows: Integer read FFixedRows write SetFixedRows default cFixedRowsDef; + { Specifies the height of the grid in pixels. If GridHeight is less than + the value of ClientHeight, all of the rows of the grid appear in the control + with an empty region below the grid. If the underlying grid is too tall + to appear in the control, GridHeight is the same as ClientHeight, + and the user must scroll to see the entire contents of the grid. } + property GridHeight: Integer read GetGridHeight; + { Specifies the width (in pixels) of the lines that separate the cells of the grid. } + property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default cGridLineWidthDef; + { Specifies the width of the grid in pixels. If GridWidth is less than the value + of ClientWidth, all of the columns of the grid appear in the control with + an empty region to the right of the grid. If the underlying grid is + too wide to appear in the control, GridWidth is the same as ClientWidth, + and the user must scroll to see the entire contents of the grid. } + property GridWidth: Integer read GetGridWidth; + { Determines if the grid, inplace editor or any child window of inplace editor + has input focus. } + function HasFocus: Boolean; virtual; + { Returns the last (even partially) visible column in the grid. } + property LastVisibleCol: Integer read GetLastVisibleCol; + { Returns the last (even partially) visible row in the grid. } + property LastVisibleRow: Integer read GetLastVisibleRow; + { Specifies the index of the first visible scrollable column in the grid. + Set LeftCol to scroll the columns in the grid so that the column with index + LeftCol is the first column after the fixed columns. } + property LeftCol: Integer read FTopLeft.Col write SetLeftCol; + { Specifies the number of columns the grid would have if no columns would + have been deleted. } + property MaxCol: Integer read FMaxCol; + { Specifies the number of rows the grid would have if no rows would + have been deleted. } + property MaxRow: Integer read FMaxRow; + { Specifies the minimum width a column can have. } + property MinColWidth: Integer read FMinColWidth write SetMinColWidth default cMinColWidthDef; + { Specifies the minimum height a row can have. } + property MinRowHeight: Integer read FMinRowHeight write SetMinRowHeight default cMinRowHeightDef; + { Determines if more cells are selected (more than one cell). } + property MoreCellsSelected: Boolean read GetMoreCellsSelected; + { Specifies how fast the mouse cell hint should be. } + property MouseCellHintTime: Cardinal read FMouseCellHintTime write SetMouseCellHintTime default cMouseCellHintTimeDef; + { Specifies the behavior after the user presses Enter. This property has + no effect unless goEnterMoves is included in @link(TKCustomGrid.Options). } + property MoveDirection: TKGridMoveDirection read FMoveDirection write FMoveDirection default cMoveDirectionDef; + { Lists the objects for each cell in the grid. Setting Objects forces a descendant + of @link(TKGridObjectCell) to be created for the related cell. If @link(TKCustomGrid.CellClass) + contains such a descendant, then it will be used instead of TKGridObjectCell. + TObject instance given to Objects will be then stored in @link(TKGridObjectCell.CellObject) + property. In contrast to TStringGrid, the passed TObject is owned by the + TKGridObjectCell instance. Override TKGridObjectCell to implement another + behavior. } + property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; + { Specifies basic display and behavioral properties of the grid. } + property Options: TKGridOptions read FOptions write SetOptions default cOptionsDef; + { Specifies extended display and behavioral properties of the grid. } + property OptionsEx: TKGridOptionsEx read FOptionsEx write SetOptionsEx default cOptionsExDef; + { Inherited property - see Delphi help. } + property ParentColor default False; + { Specifies the style how multiple cells are selected. } + property RangeSelectStyle: TKGridRangeSelectStyle read FRangeSelectStyle write FRangeSelectStyle default cRangeSelectStyleDef; + { Gains access to selection base cell. Setting Row discards the current selection + and moves focus to a new base cell in the current column that is in the new row. + The first row has an index of 0, the second row an index of 1, and so on. + If the index denotes a row that is not selectable, nothing happens. } + property Row: Integer read FSelection.Row1 write SetRow; + { Row class used to create new row instances. Row instances are always + created when @link(TKCustomGrid.RowCount) grows. } + property RowClass: TKGridRowClass read FRowClass write FRowClass; + { Specifies the number of rows in the grid. Set RowCount to add or delete rows + at the bottom of the grid. The value of RowCount includes any fixed rows at + the top of the grid as well as the scrollable rows in the body of the grid. } + property RowCount: Integer read FRowCount write SetRowCount default cRowCountDef; + { Indicates the height (in pixels) of all the rows in the grid. Set RowHeights + at runtime to change the height of an individual row. If the height of + a row has not been set explicitly by resizing with the mouse, or by using + the RowHeights property, its height is @link(TKCustomGrid.DefaultRowHeight). } + property RowHeights[Index: Integer]: Integer read GetRowHeights write SetRowHeights; + { Gains access to the row instances. Row instances are always + created by utilizing @link(TKCustomGrid.RowClass) when @link(TKCustomGrid.RowCount) + grows. To replace all other row instances with ColClass, call + @link(TKCustomGrid.RealizeRowClass). } + property Rows[Index: Integer]: TKGridRow read GetRows; + { Specifies whether the grid includes horizontal and vertical scroll bars. + If all the cells in the grid fit in the ClientWidth, no horizontal scroll bar + appears, even if ScrollBars is ssHorizontal or ssBoth. If all the cells fit + in the ClientHeight, no vertical scroll bar appears, even if ScrollBars is + ssVertical or ssBoth. } + property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default cScrollBarsDef; + { Specifies how horizontal scrollbar's trackbar scrolls the grid. } + property ScrollModeHorz: TKGridScrollMode read FScrollModeHorz write SetScrollModeHorz default cScrollModeDef; + { Specifies how vertical scrollbar's trackbar scrolls the grid. } + property ScrollModeVert: TKGridScrollMode read FScrollModeVert write SetScrollModeVert default cScrollModeDef; + { Specifies how fast the scrolling by timer should be. } + property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; + { Indicates the boundaries of the current selection. Set Selection to select + a range of cells in the grid. In the TKGridRect structure, the Cell1 parameter + always denotes base selection cell and Cell2 expanded selection cell. + A base cell is always the cell that has input focus and can be currently + edited. An expanded cell denotes the other selection corner. } + property Selection: TKGridRect read GetSelection write SetSelection; + { Returns the current number of selections. Returns always a value greater or equal to 1. } + property SelectionCount: Integer read GetSelectionCount; + { Returns the selection rectangle. } + property SelectionRect: TRect read GetSelectionRect; + { Gains access to all currently existing selections. This property cannot be used + to add new selection. Please use @link(TKCustomGrid.SelectionAdd) instead. } + property Selections[Index: Integer]: TKGridRect read GetSelections write SetSelections; + { Specifies how a column or row appears while being resized by mouse. } + property SizingStyle: TKGridSizingStyle read FSizingStyle write SetSizingStyle default cSizingStyleDef; + { Returns index of the column having its SortMode property smDown or smUp. + There must be always one such column in the grid. } + property SortCol: Integer read GetSortCol; + { Returns index of the row having its SortMode property smDown or smUp. + There must be always one such row in the grid. } + property SortRow: Integer read GetSortRow; + { Specifies how sorting is performed when user clicks on clickable fixed cells + that normally indicate sorting by an arrow. } + property SortStyle: TKGridSortStyle read FSortStyle write FSortStyle default cSortStyleDef; + { Indicates whether the user can tab to specified columns in the grid if + goTabs is included in @link(TKCustomGrid.Options). Set TabStops to False + to remove the column identified by Index from the tab order. The first column + in the grid is identified by an Index of 0. Setting TabStops for fixed + columns has no effect. } + property TabStops[Index: Integer]: Boolean read GetTabStops write SetTabStops; + { Determines if cells can be painted with OS themes at the moment. Returns + True if OS themes are available and both goThemes and goThemedCells are + included in @link(TKCustomGrid.Options). } + property ThemedCells: Boolean read GetThemedCells; + { Determines if OS themes are available to the grid. } + property Themes: Boolean read GetThemes; + { If the SelectedByMouse parameter in @link(TKCustomGrid.OnEditorSelect) is True + you can set ThroughClick to True to click the inplace editor within the same + mouse click that selected this cell. } + property ThroughClick: Boolean read FThroughClick write FThroughClick; + { Specifies the index of the first visible scrollable row in the grid. + Set TopRow to scroll the rows in the grid so that the row with index + TopRow is the first row after the fixed rows. } + property TopRow: Integer read FTopLeft.Row write SetTopRow; + { Use VisibleColCount to determine the number of scrollable columns fully visible in the grid. + VisibleColCount does not include the fixed columns counted by the FixedCols property. + It does not include any partially visible columns on the right edge of the grid. } + property VisibleColCount: Integer read GetVisibleColCount; + { Indicates the area of scrollable cells visible in the grid. VisibleGridRect does not + include any fixed cells or partially visible cells on the right or bottom side of the grid. } + property VisibleGridRect: TKGridRect read GetVisibleGridRect; + { Use VisibleRowCount to determine the number of scrollable rows fully visible in the grid. + VisibleRowCount does not include the fixed rows counted by the FixedRows property. + It does not include any partially visible rows on the bottom of the grid. } + property VisibleRowCount: Integer read GetVisibleRowCount; + { OnBeginColDrag is called when the user clicks on a column to start dragging. + It enables the grid to control whether the column can be repositioned and + if so, which column. Origin is the index of the column to be dragged. + When OnBeginColDrag occurs, this is the index of the column in which the mouse + was clicked. You can change this value for application specific behavior. } + property OnBeginColDrag: TKGridBeginDragEvent read FOnBeginColDrag write FOnBeginColDrag; + { OnBeginColSizing is called when the user clicks between two columns to start + resizing. It enables the grid to control whether the column can be resized and + if so, which column. Index is the index of the column to be resized. Pos is + the X-coordinate of the sizing line. These values correspond with the default + processing initiated by mouse click. You can change both of these values + for application specific behavior. } + property OnBeginColSizing: TKGridBeginSizingEvent read FOnBeginColSizing write FOnBeginColSizing; + { OnBeginRowDrag is called when the user clicks on a row to start dragging. + It enables the grid to control whether the row can be repositioned and + if so, which row. Origin is the index of the row to be dragged. + When OnBeginRowDrag occurs, this is the index of the row in which the mouse + was clicked. You can change this value for application specific behavior. } + property OnBeginRowDrag: TKGridBeginDragEvent read FOnBeginRowDrag write FOnBeginRowDrag; + { OnBeginRowSizing is called when the user clicks between two rows to start + resizing. It enables the grid to control whether the row can be resized and + if so, which row. Index is the index of the row to be resized. Pos is + the Y-coordinate of the sizing line. These values correspond with the default + processing initiated by mouse click. You can change both of these values + for application specific behavior. } + property OnBeginRowSizing: TKGridBeginSizingEvent read FOnBeginRowSizing write FOnBeginRowSizing; + { OnCellSpan is called whenever the grid needs to get information about column + or row span of current cell. Use this only in virtual grid mode and do not write + complex code here as this event is called really VERY frequently. You must provide + the same cell span information as the TKGridCell.@link(TKGridCell.Span) for + non-virtual mode. } + property OnCellSpan: TKGridCellSpanEvent read FOnCellSpan write FOnCellSpan; + { OnChanged is called after @link(TKCustomGrid.OnEditorDataToGrid) only if + @link(TKCustomGrid.OnCompareCellInstances) returns different cells. Its purpose + is to notify the application about any changes the user made via inplace editors. + Does not work in virtual mode (if goVirtualGrid is included in @link(TKCustomGrid.Options)). } + property OnChanged: TKGridCellEvent read FOnChanged write FOnChanged; + { OnCheckColDrag validates whether the column currently selected for dragging + can be dropped at the current location. Origin is the index of the column being + actually dragged. Destination represents the potential drop target. You can + modify Destination or set CanDrop to False for application specific behavior. } + property OnCheckColDrag: TKGridCheckDragEvent read FOnCheckColDrag write FOnCheckColDrag; + { OnCheckRowDrag validates whether the row currently selected for dragging + can be dropped at the current location. Origin is the index of the row being + actually dragged. Destination represents the potential drop target. You can + modify Destination or set CanDrop to False for application specific behavior. } + property OnCheckRowDrag: TKGridCheckDragEvent read FOnCheckRowDrag write FOnCheckRowDrag; + { OnColumnMoved is called after a column has been physically moved. } + property OnColumnMoved: TKGridMovedEvent read FOnColMoved write FOnColMoved; + { OnColWidthsChanged is called whenever the width of a single or more columns changes. } + property OnColWidthsChanged: TNotifyEvent read FOnColWidthsChanged write FOnColWidthsChanged; + { OnColWidthsChangedEx is called whenever the width of a single or more columns changes. + AIndex corresponds to the first column whose width has been modified. } + property OnColWidthsChangedEx: TKGridExtentEvent read FOnColWidthsChangedEx write FOnColWidthsChangedEx; + { OnCompareCellInstances is currently called only if the grid needs to decide + whether to call the @link(TKCustomGrid.OnChanged) event handler. This event + is not called in virtual mode (if goVirtualGrid is included in @link(TKCustomGrid.Options)). } + property OnCompareCellInstances: TKGridCompareCellInstancesEvent read FOnCompareCellInstances write FOnCompareCellInstances; + { OnCompareCells is called whenever the grid needs to compare contents of two + cells. This occurs if the @link(TKCustomGrid.SortCols), @link(TKCustomGrid.SortRows), + @link(TKCustomGrid.InsertSortedCol) and @link(TKCustomGrid.InsertSortedRow) + methods are called, either programmatically or by mouse click on the first + fixed column or row. Do not write complex code here as this event is called + VERY frequently. To speed up sorting, use properties introduced for fast + data access, such as @link(TKCustomGrid.ArrayOfCells) or + @link(TKGridTextCell.TextPtr). } + property OnCompareCells: TKGridCompareCellsEvent read FOnCompareCells write FOnCompareCells; + { OnCustomSortCols is called whenever the grid needs to sort columns. Use this + event to override the default sorting algorithm. } + property OnCustomSortCols: TKGridCustomSortEvent read FOnCustomSortCols write FOnCustomSortCols; + { OnCustomSortRows is called whenever the grid needs to sort rows. Use this + event to override the default sorting algorithm. } + property OnCustomSortRows: TKGridCustomSortEvent read FOnCustomSortRows write FOnCustomSortRows; + { OnDrawCell is called whenever a cell in the grid needs to be drawn. Draw + on the cell using the methods of the Canvas property. If the OnDrawCell event + handler is not assigned, all cells in grid will be painted with the cell + class aware @link(TKGridCell.DrawCell) method. If the cell has no assigned + cell instance, it appears empty. } + property OnDrawCell: TKGridDrawCellEvent read FOnDrawCell write FOnDrawCell; + { OnEditorCreate is called whenever a cell is about to be edited. This event + handler allows you to create a custom inplace editor for each cell. The editor + should only be created, such as by means of AEditor := TEdit.Create(nil). + Correct positioning within the grid, focusing, painting etc. is maintained + later by grid itself. No manipulation requiring the editor's Handle is allowed here. } + property OnEditorCreate: TKGridEditorCreateEvent read FOnEditorCreate write FOnEditorCreate; + { OnEditorDataFromGrid is called after @link(TKCustomGrid.OnEditorCreate). + The inplace editor is correctly positioned, has a parent control, its Handle + is allocated but is still not visible. Set data from the grid to the inplace + editor in an user defined way here. Data can be set in EditorCreate but some + assignments need that the inplace editor has a parent control. Grid is always + parent control of inplace editor. } + property OnEditorDataFromGrid: TKGridEditorDataEvent read FOnEditorDataFromGrid write FOnEditorDataFromGrid; + { OnEditorDataToGrid is called if the inplace editor is about to disappear. + The inplace editor is still visible here and has a parent control. Its Handle + is still allocated. Set data from the inplace editor to the grid in an user + defined way here. Data can be transferred in @link(TKCustomGrid.EditorDestroy) + but some assignments need that the inplace editor has a parent control. } + property OnEditorDataToGrid: TKGridEditorDataEvent read FOnEditorDataToGrid write FOnEditorDataToGrid; + { OnEditorDestroy is called after @link(TKCustomGrid.OnEditorDataToGrid), + just before the inplace editor is destroyed. It is no longer visible here + and has no parent control. Its Handle is no more valid. Perform application + specific operations just before the editor is destroyed here. You need not + destroy the AEditor instance, but if so, set AEditor to nil after destroying it + Example: FreeAndNil(AEditor). } + property OnEditorDestroy: TKGridEditorDestroyEvent read FOnEditorDestroy write FOnEditorDestroy; + { OnEditorKeyPreview is called whenever inplace editor is focused and the user + presses some key that is normally handled by the grid if no inplace editor + is visible. Sometimes this key needs to be handled by the grid instead of + the inplace editor. For example, the @link(EditKeyPreview) function decides + whether the key needs to be handled by the grid or by the inplace editor. + Write your own code that is specific for your custom inplace editors. } + property OnEditorKeyPreview: TKGridEditorKeyPreviewEvent read FOnEditorKeyPreview write FOnEditorKeyPreview; + { OnEditorResize is called whenever the grid needs to relocate the inplace + editor (this might be quite often). By default, each inplace editor is always + located so that its bounding rectangle equals to the cell rectangle. + Write your own code to change this behavior. Inplace editors cannot appear + outside the edited cell, clipping is always present. Note: Not every + TWinControl instance intended as inplace editor can be arbitrary resized. } + property OnEditorResize: TKGridEditorResizeEvent read FOnEditorResize write FOnEditorResize; + { OnEditorSelect is called immediately after @link(TKCustomGrid.OnEditorDataFromGrid). + This event handler allows you to correctly set the caret position within + your inplace editor. } + property OnEditorSelect: TKGridEditorSelectEvent read FOnEditorSelect write FOnEditorSelect; + { Determines whether a particular column can be dropped immediately after + the user releases the mouse button but before the column is actually moved. } + property OnEndColDrag: TKGridEndDragEvent read FOnEndColDrag write FOnEndColDrag; + { Determines whether a particular column can be resized immediately after + the user releases the mouse button but before the column is actually resized. + This event handler has no effect if @link(TKCustomGrid.SizingStyle) is ssUpdate. } + property OnEndColSizing: TKGridEndSizingEvent read FOnEndColSizing write FOnEndColSizing; + { Determines whether a particular row can be dropped immediately after + the user releases the mouse button but before the row is actually moved. } + property OnEndRowDrag: TKGridEndDragEvent read FOnEndRowDrag write FOnEndRowDrag; + { Determines whether a particular row can be resized immediately after + the user releases the mouse button but before the row is actually resized. + This event handler has no effect if @link(TKCustomGrid.SizingStyle) is ssUpdate. } + property OnEndRowSizing: TKGridEndSizingEvent read FOnEndRowSizing write FOnEndRowSizing; + { OnExchangeCols is called whenever the grid sorts columns or needs to + exchange two columns. Typically you assign this event handler in virtual + grid mode @link(goVirtualGrid) to physically sort your data or when + implementing a custom behavior parallel to sorting cell instances owned + by the grid. This event is called from @link(TKCustomGrid.MoveCol), either. } + property OnExchangeCols: TKGridExchangeEvent read FOnExchangeCols write FOnExchangeCols; + { OnExchangeRows is called whenever the grid sorts rows or needs to + exchange two rows. Typically you assign this event handler in virtual + grid mode @link(goVirtualGrid) to physically sort your data or when + implementing a custom behavior parallel to sorting cell instances owned + by the grid. This event is called from @link(TKCustomGrid.MoveRow), either. } + property OnExchangeRows: TKGridExchangeEvent read FOnExchangeRows write FOnExchangeRows; + { OnMeasureCell is called whenever the grid needs to get the horizontal and vertical extent + of the data displayed in a cell. If the OnMeasureCell event + handler is not assigned, all cells in the grid will be measured by default. } + property OnMeasureCell: TKGridMeasureCellEvent read FOnMeasureCell write FOnMeasureCell; + { OnMouseCellHint is called whenever a cell is clicked by left mouse button. } + property OnMouseCellHint: TKGridCellHintEvent read FOnMouseCellHint write FOnMouseCellHint; + { OnMouseClickCell is called whenever a cell is clicked by left mouse button. } + property OnMouseClickCell: TKGridCellEvent read FOnMouseClickCell write FOnMouseClickCell; + { OnMouseDblClickCell is called whenever a cell is clicked by left mouse button. } + property OnMouseDblClickCell: TKGridCellEvent read FOnMouseDblClickCell write FOnMouseDblClickCell; + { OnMouseEnterCell is called whenever mouse enters a cell. } + property OnMouseEnterCell: TKGridCellEvent read FOnMouseEnterCell write FOnMouseEnterCell; + { OnMouseLeaveCell is called whenever mouse leaves a cell. } + property OnMouseLeaveCell: TKGridCellEvent read FOnMouseLeaveCell write FOnMouseLeaveCell; + { OnRowHeightsChanged is called whenever the height of a single or more rows changes. } + property OnRowHeightsChanged: TNotifyEvent read FOnRowHeightsChanged write FOnRowHeightsChanged; + { OnRowHeightsChangedEx is called whenever the height of a single or more rows changes. + AIndex corresponds to the first row whose height has been modified. } + property OnRowHeightsChangedEx: TKGridExtentEvent read FOnRowHeightsChangedEx write FOnRowHeightsChangedEx; + { OnRowMoved is called after a row has been physically moved. } + property OnRowMoved: TKGridMovedEvent read FOnRowMoved write FOnRowMoved; + { OnSelectCell is called whenever a cell is about to be selected. A cell can + be selected either by mouse or keyboard, or programmatically e.g. by the + @link(TKCustomGrid.FocusCell) method. CanSelect is True by default to allow all + selectable cells to be selected. Change this parameter to False to disallow + cell selection. A cell that cannot be selected, cannot be edited as well. + Many times you need some cells not to become editable. In this case, + let @link(TKCustomGrid.OnEditorCreate) decide it rather than OnSelectCell. } + property OnSelectCell: TKGridSelectCellEvent read FOnSelectCell write FOnSelectCell; + { OnSelectionExpand is called if the user expands the current selection. + The selection can be expanded either by mouse or keyboard, or programmatically + e.g. by the @link(TKCustomGrid.Selection) property. CanExpand is True by default + to allow all cells to become a target of selection expansion. Change this + parameter to False to disallow selection expansion.} + property OnSelectionExpand: TKGridSelectionExpandEvent read FOnSelectionExpand write FOnSelectionExpand; + { OnSizeChanged is called whenever the @link(TKCustomGrid.ColCount) or + @link(TKCustomGrid.RowCount) properties change. } + property OnSizeChanged: TKGridSizeChangedEvent read FOnSizeChanged write FOnSizeChanged; + { OnTopLeftChanged is called whenever the @link(TKCustomGrid.LeftCol) or + @link(TKCustomGrid.TopRow) properties change. } + property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; + end; + + { @abstract(KGrid design-time component) This is the class you use both + on run-time and design-time. } + TKGrid = class(TKCustomGrid) + published + { Inherited property - see Delphi help. } + property Align; + { Inherited property - see Delphi help. } + property Anchors; + { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details. } + property BorderStyle; + { Inherited property - see Delphi help. } + property BorderWidth; + { See TKCustomGrid.@link(TKCustomGrid.ColCount) for details. } + property ColCount; + { See TKCustomGrid.@link(TKCustomGrid.Color) for details. } + property Color; + { See TKCustomGrid.@link(TKCustomGrid.Colors) for details. } + property Colors; + { Inherited property - see Delphi help. } + property Constraints; + {$IFDEF FPC} + { See TKCustomGrid.@link(TKCustomGrid.Flat) for details. } + property Flat; + {$ELSE} + { Inherited property - see Delphi help. } + property Ctl3D; + {$ENDIF} + { See TKCustomGrid.@link(TKCustomGrid.DefaultColWidth) for details. } + property DefaultColWidth; + { See TKCustomGrid.@link(TKCustomGrid.DefaultDrawing) for details. } + property DefaultDrawing; + { See TKCustomGrid.@link(TKCustomGrid.DefaultRowHeight) for details. } + property DefaultRowHeight; + { See TKCustomGrid.@link(TKCustomGrid.DisabledDrawStyle) for details. } + property DisabledDrawStyle; + { Inherited property - see Delphi help. } + property DragCursor; + { Inherited property - see Delphi help. } + property DragKind; + { Inherited property - see Delphi help. } + property DragMode; + { See TKCustomGrid.@link(TKCustomGrid.DragStyle) for details. } + property DragStyle; + { Inherited property - see Delphi help. } + property Enabled; + { See TKCustomGrid.@link(TKCustomGrid.FixedCols) for details. } + property FixedCols; + { See TKCustomGrid.@link(TKCustomGrid.FixedRows) for details. } + property FixedRows; + { Inherited property - see Delphi help. } + property Font; + { See TKCustomGrid.@link(TKCustomGrid.GridLineWidth) for details. } + property GridLineWidth; + { See TKCustomGrid.@link(TKCustomGrid.MinColWidth) for details. } + property MinColWidth; + { See TKCustomGrid.@link(TKCustomGrid.MinRowHeight) for details. } + property MinRowHeight; + { See TKCustomGrid.@link(TKCustomGrid.MouseCellHintTime) for details. } + property MouseCellHintTime; + { See TKCustomGrid.@link(TKCustomGrid.MoveDirection) for details. } + property MoveDirection; + { See TKCustomGrid.@link(TKCustomGrid.Options) for details. } + property Options; + { See TKCustomGrid.@link(TKCustomGrid.OptionsEx) for details. } + property OptionsEx; + { Inherited property - see Delphi help. } + property ParentColor; + { Inherited property - see Delphi help. } + property ParentFont; + { Inherited property - see Delphi help. } + property ParentShowHint; + { Inherited property - see Delphi help. } + property PopupMenu; + { See TKCustomGrid.@link(TKCustomGrid.RangeSelectStyle) for details. } + property RangeSelectStyle; + { See TKCustomGrid.@link(TKCustomGrid.RowCount) for details. } + property RowCount; + { See TKCustomGrid.@link(TKCustomGrid.ScrollBars) for details. } + property ScrollBars; + { See TKCustomGrid.@link(TKCustomGrid.ScrollModeHorz) for details. } + property ScrollModeHorz; + { See TKCustomGrid.@link(TKCustomGrid.ScrollModeVert) for details. } + property ScrollModeVert; + { See TKCustomGrid.@link(TKCustomGrid.ScrollSpeed) for details. } + property ScrollSpeed; + { Inherited property - see Delphi help. } + property ShowHint; + { See TKCustomGrid.@link(TKCustomGrid.SizingStyle) for details. } + property SizingStyle; + { See TKCustomGrid.@link(TKCustomGrid.SortStyle) for details. } + property SortStyle; + { Inherited property - see Delphi help. } + property TabOrder; + { Inherited property - see Delphi help. } + property TabStop default True; + { Inherited property - see Delphi help. } + property Visible; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginColDrag) for details. } + property OnBeginColDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginColSizing) for details. } + property OnBeginColSizing; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginRowDrag) for details. } + property OnBeginRowDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnBeginRowSizing) for details. } + property OnBeginRowSizing; + { See TKCustomGrid.@link(TKCustomGrid.OnCellSpan) for details. } + property OnCellSpan; + { See TKCustomGrid.@link(TKCustomGrid.OnChanged) for details. } + property OnChanged; + { See TKCustomGrid.@link(TKCustomGrid.OnCheckColDrag) for details. } + property OnCheckColDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnCheckRowDrag) for details. } + property OnCheckRowDrag; + { Inherited property - see Delphi help. } + property OnClick; + { See TKCustomGrid.@link(TKCustomGrid.OnColumnMoved) for details. } + property OnColumnMoved; + { See TKCustomGrid.@link(TKCustomGrid.OnColWidthsChanged) for details. } + property OnColWidthsChanged; + { See TKCustomGrid.@link(TKCustomGrid.OnColWidthsChangedEx) for details. } + property OnColWidthsChangedEx; + { See TKCustomGrid.@link(TKCustomGrid.OnCompareCellInstances) for details. } + property OnCompareCellInstances; + { See TKCustomGrid.@link(TKCustomGrid.OnCompareCells) for details. } + property OnCompareCells; + { Inherited property - see Delphi help. } + property OnContextPopup; + { See TKCustomGrid.@link(TKCustomGrid.OnCustomSortCols) for details. } + property OnCustomSortCols; + { See TKCustomGrid.@link(TKCustomGrid.OnCustomSortRows) for details. } + property OnCustomSortRows; + { Inherited property - see Delphi help. } + property OnDblClick; + { Inherited property - see Delphi help. } + property OnDockDrop; + { Inherited property - see Delphi help. } + property OnDockOver; + { Inherited property - see Delphi help. } + property OnDragDrop; + { Inherited property - see Delphi help. } + property OnDragOver; + { See TKCustomGrid.@link(TKCustomGrid.OnDrawCell) for details. } + property OnDrawCell; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorCreate) for details. } + property OnEditorCreate; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDataFromGrid) for details. } + property OnEditorDataFromGrid; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDataToGrid) for details. } + property OnEditorDataToGrid; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorDestroy) for details. } + property OnEditorDestroy; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorKeyPreview) for details. } + property OnEditorKeyPreview; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorResize) for details. } + property OnEditorResize; + { See TKCustomGrid.@link(TKCustomGrid.OnEditorSelect) for details. } + property OnEditorSelect; + { See TKCustomGrid.@link(TKCustomGrid.OnEndColDrag) for details. } + property OnEndColDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnEndColSizing) for details. } + property OnEndColSizing; + { Inherited property - see Delphi help. } + property OnEndDock; + { Inherited property - see Delphi help. } + property OnEndDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnEndRowDrag) for details. } + property OnEndRowDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnEndRowSizing) for details. } + property OnEndRowSizing; + { Inherited property - see Delphi help. } + property OnEnter; + { Inherited property - see Delphi help. } + property OnExit; + { See TKCustomGrid.@link(TKCustomGrid.OnExchangeCols) for details. } + property OnExchangeCols; + { See TKCustomGrid.@link(TKCustomGrid.OnExchangeRows) for details. } + property OnExchangeRows; + { Inherited property - see Delphi help. } + property OnGetSiteInfo; + { Inherited property - see Delphi help. } + property OnKeyDown; + { Inherited property - see Delphi help. } + property OnKeyPress; + { Inherited property - see Delphi help. } + property OnKeyUp; + { See TKCustomGrid.@link(TKCustomGrid.OnMeasureCell) for details. } + property OnMeasureCell; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseCellHint) for details. } + property OnMouseCellHint; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseClickCell) for details. } + property OnMouseClickCell; + { See TKCustomGrid.@link(TKCustomGrid.OnMouseDblClickCell) for details. } + property OnMouseDblClickCell; + { Inherited property - see Delphi help. } + property OnMouseDown; + {$IFDEF COMPILER9_UP} + { Inherited property - see Delphi help. } + property OnMouseEnter; + {$ENDIF} + { See TKCustomGrid.@link(TKCustomGrid.OnMouseEnterCell) for details. } + property OnMouseEnterCell; + {$IFDEF COMPILER9_UP} + { Inherited property - see Delphi help. } + property OnMouseLeave; + {$ENDIF} + { See TKCustomGrid.@link(TKCustomGrid.OnMouseLeaveCell) for details. } + property OnMouseLeaveCell; + { Inherited property - see Delphi help. } + property OnMouseMove; + { Inherited property - see Delphi help. } + property OnMouseUp; + { Inherited property - see Delphi help. } + property OnMouseWheel; + { Inherited property - see Delphi help. } + property OnMouseWheelDown; + { Inherited property - see Delphi help. } + property OnMouseWheelUp; + { This event is called at certain phases of the actually running print job. } + property OnPrintNotify; + { This event is called after the shape is drawn onto the printer canvas. } + property OnPrintPaint; + { Inherited property - see Delphi help. } + property OnResize; + { See TKCustomGrid.@link(TKCustomGrid.OnRowHeightsChanged) for details. } + property OnRowHeightsChanged; + { See TKCustomGrid.@link(TKCustomGrid.OnRowHeightsChangedEx) for details. } + property OnRowHeightsChangedEx; + { See TKCustomGrid.@link(TKCustomGrid.OnRowMoved) for details. } + property OnRowMoved; + { See TKCustomGrid.@link(TKCustomGrid.OnSelectCell) for details. } + property OnSelectCell; + { See TKCustomGrid.@link(TKCustomGrid.OnSelectionExpand) for details. } + property OnSelectionExpand; + { See TKCustomGrid.@link(TKCustomGrid.OnSizeChanged) for details. } + property OnSizeChanged; + { Inherited property - see Delphi help. } + property OnStartDock; + { Inherited property - see Delphi help. } + property OnStartDrag; + { See TKCustomGrid.@link(TKCustomGrid.OnTopLeftChanged) for details. } + property OnTopLeftChanged; + { Inherited property - see Delphi help. } + property OnUnDock; + end; + +{ Determines if the Cell specified by ACol and ARow lies within grid rectangle R. } +function CellInGridRect(ACol, ARow: Integer; const R: TKGridRect): Boolean; + +{ Determines if the grid rectangle contains a subset of cells belonging to the + column specified by ACol. } +function ColInGridRect(ACol: Integer; const R: TKGridRect): Boolean; + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultComboKeyPreview) instead. } +procedure ComboKeyPreview(AGrid: TKCustomGrid; AEditor: TComboBox; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultComboSelect) instead. } +procedure ComboSelect(AGrid: TKCustomGrid; AEditor: TComboBox; SelectAll, + CaretToLeft: Boolean); + +{ Compares two TKGridAxisItems arrays. The function returns True if the arrays are + equal in length and all corresponding TKGridAxisItem instances within both arrays + have equal property values. } +function CompareAxisItems(AxisItems1, AxisItems2: TKGridAxisItems): Boolean; + +{ Obsolete function. Implements default painting for TKCustomGrid cells. + Call TKCustomGrid.CellPainter.@link(TKGridCellPainter.DefaultDraw) instead. } +procedure DefaultDrawCell(AGrid: TKCustomGrid; ACol, ARow: Integer; ARect: TRect; + AState: TKGridDrawState; HAlign: TKHAlign; VAlign: TKVAlign; + HPadding, VPadding: Integer; const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultEditorKeyPreview) instead. } +procedure DefaultKeyPreview(AGrid: TKCustomGrid; AEditor: TWinControl; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultEditorSelect) instead. } +procedure DefaultSelect(AGrid: TKCustomGrid; AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultEditKeyPreview) instead. } +procedure EditKeyPreview(AGrid: TKCustomGrid; AEditor: TCustomEdit; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultEditSelect) instead. } +procedure EditSelect(AGrid: TKCustomGrid; AEditor: TCustomEdit; SelectAll, + CaretToLeft: Boolean); + +{ Makes a @link(TKGridCoord) record from ACol and ARow. } +function GridPoint(ACol, ARow: Integer): TKGridCoord; + +{ Makes a @link(TKGridRect) record from ACell. Cell will be copied both to Cell1 and + Cell2 fields of the resulting grid rectangle. } +function GridRect(ACell: TKGridCoord): TKGridRect; overload; + +{ Makes a @link(TKGridRect) record from ACell1 and ACell2. All the input parameters + will be copied to the corresponding fields of the resulting grid rectangle. } +function GridRect(ACell1, ACell2: TKGridCoord): TKGridRect; overload; + +{ Makes a @link(TKGridRect) record from ACol1, ARow1, ACol2 and ARow2. All the input + parameters will be copied to the corresponding fields of the resulting grid rectangle. } +function GridRect(ACol1, ARow1, ACol2, ARow2: Integer): TKGridRect; overload; + +{ Compares two grid rectangles. Returns True if all the corresponding fields + in GridRect1 equal those in GridRect2. } +function GridRectEqual(const GridRect1, GridRect2: TKGridRect): Boolean; + +{ Makes a @link(TKGridCellSpan) record from AColumns and ARows. } +function MakeCellSpan(AColumns, ARows: Integer): TKGridCellSpan; + +{ Makes Cell1 field of GridRect always top-left cell and Cell2 field always + bottom-right cell. } +procedure NormalizeGridRect(var GridRect: TKGridRect); + +{ Determines if the grid rectangle contains a subset of cells belonging to the + row specified by ARow. } +function RowInGridRect(ARow: Integer; const R: TKGridRect): Boolean; + +{ Obsolete function. Call TKCustomGrid.@link(TKCustomGrid.DefaultScrollBarKeyPreview) instead. } +procedure ScrollBarKeyPreview(AGrid: TKCustomGrid; AEditor: TScrollBar; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); + +implementation + +uses + Math, TypInfo +{$IFDEF USE_THEMES} + , Themes + {$IFNDEF FPC} + , UxTheme + {$ENDIF} +{$ENDIF} + ; + +function CellInGridRect(ACol, ARow: Integer; const R: TKGridRect): Boolean; +begin + Result := ( + (R.Col1 <= R.Col2) and (ACol >= R.Col1) and (ACol <= R.Col2) or + (R.Col1 > R.Col2) and (ACol >= R.Col2) and (ACol <= R.Col1) + ) and ( + (R.Row1 <= R.Row2) and (ARow >= R.Row1) and (ARow <= R.Row2) or + (R.Row1 > R.Row2) and (ARow >= R.Row2) and (ARow <= R.Row1) + ) +end; + +function ColInGridRect(ACol: Integer; const R: TKGridRect): Boolean; +begin + Result := ( + (R.Col1 <= R.Col2) and (ACol >= R.Col1) and (ACol <= R.Col2) or + (R.Col1 > R.Col2) and (ACol >= R.Col2) and (ACol <= R.Col1) + ); +end; + +procedure ComboKeyPreview(AGrid: TKCustomGrid; AEditor: TComboBox; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + AGrid.DefaultComboKeyPreview(AEditor, ACol, ARow, Key, ShiftState, IsGridKey); +end; + +procedure ComboSelect(AGrid: TKCustomGrid; AEditor: TComboBox; SelectAll, + CaretToLeft: Boolean); +begin + AGrid.DefaultComboSelect(AEditor, SelectAll, CaretToLeft); +end; + +function CompareAxisItems(AxisItems1, AxisItems2: TKGridAxisItems): Boolean; +var + I: Integer; +begin + Result := Length(AxisItems1) = Length(AxisItems2); + if Result then + for I := 0 to Length(AxisItems1) - 1 do + if not AxisItems1[I].Equals(AxisItems2[I]) then + begin + Result := False; + Exit; + end; +end; + +procedure DefaultDrawCell(AGrid: TKCustomGrid; ACol, ARow: Integer; ARect: TRect; + AState: TKGridDrawState; HAlign: TKHAlign; VAlign: TKVAlign; + HPadding, VPadding: Integer; const AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +begin + with AGrid do + begin + CellPainter.Initialize; + CellPainter.Col := ACol; + CellPainter.Row := ARow; + CellPainter.CellRect := ARect; + CellPainter.State := AState; + CellPainter.HAlign := HAlign; + CellPainter.VAlign := VAlign; + CellPainter.HPadding := HPadding; + CellPainter.VPadding := VPadding; + CellPainter.Text := AText; + CellPainter.DefaultDraw; + end; +end; + +procedure DefaultKeyPreview(AGrid: TKCustomGrid; AEditor: TWinControl; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + AGrid.DefaultEditorKeyPreview(AEditor, ACol, ARow, Key, ShiftState, IsGridKey); +end; + +procedure DefaultSelect(AGrid: TKCustomGrid; AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); +begin + AGrid.DefaultEditorSelect(AEditor, ACol, ARow, SelectAll, CaretToLeft, SelectedByMouse); +end; + +function DirectionToCommand(Direction: TKGridMoveDirection): TKGridMoveCommand; +begin + case Direction of + mdDown: Result := mcDown; + mdLeft: Result := mcLeft; + mdRight: Result := mcRight; + else + Result := mcUp; + end; +end; + +procedure DoEditKeyPreview(ATextLen, ASelStart, ASelLength, ALineCount: Integer; + AMultiLine, AStartLine, AEndLine: Boolean; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + if ((Key in [VK_LEFT, VK_HOME]) and ((ASelStart > 0) or (ASelLength > 1))) or // 1 to support TMaskEdit + ((Key in [VK_RIGHT, VK_END]) and ((ASelStart < ATextLen) or (ASelLength > 0))) or + ((Key in [VK_PRIOR, VK_UP]) and AMultiLine and (not AStartLine or (ASelLength > 0) and (ASelLength < ATextLen))) or + ((Key in [VK_NEXT, VK_DOWN]) and AMultiLine and (not AEndLine or (ASelLength > 0) and (ASelLength < ATextLen))) or + (Key = VK_RETURN) and AMultiLine then + IsGridKey := False; +end; + +procedure EditKeyPreview(AGrid: TKCustomGrid; AEditor: TCustomEdit; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + AGrid.DefaultEditKeyPreview(AEditor, ACol, ARow, Key, ShiftState, IsGridKey); +end; + +procedure EditSelect(AGrid: TKCustomGrid; AEditor: TCustomEdit; SelectAll, + CaretToLeft: Boolean); +begin + AGrid.DefaultEditSelect(AEditor, SelectAll, CaretToLeft); +end; + +function GridRectEqual(const GridRect1, GridRect2: TKGridRect): Boolean; +begin + Result := CompareMem(@GridRect1, @GridRect2, SizeOf(TKGridRect)); +end; + +function GridPoint(ACol, ARow: Integer): TKGridCoord; +begin + with Result do + begin + Col := ACol; + Row := ARow; + end; +end; + +function GridRect(ACell: TKGridCoord): TKGridRect; overload; +begin + with Result do + begin + Col1 := ACell.Col; + Col2 := ACell.Col; + Row1 := ACell.Row; + Row2 := ACell.Row; + end; +end; + +function GridRect(ACell1, ACell2: TKGridCoord): TKGridRect; overload; +begin + with Result do + begin + Cell1 := ACell1; + Cell2 := ACell2; + end; +end; + +function GridRect(ACol1, ARow1, ACol2, ARow2: Integer): TKGridRect; overload; +begin + with Result do + begin + Col1 := ACol1; + Col2 := ACol2; + Row1 := ARow1; + Row2 := ARow2; + end; +end; + +function MakeCellSpan(AColumns, ARows: Integer): TKGridCellSpan; +begin + Result.ColSpan := AColumns; + Result.RowSpan := ARows; +end; + +procedure NormalizeGridRect(var GridRect: TKGridRect); +begin + if GridRect.Col1 > GridRect.Col2 then Exchange(GridRect.Col1, GridRect.Col2); + if GridRect.Row1 > GridRect.Row2 then Exchange(GridRect.Row1, GridRect.Row2); +end; + +function RowInGridRect(ARow: Integer; const R: TKGridRect): Boolean; +begin + Result := ( + (R.Row1 <= R.Row2) and (ARow >= R.Row1) and (ARow <= R.Row2) or + (R.Row1 > R.Row2) and (ARow >= R.Row2) and (ARow <= R.Row1) + ); +end; + +procedure ScrollBarKeyPreview(AGrid: TKCustomGrid; AEditor: TScrollBar; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + AGrid.DefaultScrollBarKeyPreview(AEditor, ACol, ARow, Key, ShiftState, IsGridKey); +end; + +{ TKGridAxisItem } + +constructor TKGridAxisItem.Create(AGrid: TKCustomGrid); +begin + FGrid := AGrid; + FCanResize := True; + FExtent := 0; + FInitialPos := -1; + FMaxExtent := 0; + FMinExtent := 0; + FSortArrowIndex := 0; +end; + +procedure TKGridAxisItem.Assign(Source: TKGridAxisItem); +begin + FCanResize := Source.CanResize; + FExtent := Source.Extent; +// FInitialPos := Source.InitialPos; +end; + +procedure TKGridAxisItem.BeginDrag(var Origin: Integer; + const MousePt: TPoint; var CanBeginDrag: Boolean); +begin +end; + +procedure TKGridAxisItem.CheckDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint; var CanDrop: Boolean); +begin +end; + +procedure TKGridAxisItem.EndDrag(Origin, Destination: Integer; + const MousePt: TPoint; var CanEndDrag: Boolean); +begin +end; + +function TKGridAxisItem.{$ifdef COMPILER12_UP}EqualProperties{$ELSE}Equals{$ENDIF}(Item: TKGridAxisItem): Boolean; +begin + Result := (Item.Extent = FExtent) and + (Item.CanResize = FCanResize); +end; + +procedure TKGridAxisItem.SetMaxExtent(AValue: Integer); +begin + if FMinExtent > 0 then + AValue := Max(AValue, FMinExtent); + if (AValue >= 0) and (FMaxExtent <> AValue) then + begin + FMaxExtent := AValue; + if (FMaxExtent > 0) and (FExtent > FMaxExtent) then + Extent := FMaxExtent; + end; +end; + +procedure TKGridAxisItem.SetMinExtent(AValue: Integer); +begin + if FMaxExtent > 0 then + AValue := Min(AValue, FMaxExtent); + if (AValue >= 0) and (FMinExtent <> AValue) then + begin + FMinExtent := AValue; + if (FMinExtent > 0) and Visible and (FExtent < FMinExtent) then + Extent := FMinExtent; + end; +end; + +function TKGridAxisItem.GetVisible: Boolean; +begin + Result := FExtent > 0; +end; + +{ TKGridCol } + +constructor TKGridCol.Create(AGrid: TKCustomGrid); +begin + inherited; + FExtent := FGrid.DefaultColWidth; + FCellHint := False; + FTabStop := True; +end; + +procedure TKGridCol.Assign(Source: TKGridAxisItem); +begin + inherited; + if Source is TKGridCol then + begin + FCellHint := TKGridCol(Source).CellHint; + FTabStop := TKGridCol(Source).TabStop; + end; +end; + +procedure TKGridCol.Assign(Source: TStrings); +var + I, J: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and (Source.Count > 0) and FindCol(I) then + begin + FGrid.LockUpdate; + try + for J := 0 to Min(FGrid.RowCount, Source.Count) - 1 do + begin + Cell := FGrid.ArrayOfCells[J, I]; + if Cell is TKGridTextCell then + TKGridTextCell(Cell).Text := Source[J]; + end; + finally + FGrid.UnlockUpdate; + end; + end; +end; + +{$IFDEF TKGRID_USE_JCL} +procedure TKGridCol.Assign(Source: TWideStrings); +var + I, J: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and (Source.Count > 0) and FindCol(I) then + begin + FGrid.LockUpdate; + try + for J := 0 to Min(FGrid.RowCount, Source.Count) - 1 do + begin + Cell := FGrid.ArrayOfCells[J, I]; + if Cell is TKGridTextCell then + TKGridTextCell(Cell).Text := Source[J]; + end; + finally + FGrid.UnlockUpdate; + end; + end; +end; +{$ENDIF} + +procedure TKGridCol.Clear; +var + I: Integer; +begin + if Assigned(FGrid) and FindCol(I) then + FGrid.ClearCol(I); +end; + +function TKGridCol.{$ifdef COMPILER12_UP}EqualProperties{$ELSE}Equals{$ENDIF}(Item: TKGridAxisItem): Boolean; +begin + Result := inherited Equals(Item) and (Item is TKGridCol) and + (TKGridCol(Item).TabStop = FTabStop) and + (TKGridCol(Item).CellHint = FCellHint); +end; + +function TKGridCol.FindCol(out Index: Integer): Boolean; +begin + Result := False; + Index := 0; + while Index < FGrid.ColCount do + begin + if FGrid.ArrayOfCols[Index] <> Self then + Inc(Index) + else + begin + Result := True; + Exit; + end; + end; +end; + +function TKGridCol.GetObjects(Index: Integer): TObject; +var + I: Integer; + Cell: TKGridCell; +begin + Result := nil; + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.RowValid(Index) and FindCol(I) then + begin + Cell := FGrid.ArrayOfCells[Index, I]; + if Cell is TKGridObjectCell then + Result := TKGridObjectCell(Cell).CellObject; + end; +end; + +function TKGridCol.GetStrings(Index: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; +var + I: Integer; + Cell: TKGridCell; +begin + Result := ''; + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.RowValid(Index) and FindCol(I) then + begin + Cell := FGrid.ArrayOfCells[Index, I]; + if Cell is TKGridTextCell then + Result := TKGridTextCell(Cell).Text; + end; +end; + +procedure TKGridCol.SetExtent(const Value: Integer); +var + I: Integer; +begin + if (Value >= 0) and (Value <> FExtent) then + begin + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and FindCol(I) then + FGrid.ColWidths[I] := Value + else + begin + if FExtent <> 0 then FBackExtent := FExtent; + FExtent := Value; + end; + end; +end; + +procedure TKGridCol.SetObjects(Index: Integer; const Value: TObject); +var + I: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.RowValid(Index) and FindCol(I) then + begin + Cell := FGrid.ArrayOfCells[Index, I]; + if Cell is TKGridObjectCell then + TKGridObjectCell(Cell).CellObject := Value; + end; +end; + +procedure TKGridCol.SetSortArrowIndex(Value: Integer); +var + I: Integer; +begin + Value := Max(Value, 0); + if Value <> FSortArrowIndex then + begin + FSortArrowIndex := Value; + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and + (FSortMode <> smNone) and (FGrid.FixedRows > 1) and FindCol(I) then + FGrid.InvalidateGridRect(GridRect(I, 0, I, FGrid.FixedRows - 1)); + end; +end; + +procedure TKGridCol.SetSortMode(const Value: TKGridSortMode); +var + I: Integer; +begin + if (Value <> FSortMode) and FGrid.SortModeUnlocked then + begin + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and FindCol(I) then + FGrid.SortRows(I, Value) + else + FSortMode := Value; + end; +end; + +procedure TKGridCol.SetStrings(Index: Integer; const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +var + I: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.RowValid(Index) and FindCol(I) then + begin + Cell := FGrid.ArrayOfCells[Index, I]; + if Cell is TKGridTextCell then + TKGridObjectCell(Cell).Text := Value; + end; +end; + +procedure TKGridCol.SetVisible(Value: Boolean); +begin + if Value then + begin + if FBackExtent <= FGrid.MinColWidth then + Extent := FGrid.MinColWidth + else + Extent := FBackExtent; + end else + Extent := 0 +end; + +{ TKGridRow } + +constructor TKGridRow.Create(AGrid: TKCustomGrid); +begin + inherited; + FExtent := FGrid.DefaultRowHeight; +end; + +procedure TKGridRow.Assign(Source: TStrings); +var + I, J: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and (Source.Count > 0) and FindRow(I) then + begin + FGrid.LockUpdate; + try + for J := 0 to Min(FGrid.ColCount, Source.Count) - 1 do + begin + Cell := FGrid.ArrayOfCells[I, J]; + if Cell is TKGridTextCell then + TKGridTextCell(Cell).Text := Source[J]; + end; + finally + FGrid.UnlockUpdate; + end; + end; +end; + +{$IFDEF TKGRID_USE_JCL} +procedure TKGridRow.Assign(Source: TWideStrings); +var + I, J: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and (Source.Count > 0) and FindRow(I) then + begin + FGrid.LockUpdate; + try + for J := 0 to Min(FGrid.ColCount, Source.Count) - 1 do + begin + Cell := FGrid.ArrayOfCells[I, J]; + if Cell is TKGridTextCell then + TKGridTextCell(Cell).Text := Source[J]; + end; + finally + FGrid.UnlockUpdate; + end; + end; +end; +{$ENDIF} + +procedure TKGridRow.Clear; +var + I: Integer; +begin + for I := 0 to FGrid.RowCount - 1 do + if FGrid.Rows[I] = Self then + begin + FGrid.ClearRow(I); + Exit; + end; +end; + +function TKGridRow.FindRow(out Index: Integer): Boolean; +begin + Result := False; + Index := 0; + while Index < FGrid.RowCount do + begin + if FGrid.ArrayOfRows[Index] <> Self then + Inc(Index) + else + begin + Result := True; + Exit; + end; + end; +end; + +function TKGridRow.GetObjects(Index: Integer): TObject; +var + I: Integer; + Cell: TKGridCell; +begin + Result := nil; + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.ColValid(Index) and FindRow(I) then + begin + Cell := FGrid.ArrayOfCells[I, Index]; + if Cell is TKGridObjectCell then + Result := TKGridObjectCell(Cell).CellObject; + end; +end; + +function TKGridRow.GetStrings(Index: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; +var + I: Integer; + Cell: TKGridCell; +begin + Result := ''; + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.ColValid(Index) and FindRow(I) then + begin + Cell := FGrid.ArrayOfCells[I, Index]; + if Cell is TKGridTextCell then + Result := TKGridTextCell(Cell).Text; + end; +end; + +procedure TKGridRow.SetExtent(const Value: Integer); +var + I: Integer; +begin + if (Value >= 0) and (Value <> FExtent) then + begin + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and FindRow(I) then + FGrid.RowHeights[I] := Value + else + begin + if FExtent <> 0 then FBackExtent := FExtent; + FExtent := Value; + end; + end; +end; + +procedure TKGridRow.SetObjects(Index: Integer; const Value: TObject); +var + I: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.ColValid(Index) and FindRow(I) then + begin + Cell := FGrid.ArrayOfCells[I, Index]; + if Cell is TKGridObjectCell then + TKGridObjectCell(Cell).CellObject := Value; + end; +end; + +procedure TKGridRow.SetSortArrowIndex(Value: Integer); +var + I: Integer; +begin + Value := Max(Value, 0); + if Value <> FSortArrowIndex then + begin + FSortArrowIndex := Value; + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and + (FSortMode <> smNone) and (FGrid.FixedCols > 1) and FindRow(I) then + FGrid.InvalidateGridRect(GridRect(0, I, FGrid.FixedCols - 1, I)); + end; +end; + +procedure TKGridRow.SetSortMode(const Value: TKGridSortMode); +var + I: Integer; +begin + if (Value <> FSortMode) and FGrid.SortModeUnlocked then + begin + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) and FindRow(I) then + FGrid.SortCols(I, Value) + else + FSortMode := Value; + end; +end; + +procedure TKGridRow.SetStrings(Index: Integer; const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +var + I: Integer; + Cell: TKGridCell; +begin + if Assigned(FGrid) and Assigned(FGrid.ArrayOfCells) and FGrid.ColValid(Index) and FindRow(I) then + begin + Cell := FGrid.ArrayOfCells[I, Index]; + if Cell is TKGridTextCell then + TKGridTextCell(Cell).Text := Value; + end; +end; + + +procedure TKGridRow.SetVisible(Value: Boolean); +begin + if Value then + begin + if FBackExtent <= FGrid.MinRowHeight then + Extent := FGrid.MinRowHeight + else + Extent := FBackExtent; + end else + Extent := 0 +end; + +{ TKGridCell } + +constructor TKGridCell.Create(AGrid: TKCustomGrid); +begin + FGrid := AGrid; + Initialize; +end; + +procedure TKGridCell.Assign(Source: TKGridCell); +begin + BeforeUpdate; + FSpan := Source.Span; + AfterUpdate; +end; + +procedure TKGridCell.Clear; +begin + BeforeUpdate; + try + Initialize; + finally + AfterUpdate; + end; +end; + +procedure TKGridCell.AfterUpdate; +var + Cells: TKGridCells; + Info: TKGridAxisInfoBoth; + I, J, HExtent, VExtent: Integer; +begin + if Assigned(FGrid) and FGrid.UpdateUnlocked and not FGrid.Flag(cGF_GridUpdates) then + begin + // invalidate cell, iterate only visible cells in a fast way + Cells := FGrid.ArrayOfCells; + Info := FGrid.GetAxisInfoBoth([]); + I := 0; HExtent := 0; + while (I < Info.Horz.TotalCellCount) and (HExtent < Info.Horz.ClientExtent) do + begin + if I = Info.Horz.FixedCellCount then + I := Info.Horz.FirstGridCell; // switch to first visible nonfixed cell + J := 0; VExtent := 0; + while (J < Info.Vert.TotalCellCount) and (VExtent < Info.Vert.ClientExtent) do + begin + if J = Info.Vert.FixedCellCount then + J := Info.Vert.FirstGridCell; // switch to first visible nonfixed cell + if Cells[J, I] = Self then + begin + FGrid.InvalidateCell(I, J); + Exit; + end; + Inc(VExtent, Info.Vert.CellExtent(J) + Info.Vert.EffectiveSpacing(J)); + Inc(J); + end; + Inc(HExtent, Info.Horz.CellExtent(I) + Info.Horz.EffectiveSpacing(I)); + Inc(I); + end; + end; +end; + +procedure TKGridCell.BeforeUpdate; +begin + // empty +end; + +procedure TKGridCell.ApplyDrawProperties; +begin +end; + +procedure TKGridCell.DrawCell(ACol, ARow: Integer; const ARect: TRect; + State: TKGridDrawState); +begin + FGrid.CellPainter.DefaultDraw; +end; + +procedure TKGridCell.EditorCreate(ACol, ARow: Integer; var AEditor: TWinControl); +begin + FGrid.DefaultEditorCreate(ACol, ARow, AEditor); +end; + +procedure TKGridCell.EditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); +begin + FGrid.DefaultEditorDataFromGrid(AEditor, ACol, ARow, AssignText); +end; + +procedure TKGridCell.EditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer; + var AssignText: Boolean); +begin + FGrid.DefaultEditorDataToGrid(AEditor, ACol, ARow, AssignText); +end; + +procedure TKGridCell.EditorDestroy(var AEditor: TWinControl; ACol, ARow: Integer); +begin + FGrid.DefaultEditorDestroy(AEditor, ACol, ARow); +end; + +procedure TKGridCell.EditorKeyPreview(AEditor: TWinControl; ACol, ARow: Integer; + var Key: Word; Shift: TShiftState; var IsGridKey: Boolean); +begin + FGrid.DefaultEditorKeyPreview(AEditor, ACol, ARow, Key, Shift, IsGridKey); +end; + +procedure TKGridCell.EditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); +begin + FGrid.DefaultEditorResize(AEditor, ACol, ARow, ARect); +end; + +procedure TKGridCell.EditorSelect(AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); +begin + FGrid.DefaultEditorSelect(AEditor, ACol, ARow, SelectAll, CaretToLeft, SelectedByMouse); +end; + +function TKGridCell.FindCell(out ACol, ARow: Integer): Boolean; +var + I, J: Integer; +begin + Result := False; + if Assigned(FGrid) then + for I := 0 to FGrid.ColCount - 1 do + for J := 0 to FGrid.RowCount - 1 do + if FGrid.ArrayOfCells[J, I] = Self then + begin + ACol := I; + ARow := J; + Result := True; + Exit; + end; +end; + +procedure TKGridCell.Initialize; +begin + FSpan := MakeCellSpan(1, 1); +end; + +procedure TKGridCell.MeasureCell(ACol, ARow: Integer; const ARect: TRect; + State: TKGridDrawState; Priority: TKGridMeasureCellPriority; var Extent: TPoint); +begin + Extent := FGrid.CellPainter.DefaultMeasure(Priority); +end; + +procedure TKGridCell.SelectCell(ACol, ARow: Integer; var ACanSelect: Boolean); +begin +end; + +procedure TKGridCell.SelectionExpand(ACol, ARow: Integer; var ACanExpand: Boolean); +begin +end; + +procedure TKGridCell.SetColSpan(const Value: Integer); +var + ACol, ARow: Integer; +begin + if Value <> FSpan.ColSpan then + begin + if Assigned(FGrid) and not FGrid.Flag(cGF_GridUpdates) then + begin + if FindCell(ACol, ARow) then + FGrid.CellSpan[ACol, ARow] := MakeCellSpan(Value, FSpan.RowSpan); + end else + FSpan.ColSpan := Value; + end; +end; + +procedure TKGridCell.SetRowSpan(const Value: Integer); +var + ACol, ARow: Integer; +begin + if Value <> FSpan.RowSpan then + begin + if Assigned(FGrid) and not FGrid.Flag(cGF_GridUpdates) then + begin + if FindCell(ACol, ARow) then + FGrid.CellSpan[ACol, ARow] := MakeCellSpan(FSpan.ColSpan, Value); + end else + FSpan.RowSpan := Value; + end; +end; + +procedure TKGridCell.SetSpan(const Value: TKGridCellSpan); +var + ACol, ARow: Integer; +begin + if (Value.ColSpan <> FSpan.ColSpan) or (Value.RowSpan <> FSpan.RowSpan) then + begin + if Assigned(FGrid) and not FGrid.Flag(cGF_GridUpdates) then + begin + if FindCell(ACol, ARow) then + FGrid.CellSpan[ACol, ARow] := Value; + end else + FSpan := Value; + end; +end; + +{ TKGridTextCell } + +constructor TKGridTextCell.Create(AGrid: TKCustomGrid); +begin +{$IFDEF STRING_IS_UNICODE} + FText := ''; +{$ELSE} + FText := nil; +{$ENDIF} + inherited; +end; + +destructor TKGridTextCell.Destroy; +begin + inherited; +{$IFNDEF STRING_IS_UNICODE} + FreeMem(FText); +{$ENDIF} +end; + +procedure TKGridTextCell.ApplyDrawProperties; +begin + FGrid.CellPainter.Text := Text; +end; + +procedure TKGridTextCell.Assign(Source: TKGridCell); +begin + inherited; + if Source is TKGridTextCell then + SetText(TKGridTextCell(Source).TextPtr); +end; + +procedure TKGridTextCell.AssignText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +{$IFNDEF STRING_IS_UNICODE} +var + Len: Integer; +{$ENDIF} +begin +{$IFDEF STRING_IS_UNICODE} + FText := Value; +{$ELSE} + Len := (Length(Value) + 1) * SizeOf(WideChar); + ReallocMem(FText, Len); + if Value <> '' then + Move(Value[1], FText^, Len) + else if FText <> nil then + FText[0] := #0; +{$ENDIF} +end; + +procedure TKGridTextCell.EditorCreate(ACol, ARow: Integer; var AEditor: TWinControl); +begin + AEditor := TEdit.Create(nil); +end; + +{$IFDEF STRING_IS_UNICODE} +function TKGridTextCell.GetTextPtr: PChar; +begin + Result := PChar(FText); +end; +{$ELSE} +function TKGridTextCell.GetText: WideString; +begin + Result := FText; +end; +{$ENDIF} + +procedure TKGridTextCell.Initialize; +begin + inherited; +{$IFDEF STRING_IS_UNICODE} + FText := ''; +{$ELSE} + FreeMem(FText); + FText := nil; +{$ENDIF} +end; + +procedure TKGridTextCell.SetText(const Value: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +begin +{$IFDEF STRING_IS_UNICODE} + if Value <> FText then +{$ELSE} + if CompareWideChars(PWideChar(Value), FText) <> 0 then +{$ENDIF} + begin + BeforeUpdate; + AssignText(Value); + AfterUpdate; + end; +end; + +{ TKGridAttrTextCell } + +constructor TKGridAttrTextCell.Create(AGrid: TKCustomGrid); +begin + inherited; + FBrush := TBrush.Create; + FBrush.OnChange := BrushChange; + FBrushChanged := False; + FFont := TFont.Create; + FFont.OnChange := FontChange; + FFontChanged := False; + Initialize; +end; + +destructor TKGridAttrTextCell.Destroy; +begin + FBrush.Free; + FFont.Free; + inherited; +end; + +procedure TKGridAttrTextCell.ApplyDrawProperties; +var + AColor: TColor; +begin + inherited; + if FGrid.CellPainter.State * [gdSelected] <> [] then + begin + // Brush remains unaffected by default + if FFontChanged then + begin + // Font color remains unaffected by default + AColor := FGrid.CellPainter.Canvas.Font.Color; + FGrid.CellPainter.Canvas.Font := FFont; + FGrid.CellPainter.Canvas.Font.Color := AColor; + if FGrid.CellPainter.FPrinting then + FGrid.CellPainter.Canvas.Font.Height := Abs(FFont.Height); + end; + end else + begin + FGrid.CellPainter.BackColor := FBackColor; + if FBrushChanged then + begin + FGrid.CellPainter.Canvas.Brush := FBrush; + {$IFNDEF FPC} + SetBrushOrgEx(FGrid.CellPainter.Canvas.Handle, FGrid.CellPainter.CellRect.Left, + FGrid.CellPainter.CellRect.Top, nil); + {$ENDIF} + end; + if FFontChanged then + begin + FGrid.CellPainter.Canvas.Font := FFont; + if FGrid.CellPainter.FPrinting then + FGrid.CellPainter.Canvas.Font.Height := Abs(FFont.Height); + end; + end; + FGrid.CellPainter.HAlign := FHAlign; + FGrid.CellPainter.VAlign := FVAlign; + FGrid.CellPainter.HPadding := FHPadding; + FGrid.CellPainter.VPadding := FVPadding; +end; + +procedure TKGridAttrTextCell.Assign(Source: TKGridCell); +begin + inherited; + if Source is TKGridAttrTextCell then + begin + FBackColor := TKGridAttrTextCell(Source).BackColor; + FBrush.Assign(TKGridAttrTextCell(Source).Brush); + FBrushChanged := TKGridAttrTextCell(Source).BrushChanged; + FFont.Assign(TKGridAttrTextCell(Source).Font); + FFontChanged := TKGridAttrTextCell(Source).FontChanged; + FHAlign := TKGridAttrTextCell(Source).HAlign; + FHPadding := TKGridAttrTextCell(Source).HPadding; + FVAlign := TKGridAttrTextCell(Source).VAlign; + FVPadding := TKGridAttrTextCell(Source).VPadding; + end; +end; + +procedure TKGridAttrTextCell.BrushChange(Sender: TObject); +begin + BeforeUpdate; + FBrushChanged := True; + AfterUpdate; +end; + +procedure TKGridAttrTextCell.FontChange(Sender: TObject); +begin + BeforeUpdate; + FFontChanged := True; + AfterUpdate; +end; + +procedure TKGridAttrTextCell.Initialize; +begin + inherited; + FBackColor := clWindow; + FHAlign := halLeft; + FHPadding := 2; + FVAlign := valCenter; + FVPadding := 0; + // no defaults for Brush and Font! +end; + +procedure TKGridAttrTextCell.SetBackColor(const Value: TColor); +begin + if Value <> FBackColor then + begin + BeforeUpdate; + FBackColor := Value; + AfterUpdate; + end; +end; + +procedure TKGridAttrTextCell.SetFHAlign(const Value: TKHAlign); +begin + if Value <> FHAlign then + begin + BeforeUpdate; + FHAlign := Value; + AfterUpdate; + end; +end; + +procedure TKGridAttrTextCell.SetAttributes(const AValue: TKTextAttributes); +begin + if AValue <> FAttributes then + begin + BeforeUpdate; + FAttributes := AValue; + AfterUpdate; + end; +end; + +procedure TKGridAttrTextCell.SetFHPadding(const Value: Integer); +begin + if Value <> FHPadding then + begin + BeforeUpdate; + FHPadding := Value; + AfterUpdate; + end; +end; + +procedure TKGridAttrTextCell.SetFVAlign(const Value: TKVAlign); +begin + if Value <> FVAlign then + begin + BeforeUpdate; + FVAlign := Value; + AfterUpdate; + end; +end; + +procedure TKGridAttrTextCell.SetFVPadding(const Value: Integer); +begin + if Value <> FVPadding then + begin + BeforeUpdate; + FVPadding := Value; + AfterUpdate; + end; +end; + +{ TKGridObjectCell } + +constructor TKGridObjectCell.Create(AGrid: TKCustomGrid); +begin + FCellObject := nil; + inherited; +end; + +destructor TKGridObjectCell.Destroy; +begin + inherited; + FCellObject.Free; +end; + +procedure TKGridObjectCell.Assign(Source: TKGridCell); +var + Obj: TObject; +begin + inherited; + if Source is TKGridObjectCell then + begin + Obj := TKGridObjectCell(Source).CellObject; + if (Obj is TPersistent) and (FCellObject.ClassType = Obj.ClassType) then + TPersistent(FCellObject).Assign(TPersistent(Obj)); + end; +end; + +procedure TKGridObjectCell.Initialize; +begin + inherited; + FreeAndNil(FCellObject); +end; + +procedure TKGridObjectCell.SetCellObject(Value: TObject); +begin + if Value <> FCellObject then + begin + FCellObject.Free; + FCellObject := Value; + end; +end; + +{ TKGridCellPainter } + +constructor TKGridCellPainter.Create(AGrid: TKCustomGrid); +begin + inherited Create; + FGrid := AGrid; + FCanvas := nil; + FCol := 0; + FClipLock := 0; + FRgn := 0; + FRow := 0; + FState := []; + FValidClipping := False; + FSortArrow := TKAlphaBitmap.CreateFromRes('KGRID_SORT_ARROW'); + Initialize; +end; + +destructor TKGridCellPainter.Destroy; +begin + FSortArrow.Free; + inherited; +end; + +function TKGridCellPainter.BeginClip; +var + R: TRect; +begin + if FClipLock = 0 then with FCanvas do + begin + R := FCellRect; + TranslateRectToDevice(Handle, R); + FValidClipping := ExtSelectClipRect(Handle, R, RGN_AND, FRgn); + end; + Inc(FClipLock); + Result := FValidClipping; +end; + +procedure TKGridCellPainter.BeginDraw; +begin + DefaultAttributes; +end; + +function TKGridCellPainter.CellCheckBoxRect(var BaseRect: TRect; out Bounds, Interior: TRect; StretchMode: TKStretchMode): Boolean; +begin + if FCheckBox and not IsRectEmpty(BaseRect) then + begin + ExcludeShapeFromBaseRect(BaseRect, cCheckBoxFrameSize{$IFDEF LCLQT} + 1{$ENDIF}, cCheckBoxFrameSize, FCheckBoxHAlign, + FCheckBoxVAlign, FCheckBoxHPadding, FCheckBoxVPadding, StretchMode, Bounds, Interior); + Result := True; + end else + Result := False; +end; + +function TKGridCellPainter.CellGraphicRect(var BaseRect: TRect; out Bounds, Interior: TRect; StretchMode: TKStretchMode): Boolean; +begin + if Assigned(FGraphic) and not IsRectEmpty(BaseRect) then + begin + ExcludeShapeFromBaseRect(BaseRect, FGraphic.Width, FGraphic.Height, FGraphicHAlign, + FGraphicVAlign, FGraphicHPadding, FGraphicVPadding, StretchMode, Bounds, Interior); + Result := True; + end else + Result := False; +end; + +function TKGridCellPainter.CellSortArrowRect(var BaseRect: TRect; out Bounds, Interior: TRect): Boolean; +var + ArrowWidth: Integer; +begin + ArrowWidth := SortArrowWidth; + if (ArrowWidth > 0) and not IsRectEmpty(BaseRect) then + begin + ExcludeShapeFromBaseRect(BaseRect, ArrowWidth, BaseRect.Bottom - BaseRect.Top, FSortArrowHAlign, + valCenter, FSortArrowHPadding, 0, stmNone, Bounds, Interior); + Result := True; + end else + Result := False; +end; + +function TKGridCellPainter.CellTextExtent(const BaseRect: TRect; out Extent: TPoint): Boolean; +var + R: TRect; +begin + if (FText <> '') and not IsRectEmpty(BaseRect) then + begin + R := BaseRect; + DrawAlignedText(FCanvas, R, FHAlign, FVAlign, + FHPadding, FVPadding, FText, FBackColor, FAttributes + [taCalcRect]); + Extent.X := R.Right - R.Left; + Extent.Y := R.Bottom - R.Top; + Result := True; + end else + Result := False; +end; + +function TKGridCellPainter.CellTextRect(var BaseRect: TRect; out Bounds, Interior: TRect): Boolean; +var + Extent: TPoint; +begin + if CellTextExtent(BaseRect, Extent) then + begin + ExcludeShapeFromBaseRect(BaseRect, Extent.X, Extent.Y, FHAlign, + FVAlign, FHPadding, FVPadding, stmNone, Bounds, Interior); + Result := True; + end else + Result := False; +end; + +procedure TKGridCellPainter.DefaultAttributes; +var + Color: TColor; +begin + Initialize; + // prepare default brush and font style + with FCanvas do + begin + Brush.Style := bsSolid; + Pen.Style := psSolid; + Pen.Mode := pmCopy; + Font := FGrid.Font; + if FPrinting then + Font.Height := Abs(FGrid.Font.Height); + if gdFixed in FState then + begin + // aki: + if gdSelected in FState then + Color := FGrid.Colors.SelectedFixedCellBkGnd + else if (goIndicateSelection in FGrid.Options) and (FGrid.ColSelected(FCol) and + not (goRowSelect in FGrid.Options) or FGrid.RowSelected(FRow)) then + Color := FGrid.Colors.FixedCellIndication + else + Color := FGrid.Colors.FixedCellBkGnd; + if gdMouseDown in FState then + Brush.Color := BrightColor(Color, 0.6, bsOfTop) + else + Brush.Color := Color; + Font.Color := FGrid.Colors.FixedCellText; + end else if gdSelected in FState then + begin + if FPrinting or FGrid.HasFocus then + begin + if (FGrid.Col = FCol) and (FGrid.Row = FRow) then + begin + Brush.Color := FGrid.Colors.FocusedCellBkGnd; + Font.Color := FGrid.Colors.FocusedCellText; + end else + begin + Brush.Color := FGrid.Colors.FocusedRangeBkGnd; + Font.Color := FGrid.Colors.FocusedRangeText; + end; + end else + begin + if (FGrid.Col = FCol) and (FGrid.Row = FRow) then + begin + Brush.Color := FGrid.Colors.SelectedCellBkGnd; + Font.Color := FGrid.Colors.SelectedCellText; + end else + begin + Brush.Color := FGrid.Colors.SelectedRangeBkGnd; + Font.Color := FGrid.Colors.SelectedRangeText; + end; + end; + end else + begin + Brush.Color := FGrid.Colors.CellBkGnd; + Font.Color := FGrid.Colors.CellText; + end; + end; +end; + +procedure TKGridCellPainter.DefaultDraw; +begin + if gdFixed in FState then + begin + if (FRow < FGrid.FixedRows) and (goHeader in FGrid.Options) then + DrawHeaderCellBackground(FCellRect) + else + DrawFixedCellBackground(FCellRect); + end + else if gdSelected in FState then + begin + if FGrid.Options * [goRowSelect, goRangeSelect] <> [] then + DrawSelectedCellBackground(FBlockRect, @FCellRect) + else + DrawSelectedCellBackground(FCellRect) + end else + DrawNormalCellBackground(FCellRect); + DrawCellCommon; +end; + +function TKGridCellPainter.DefaultEdges: Cardinal; +begin + Result := 0; + if goFixedHorzLine in FGrid.Options then + begin + Result := BF_TOP; + if not (goAlignLastRow in FGrid.Options) or (FRow < FGrid.RowCount - 1) then + Result := Result or BF_BOTTOM; + end; + if goFixedVertLine in FGrid.Options then + begin + Result := Result or BF_LEFT; + if not (goAlignLastCol in FGrid.Options) or (FCol < FGrid.ColCount - 1) then + Result := Result or BF_RIGHT; + end; +end; + +function TKGridCellPainter.DefaultMeasure(Priority: TKGridMeasureCellPriority): TPoint; +const + cMaxAutoSizeColWidth = 10000; + cMaxAutoSizeRowHeight = 10000; + cMaxAutoSizeStretchImageHeight = 1024; +var + BaseRect, Bounds, Interior: TRect; +begin + BaseRect := FCellRect; + case Priority of + mpColWidth: BaseRect.Right := cMaxAutoSizeColWidth; + mpRowHeight: BaseRect.Bottom := cMaxAutoSizeRowHeight; + else + BaseRect.Right := cMaxAutoSizeColWidth; + BaseRect.Bottom := cMaxAutoSizeRowHeight; + end; + if Assigned(FGraphic) and (FGraphicStretchMode in [stmZoom, stmZoomInOnly]) then + BaseRect.Bottom := Min(BaseRect.Bottom, BaseRect.Top + (FGraphicVPadding shl 1) + cMaxAutoSizeStretchImageHeight); +// BaseRect.Right := MaxInt; // keep cell height, maximize cell width and cut each object from BaseRect + Result.X := 0; + Result.Y := 0; + if CellSortArrowRect(BaseRect, Bounds, Interior) then + begin + Inc(Result.X, Bounds.Right - Bounds.Left); + Result.Y := Interior.Bottom - Interior.Top; + end; + if CellCheckBoxRect(BaseRect, Bounds, Interior, stmNone) then // for measuring always consider check box frame with original size + begin + Inc(Result.X, Bounds.Right - Bounds.Left); + Result.Y := Max(Result.Y, Interior.Bottom - Interior.Top + (FCheckBoxVPadding shl 1)); + end; + if CellGraphicRect(BaseRect, Bounds, Interior, FGraphicStretchMode) then // for measuring consider stretched image as for drawing + begin + Inc(Result.X, Bounds.Right - Bounds.Left); + Result.Y := Max(Result.Y, Interior.Bottom - Interior.Top + (FGraphicVPadding shl 1)); + end; + if CellTextExtent(BaseRect, Interior.TopLeft) then + begin + Inc(Result.X, Interior.Left + (FHPadding shl 1)); + Result.Y := Max(Result.Y, Interior.Top + (FVPadding shl 1)); + end; +end; + +procedure TKGridCellPainter.DrawCellCommon; +var + BaseRect, Bounds, Interior, BoundsSA, InteriorSA: TRect; + IsSortArrow: Boolean; +begin + if not (gdEdited in FState) then + begin + BaseRect := FCellRect; + IsSortArrow := CellSortArrowRect(BaseRect, BoundsSA, InteriorSA); + if CellCheckBoxRect(BaseRect, Bounds, Interior, stmZoomOutOnly) then // disallow zoom in for check box frame + DrawCellCheckBox(Bounds, Interior); + if CellGraphicRect(BaseRect, Bounds, Interior, FGraphicStretchMode) then + DrawCellGraphic(Bounds, Interior); + if not IsRectEmpty(BaseRect) then + begin + if FButton then + DrawCellButton(BaseRect) + else + DrawCellText(BaseRect); + end; + if IsSortArrow then + DrawCellSortArrow(BoundsSA, InteriorSA); + if gdSelected in FState then + DrawCellFocus(FCellRect); + end; +end; + +procedure TKGridCellPainter.DrawButtonFrame(const ARect: TRect); +var + BM: TBitmap; + TmpCanvas: TCanvas; + TmpRect: TRect; + ButtonState: Integer; + IsHot: Boolean; + MousePt: TPoint; +{$IFDEF USE_THEMES} + ButtonTheme: TThemedButton; +{$ENDIF} +begin + // a LOT of tweaking here... +{$IF DEFINED(USE_WINAPI) OR DEFINED(LCLQT) } // GTK2 cannot strech and paint on bitmap canvas, grrr.. + if CanvasScaled(FCanvas) {$IFDEF USE_WINAPI}and FGrid.ThemedCells{$ENDIF} then + begin + BM := TBitmap.Create; + BM.Width := ARect.Right - ARect.Left; + BM.Height := ARect.Bottom - ARect.Top; + BM.Canvas.Brush.Assign(FCanvas.Brush); + TmpRect := Rect(0, 0, BM.Width, BM.Height); + BM.Canvas.FillRect(TmpRect); + TmpCanvas := BM.Canvas; + end else +{$IFEND} + begin + BM := nil; + TmpRect := ARect; + TmpCanvas := FCanvas; + end; + try + MousePt := FGrid.ScreenToClient(Mouse.CursorPos); + IsHot := (gdMouseOver in FState) and + (not FHotFrameOnly or PtInRect(ARect, MousePt)); + {$IFDEF USE_THEMES} + if FGrid.ThemedCells then + begin + if FGrid.Enabled then + if FButtonPressed then + ButtonTheme := tbPushButtonPressed + else + if IsHot then + ButtonTheme := tbPushButtonHot + else + ButtonTheme := tbPushButtonNormal + else + ButtonTheme := tbPushButtonDisabled; + ThemeServices.DrawElement(TmpCanvas.Handle, ThemeServices.GetElementDetails(ButtonTheme), TmpRect); + end else + {$ENDIF} + begin + ButtonState := DFCS_BUTTONPUSH; + if FButtonPressed then ButtonState := ButtonState or DFCS_PUSHED; + if not FGrid.Enabled then ButtonState := ButtonState or DFCS_INACTIVE; + DrawFrameControl(TmpCanvas.Handle, TmpRect, DFC_BUTTON, ButtonState); + end; + if BM <> nil then + FCanvas.Draw(ARect.Left, ARect.Top, BM); + finally + BM.Free; + end; +end; + +procedure TKGridCellPainter.DrawCellButton(Bounds: TRect); +begin + DrawButtonFrame(Bounds); + DrawCellText(Bounds); +end; + +procedure TKGridCellPainter.DrawCellCheckBox(const Bounds, Interior: TRect); +begin + DrawCheckBoxFrame(Interior); +end; + +procedure TKGridCellPainter.DrawCellGraphic(const Bounds, Interior: TRect); +begin + if Assigned(FGraphic) then + begin + if FGraphicStretchMode = stmZoom then + SafeStretchDraw(FCanvas, Interior, FGraphic, FBackColor) + else if BeginClip then + try + SafeStretchDraw(FCanvas, Interior, FGraphic, FBackColor); + finally + EndClip; + end; + end; +end; + +procedure TKGridCellPainter.DrawCellFocus(const ARect: TRect; SkipTest: Boolean); +begin + if (gdFocused in FState) and (SkipTest or (FGrid.Options * [goRangeSelect, goRowSelect, + goDrawFocusSelected] = [goDrawFocusSelected])) then + begin + // to ensure coming DrawFocusRect will be painted correctly: + SetBkColor(FCanvas.Handle, $FFFFFF); + SetTextColor(FCanvas.Handle, 0); + FCanvas.DrawFocusRect(FCellRect); + end; +end; + +procedure TKGridCellPainter.DrawCellSortArrow(const Bounds, Interior: TRect); +var + ArrowCopy: TKAlphaBitmap; + Mirror, Rotate: Boolean; +begin + if FSortArrow <> nil then + begin + if BeginClip then + try + Mirror := FState * [gdColsSortedDown, gdRowsSortedDown] <> []; + Rotate := FState * [gdColsSortedDown, gdColsSortedUp] <> []; + ArrowCopy := TKAlphaBitmap.Create; + try + if Rotate then + begin + ArrowCopy.CopyFromRotated(FSortArrow); + if Mirror then + ArrowCopy.MirrorHorz; + end else + begin + ArrowCopy.CopyFrom(FSortArrow); + if Mirror then + ArrowCopy.MirrorVert; + end; + ArrowCopy.AlphaDrawTo(FCanvas, Interior.Left, Interior.Top + (Interior.Bottom - Interior.Top - ArrowCopy.Height) div 2); + finally + ArrowCopy.Free; + end; + finally + EndClip; + end; + end; +end; + +procedure TKGridCellPainter.DrawCellText(var ARect: TRect); +var + TextAttributes: TKTextAttributes; +begin + TextAttributes := FAttributes; +{ if FFillCellBackground then + Include(TextAttributes, taFillRect) + else + Exclude(TextAttributes, taFillRect);} + DrawAlignedText(FCanvas, ARect, FHAlign, FVAlign, + FHPadding, FVPadding, FText, FBackColor, TextAttributes); +end; + +procedure TKGridCellPainter.DrawCheckBoxFrame(const ARect: TRect); +var + BM: TBitmap; + TmpCanvas: TCanvas; + TmpRect: TRect; + State: Integer; + IsHot: Boolean; + MousePt: TPoint; +{$IFDEF USE_THEMES} + CheckBoxTheme: TThemedButton; +{$ENDIF} +begin + // a LOT of tweaking here... +{$IF DEFINED(USE_WINAPI) OR DEFINED(LCLQT) } // GTK2 cannot strech and paint on bitmap canvas, grrr.. + if CanvasScaled(FCanvas) {$IFDEF USE_WINAPI}and FGrid.ThemedCells{$ENDIF} then + begin + BM := TBitmap.Create; + BM.Width := ARect.Right - ARect.Left; + BM.Height := ARect.Bottom - ARect.Top; + BM.Canvas.Brush.Assign(FCanvas.Brush); + TmpRect := Rect(0, 0, BM.Width, BM.Height); + BM.Canvas.FillRect(TmpRect); + TmpCanvas := BM.Canvas; + end else +{$IFEND} + begin + BM := nil; + TmpRect := ARect; + TmpCanvas := FCanvas; + end; + try + {$IFDEF USE_THEMES} + MousePt := FGrid.ScreenToClient(Mouse.CursorPos); + IsHot := (gdMouseOver in FState) and + (not FHotFrameOnly or PtInRect(ARect, MousePt)); + if FGrid.ThemedCells then + begin + if FGrid.Enabled then + case FCheckBoxState of + cbChecked: + begin + if IsHot then + CheckBoxTheme := tbCheckBoxCheckedHot + else + CheckBoxTheme := tbCheckBoxCheckedNormal; + end; + cbUnchecked: + begin + if IsHot then + CheckBoxTheme := tbCheckBoxUncheckedHot + else + CheckBoxTheme := tbCheckBoxUncheckedNormal; + end; + else + if IsHot then + CheckBoxTheme := tbCheckBoxMixedHot + else + CheckBoxTheme := tbCheckBoxMixedNormal; + end + else + case FCheckboxState of + cbChecked: + CheckBoxTheme := tbCheckBoxCheckedDisabled; + cbUnchecked: + CheckBoxTheme := tbCheckBoxUncheckedDisabled; + else + CheckBoxTheme := tbCheckBoxMixedDisabled; + end; + ThemeServices.DrawElement(TmpCanvas.Handle, ThemeServices.GetElementDetails(CheckBoxTheme), TmpRect); + end else + {$ENDIF} + begin + State := DFCS_BUTTON3STATE; + case FCheckBoxState of + cbChecked: + State := State or DFCS_CHECKED; +// cbGrayed: +// State := State or DFCS_GRAYED; + end; + if not FGrid.Enabled then State := State or DFCS_INACTIVE; + DrawFrameControl(TmpCanvas.Handle, TmpRect, DFC_BUTTON, State); + end; + if BM <> nil then + FCanvas.Draw(ARect.Left, ARect.Top, BM); + finally + BM.Free; + end; +end; + +procedure TKGridCellPainter.DrawHeaderCellBackground(const ARect: TRect); +{$IFDEF USE_THEMES} +var + Details: TThemedElementDetails; + Header: TThemedHeader; + TmpRect: TRect; +{$ENDIF} +begin +{$IFDEF USE_THEMES} + if FGrid.ThemedCells then with ThemeServices do + begin + if gdSelected in FState then + Header := thHeaderItemPressed + else if gdMouseDown in FState then + Header := thHeaderItemPressed + else if gdMouseOver in FState then + Header := thHeaderItemHot + else + Header := thHeaderItemNormal; + { The background for the themed header is messy. HasTransparentParts returns + always True and we cannot call DrawParentBackground as this is wrong + approach here. So for this reason, thHeaderItemNormal is always supposed + to be visually not transparent. We paint it only if double buffering is + present because double buffer is a temporary memory and, of course, + the screen content is not copied back to the double buffer. } + TmpRect := ARect; + Inc(TmpRect.Bottom); // it is nicer + if FGrid.IsDoubleBuffered and (Header <> thHeaderItemNormal) then + DrawElement(FCanvas.Handle, GetElementDetails(thHeaderItemNormal), TmpRect); + Details := GetElementDetails(Header); + DrawElement(FCanvas.Handle, Details, TmpRect); + end else +{$ENDIF} + DrawFixedCellNonThemedBackground(ARect); +end; + +procedure TKGridCellPainter.DrawEmptyCell; +begin + DrawNormalCellBackground(FCellRect); +end; + +procedure TKGridCellPainter.DrawFixedCell; +begin + DrawFixedCellBackground(FCellRect); + DrawCellCommon; +end; + +procedure TKGridCellPainter.DrawFixedCellBackground(const ARect: TRect); +{$IFDEF USE_THEMES} +var + Color1, Color2: TColor; +{$ENDIF} +begin +{$IFDEF USE_THEMES} + if FGrid.ThemedCells and (gxFixedThemedCells in FGrid.OptionsEx) then + DrawHeaderCellBackground(ARect) + else if FGrid.ThemedCells then + begin + DrawFilledRectangle(FCanvas, ARect, FBackColor); + if {$IFDEF FPC}not FGrid.Flat{$ELSE}FGrid.Ctl3D{$ENDIF} then + begin + if gdMouseDown in FState then + begin + Color1 := FGrid.Colors.FixedThemedCellShadow; + Color2 := FGrid.Colors.FixedThemedCellHighlight; + end else + begin + Color1 := FGrid.Colors.FixedThemedCellHighlight; + Color2 := FGrid.Colors.FixedThemedCellShadow; + end; + DrawEdges(FCanvas, ARect, Color1, Color2, DefaultEdges); + end; + end else +{$ENDIF} + DrawFixedCellNonThemedBackground(ARect); +end; + +procedure TKGridCellPainter.DrawFixedCellNonThemedBackground(const ARect: TRect); +{$IFDEF USE_WINAPI} +var + R: TRect; +{$ENDIF} +begin + DrawFilledRectangle(FCanvas, ARect, FBackColor); + if {$IFDEF FPC}not FGrid.Flat{$ELSE}FGrid.Ctl3D{$ENDIF} and not (gdMouseDown in FState) then + begin + {$IFDEF USE_WINAPI} + // looks somewhat better though + R := ARect; + DrawEdge(FCanvas.Handle, R, BDR_RAISEDINNER, DefaultEdges); + {$ELSE} + DrawEdges(FCanvas, ARect, cl3DHilight, cl3DShadow, DefaultEdges); + {$ENDIF} + end; +end; + +procedure TKGridCellPainter.DrawHeaderCell; +begin + DrawHeaderCellBackground(FCellRect); + DrawCellCommon; +end; + +procedure TKGridCellPainter.DrawNormalCellBackground(const ARect: TRect); +begin + DrawFilledRectangle(FCanvas, ARect, FBackColor); +end; + +procedure TKGridCellPainter.DrawSelectableCell; +begin + if gdSelected in FState then + DrawSelectedCellBackground(FCellRect) + else + DrawNormalCellBackground(FCellRect); + DrawCellCommon; +end; + +procedure TKGridCellPainter.DrawSelectedCellBackground(const ARect: TRect; RClip: PRect); +var +{$IFDEF USE_THEMES} + {$IF (DEFINED(COMPILER9_UP) OR DEFINED(FPC)) AND DEFINED(USE_WINAPI)} + {$IFDEF FPC} + Details: TThemedElementDetails; + {$ELSE} + SelectionTheme: HTHEME; + {$ENDIF} + Color: TColorRef; + {$IFEND} +{$ENDIF} + R: TRect; +begin +{$IFDEF USE_THEMES} + {$IF (DEFINED(COMPILER9_UP) OR DEFINED(FPC)) AND DEFINED(USE_WINAPI)} + if FGrid.ThemedCells and (Win32MajorVersion >= 6) then // Windows Vista and later + begin + // make the background brigther + if FPrinting or FGrid.HasFocus then + FCanvas.Brush.Color := BrightColor(FCanvas.Brush.Color, 0.8, bsOfTop) + else + FCanvas.Brush.Color := clWhite; + if RClip <> nil then + FCanvas.FillRect(RClip^) + else + FCanvas.FillRect(ARect); + {$IFDEF FPC} + Details := ThemeServices.GetElementDetails(tmPopupItemHot); + ThemeServices.DrawElement(FCanvas.Handle, Details, ARect, RClip); + Color := clWindowText; // getting text color not supported + {$ELSE} + SelectionTheme := ThemeServices.Theme[teMenu]; + DrawThemeBackground(SelectionTheme, FCanvas.Handle, MENU_POPUPITEM, MPI_HOT, ARect, RClip); + GetThemeColor(SelectionTheme, MENU_POPUPITEM, MPI_HOT, TMT_TEXTCOLOR, Color); + {$ENDIF} + FCanvas.Font.Color := Color; + end else + {$IFEND} +{$ENDIF} + begin + if RClip <> nil then + R := RClip^ + else + R := ARect; + DrawFilledRectangle(FCanvas, R, FBackColor); + end; +end; + +procedure TKGridCellPainter.DrawThemedFixedCell; +begin + DrawFixedCellBackground(FCellRect); + DrawCellCommon; +end; + +procedure TKGridCellPainter.DrawThemedHeaderCell; +begin + DrawHeaderCellBackground(FCellRect); + DrawCellCommon; +end; + +procedure TKGridCellPainter.EndClip; +begin + if FClipLock > 0 then with FCanvas do + begin + Dec(FClipLock); + if FClipLock = 0 then + begin + FinalizePrevRgn(Handle, FRgn); + FValidClipping := False; + end; + end; +end; + +procedure TKGridCellPainter.EndDraw; +begin +end; + +function TKGridCellPainter.GetCheckBoxChecked: Boolean; +begin + Result := FCheckBoxState = cbChecked; +end; + +function TKGridCellPainter.GetSortArrowWidth: Integer; +begin + if FSortArrow <> nil then + begin + if FState * [gdColsSortedDown, gdColsSortedUp] <> [] then + Result := FSortArrow.Height + 3 + else if FState * [gdRowsSortedDown, gdRowsSortedUp] <> [] then + Result := FSortArrow.Width + 3 + else + Result := 0; + end else + Result := 0; +end; + +procedure TKGridCellPainter.Initialize; +begin + FAttributes := [taEndEllipsis]; + FBackColor := clWindow; + FButton := False; + FButtonPressed := False; + FCheckBox := False; + FCheckBoxHAlign := halLeft; + FCheckBoxHPadding := 2; + FCheckBoxVAlign := valCenter; + FCheckBoxVPadding := 2; + FCheckBoxState := cbUnchecked; + FGraphic := nil; + FGraphicDrawText := False; + FGraphicHAlign := halCenter; + FGraphicHPadding := 2; + FGraphicStretchMode := stmZoom; + FGraphicVAlign := valCenter; + FGraphicVPadding := 2; + FHAlign := halLeft; + FHotFrameOnly := False; + FHPadding := 2; + FSortArrowHAlign := halRight; + FSortArrowHPadding := 2; + FText := ''; + FVAlign := valCenter; + FVPadding := 0; +end; + +procedure TKGridCellPainter.SetCheckBox(AValue: Boolean); +begin + if AValue <> FCheckBox then + begin + FCheckBox := AValue; + if AValue then + begin + // set default padding for check box text (not tested for Linux and MAC) + if FGrid.Themes then + FHPadding := 3 + else + FHPadding := 4; + end; + end; +end; + +procedure TKGridCellPainter.SetCheckBoxChecked(const Value: Boolean); +begin + if Value then + FCheckBoxState := cbChecked + else + FCheckBoxState := cbUnchecked; +end; + +{ TKGridColors } + +constructor TKGridColors.Create(AGrid: TKCustomGrid); +begin + inherited Create; + FGrid := AGrid; + FBrightRangeBkgnd := True; + Initialize; + ClearBrightColors; + //BrightRangeBkGnds; +end; + +procedure TKGridColors.Assign(Source: TPersistent); +begin + inherited; + if Source is TKGridColors then + begin + Colors := TKGridColors(Source).Colors; + FGrid.Invalidate; + end +end; + +procedure TKGridColors.BrightRangeBkGnds; + procedure DoBright(Src: TColor; var Dest: TColor); + begin + Dest := BrightColor(Src, 0.4, bsOfTop); + end; +begin + if FBrightRangeBkGnd and (FGrid.ComponentState * [csDesigning, csLoading] = []) then + begin + DoBright(FColors[ciFocusedCellBkGnd], FColors[ciFocusedRangeBkGnd]); + DoBright(FColors[ciSelectedCellBkGnd], FColors[ciSelectedRangeBkGnd]); + end; +end; + +procedure TKGridColors.ClearBrightColors; +var + I: TKGridColorIndex; +begin + for I := 0 to Length(FBrightColors) - 1 do + FBrightColors[I] := clNone; +end; + +function TKGridColors.GetColor(Index: TKGridColorIndex): TColor; +begin + Result := InternalGetColor(Index); +end; + +function TKGridColors.GetColorEx(Index: TKGridColorIndex): TColor; +begin + Result := FColors[Index]; +end; + +procedure TKGridColors.Initialize; +begin + SetLength(FColors, ciGridColorsMax + 1); + SetLength(FBrightColors, ciGridColorsMax + 1); + FColors[ciCellBkGnd] := cCellBkGndDef; + FColors[ciCellLines] := cCellLinesDef; + FColors[ciCellText] := cCellTextDef; + FColors[ciDragSuggestionBkGnd] := cDragSuggestionBkGndDef; + FColors[ciDragSuggestionLine] := cDragSuggestionLineDef; + FColors[ciFixedCellBkGnd] := cFixedCellBkGndDef; + FColors[ciFixedCellIndication] := cFixedCellIndicationDef; + FColors[ciFixedCellLines] := cFixedCellLinesDef; + FColors[ciFixedCellText] := cFixedCellTextDef; + FColors[ciFixedThemedCellLines] := cFixedThemedCellLinesDef; + FColors[ciFixedThemedCellHighlight] := cFixedThemedCellHighlightDef; + FColors[ciFixedThemedCellShadow] := cFixedThemedCellShadowDef; + FColors[ciFocusedCellBkGnd] := cFocusedCellBkGndDef; + FColors[ciFocusedCellText] := cFocusedCellTextDef; + FColors[ciFocusedRangeBkGnd] := cFocusedRangeBkGndDef; + FColors[ciFocusedRangeText] := cFocusedRangeTextDef; + FColors[ciSelectedCellBkGnd] := cSelectedCellBkGndDef; + FColors[ciSelectedCellText] := cSelectedCellTextDef; + FColors[ciSelectedRangeBkGnd] := cSelectedRangeBkGndDef; + FColors[ciSelectedRangeText] := cSelectedRangeTextDef; + // aki: + FColors[ciSelectedFixedCellBkGnd] := cSelectedFixedCellBkGndDef; +end; + +function TKGridColors.InternalGetColor(Index: TKGridColorIndex): TColor; +begin + case FColorScheme of + csBright: + begin + if FBrightColors[Index] = clNone then + FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); + Result := FBrightColors[Index]; + end; + csGrayed: + case Index of + ciCellBkGnd, ciFocusedCellText, ciSelectedCellText: Result := clWindow; + ciCellText, ciFixedCellText, ciFocusedCellBkGnd: Result := clGrayText; + else + Result := FColors[Index]; + end; + csGrayScale: + Result := ColorToGrayScale(FColors[Index]); + else + Result := FColors[Index]; + end; +end; + +procedure TKGridColors.InternalSetColor(Index: TKGridColorIndex; Value: TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + FBrightColors[Index] := clNone; + if not (csLoading in FGrid.ComponentState) then + FGrid.Invalidate; + end; +end; + +procedure TKGridColors.SetColor(Index: TKGridColorIndex; Value: TColor); +begin + InternalSetColor(Index, Value); +end; + +procedure TKGridColors.SetColorEx(Index: TKGridColorIndex; Value: TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + FBrightColors[Index] := clNone; + end; +end; + +procedure TKGridColors.SetColors(const Value: TKColorArray); +var + I: Integer; +begin + for I := 0 to Min(Length(FColors), Length(Value)) - 1 do + FColors[I] := Value[I]; + ClearBrightColors; + BrightRangeBkGnds; +end; + +{ TKCustomGrid } + +constructor TKCustomGrid.Create(AOwner: TComponent); +const + GridStyle = [csCaptureMouse, csDoubleClicks, csOpaque]; +begin + inherited; + if NewStyleControls then + ControlStyle := GridStyle + else + ControlStyle := GridStyle + [csFramed]; +{$IFDEF FPC} + FFlat := False; +{$ENDIF} + FCellHintTimer := TTimer.Create(Self); + FCellHintTimer.Enabled := False; + FCellHintTimer.Interval := cMouseCellHintTimeDef; + FCellHintTimer.OnTimer := CellHintTimerHandler; + FCells := nil; + FCellClass := TKGridTextCell; + FCellPainterClass := TKGridCellPainter; + FCellPainter := FCellPainterClass.Create(Self); + FColClass := TKGridCol; + FColCount := cInvalidIndex; + FCols := nil; + FColors := TKGridColors.Create(Self); + FDefaultColWidth := cDefaultColWidthDef; + FDefaultRowHeight := cDefaultRowHeightDef; + FDisabledDrawStyle := cDisabledDrawStyleDef; + FDragArrow := TKAlphaBitmap.CreateFromRes('KGRID_DRAG_ARROW'); + FDragWindow := nil; + FDragStyle := dsLayeredFaded; + FEditedCell := nil; + FEditor := nil; + FEditorCell := GridPoint(-1, -1); + FEditorTransparency := cEditorTransparencyDef; + FFixedCols := cInvalidIndex; + FFixedRows := cInvalidIndex; + FGridLineWidth := cGridLineWidthDef; + FGridState := gsNormal; + FHCI.HBegin := TKAlphaBitmap.CreateFromRes('KGRID_HCI_HBEGIN'); + FHCI.HCenter := TKAlphaBitmap.CreateFromRes('KGRID_HCI_HCENTER'); + FHCI.HEnd := TKAlphaBitmap.CreateFromRes('KGRID_HCI_HEND'); + FHCI.VBegin := TKAlphaBitmap.CreateFromRes('KGRID_HCI_VBEGIN'); + FHCI.VCenter := TKAlphaBitmap.CreateFromRes('KGRID_HCI_VCENTER'); + FHCI.VEnd := TKAlphaBitmap.CreateFromRes('KGRID_HCI_VEND'); + FMaxCol := cInvalidIndex; + FMaxRow := cInvalidIndex; + FMemCol := cInvalidIndex; + FMemRow := cInvalidIndex; + FMinColWidth := cMinColWidthDef; + FMinRowHeight := cMinRowHeightDef; + FMouseCellHintTime := cMouseCellHintTimeDef; + FMouseOver := GridPoint(-1, -1); + FMoveDirection := cMoveDirectionDef; + FOptions := cOptionsDef; + FOptionsEx := cOptionsExDef; + FRangeSelectStyle := cRangeSelectStyleDef; + FRowClass := TKGridRow; + FRowCount := cInvalidIndex; + FRows := nil; + FScrollBars := cScrollBarsDef; + FScrollModeHorz := cScrollModeDef; + FScrollModeVert := cScrollModeDef; + FScrollOffset := Point(0, 0); + FScrollSpeed := cScrollSpeedDef; + FScrollTimer := TTimer.Create(Self); + FScrollTimer.Enabled := False; + FScrollTimer.Interval := FScrollSpeed; + FScrollTimer.OnTimer := ScrollTimerHandler; + FSelections := nil; + FSizingStyle := cSizingStyleDef; + FSortStyle := cSortStyleDef; + FSortModeLock := 0; + FTmpBitmap := TBitmap.Create; + FTmpBitmap.Width := 1; + FTmpBitmap.Height := 1; + FTopLeft := GridPoint(cInvalidIndex, cInvalidIndex); + FOnBeginColDrag := nil; + FOnBeginColSizing := nil; + FOnBeginRowDrag := nil; + FOnBeginRowSizing := nil; + FOnCellSpan := nil; + FOnChanged := nil; + FOnCheckColDrag := nil; + FOnCheckRowDrag := nil; + FOnColMoved := nil; + FOnColWidthsChanged := nil; + FOnColWidthsChangedEx := nil; + FOnCompareCellInstances := nil; + FOnCompareCells := nil; + FOnCustomSortCols := nil; + FOnCustomSortRows := nil; + FOnDrawCell := nil; + FOnEditorCreate := nil; + FOnEditorDataFromGrid := nil; + FOnEditorDataToGrid := nil; + FOnEditorDestroy := nil; + FOnEditorKeyPreview := nil; + FOnEditorResize := nil; + FOnEndColDrag := nil; + FOnEndColSizing := nil; + FOnEndRowDrag := nil; + FOnEndRowSizing := nil; + FOnExchangeCols := nil; + FOnExchangeRows := nil; + FOnMeasureCell := nil; + FOnMouseCellHint := nil; + FOnMouseClickCell := nil; + FOnMouseDblClickCell := nil; + FOnMouseEnterCell := nil; + FOnMouseLeaveCell := nil; + FOnRowHeightsChanged := nil; + FOnRowMoved := nil; + FOnSelectCell := nil; + FOnSizeChanged := nil; + FOnTopLeftChanged := nil; + Color := clWindow; + LoadCustomCursor(crHResize, 'KGRID_CURSOR_HRESIZE'); + LoadCustomCursor(crVResize, 'KGRID_CURSOR_VRESIZE'); + ParentColor := False; + TabStop := True; + ChangeDataSize(True, 0, cColCountDef, True, 0, cRowCountDef); + SetBounds(Left, Top, FColCount * FDefaultColWidth, + FRowCount * FDefaultRowHeight); +end; + +destructor TKCustomGrid.Destroy; +begin + EditorMode := False; + inherited Destroy; + FHint.Free; + FCellPainter.Free; + FColors.Free; + FEditedCell.Free; + FDragArrow.Free; + FDragWindow.Free; + FHCI.HBegin.Free; + FHCI.HCenter.Free; + FHCI.HEnd.Free; + FHCI.VBegin.Free; + FHCI.VCenter.Free; + FHCI.VEnd.Free; + FTmpBitmap.Free; + FreeData; +end; + +procedure TKCustomGrid.AdjustPageSetup; +begin + inherited; + PageSetup.PrintingMapped := True; +end; + +function TKCustomGrid.AdjustSelection(const ASelection: TKGridRect): TKGridRect; +begin + Result := ASelection; + if goRowSelect in FOptions then + begin + // aki: + if gxEditFixedCols in FOptionsEx then + begin + Result.Col1:=0; + Result.Col2:=FColCount - 1; + end else + begin + Result.Col1 := FFixedCols; + Result.Col2 := FColCount - 1; + end; + end; +end; + +procedure TKCustomGrid.AutoSizeCol(ACol: Integer; FixedCells: Boolean); +var + R: TRect; + Dummy, Extent, FirstRow, I, MaxExtent: Integer; + Span: TKGridCellSpan; + GridFocused: Boolean; +begin + if ColValid(ACol) then + begin + GridFocused := HasFocus; + R.Left := 0; + R.Top := 0; + MaxExtent := FMinColWidth; + Extent := InternalGetColWidths(ACol); + if FixedCells then FirstRow := 0 else FirstRow := FFixedRows; + for I := FirstRow to FRowCount - 1 do + begin + Span := InternalGetCellSpan(ACol, I); + if (Span.RowSpan > 0) and (Span.ColSpan > 0) then + begin + InternalGetHExtent(ACol, Span.ColSpan, R.Right, Dummy); + InternalGetVExtent(I, Span.RowSpan, R.Bottom, Dummy); + MaxExtent := Max(MaxExtent, MeasureCell(ACol, I, R, GetDrawState(ACol, I, GridFocused), mpColWidth).X - R.Right + Extent); + end; + end; + ColWidths[ACol] := MaxExtent; + end; +end; + +procedure TKCustomGrid.AutoSizeGrid(Priority: TKGridMeasureCellPriority; FixedCells: Boolean); +var + R: TRect; + CellExtent: TPoint; + Dummy, Extent, FirstCol, FirstRow, I, J, MaxExtent: Integer; + Span: TKGridCellSpan; + ModifyCols, ModifyRows, GridFocused: Boolean; + ColMaxExtents: TDynIntegers; +begin + LockUpdate; + try + { Despite the update lock, this function is rather slow for huge grids, + of course, because it has to measure all cells. } + GridFocused := HasFocus; + MaxExtent := 0; + Extent := 0; + R.Left := 0; + R.Top := 0; + if FixedCells then FirstCol := 0 else FirstCol := FFixedCols; + if FixedCells then FirstRow := 0 else FirstRow := FFixedRows; + ModifyCols := Priority in [mpColWidth, mpCellExtent]; + ModifyRows := Priority in [mpRowHeight, mpCellExtent]; + if ModifyCols then + begin + SetLength(ColMaxExtents, FColCount - FirstCol); + for I := 0 to FColCount - FirstCol - 1 do + ColMaxExtents[I] := FMinColWidth; + end; + for J := FirstRow to FRowCount - 1 do + begin + if ModifyRows then + begin + MaxExtent := 0; + Extent := InternalGetRowHeights(J); + end; + for I := FirstCol to FColCount - 1 do + begin + Span := InternalGetCellSpan(I, J); + if (Span.RowSpan > 0) and (Span.ColSpan > 0) then + begin + InternalGetHExtent(I, Span.ColSpan, R.Right, Dummy); + InternalGetVExtent(J, Span.RowSpan, R.Bottom, Dummy); + CellExtent := MeasureCell(I, J, R, GetDrawState(I, J, GridFocused), Priority); + if ModifyRows then + MaxExtent := Max(MaxExtent, CellExtent.Y - R.Bottom + Extent); + if ModifyCols then + ColMaxExtents[I - FirstCol] := Max(ColMaxExtents[I - FirstCol], CellExtent.x - R.Right + InternalGetColWidths(I)); + end; + end; + if ModifyRows then + RowHeights[J] := MaxExtent; + end; + if ModifyCols then + for I := FirstCol to FColCount - 1 do + ColWidths[I] := ColMaxExtents[I - FirstCol]; + finally + UnlockUpdate; + end; +end; + +procedure TKCustomGrid.AutoSizeRow(ARow: Integer; FixedCells: Boolean); +var + R: TRect; + Dummy, Extent, FirstCol, I, MaxExtent: Integer; + Span: TKGridCellSpan; + GridFocused: Boolean; +begin + if RowValid(ARow) then + begin + GridFocused := HasFocus; + R.Left := 0; + R.Top := 0; + MaxExtent := FMinRowHeight; + Extent := InternalGetRowHeights(ARow); + if FixedCells then FirstCol := 0 else FirstCol := FFixedCols; + for I := FirstCol to FColCount - 1 do + begin + Span := InternalGetCellSpan(I, ARow); + if (Span.RowSpan > 0) and (Span.ColSpan > 0) then + begin + InternalGetHExtent(I, Span.ColSpan, R.Right, Dummy); + InternalGetVExtent(ARow, Span.RowSpan, R.Bottom, Dummy); + MaxExtent := Max(MaxExtent, MeasureCell(I, ARow, R, GetDrawState(I, ARow, GridFocused), mpRowHeight).Y - R.Bottom + Extent); + end; + end; + RowHeights[ARow] := MaxExtent; + end; +end; + +function TKCustomGrid.BeginColDrag(var Origin: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnBeginColDrag) then + FOnBeginColDrag(Self, Origin, MousePt, Result) + else if Assigned(FCols) then + FCols[Origin].BeginDrag(Origin, MousePt, Result); + Origin := MinMax(Origin, FFixedCols, FColCount - 1); +end; + +function TKCustomGrid.BeginColSizing(var Index, Pos: Integer): Boolean; +begin + Result := True; + if Assigned(FOnBeginColSizing) then + FOnBeginColSizing(Self, Index, Pos, Result) + else if Assigned(FCols) then + Result := FCols[Index].CanResize; + Index := MinMax(Index, 0, FColCount - 1); +end; + +function TKCustomGrid.BeginRowDrag(var Origin: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnBeginRowDrag) then + FOnBeginRowDrag(Self, Origin, MousePt, Result) + else if Assigned(FRows) then + FRows[Origin].BeginDrag(Origin, MousePt, Result); + Origin := MinMax(Origin, FFixedRows, FRowCount - 1); +end; + +function TKCustomGrid.BeginRowSizing(var Index, Pos: Integer): Boolean; +begin + Result := True; + if Assigned(FOnBeginRowSizing) then + FOnBeginRowSizing(Self, Index, Pos, Result) + else if Assigned(FRows) then + Result := FRows[Index].CanResize; + Index := MinMax(Index, 0, FRowCount - 1); +end; + +procedure TKCustomGrid.CancelMode; +begin + try + case FGridState of + gsColSizing, gsRowSizing: + SuggestSizing(csStop); + gsColMoving, gsRowMoving: + begin + ProcessDragWindow(FHitPos, Point(0, 0), cInvalidIndex, FGridState = gsColMoving, True); + SuggestDrag(csStop); + end; + else + InvalidateCell(FHitCell.Col, FHitCell.Row); + end; + finally + MouseCapture := False; + FGridState := gsNormal; + end; +end; + +procedure TKCustomGrid.CellHintTimerHandler(Sender: TObject); +begin + if (FMouseOver.Col = FHintCell.Col) and (FMouseOver.Row = FHintCell.Row) then + MouseCellHint(FMouseOver.Col, FMouseOver.Row, True); + FCellHintTimer.Enabled := False; +end; + +function TKCustomGrid.CellRect(ACol, ARow: Integer; out R: TRect; + VisibleOnly: Boolean): Boolean; +var + I, W, H: Integer; + Span: TKGridCellSpan; +begin + Result := False; + if ColValid(ACol) and RowValid(ARow) then + begin + Span := InternalGetCellSpan(ACol, ARow); + if (Span.ColSpan <= 0) or (Span.RowSpan <= 0) then + Span := MakeCellSpan(1, 1); + if CellToPoint(ACol, ARow, R.TopLeft, VisibleOnly) then + begin + W := 0; + for I := ACol to ACol + Span.ColSpan - 1 do + Inc(W, InternalGetColWidths(I) + InternalGetEffectiveColSpacing(I)); + H := 0; + for I := ARow to ARow + Span.RowSpan - 1 do + Inc(H, InternalGetRowHeights(I) + InternalGetEffectiveRowSpacing(I)); + if ACol >= FFixedCols then + begin + if goVertLine in FOptions then Dec(W, FGridLineWidth); + end else + if goFixedVertLine in FOptions then Dec(W, FGridLineWidth); + if ARow >= FFixedRows then + begin + if goHorzLine in FOptions then Dec(H, FGridLineWidth); + end else + if goFixedHorzLine in FOptions then Inc(H, FGridLineWidth); + if (W > 0) and (H > 0) then + begin + R.Right := R.Left + W; + R.Bottom := R.Top + H; + Result := True; + end; + end; + end; +end; + +function TKCustomGrid.CellSelected(ACol, ARow: Integer): Boolean; +begin + Result := CellInGridRect(ACol, ARow, Selection); +end; + +function TKCustomGrid.CellToPoint(ACol, ARow: Integer; var Point: TPoint; + VisibleOnly: Boolean): Boolean; + + function Axis(const Info: TKGridAxisInfo; Cell: Integer; out Coord: Integer): Boolean; + var + I: Integer; + begin + Result := False; + if (Cell >= 0) and (Cell < Info.TotalCellCount) then + begin + I := 0; + Coord := 0; + while (I < Cell) and (I < Info.FixedCellCount) and (not VisibleOnly or (Coord < Info.ClientExtent)) do + begin + Inc(Coord, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + Inc(I); + end; + if not VisibleOnly or (Coord < Info.ClientExtent) then + begin + if I = Info.FixedCellCount then + begin + Dec(Coord, Info.ScrollOffset); + I := Info.FirstGridCell; + while not VisibleOnly and (Cell < I) and (I > Info.FixedCellCount) do + begin + Dec(I); + Dec(Coord, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + end; + while (I < Cell) and (I < Info.TotalCellCount) and (not VisibleOnly or (Coord < Info.ClientExtent)) do + begin + Inc(Coord, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + Inc(I); + end; + end; + Result := Cell = I; + if Result then + begin + while (I >= 0) and (Info.CellExtent(I) = 0) do Dec(I); + if I < Cell - 1 then + Dec(Coord, Info.EffectiveSpacing(I + 1)); + end; + end; + end; + end; + +begin + if ColValid(ACol) and RowValid(ARow) then + begin + Result := Axis(GetAxisInfoHorz([]), ACol, Point.X); + if Result then + Result := Axis(GetAxisInfoVert([]), ARow, Point.Y); + end else + Result := False; +end; + +function TKCustomGrid.CellVisible(ACol, ARow: Integer): Boolean; +begin + Result := CellInGridRect(ACol, ARow, VisibleGridRect); +end; + +procedure TKCustomGrid.Changed; +begin + if Assigned(FOnChanged) then + FOnChanged(Self, FEditorCell.Col, FEditorCell.Row); +end; + +procedure TKCustomGrid.ChangeDataSize(ColInsert: Boolean; ColAt, ColCnt: Integer; + RowInsert: Boolean; RowAt, RowCnt: Integer); + + procedure Axis(var Data: TKGridAxisItems; AxisItemClass: TKGridAxisItemClass; + Insert: Boolean; DefFixedCnt: Integer; var At, Cnt, MaxLen, ItemCount, FixedCount: Integer); + var + I, Len: Integer; + begin + if Cnt > 0 then + begin + Len := Length(Data); + if Insert then + begin + At := MinMax(At, 0, Len); + SetLength(Data, Len + Cnt); + for I := Len - 1 downto At do Data[I + Cnt] := Data[I]; + for I := At to At + Cnt - 1 do + begin + Data[I] := AxisItemClass.Create(Self); + Data[I].InitialPos := MaxLen + 1; + Inc(MaxLen); + end; + if FixedCount < 0 then + FixedCount := DefFixedCnt + else if At < FixedCount then + Inc(FixedCount, Cnt); + end + else if Len > 0 then + begin + At := MinMax(At, 0, Len - 1); + Cnt := Min(Cnt, Len - At); + if Cnt > 0 then + begin + for I := At to At + Cnt - 1 do + Data[I].Free; + for I := At to Len - Cnt - 1 do Data[I] := Data[I + Cnt]; + SetLength(Data, Len - Cnt); + if At < FixedCount then + Dec(FixedCount, FixedCount - At); + end; + end; + ItemCount := Length(Data); + FixedCount := Min(FixedCount, ItemCount - 1); + end; + end; + +var + OldFixedRows, OldFixedCols, I, J, Len: Integer; + UpdateNeeded: Boolean; + Reason: TKGridSizeChange; +begin + EditorMode := False; + UpdateNeeded := False; + if not ColInsert then + ColCnt := Min(ColCnt, FColCount - 1); + if not RowInsert then + RowCnt := Min(RowCnt, FRowCount - 1); + OldFixedCols := FFixedCols; + Axis(FCols, FColClass, ColInsert, cFixedColsDef, + ColAt, ColCnt, FMaxCol, FColCount, FFixedCols); + OldFixedRows := FFixedRows; + Axis(FRows, FRowClass, RowInsert, cFixedRowsDef, + RowAt, RowCnt, FMaxRow, FRowCount, FFixedRows); + FMemCol := cInvalidIndex; + FMemRow := cInvalidIndex; + if goVirtualGrid in FOptions then + begin + if Assigned(FCells) then + begin + for I := 0 to Length(FCells) - 1 do + for J := 0 to Length(FCells[I]) - 1 do + FCells[I, J].Free; + FCells := nil; + UpdateNeeded := True; + end; + end else + begin + // take rows first because probably there will be always much more rows + if RowCnt > 0 then + begin + Len := Length(FCells); + if FRowCount > Len then + begin + SetLength(FCells, Len + RowCnt); + for I := Len - 1 downto RowAt do FCells[I + RowCnt] := FCells[I]; + for I := RowAt to RowAt + RowCnt - 1 do + begin + SetLength(FCells[I], FColCount); + for J := 0 to Length(FCells[I]) - 1 do FCells[I, J] := nil; + end; + end else + begin + for I := RowAt to RowAt + RowCnt - 1 do + begin + for J := 0 to Length(FCells[I]) - 1 do FCells[I, J].Free; + FCells[I] := nil; + end; + for I := RowAt to Len - RowCnt - 1 do FCells[I] := FCells[I + RowCnt]; + SetLength(FCells, Len - RowCnt); + end; + end; + if ColCnt > 0 then + begin + for I := 0 to Length(FCells) - 1 do + begin + Len := Length(FCells[I]); + if FColCount > Len then + begin + SetLength(FCells[I], Len + ColCnt); + for J := Len - 1 downto ColAt do FCells[I, J + ColCnt] := FCells[I, J]; + for J := ColAt to ColAt + ColCnt - 1 do FCells[I, J] := nil; + end + else if FColCount < Len then + begin + for J := ColAt to ColAt + ColCnt - 1 do FCells[I, J].Free; + for J := ColAt to Len - ColCnt - 1 do FCells[I, J] := FCells[I, J + ColCnt]; + SetLength(FCells[I], Len - ColCnt); + end; + end; + end; + end; + if (ColCnt > 0) or (RowCnt > 0) then + begin + SelectionFix(FSelection); + if (FFixedRows <> OldFixedRows) or (FFixedCols <> OldFixedCols) then + ResetTopLeft; + UpdateAxes(ColCnt > 0, cAll, RowCnt > 0, cAll, []); + UpdateCellSpan; + if ColCnt > 0 then + begin + if ColInsert then + begin + ClearSortModeVert; + Reason := scColInserted; + end else + Reason := scColDeleted; + SizeChanged(Reason, ColAt, ColCnt); + end; + if RowCnt > 0 then + begin + if RowInsert then + begin + ClearSortModeHorz; + Reason := scRowInserted + end else + Reason := scRowDeleted; + SizeChanged(Reason, RowAt, RowCnt); + end; + end else if UpdateNeeded then + Invalidate; +end; + +function TKCustomGrid.CheckColDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnCheckColDrag) then + FOnCheckColDrag(Self, Origin, Destination, MousePt, Result) + else if Assigned(FCols) then + FCols[Destination].CheckDrag(Origin, Destination, MousePt, Result); + Destination := MinMax(Destination, FFixedCols, FColCount - 1); +end; + +function TKCustomGrid.CheckRowDrag(Origin: Integer; var Destination: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnCheckRowDrag) then + FOnCheckRowDrag(Self, Origin, Destination, MousePt, Result) + else if Assigned(FRows) then + FRows[Destination].CheckDrag(Origin, Destination, MousePt, Result); + Destination := MinMax(Destination, FFixedRows, FRowCount - 1); +end; + +function TKCustomGrid.ClampInView(ACol, ARow: Integer): Boolean; +var + DeltaHorz, DeltaVert: Integer; +begin + Result := ScrollNeeded(ACol, ARow, DeltaHorz, DeltaVert); + if Result then + Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, True); +end; + +procedure TKCustomGrid.ClearCol(ACol: Integer); +var + I: Integer; +begin + if Assigned(FCells) and ColValid(ACol) then + begin + for I := 0 to FRowCount - 1 do + FreeAndNil(FCells[I, ACol]); + UpdateCellSpan; + InvalidateCol(ACol); + end; +end; + +procedure TKCustomGrid.ClearGrid; +var + I, J: Integer; +begin + if Assigned(FCells) then + begin + for I := 0 to FColCount - 1 do + for J := 0 to FRowCount - 1 do + FreeAndNil(FCells[J, I]); + UpdateCellSpan; + Invalidate; + end; +end; + +procedure TKCustomGrid.ClearRow(ARow: Integer); +var + I: Integer; +begin + if Assigned(FCells) and RowValid(ARow) then + begin + for I := 0 to FColCount - 1 do + FreeAndNil(FCells[ARow, I]); + UpdateCellSpan; + InvalidateRow(ARow); + end; +end; + +procedure TKCustomGrid.ClearSortMode; +begin + ClearSortModeHorz; + ClearSortModeVert; +end; + +procedure TKCustomGrid.ClearSortModeHorz; +var + OldIndex: Integer; +begin + if SortModeUnlocked then + begin + OldIndex := SortCol; + if OldIndex >= 0 then + begin + FlagSet(cGF_GridUpdates); + try + FCols[OldIndex].SortMode := smNone; + finally + FlagClear(cGF_GridUpdates); + end; + InvalidateGridRect(GridRect(OldIndex, 0, OldIndex, FFixedRows - 1)); + end; + end; +end; + +procedure TKCustomGrid.ClearSortModeVert; +var + OldIndex: Integer; +begin + if SortModeUnlocked then + begin + OldIndex := SortRow; + if OldIndex >= 0 then + begin + FlagSet(cGF_GridUpdates); + try + FRows[OldIndex].SortMode := smNone; + finally + FlagClear(cGF_GridUpdates); + end; + InvalidateGridRect(GridRect(0, OldIndex, FFixedCols - 1, OldIndex)); + end; + end; +end; + +procedure TKCustomGrid.CMDesignHitTest(var Msg: TLMMouse); +begin + Msg.Result := Integer(Flag(cGF_DesignHitTest)); +end; + +procedure TKCustomGrid.CMEnabledChanged(var Msg: TLMessage); +begin + inherited; + if not Enabled then EditorMode := False; + Invalidate; +end; + +procedure TKCustomGrid.CMShowingChanged(var Msg: TLMessage); +begin + inherited; + if Showing then + UpdateScrollRange(True, True, False); +end; + +procedure TKCustomGrid.CMSysColorChange(var Msg: TLMessage); +begin + inherited; + FColors.ClearBrightColors; +end; + +procedure TKCustomGrid.CMVisibleChanged(var Msg: TLMessage); +begin + inherited; + if not Visible then + EditorMode := False; +end; + +procedure TKCustomGrid.CMWantSpecialKey(var Msg: TLMKey); +begin + inherited; + if (goEditing in Options) and (Msg.CharCode in [VK_RETURN, VK_ESCAPE]) then + Msg.Result := 1; +end; + +procedure TKCustomGrid.ColMoved(FromIndex, ToIndex: Integer); +begin + if Assigned(FOnColMoved) then + FOnColMoved(Self, FromIndex, ToIndex); +end; + +function TKCustomGrid.ColSelectable(ACol: Integer): Boolean; +begin + Result := (ACol >= FFixedCols) and (ACol < FColCount); +end; + +function TKCustomGrid.ColSelected(ACol: Integer): Boolean; +begin + Result := ColInGridRect(ACol, Selection); +end; + +function TKCustomGrid.ColValid(ACol: Integer): Boolean; +begin + Result := (ACol >= 0) and (ACol < FColCount); +end; + +procedure TKCustomGrid.ColWidthsChanged(ACol: Integer); +begin + if Assigned(FOnColWidthsChanged) then + FOnColWidthsChanged(Self) + else if Assigned(FOnColWidthsChangedEx) then + FOnColWidthsChangedEx(Self, ACol); +end; + +function TKCustomGrid.CompareCellInstances(ACell1, ACell2: TKGridCell): Integer; +begin + if Assigned(FOnCompareCellInstances) then + Result := FOnCompareCellInstances(Self, ACell1, ACell2) + else if Assigned(FCells) then + Result := DefaultCompareCells(ACell1, ACell2) + else + Result := 0; +end; + +function TKCustomGrid.CompareCells(ACol1, ARow1, ACol2, ARow2: Integer): Integer; +begin + if Assigned(FOnCompareCells) then + Result := FOnCompareCells(Self, ACol1, ARow1, ACol2, ARow2) + else if Assigned(FCells) then + Result := DefaultCompareCells(InternalGetCell(ACol1, ARow1), InternalGetCell(ACol2, ARow1)) + else + Result := 0; +end; + +function TKCustomGrid.CompareCols(ARow, ACol1, ACol2: Integer): Integer; +begin + if Assigned(FOnCompareCells) then + Result := FOnCompareCells(Self, ACol1, ARow, ACol2, ARow) + else if Assigned(FCells) then + Result := DefaultCompareCells(InternalGetCell(ACol1, ARow), InternalGetCell(ACol2, ARow)) + else + Result := 0; +end; + +function TKCustomGrid.CompareRows(ACol, ARow1, ARow2: Integer): Integer; +begin + if Assigned(FOnCompareCells) then + Result := FOnCompareCells(Self, ACol, ARow1, ACol, ARow2) + else if Assigned(FCells) then + Result := DefaultCompareCells(InternalGetCell(ACol, ARow1), InternalGetCell(ACol, ARow2)) + else + Result := 0; +end; + +procedure TKCustomGrid.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + Style := Style or WS_TABSTOP or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; + if HasHorzScrollBar then Style := Style or WS_HSCROLL; + if HasVertScrollBar then Style := Style or WS_VSCROLL; + end; +end; + +function TKCustomGrid.CustomSortCols(ByRow: Integer; + var SortMode: TKGridSortMode): Boolean; +begin + Result := False; + if Assigned(FOnCustomSortCols) then FOnCustomSortCols(Self, ByRow, SortMode, Result); +end; + +function TKCustomGrid.CustomSortRows(ByCol: Integer; + var SortMode: TKGridSortMode): Boolean; +begin + Result := False; + if Assigned(FOnCustomSortRows) then FOnCustomSortRows(Self, ByCol, SortMode, Result); +end; + +procedure TKCustomGrid.DefaultColWidthChanged; +var + I: Integer; +begin + FlagSet(cGF_GridUpdates); + try + for I := 0 to FColCount - 1 do FCols[I].Extent := FDefaultColWidth; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(True, cAll, False, cAll, [afCheckMinExtent]); +end; + +procedure TKCustomGrid.DefaultComboKeyPreview(AEditor: TComboBox; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + if Key in [VK_RETURN, VK_ESCAPE, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT] then + begin + if AEditor.DroppedDown then + IsGridKey := False; + end + else if AEditor.Style in [csSimple, csDropDown] then + begin + // we have a combo box with edit control + DoEditKeyPreview(StringLength(AEditor.Text), AEditor.SelStart, AEditor.SelLength, 1, False, True, True, + Key, ShiftState, IsGridKey); + end; +end; + +procedure TKCustomGrid.DefaultComboSelect(AEditor: TComboBox; SelectAll, + CaretToLeft: Boolean); +begin + if AEditor.Style in [csSimple, csDropDown] then + begin + // we have a combo box with edit control + if SelectAll then + AEditor.SelectAll + else + begin + AEditor.SelLength := 0; + if CaretToLeft then + AEditor.SelStart := 0 + else + AEditor.SelStart := StringLength(AEditor.Text); + end; + end; +end; + +procedure TKCustomGrid.DefaultEditKeyPreview(AEditor: TCustomEdit; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +var + MultiLine, StartLine, EndLine: Boolean; + TextLen, LineCount: Integer; +begin + TextLen := StringLength(AEditor.Text); + if AEditor is TCustomMemo then + begin + MultiLine := True; + LineCount := TCustomMemo(AEditor).Lines.Count; + StartLine := AEditor.SelStart < StringLength(TCustomMemo(AEditor).Lines[0]); + EndLine := AEditor.SelStart > TextLen - StringLength(TCustomMemo(AEditor).Lines[TCustomMemo(AEditor).Lines.Count - 1]); + end else + begin + MultiLine := False; + StartLine := True; + EndLine := True; + LineCount := 1; + end; + DoEditKeyPreview(StringLength(AEditor.Text), AEditor.SelStart, AEditor.SelLength, LineCount, MultiLine, StartLine, EndLine, + Key, ShiftState, IsGridKey); +end; + +procedure TKCustomGrid.DefaultEditorCreate(ACol, ARow: Integer; + var AEditor: TWinControl); +begin + AEditor := TEdit.Create(nil); +end; + +procedure TKCustomGrid.DefaultEditorDataFromGrid(AEditor: TWinControl; + ACol, ARow: Integer; var AssignText: Boolean); +begin + // empty +end; + +procedure TKCustomGrid.DefaultEditorDataToGrid(AEditor: TWinControl; + ACol, ARow: Integer; var AssignText: Boolean); +begin + // empty +end; + +procedure TKCustomGrid.DefaultEditorDestroy(AEditor: TWinControl; ACol, + ARow: Integer); +begin + // empty +end; + +procedure TKCustomGrid.DefaultEditorKeyPreview(AEditor: TWinControl; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + if AEditor is TCustomEdit then + DefaultEditKeyPreview(TCustomEdit(AEditor), ACol, ARow, Key, ShiftState, IsGridKey) + else if AEditor is TCustomComboBox then + DefaultComboKeyPreview(TComboBox(AEditor), ACol, ARow, Key, ShiftState, IsGridKey) +end; + +procedure TKCustomGrid.DefaultEditorResize(AEditor: TWinControl; + ACol, ARow: Integer; var ARect: TRect); +begin + // empty +end; + +procedure TKCustomGrid.DefaultEditorSelect(AEditor: TWinControl; + ACol, ARow: Integer; SelectAll, CaretToLeft, SelectedByMouse: Boolean); +begin + if AEditor is TCustomEdit then + DefaultEditSelect(TCustomEdit(AEditor), SelectAll, CaretToLeft) + else if AEditor is TCustomComboBox then + DefaultComboSelect(TComboBox(AEditor), SelectAll, CaretToLeft); +end; + +procedure TKCustomGrid.DefaultEditSelect(AEditor: TCustomEdit; SelectAll, + CaretToLeft: Boolean); +begin + if SelectAll then + AEditor.SelectAll + else + begin + if CaretToLeft then + AEditor.SelStart := 0 + else + AEditor.SelStart := StringLength(AEditor.Text); + AEditor.SelLength := 0; + end; +end; + +function TKCustomGrid.DefaultCompareCells(ACell1, ACell2: TKGridCell): Integer; +var +{$IFDEF STRING_IS_UNICODE} + S1, S2: string; +{$ELSE} + W1, W2: PWideChar; +{$ENDIF} +begin +{$IFDEF STRING_IS_UNICODE} + if ACell1 is TKGridTextCell then S1 := TKGridTextCell(ACell1).Text else S1 := ''; + if ACell2 is TKGridTextCell then S2 := TKGridTextCell(ACell2).Text else S2 := ''; + Result := CompareStrings(S1, S2); +{$ELSE} + if ACell1 is TKGridTextCell then W1 := TKGridTextCell(ACell1).TextPtr else W1 := ''; + if ACell2 is TKGridTextCell then W2 := TKGridTextCell(ACell2).TextPtr else W2 := ''; + Result := CompareWideChars(W1, W2); +{$ENDIF} +end; + +procedure TKCustomGrid.DefaultMouseCellHint(ACol, ARow: Integer; + AShow: Boolean); +var + R: TRect; + Extent: TPoint; + AText: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; +begin + if ColValid(ACol) and Cols[ACol].CellHint then + begin + if AShow then + begin + AText := Cells[ACol, ARow]; + if (AText <> '') and (ARow >= FFixedRows) and + ((ARow <> FEditorCell.Row) or (ACol <> FEditorCell.Col) or not EditorMode) and + CellRect(ACol, ARow, R, True) then + begin + Extent := MeasureCell(ACol, ARow, R, GetDrawState(ACol, ARow, HasFocus), mpCellExtent); + if (Extent.X > R.Right - R.Left) or (Extent.Y > R.Bottom - R.Top) then + begin + FreeAndNil(FHint); + FHint := TKTextHint.Create(nil); + TKTextHint(FHint).Text := AText; + Inc(R.Left, 10); + Inc(R.Top, 10); + FHint.ShowAt(ClientToScreen(R.TopLeft)); + end; + end; + end else + FreeAndNil(FHint); + end else + FreeAndNil(FHint); +end; + +procedure TKCustomGrid.DefaultRowHeightChanged; +var + I: Integer; +begin + FlagSet(cGF_GridUpdates); + try + for I := 0 to FRowCount - 1 do FRows[I].Extent := FDefaultRowHeight; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(False, cAll, True, cAll, [afCheckMinExtent]); +end; + +procedure TKCustomGrid.DefaultScrollBarKeyPreview(AEditor: TScrollBar; + ACol, ARow: Integer; var Key: Word; ShiftState: TShiftState; var IsGridKey: Boolean); +begin + if (Key = VK_LEFT) and (AEditor.Position > AEditor.Min) or + (Key = VK_RIGHT) and (AEditor.Position < AEditor.Max) then + IsGridKey := False; +end; + +procedure TKCustomGrid.DefaultSetCaretToLeft(Key: Word; ShiftState: TShiftState); +begin + if (Key in [VK_DOWN, VK_NEXT]) or (Key in [VK_RIGHT, VK_END]) and (Col < FColCount - 1) then + FlagSet(cGF_CaretToLeft); +end; + +procedure TKCustomGrid.DefineProperties(Filer: TFiler); + + function DoColData: Boolean; + begin + if (Filer.Ancestor <> nil) and (Filer.Ancestor is TKCustomGrid) then + Result := not CompareAxisItems(TKCustomGrid(Filer.Ancestor).FCols, FCols) + else + Result := FCols <> nil; + end; + + function DoRowData: Boolean; + begin + if (Filer.Ancestor <> nil) and (Filer.Ancestor is TKCustomGrid) then + Result := not CompareAxisItems(TKCustomGrid(Filer.Ancestor).FRows, FRows) + else + Result := FRows <> nil; + end; + +begin + inherited; + with Filer do + begin + DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColData); + DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowData); + end; +end; + +procedure TKCustomGrid.DeleteCol(At: Integer); +begin + DeleteCols(At, 1); +end; + +procedure TKCustomGrid.DeleteCols(At, Count: Integer); +begin + if ColValid(At) and (FColCount > 1) then + begin + Count := Min(Count, FColCount - Max(At, 1)); + ChangeDataSize(False, At, Count, False, 0, 0); + end; +end; + +procedure TKCustomGrid.DeleteRow(At: Integer); +begin + DeleteRows(At, 1); +end; + +procedure TKCustomGrid.DeleteRows(At, Count: Integer); +begin + if RowValid(At) and (FRowCount > 1) then + begin + Count := Min(Count, FRowCount - Max(At, 1)); + ChangeDataSize(False, 0, 0, False, At, Count); + end; +end; + +function TKCustomGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +var + Key: Word; +begin + Result := inherited DoMouseWheelDown(Shift, MousePos); + if not Result then + begin + Key := VK_DOWN; + KeyDown(Key, []); + Result := True; + end; +end; + +function TKCustomGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +var + Key: Word; +begin + Result := inherited DoMouseWheelUp(Shift, MousePos); + if not Result then + begin + Key := VK_UP; + KeyDown(Key, []); + Result := True; + end; +end; + +procedure TKCustomGrid.DragMove(ACol, ARow: Integer; MousePt: TPoint); +begin + case FGridState of + gsColMoving: if CheckColDrag(FDragOrigin, ACol, MousePt) and (FDragDest <> ACol) then + begin + SuggestDrag(csHide); + FDragDest := ACol; + SuggestDrag(csShow); + end; + gsRowMoving: if CheckRowDrag(FDragOrigin, ARow, MousePt) and (FDragDest <> ARow) then + begin + SuggestDrag(csHide); + FDragDest := ARow; + SuggestDrag(csShow); + end; + end; +end; + +function TKCustomGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; + AState: TKGridDrawState): Boolean; +begin + Result := True; + if Assigned(FOnDrawCell) then + FOnDrawCell(Self, ACol, ARow, ARect, AState) + else if Assigned(FCells) then with InternalGetCell(ACol, ARow) do + begin + ApplyDrawProperties; + DrawCell(ACol, ARow, ARect, AState) + end else + Result := False; +end; + +function TKCustomGrid.EditorCreate(ACol, ARow: Integer): TWinControl; +begin + Result := nil; + if Assigned(FOnEditorCreate) then + FOnEditorCreate(Self, ACol, ARow, Result) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorCreate(ACol, ARow, Result) + else + DefaultEditorCreate(ACol, ARow, Result); +end; + +procedure TKCustomGrid.EditorDataFromGrid(AEditor: TWinControl; ACol, ARow: Integer); +var + AssignText: Boolean; +begin + AssignText := True; + if Assigned(FOnEditorDataFromGrid) then + FOnEditorDataFromGrid(Self, AEditor, ACol, ARow, AssignText) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorDataFromGrid(AEditor, ACol, ARow, AssignText) + else + DefaultEditorDataFromGrid(AEditor, ACol, ARow, AssignText); + if AssignText then + SetControlText(AEditor, Cells[ACol, ARow]); +end; + +procedure TKCustomGrid.EditorDataToGrid(AEditor: TWinControl; ACol, ARow: Integer); +var + AssignText: Boolean; +begin + AssignText := True; + if Assigned(FOnEditorDataToGrid) then + FOnEditorDataToGrid(Self, AEditor, ACol, ARow, AssignText) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorDataToGrid(AEditor, ACol, ARow, AssignText) + else + DefaultEditorDataToGrid(AEditor, ACol, ARow, AssignText); + if AssignText then + Cells[ACol, ARow] := GetControlText(AEditor); +end; + +procedure TKCustomGrid.EditorDestroy(var AEditor: TWinControl; ACol, ARow: Integer); +begin + if Assigned(FOnEditorDestroy) then + FOnEditorDestroy(Self, AEditor, ACol, ARow) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorDestroy(AEditor, ACol, ARow) + else + DefaultEditorDestroy(AEditor, ACol, ARow); +end; + +function TKCustomGrid.EditorIsTransparent: Boolean; +begin + Result := False; + if FEditorTransparency = etTransparent then + Result := True + else if FEditorTransparency = etDefault then + begin + { Default behavior. For example TCheckBox is not meant to be transparent + by VCL/LCL but from grid's point of view it should be. } + Result := + (FEditor is TCustomCheckBox) or + (FEditor is TRadioButton) or + (FEditor is TStaticText); + end; +end; + +function TKCustomGrid.EditorKeyPreview(AEditor: TWinControl; ACol, ARow: Integer; + var Key: Word; Shift: TShiftState): Boolean; +begin + Result := True; + if Assigned(FOnEditorKeyPreview) then + FOnEditorKeyPreview(Self, AEditor, ACol, ARow, Key, Shift, Result) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorKeyPreview(AEditor, ACol, ARow, Key, Shift, Result) + else + DefaultEditorKeyPreview(AEditor, ACol, ARow, Key, Shift, Result); +end; + +procedure TKCustomGrid.EditorResize(AEditor: TWinControl; ACol, ARow: Integer; + var ARect: TRect); +begin + if Assigned(FOnEditorResize) then + FOnEditorResize(Self, AEditor, ACol, ARow, ARect) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorResize(AEditor, ACol, ARow, ARect) + else + DefaultEditorResize(AEditor, ACol, ARow, ARect); +end; + +procedure TKCustomGrid.EditorSelect(AEditor: TWinControl; ACol, ARow: Integer; + SelectAll, CaretToLeft, SelectedByMouse: Boolean); +begin + if Assigned(FOnEditorSelect) then + FOnEditorSelect(Self, AEditor, ACol, ARow, SelectAll, CaretToLeft, SelectedByMouse) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).EditorSelect(AEditor, ACol, ARow, SelectAll, CaretToLeft, SelectedByMouse) + else + DefaultEditorSelect(AEditor, ACol, ARow, SelectAll, CaretToLeft, SelectedByMouse); +end; + +procedure TKCustomGrid.EditorWindowProc(var Msg: TLMessage); + + procedure PaintCellBackground(DC: HDC); + var + SaveIndex: Integer; + ACanvas: TCanvas; + R, TmpBlockRect: TRect; + begin + if CellRect(Col, Row, R) then + begin + ACanvas := TCanvas.Create; + SaveIndex := SaveDC(DC); + try + ACanvas.Handle := DC; + R := Rect(0, 0, R.Right - R.Left, R.Bottom - R.Top); + TmpBlockRect := SelectionRect; + OffsetRect(TmpBlockRect, -R.Left, -R.Top); + InternalPaintCell(Col, Row, GetDrawState(Col, Row, HasFocus), + R, TmpBlockRect, ACanvas, False, False); + FEditor.Brush.Color := ACanvas.Brush.Color; + finally + RestoreDC(DC, SaveIndex); + ACanvas.Free; + end; + end; + end; + + procedure GotFocus; + begin + InvalidateCurrentSelection; + end; + + procedure LostFocus; + begin + InvalidateCurrentSelection; + end; + +var + Key: Word; + Shift: TShiftState; + CallDefault: Boolean; + Form: TCustomForm; +begin + CallDefault := True; + case Msg.Msg of + CM_MOUSEENTER, CM_MOUSELEAVE: // not called if editor is captured + try + MouseOverCells; // some win32 error might popup here + except + end; + CN_CHAR: + ClampInView(FEditorCell.Col, FEditorCell.Row); + {$IFNDEF FPC} + CN_COMMAND: + if TWMCommand(Msg).Ctl = FEditor.Handle then + begin + case TWMCommand(Msg).NotifyCode of + CBN_KILLFOCUS, BN_KILLFOCUS, LBN_KILLFOCUS, EN_KILLFOCUS: LostFocus; + CBN_SETFOCUS, BN_SETFOCUS, EN_SETFOCUS: GotFocus; + end; + end; + {$ELSE} + LM_ERASEBKGND: + begin + if EditorIsTransparent then + begin + PaintCellBackground(TLMEraseBkGnd(Msg).DC); + CallDefault := False; + Msg.Result := 1; + end; + end; + {$ENDIF} + { CN_KEYDOWN is sent from TApplication.IsKeyMsg as 'preview' so this message + is used as KeyPreview. WM_KEYDOWN is not sent here by all inplace editors as + some of them might have another child window with input focus + (in such cases WM_KEYDOWN is sent directly to it). But if it is sent here + so let's decide if it can be processed by inplace editor, either. } + CN_KEYDOWN, LM_KEYDOWN: + begin + Key := TLMKey(Msg).CharCode; + Shift := KeyDataToShiftState(TLMKey(Msg).KeyData); + case Key of + VK_RETURN, VK_ESCAPE, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, + VK_PRIOR, VK_NEXT, VK_HOME, VK_END, VK_TAB: + begin + if EditorKeyPreview(FEditor, FEditorCell.Col, FEditorCell.Row, Key, Shift) then + begin + DefaultSetCaretToLeft(Key, Shift); + if Msg.Msg = CN_KEYDOWN then + PostLateUpdate(Msg) + else + ClampInView(FEditorCell.Col, FEditorCell.Row); + if (Key <> VK_TAB) or (goTabs in FOptions) then + begin + CallDefault := False; + Msg.Result := 1; + end; + end; + end else + ClampInView(FEditorCell.Col, FEditorCell.Row); + end; + end; + LM_GETDLGCODE: if goTabs in FOptions then + Msg.Result := Msg.Result or DLGC_WANTTAB or DLGC_WANTARROWS; + LM_KILLFOCUS: + LostFocus; + LM_MOUSEMOVE: + begin + if Flag(cGF_ThroughClick) and (GetCaptureControl = FEditor) then + begin + if (FGridState = gsSelecting) and not PtInRect(FEditor.BoundsRect, ScreenToClient(Mouse.CursorPos)) then + begin + MouseCapture := True; + FlagClear(cGF_ThroughClick); + end; + MouseOverCells; + end; + end; + LM_LBUTTONUP: + begin + if Flag(cGF_ThroughClick) then + begin + FGridState := gsNormal; + FlagClear(cGF_ThroughClick); + end; + end; + LM_SETFOCUS: + begin + Form := GetParentForm(Self); + if Assigned(Form) and not (csDestroying in Form.ComponentState) then + GotFocus + else + CallDefault := False; // eat the message to avoid an exception in LCL (TForm.SetFocusedControl) + end; + end; + if CallDefault then + FEditorWindowProc(Msg); +end; + +function TKCustomGrid.EndColDrag(Origin, Destination: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnEndColDrag) then + FOnEndColDrag(Self, Origin, Destination, MousePt, Result) + else if Assigned(FCols) then + FCols[Destination].EndDrag(Origin, Destination, MousePt, Result) +end; + +function TKCustomGrid.EndColSizing(var Index, Pos: Integer): Boolean; +begin + Result := True; + if Assigned(FOnEndColSizing) then + FOnEndColSizing(Self, Index, Pos, Result); + Index := MinMax(Index, 0, FColCount - 1); +end; + +function TKCustomGrid.EndRowDrag(Origin, Destination: Integer; + const MousePt: TPoint): Boolean; +begin + Result := True; + if Assigned(FOnEndRowDrag) then + FOnEndRowDrag(Self, Origin, Destination, MousePt, Result) + else if Assigned(FRows) then + FRows[Destination].EndDrag(Origin, Destination, MousePt, Result) +end; + +function TKCustomGrid.EndRowSizing(var Index, Pos: Integer): Boolean; +begin + Result := True; + if Assigned(FOnEndRowSizing) then + FOnEndRowSizing(Self, Index, Pos, Result); + Index := MinMax(Index, 0, FRowCount - 1); +end; + +procedure TKCustomGrid.FindBaseCell(ACol, ARow: Integer; out BaseCol, + BaseRow: Integer); +begin + if ColValid(ACol) and RowValid(ARow) then + InternalFindBaseCell(ACol, ARow, BaseCol, BaseRow); +end; + +procedure TKCustomGrid.FocusCell(ACol, ARow: Integer); +begin + if ColValid(ACol) and RowValid(ARow) then + begin + InternalFindBaseCell(ACol, ARow, ACol, ARow); + if SelectionMove(ACol, ARow, ssInit, [sfMustUpdate, sfClampInView]) then + Click; + end; +end; + +procedure TKCustomGrid.FreeData; +var + I, J: Integer; +begin + for I := 0 to FColCount - 1 do + FCols[I].Free; + FCols := nil; + for I := 0 to FRowCount - 1 do + FRows[I].Free; + FRows := nil; + for I := 0 to Length(FCells) - 1 do + for J := 0 to Length(FCells[I]) - 1 do + FCells[I, J].Free; + FCells := nil; +end; + +function TKCustomGrid.GetAllCellsSelected: Boolean; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Result := (R.Col1 = FFixedCols) and (R.Col2 = FColCount - 1) and + (R.Row1 = FFixedRows) and (R.Row2 = FRowCount - 1); +end; + +function TKCustomGrid.GetAllColsSelected: Boolean; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Result := (R.Row1 = FFixedRows) and (R.Row2 = FRowCount - 1); +end; + +function TKCustomGrid.GetAllRowsSelected: Boolean; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Result := (R.Col1 = FFixedCols) and (R.Col2 = FColCount - 1); +end; + +procedure TKCustomGrid.GetAxisInfo(var Info: TKGridAxisInfo); +var + I, Extent: Integer; +begin + with Info do + begin + if InfoMask * [aiFixedParams, aiFullVisBoundary, aiGridBoundary, aiGridExtent] <> [] then + begin + FixedBoundary := 0; + I := 0; + while I < FixedCellCount do + begin + Inc(FixedBoundary, CellExtent(I) + EffectiveSpacing(I)); + Inc(I); + end; + end; + if aiGridExtent in InfoMask then + begin + I := FixedCellCount; + GridExtent := FixedBoundary; + while I < TotalCellCount do + begin + Inc(GridExtent, Int64(CellExtent(I)) + EffectiveSpacing(I)); + Inc(I); + end; + end; + if aiGridBoundary in InfoMask then + begin + GridCells := FirstGridCell; + GridBoundary := FixedBoundary - ScrollOffset; + while (GridCells < TotalCellCount) and (GridBoundary < ClientExtent) do + begin + Inc(GridBoundary, CellExtent(GridCells) + EffectiveSpacing(GridCells)); + Inc(GridCells); + end; + GridBoundary := Min(GridBoundary, ClientExtent); + GridCells := Min(GridCells, TotalCellCount); + end; + if aiFullVisBoundary in InfoMask then + begin + FullVisCells := FirstGridCell; + FullVisBoundary := FixedBoundary - ScrollOffset; + while FullVisCells < TotalCellCount do + begin + Extent := CellExtent(FullVisCells) + EffectiveSpacing(FullVisCells); + if FullVisBoundary + Extent <= ClientExtent then + begin + Inc(FullVisBoundary, Extent); + Inc(FullVisCells); + end else + Break; + end; + FullVisCells := Min(FullVisCells, TotalCellCount); + end; + end; +end; + +function TKCustomGrid.GetAxisInfoBoth(Mask: TKGridAxisInfoMask): TKGridAxisInfoBoth; +begin + Result.Horz := GetAxisInfoHorz(Mask); + Result.Vert := GetAxisInfoVert(Mask); +end; + +function TKCustomGrid.GetAxisInfoHorz(Mask: TKGridAxisInfoMask): TKGridAxisInfo; +begin + with Result do + begin + AlignLastCell := goAlignLastCol in FOptions; + CanResize := BeginColSizing; + CellExtent := InternalGetColWidths; + EffectiveSpacing := InternalGetEffectiveColSpacing; + FixedCellCount := FFixedCols; + FixedSelectable := gxEditFixedCols in FOptionsEx; + FirstGridCell := FTopLeft.Col; + FirstGridCellExtent := FTopLeftExtent.Col; + if HandleAllocated then + ClientExtent := ClientWidth + else + // don't create Handle, fake ClientWidth instead + ClientExtent := Width; + MinCellExtent := InternalGetMinColWidth; + MaxCellExtent := InternalGetMaxColWidth; + TotalCellCount := FColCount; + ScrollOffset := FScrollOffset.X; + InfoMask := Mask; + end; + GetAxisInfo(Result); +end; + +function TKCustomGrid.GetAxisInfoVert(Mask: TKGridAxisInfoMask): TKGridAxisInfo; +begin + with Result do + begin + AlignLastCell := goAlignLastRow in FOptions; + CanResize := BeginRowSizing; + CellExtent := InternalGetRowHeights; + EffectiveSpacing := InternalGetEffectiveRowSpacing; + FixedCellCount := FFixedRows; + FixedSelectable := gxEditFixedRows in FOptionsEx; + FirstGridCell := FTopLeft.Row; + FirstGridCellExtent := FTopLeftExtent.Row; + if HandleAllocated then + ClientExtent := ClientHeight + else + // don't create Handle, fake ClientWidth instead + ClientExtent := Height; + MinCellExtent := InternalGetMinRowHeight; + MaxCellExtent := InternalGetMaxRowHeight; + TotalCellCount := FRowCount; + ScrollOffset := FScrollOffset.Y; + InfoMask := Mask; + end; + GetAxisInfo(Result); +end; + +function TKCustomGrid.GetCell(ACol, ARow: Integer): TKGridCell; +begin + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + Result := InternalGetCell(ACol, ARow) + else + Result := nil; +end; + +function TKCustomGrid.GetCells(ACol, ARow: Integer): {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}; +var + Data: TKGridCell; +begin + Result := ''; + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + begin + Data := InternalGetCell(ACol, ARow); + if Data is TKGridTextCell then + Result := TKGridTextCell(Data).Text; + end; +end; + +function TKCustomGrid.GetCellSpan(ACol, ARow: Integer): TKGridCellSpan; +begin + if ColValid(ACol) and RowValid(ARow) then + Result := InternalGetCellSpan(ACol, ARow) + else + Result := MakeCellSpan(1, 1); +end; + +function TKCustomGrid.GetCols(Index: Integer): TKGridCol; +begin + if ColValid(Index) and (FCols[Index] is TKGridCol) then + Result := TKGridCol(FCols[Index]) + else + Result := nil; +end; + +function TKCustomGrid.GetColWidths(Index: Integer): Integer; +begin + if ColValid(Index) then + Result := FCols[Index].Extent + else + Result := 0 +end; + +function TKCustomGrid.GetDefaultDrawing: Boolean; +begin + Result := False; +end; + +function TKCustomGrid.GetDragRect(Info: TKGridAxisInfoBoth; out DragRect: TRect): Boolean; +var + W, H, ES: Integer; + P: TPoint; +begin + Result := False; + if FGridState = gsColMoving then + begin + if CellToPoint(FDragDest, 0, P) then + begin + if FDragDest > FDragOrigin then + begin + ES := Info.Horz.EffectiveSpacing(FDragDest); + Inc(P.X, Info.Horz.CellExtent(FDragDest)); + end else + begin + if FDragDest > 0 then + ES := Info.Horz.EffectiveSpacing(FDragDest - 1) + else + ES := 0; + Dec(P.X, ES); + end; + case FDragStyle of + dsLayeredConst, dsLayeredFaded: + begin + W := FDragArrow.Width; + H := Min(Info.Vert.FixedBoundary, Info.Vert.ClientExtent); + end; + else + W := 5; + H := Info.Vert.GridBoundary; + end; + Dec(P.X, (W - ES) shr 1); + DragRect := Rect(P.X, 0, P.X + W, H); + Result := True; + end; + end else + begin + if CellToPoint(0, FDragDest, P) then + begin + if FDragDest >= FDragOrigin then + begin + ES := Info.Vert.EffectiveSpacing(FDragDest); + Inc(P.Y, Info.Vert.CellExtent(FDragDest)); + end else + begin + if FDragDest > 0 then + ES := Info.Vert.EffectiveSpacing(FDragDest - 1) + else + ES := 0; + Dec(P.Y, ES); + end; + case FDragStyle of + dsLayeredConst, dsLayeredFaded: + begin + W := Min(Info.Horz.FixedBoundary, Info.Horz.ClientExtent); + H := FDragArrow.Height; + end; + else + W := Info.Horz.GridBoundary; + H := 5; + end; + Dec(P.Y, (H - ES) shr 1); + DragRect := Rect(0, P.Y, W, P.Y + H); + Result := True; + end; + end; +end; + +function TKCustomGrid.GetDrawState(ACol, ARow: Integer; AFocused: Boolean): TKGridDrawState; +var + BaseCol, BaseRow: Integer; +begin + Result := []; + if ColValid(ACol) and RowValid(ARow) then + begin + if (ACol < FFixedCols) or (ARow < FFixedRows) then + begin + Result := [gdFixed]; + if (goRowSorting in FOptions) and (ARow = FCols[ACol].SortArrowIndex) then + if FCols[ACol].SortMode = smDown then + Include(Result, gdRowsSortedDown) + else if FCols[ACol].SortMode = smUp then + Include(Result, gdRowsSortedUp); + if (goColSorting in FOptions) and (ACol = FRows[ARow].SortArrowIndex) and + ((ARow > 0) or not (goRowSorting in FOptions)) then + if (FRows[ARow].SortMode = smDown) then + Include(Result, gdColsSortedDown) + else if FRows[ARow].SortMode = smUp then + Include(Result, gdColsSortedUp); + //aki: + if (((gxEditFixedRows in FOptionsEx) and (ARow < FFixedRows)) or + ((gxEditFixedCols in FOptionsEx) and (ACol < FFixedCols))) and + CellSelected(ACol, ARow) then + begin + Include(Result, gdSelected); + if (ACol = FSelection.Col1) and (ARow = FSelection.Row1) then + begin + if EditorMode and (FEditor.Left >= 0) and (FEditor.Top >= 0) then + Include(Result, gdEdited) + else if AFocused then + Include(Result, gdFocused); + end; + end; + end else + begin + if CellSelected(ACol, ARow) then + begin + Result := [gdSelected]; + if (ACol = FSelection.Col1) and (ARow = FSelection.Row1) then + begin + if EditorMode and (FEditor.Left >= 0) and (FEditor.Top >= 0) then + Include(Result, gdEdited) + else if AFocused then + Include(Result, gdFocused); + end; + end else + Result := []; + if (FCols[ACol].SortMode <> smNone) or (FRows[ARow].SortMode <> smNone) then + Include(Result, gdSorted); + end; + if (FGridState in [gsNormal, gsSelecting, gsColMoveWaiting, gsRowMoveWaiting, + gsColSortWaiting, gsRowSortWaiting]) and not (csDesigning in ComponentState) then + begin + InternalFindBaseCell(ACol, ARow, BaseCol, BaseRow); + if (ACol = FMouseOver.Col) and (ARow = FMouseOver.Row) then + begin + if MouseCapture and ColValid(FHitCell.Col) and RowValid(FHitCell.Row) then + begin + InternalFindBaseCell(FHitCell.Col, FHitCell.Row, BaseCol, BaseRow); + if (BaseCol = ACol) and (BaseRow = ARow) then + Include(Result, gdMouseDown); + end; + if goMouseOverCells in FOptions then + Include(Result, gdMouseOver); + end; + end; + end; +end; + +function TKCustomGrid.GetEditorMode: Boolean; +begin + Result := Assigned(FEditor); +end; + +function TKCustomGrid.GetEffectiveColSpacing(ACol: Integer): Integer; +begin + if ColValid(ACol) then + Result := InternalGetEffectiveColSpacing(ACol) + else + Result := 0; +end; + +function TKCustomGrid.GetEffectiveRowSpacing(ARow: Integer): Integer; +begin + if RowValid(ARow) then + Result := InternalGetEffectiveRowSpacing(ARow) + else + Result := 0; +end; + +function TKCustomGrid.GetEntireColSelected(Index: Integer): Boolean; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Result := (R.Row1 = FFixedRows) and (R.Row2 = FRowCount - 1) and + (R.Col1 <= Index) and (Index <= R.Col2); +end; + +function TKCustomGrid.GetEntireRowSelected(Index: Integer): Boolean; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Result := (R.Col1 = FFixedCols) and (R.Col2 = FColCount - 1) and + (R.Row1 <= Index) and (Index <= R.Row2); +end; + +function TKCustomGrid.GetEntireSelectedColCount: Integer; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + if (R.Row1 = FFixedRows) and (R.Row2 = FRowCount - 1) then + Result := R.Col2 - R.Col1 + else + Result := 0; +end; + +function TKCustomGrid.GetEntireSelectedRowCount: Integer; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + if (R.Col1 = FFixedCols) and (R.Col2 = FColCount - 1) then + Result := R.Row2 - R.Row1 + else + Result := 0; +end; + +function TKCustomGrid.GetGridHeight: Integer; +begin + Result := GetAxisInfoVert([aiGridBoundary]).GridBoundary; +end; + +function TKCustomGrid.GetGridWidth: Integer; +begin + Result := GetAxisInfoHorz([aiGridBoundary]).GridBoundary; +end; + +function TKCustomGrid.GetLastVisibleCol: Integer; +begin + Result := GetAxisInfoHorz([aiGridBoundary]).GridCells - 1; +end; + +function TKCustomGrid.GetLastVisibleRow: Integer; +begin + Result := GetAxisInfoVert([aiGridBoundary]).GridCells - 1; +end; + +function TKCustomGrid.GetMoreCellsSelected: Boolean; +begin + Result := (FSelection.Row1 <> FSelection.Row2) or + (FSelection.Col1 <> FSelection.Col2); +end; + +function TKCustomGrid.GetObjects(ACol, ARow: Integer): TObject; +var + Data: TKGridCell; +begin + Result := nil; + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + begin + Data := InternalGetCell(ACol, ARow); + if Data is TKGridObjectCell then + Result := TKGridObjectCell(Data).CellObject; + end; +end; + +function TKCustomGrid.GetRowHeights(Index: Integer): Integer; +begin + if RowValid(Index) then + Result := FRows[Index].Extent + else + Result := 0; +end; + +function TKCustomGrid.GetRows(Index: Integer): TKGridRow; +begin + if RowValid(Index) and (FRows[Index] is TKGridRow) then + Result := TKGridRow(FRows[Index]) + else + Result := nil; +end; + +function TKCustomGrid.InternalGetSelAvail: Boolean; +begin + Result := True; +end; + +function TKCustomGrid.GetSelection: TKGridRect; +begin + Result := AdjustSelection(FSelection); +end; + +function TKCustomGrid.GetSelectionCount: Integer; +begin + Result := Length(FSelections) + 1; +end; + +function TKCustomGrid.GetSelectionRect: TRect; +begin + Result := Rect(0,0,0,0); + if GridRectToRect(Selection, Result, False, goRangeSelect in FOptions) then + begin + if FOptions * [goFixedHorzLine, goHorzLine] = [goFixedHorzLine, goHorzLine] then + Dec(Result.Bottom, GetEffectiveRowSpacing(Max(Selection.Row1, Selection.Row2))); + if FOptions * [goFixedVertLine, goVertLine] = [goFixedVertLine, goVertLine] then + Dec(Result.Right, GetEffectiveColSpacing(Max(Selection.Col1, Selection.Col2))); + end; +end; + +function TKCustomGrid.GetSelections(Index: Integer): TKGridRect; +begin + if Index = 0 then + Result := Selection + else if (Index > 0) and (Index < SelectionCount) then + Result := FSelections[Index - 1] + else + Result := GridRect(0,0,0,0); +end; + +function TKCustomGrid.GetSortCol: Integer; +var + I: Integer; +begin + Result := cInvalidIndex; + for I := 0 to FColCount - 1 do + if FCols[I].SortMode <> smNone then + begin + Result := I; + Break; + end; +end; + +function TKCustomGrid.GetSortRow: Integer; +var + I: Integer; +begin + Result := cInvalidIndex; + for I := 0 to FRowCount - 1 do + if FRows[I].SortMode <> smNone then + begin + Result := I; + Break; + end; +end; + +function TKCustomGrid.GetTabStops(Index: Integer): Boolean; +begin + if ColValid(Index) and (FCols[Index] is TKGridCol) then + Result := TKGridCol(FCols[Index]).TabStop + else + Result := True +end; + +function TKCustomGrid.GetThemedCells: Boolean; +begin + Result := Themes and (FOptions * [goThemes, goThemedCells] = [goThemes, goThemedCells]); +end; + +function TKCustomGrid.GetThemes: Boolean; +begin +{$IFDEF USE_THEMES} + Result := ThemeServices.ThemesEnabled +{$ELSE} + Result := False; +{$ENDIF} +end; + +function TKCustomGrid.GetVisibleColCount: Integer; +begin + Result := LastVisibleCol; +end; + +function TKCustomGrid.GetVisibleGridRect: TKGridRect; +begin + Result := GridRect(FTopLeft.Col, FTopLeft.Row, VisibleColCount, VisibleRowCount); +end; + +function TKCustomGrid.GetVisibleRowCount: Integer; +begin + Result := LastVisibleRow; +end; + +function TKCustomGrid.GridRectSelectable(const GridRect: TKGridRect): Boolean; +begin + Result := ColSelectable(GridRect.Col1) and ColSelectable(GridRect.Col2) and + RowSelectable(GridRect.Row1) and RowSelectable(GridRect.Row2); +end; + +function TKCustomGrid.GridRectToRect(GridRect: TKGridRect; var R: TRect; + VisibleOnly: Boolean; Merged: Boolean): Boolean; + + function Axis(const Info: TKGridAxisInfo; var Index1, Index2: Integer; Split: Boolean): Boolean; + begin + Result := True; + if Split then + begin + // adjust indexes for either fixed or nonfixed area + if Index1 >= Info.FixedCellCount then + begin + if VisibleOnly then + if Index2 >= Info.FirstGridCell then + Index1 := Max(Index1, Info.FirstGridCell) + else + Result := False; + Index2 := Max(Index2, Index1); + end else + Index2 := Min(Index2, Info.FixedCellCount - 1); + end + else if (Index1 >= Info.FixedCellCount) and VisibleOnly then + begin + if Index2 >= Info.FirstGridCell then + Index1 := Max(Index1, Info.FirstGridCell) + else + Result := False; + end; + end; + + procedure Axis1(const Info: TKGridAxisInfo; Index1, Index2, AMin: Integer; + out AMax: Integer); + var + I: Integer; + begin + AMax := AMin; + I := Index1; + if Info.CellExtent(I) = 0 then + begin + while (I >= 0) and (Info.CellExtent(I) = 0) do Dec(I); + Inc(I); + end; + while (I <= Index2) and (not VisibleOnly or (AMax < Info.ClientExtent)) do + begin + if not VisibleOnly or (I < Info.FixedCellCount) or (I >= Info.FirstGridCell) then + Inc(AMax, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + // if (Index1 < Info.FirstGridCell) and (I = Info.FirstGridCell) then + // Dec(AMax, Info.ScrollOffset); + Inc(I); + end; + end; + +var + Info: TKGridAxisInfoBoth; +begin + Result := False; + NormalizeGridRect(GridRect); + if GridRectValid(GridRect) then + begin + Info := GetAxisInfoBoth([]); + if Merged then + GridRect := InternalExpandGridRect(GridRect); + // aki: + if Axis(Info.Horz, GridRect.Col1, GridRect.Col2, not (gxEditFixedCols in FOptionsEx)) and + Axis(Info.Vert, GridRect.Row1, GridRect.Row2, not (gxEditFixedRows in FOptionsEx)) then + begin + if CellToPoint(GridRect.Col1, GridRect.Row1, R.TopLeft, VisibleOnly) then + begin + Axis1(Info.Horz, GridRect.Col1, GridRect.Col2, R.Left, R.Right); + Axis1(Info.Vert, GridRect.Row1, GridRect.Row2, R.Top, R.Bottom); + Result := (R.Right > R.Left) and (R.Bottom > R.Top); + end; + end; + end; +end; + +function TKCustomGrid.GridRectValid(const GridRect: TKGridRect): Boolean; +begin + Result := ColValid(GridRect.Col1) and ColValid(GridRect.Col2) and + RowValid(GridRect.Row1) and RowValid(GridRect.Row2); +end; + +function TKCustomGrid.GridStateToInvisibleCells: TKGridInvisibleCells; +begin + case FGridState of + gsColMoving: Result := icFixedCols; + gsRowMoving: Result := icFixedRows; + gsSelecting: Result := icCells; + else + Result := icNone; + end; +end; + +function TKCustomGrid.HasFocus: Boolean; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if (Form <> nil) and Form.Visible and Form.Enabled and Form.Active then + Result := (Form.ActiveControl = Self) or (FEditor <> nil) and (Form.ActiveControl = FEditor) + else + Result := False; +end; + +function TKCustomGrid.HasHorzScrollBar: Boolean; +begin + Result := (FScrollBars in [ssHorizontal, ssBoth]) and + not (goAlignLastCol in FOptions); +end; + +function TKCustomGrid.HasVertScrollBar: Boolean; +begin + Result := (FScrollBars in [ssVertical, ssBoth]) and + not (goAlignLastRow in FOptions); +end; + +procedure TKCustomGrid.HideCellHint; +begin + DefaultMouseCellHint(-1, -1, False); +end; + +function TKCustomGrid.InitialCol(ACol: Integer): Integer; +var + Item: TKGridAxisItem; +begin + Item := FCols[ACol]; + if Item <> nil then + Result := Item.InitialPos + else + Result := ACol; +end; + +function TKCustomGrid.InitialColInv(ACol: Integer): Integer; +var + I: Integer; + Item: TKGridAxisItem; +begin + Result := ACol; + for I := 0 to FColCount - 1 do + begin + Item := FCols[I]; + if (Item <> nil) and (Item.InitialPos = ACol) then + begin + Result := I; + Exit; + end; + end; +end; + +function TKCustomGrid.InitialRow(ARow: Integer): Integer; +var + Item: TKGridAxisItem; +begin + Item := FRows[ARow]; + if Item <> nil then + Result := Item.InitialPos + else + Result := ARow; +end; + +function TKCustomGrid.InitialRowInv(ARow: Integer): Integer; +var + I: Integer; + Item: TKGridAxisItem; +begin + Result := ARow; + for I := 0 to FRowCount - 1 do + begin + Item := FRows[I]; + if (Item <> nil) and (Item.InitialPos = ARow) then + begin + Result := I; + Exit; + end; + end; +end; + +procedure TKCustomGrid.InsertCol(At: Integer); +begin + InsertCols(At, 1); +end; + +procedure TKCustomGrid.InsertCols(At, Count: Integer); +begin + if not ColValid(At) then At := FColCount; + ChangeDataSize(True, At, Count, False, 0, 0); +end; + +procedure TKCustomGrid.InsertRow(At: Integer); +begin + InsertRows(At, 1); +end; + +procedure TKCustomGrid.InsertRows(At, Count: Integer); +begin + if not RowValid(At) then At := FRowCount; + ChangeDataSize(False, 0, 0, True, At, Count); +end; + +function TKCustomGrid.InsertSortedCol(out ByRow, ACol: Integer): Boolean; +begin + ByRow := SortRow; + if ByRow >= 0 then + begin + ACol := InternalInsertNR(ByRow, FFixedCols, FColCount - 1, FRows[ByRow].SortMode = smUp, + CompareCols); + if ACol >= FFixedCols then + begin + LockSortMode; + try + InsertCol(ACol); + finally + UnlockSortMode; + end; + end; + end; + Result := (ByRow >= 0) and (ACol >= FFixedCols); +end; + +function TKCustomGrid.InsertSortedRow(out ByCol, ARow: Integer): Boolean; +begin + ByCol := SortCol; + if ByCol >= 0 then + begin + ARow := InternalInsertNR(ByCol, FFixedRows, FRowCount - 1, FCols[ByCol].SortMode = smUp, + CompareRows); + if ARow >= FFixedRows then + begin + LockSortMode; + try + InsertRow(ARow); + finally + UnlockSortMode; + end; + end; + end; + Result := (ByCol >= 0) and (ARow >= FFixedRows); +end; + +procedure TKCustomGrid.InternalExchangeCols(Index1, Index2: Integer); +var + I: Integer; + AxisItem: TKGridAxisItem; + CellPtr: TKGridCell; +begin + AxisItem := FCols[Index1]; + FCols[Index1] := FCols[Index2]; + FCols[Index2] := AxisItem; + if Assigned(FCells) then + begin + for I := 0 to FRowCount - 1 do + begin + CellPtr := FCells[I, Index1]; + FCells[I, Index1] := FCells[I, Index2]; + FCells[I, Index2] := CellPtr; + end; + end; + if Assigned(FOnExchangeCols) then + FOnExchangeCols(Self, Index1, Index2); + if FSelection.Col1 = Index1 then + FSelection.Col1 := Index2 + else if FSelection.Col1 = Index2 then + FSelection.Col1 := Index1; + FSelection.Col2 := FSelection.Col1; + FEditorCell.Col := FSelection.Col1; +end; + +procedure TKCustomGrid.InternalExchangeRows(Index1, Index2: Integer); +var + AxisItem: TKGridAxisItem; + CellPtr: TKGridCellRow; +begin + AxisItem := FRows[Index1]; + FRows[Index1] := FRows[Index2]; + FRows[Index2] := AxisItem; + if Assigned(FCells) then + begin + CellPtr := FCells[Index1]; + FCells[Index1] := FCells[Index2]; + FCells[Index2] := CellPtr; + end else + CellPtr := nil; + if Assigned(FOnExchangeRows) then + FOnExchangeRows(Self, Index1, Index2); + if FSelection.Row1 = Index1 then + FSelection.Row1 := Index2 + else if FSelection.Row1 = Index2 then + FSelection.Row1 := Index1; + FSelection.Row2 := FSelection.Row1; + FEditorCell.Row := FSelection.Row1; +end; + +function TKCustomGrid.InternalExpandGridRect(const GridRect: TKGridRect): TKGridRect; +var + I, J, MyCol, MyRow: Integer; + Span: TKGridCellSpan; +begin + Result := GridRect; + for I := GridRect.Col1 to GridRect.Col2 do + for J := GridRect.Row1 to GridRect.Row2 do + begin + InternalFindBaseCell(I, J, MyCol, MyRow); + Span := InternalGetCellSpan(MyCol, MyRow); + Result.Col1 := Min(Result.Col1, MyCol); + Result.Col2 := Max(Result.Col2, MyCol + Span.ColSpan - 1); + Result.Row1 := Min(Result.Row1, MyRow); + Result.Row2 := Max(Result.Row2, MyRow + Span.RowSpan - 1); + end; +end; + +procedure TKCustomGrid.InternalFindBaseCell(ACol, ARow: Integer; out BaseCol, BaseRow: Integer); +begin + BaseCol := ACol; + BaseRow := ARow; + with InternalGetCellSpan(ACol, ARow) do + if (ColSpan <= 0) and (RowSpan <= 0) then + begin + BaseCol := ACol + ColSpan; + BaseRow := ARow + RowSpan; + end; +end; + +procedure TKCustomGrid.InternalFlip(Left, Right: Integer; + Exchange: TKGridExchangeProc); +var + I: Integer; +begin + for I := 0 to (Right - Left) div 2 do + Exchange(Left + I, Right - I); +end; + +function TKCustomGrid.InternalGetCell(ACol, ARow: Integer): TKGridCell; +begin + if FCells[ARow, ACol] = nil then + FCells[ARow, ACol] := FCellClass.Create(Self); + Result := FCells[ARow, ACol]; +end; + +function TKCustomGrid.InternalGetCellSpan(ACol, ARow: Integer): TKGridCellSpan; +begin + Result := MakeCellSpan(1, 1); + if Assigned(FOnCellSpan) then + FOnCellSpan(Self, ACol, ARow, Result) + else if Assigned(FCells) then with InternalGetCell(ACol, ARow) do + Result := Span; +end; + +function TKCustomGrid.InternalGetColWidths(Index: Integer): Integer; +begin + Result := FCols[Index].Extent +end; + +function TKCustomGrid.InternalGetEffectiveColSpacing(ACol: Integer): Integer; +begin + if FCols[ACol].Extent = 0 then + begin + if (goIndicateHiddenCells in FOptions) and ((ACol = 0) or (FCols[ACol - 1].Extent <> 0)) then + Result := FHCI.VBegin.Width + else + Result := 0; + end + else if FOptions * [goFixedVertLine, goVertLine] <> [] then + begin + if (ACol = FColCount - 1) and (goAlignLastCol in FOptions) then + Result := 0 + else + Result := FGridLineWidth + end else + Result := 0; +end; + +function TKCustomGrid.InternalGetEffectiveRowSpacing(ARow: Integer): Integer; +begin + if FRows[ARow].Extent = 0 then + begin + if (goIndicateHiddenCells in FOptions) and ((ARow = 0) or (FRows[ARow - 1].Extent <> 0)) then + Result := FHCI.HBegin.Height + else + Result := 0; + end + else if FOptions * [goFixedHorzLine, goHorzLine] <> [] then + begin + if (ARow = FRowCount - 1) and (goAlignLastRow in FOptions) or + ThemedCells and (ARow < FFixedRows) and (goHeader in FOptions) then + Result := 0 + else + Result := FGridLineWidth + end else + Result := 0; +end; + +procedure TKCustomGrid.InternalGetHExtent(AIndex, AColSpan: Integer; + out DestExtent, DestSpacing: Integer); +var + I, J, K, L, Spacing: Integer; +begin + DestExtent := InternalGetColWidths(AIndex); + Spacing := InternalGetEffectiveColSpacing(AIndex); + DestSpacing := Spacing; + if AColSpan > 1 then + begin + // cell is merged across columns + if DestExtent > 0 then J := DestSpacing else J := 0; + for I := AIndex + 1 to AIndex + AColSpan - 1 do + begin + K := InternalGetColWidths(I); + L := InternalGetEffectiveColSpacing(I); + if K > 0 then + J := L; + Inc(DestExtent, K); + Inc(DestSpacing, L); + end; + if DestExtent > 0 then + begin + Inc(DestExtent, DestSpacing - J); + DestSpacing := J; + end else + DestSpacing := Spacing; + end; +end; + +procedure TKCustomGrid.InternalGetVExtent(AIndex, ARowSpan: Integer; + out DestExtent, DestSpacing: Integer); +var + I, J, K, L, Spacing: Integer; +begin + DestExtent := InternalGetRowHeights(AIndex); + Spacing := InternalGetEffectiveRowSpacing(AIndex); + DestSpacing := Spacing; + if ARowSpan > 1 then + begin + // cell is merged across rows + if DestExtent > 0 then J := DestSpacing else J := 0; + for I := AIndex + 1 to AIndex + ARowSpan - 1 do + begin + K := InternalGetRowHeights(I); + L := InternalGetEffectiveRowSpacing(I); + if K > 0 then + J := L; + Inc(DestExtent, K); + Inc(DestSpacing, L); + end; + if DestExtent > 0 then + begin + Inc(DestExtent, DestSpacing - J); + DestSpacing := J; + end else + DestSpacing := Spacing; + end; +end; + +function TKCustomGrid.InternalGetMaxColWidth(Index: Integer): Integer; +begin + if (FCols[Index].MaxExtent > 0) and not (goAlignLastCol in FOptions) then + Result := FCols[Index].MaxExtent + else + Result := MaxInt; +end; + +function TKCustomGrid.InternalGetMaxRowHeight(Index: Integer): Integer; +begin + if (FRows[Index].MaxExtent > 0) and not (goAlignLastRow in FOptions) then + Result := FRows[Index].MaxExtent + else + Result := MaxInt; +end; + +function TKCustomGrid.InternalGetMinColWidth(Index: Integer): Integer; +begin + if FCols[Index].MinExtent > 0 then + Result := FCols[Index].MinExtent + else + Result := FMinColWidth; +end; + +function TKCustomGrid.InternalGetMinRowHeight(Index: Integer): Integer; +begin + if FRows[Index].MinExtent > 0 then + Result := FRows[Index].MinExtent + else + Result := FMinRowHeight; +end; + +function TKCustomGrid.InternalGetRowHeights(Index: Integer): Integer; +begin + Result := FRows[Index].Extent; + if (Result > 0) and (Index < FFixedRows) and (goHeader in FOptions) and ThemedCells + and (FOptions * [goFixedHorzLine, goHorzLine] <> []) then + Inc(Result, FGridLineWidth); +end; + +function TKCustomGrid.InternalInsertNR(ByIndex, Left, Right: Integer; + SortedUp: Boolean; Compare: TKGridCompareProc): Integer; +var + Key, Mult: Integer; +begin + if SortedUp then Mult := -1 else Mult := 1; + repeat + Key := (Left + Right) div 2; + if Compare(ByIndex, cInvalidIndex, Key) * Mult < 0 then + Right := Key - 1 + else + Left := Key + 1; + until Left > Right; + Result := Left; +end; + +function TKCustomGrid.InternalInsertIfCellModifiedNR(ByIndex, Index, Left, Right: Integer; + SortedUp: Boolean; Compare: TKGridCompareProc): Integer; +var + Key, Mult, TmpLeft, TmpRight: Integer; +begin + Result := Index; + if SortedUp then Mult := 1 else Mult := -1; + if Left < Index then + begin + TmpLeft := Left; + TmpRight := Index - 1; + repeat + Key := (TmpLeft + TmpRight) div 2; + if Compare(ByIndex, Key, Index) * Mult < 0 then + TmpRight := Key - 1 + else + TmpLeft := Key + 1; + until TmpLeft > TmpRight; + if TmpLeft < Index then + begin + Result := TmpLeft; + Exit; + end; + end; + if Index < Right then + begin + TmpLeft := Index + 1; + TmpRight := Right; + repeat + Key := (TmpLeft + TmpRight) div 2; + if Compare(ByIndex, Key, Index) * Mult < 0 then + TmpRight := Key - 1 + else + TmpLeft := Key + 1; + until TmpLeft > TmpRight; + Result := TmpRight; + end; + Result := MinMax(Result, Left, Right); +end; + +function TKCustomGrid.InternalMove(var ACol, ARow: Integer; Command: TKGridMoveCommand; Wrap, Expanding: Boolean): Boolean; +var + BaseCol, BaseRow, BkCol, BkRow, BkBaseCol, BkBaseRow: Integer; + BkCommand: TKGridMoveCommand; +begin + BkCol := ACol; + BkRow := ARow; + BkCommand := mcNone; + InternalFindBaseCell(ACol, ARow, BkBaseCol, BkBaseRow); + repeat + case Command of + mcDown: + begin + Inc(ARow); + if ARow < FRowCount then + begin + if FMemCol >= 0 then + ACol := FMemCol; + FMemRow := ARow; + end + else if Wrap then + begin + ARow := FFixedRows; + Inc(ACol); + if ACol >= FColCount then + begin + // aki: + if (gxEditFixedCols in FOptionsEx) or ((gxEditFixedRows in FOptionsEx) and (ARow < FFixedRows)) then + ACol := 0 + else + ACol := FFixedCols; + end; + FMemCol := ACol; + end + else if BkCommand <> mcNone then + begin + Dec(ARow); + Command := BkCommand; + BkCommand := mcNone; + end else + ARow := BkRow; + end; + mcEnd: + begin + ACol := FColCount - 1; + FMemCol := ACol; + if FMemRow >= 0 then + ARow := FMemRow; + Command := mcLeft; + end; + mcHome: + begin + // aki: + if (gxEditFixedCols in FOptionsEx) or ((gxEditFixedRows in FOptionsEx) and (ARow < FFixedRows)) then + ACol := 0 + else + ACol := FFixedCols; + FMemCol := ACol; + if FMemRow >= 0 then + ARow := FMemRow; + Command := mcRight; + end; + mcLeft: + begin + Dec(ACol); + // aki: + if (gxEditFixedCols in FOptionsEx) or ((gxEditFixedRows in FOptionsEx) and (ARow= 0 then + begin + if FMemRow >= 0 then + ARow := FMemRow; + FMemCol := ACol; + end + else + if Wrap then + begin + ACol := FColCount - 1; + Dec(ARow); + if ARow < 0 then ARow := FRowCount - 1; + FMemRow := ARow; + end + else if BkCommand <> mcNone then + begin + Inc(ACol); + Command := BkCommand; + BkCommand := mcNone; + end else + ACol := BkCol; + end else + begin + if ACol >= FFixedCols then + begin + if FMemRow >= 0 then + ARow := FMemRow; + FMemCol := ACol; + end + else if Wrap then + begin + ACol := FColCount - 1; + Dec(ARow); + if ARow < FFixedRows then ARow := FRowCount - 1; + FMemRow := ARow; + end + else if BkCommand <> mcNone then + begin + Inc(ACol); + Command := BkCommand; + BkCommand := mcNone; + end else + ACol := BkCol; + end; + end; + mcMoveUp: + begin + // aki: + if ((gxEditFixedRows in FOptionsEx) or (ARow > FFixedRows)) and (FMemCol >= 0) then + ACol := FMemCol; + ARow := FTopLeft.Row; + Command := mcUp; + BkCommand := mcDown; + end; + mcMoveDown: + begin + if (ARow < FRowCount - 1) and (FMemCol >= 0) then + ACol := FMemCol; + ARow := FTopLeft.Row + PageHeight - 1; + Command := mcDown; + BkCommand := mcUp; + end; + mcRight: + begin + Inc(ACol); + if ACol < FColCount then + begin + if FMemRow >= 0 then + ARow := FMemRow; + FMemCol := ACol; + end + else if Wrap then + begin + ACol := FFixedCols; + Inc(ARow); + if ARow >= FRowCount then ARow := FFixedRows; + FMemRow := ARow; + end + else if BkCommand <> mcNone then + begin + Dec(ACol); + Command := BkCommand; + BkCommand := mcNone; + end else + ACol := BkCol; + end; + mcUp: + begin + Dec(ARow); + // aki: + if (ARow >= FFixedRows) or ((gxEditFixedRows in FOptionsEx) and (ARow >= 0)) then + begin + if FMemCol >= 0 then + ACol := FMemCol; + FMemRow := ARow; + end + else if Wrap then + begin + ARow := FRowCount - 1; + Dec(ACol); + if ACol < FFixedCols then ACol := FColCount - 1; + FMemCol := ACol; + end + else if BkCommand <> mcNone then + begin + Inc(ARow); + Command := BkCommand; + BkCommand := mcNone; + end else + ARow := BkRow; + end; + mcPageDown: + begin + if (ARow < FRowCount - 1) and (FMemCol >= 0) then + ACol := FMemCol; + ARow := Min(ARow + PageHeight, FRowCount - 1); + Command := mcDown; + BkCommand := mcUp; + FMemRow := ARow; + end; + mcPageLeft: + begin + if (ARow > FFixedCols) and (FMemRow >= 0) then + ARow := FMemRow; + ACol := Max(ACol - PageWidth, FFixedCols); + Command := mcLeft; + BkCommand := mcRight; + FMemCol := ACol; + end; + mcPageRight: + begin + if (ARow < FColCount - 1) and (FMemRow >= 0) then + ARow := FMemRow; + ACol := Min(ACol + PageWidth, FColCount - 1); + Command := mcRight; + BkCommand := mcLeft; + FMemCol := ACol; + end; + mcPageUp: + begin + if (ARow > FFixedRows) and (FMemCol >= 0) then + ACol := FMemCol; + ARow := Max(ARow - PageHeight, FFixedRows); + Command := mcUp; + BkCommand := mcDown; + FMemRow := ARow; + end; + mcTop: + begin + ACol := FFixedCols; + ARow := FFixedRows; + FMemCol := ACol; + FMemRow := ARow; + Command := mcRight; + Wrap := True; + end; + mcBottom: + begin + ACol := FColCount - 1; + ARow := FRowCount - 1; + FMemCol := ACol; + FMemRow := ARow; + Command := mcLeft; + Wrap := True; + end; + end; + InternalFindBaseCell(ACol, ARow, BaseCol, BaseRow); + until (ACol = BkCol) and (ARow = BkRow) or ((BaseCol <> BkBaseCol) or (BaseRow <> BkBaseRow)) and + (not Expanding and SelectCell(BaseCol, BaseRow) or Expanding and SelectionExpand(BaseCol, BaseRow)); + Result := (ACol <> BkCol) or (ARow <> BkRow); + ACol := BaseCol; + ARow := BaseRow; +end; + +procedure TKCustomGrid.InternalPaintCell(ACol, ARow: Integer; AState: TKGridDrawState; + const ARect, ABlockRect: TRect; ACanvas: TCanvas; Clip, Printing: Boolean); +begin + FCellPainter.Col := ACol; + FCellPainter.Row := ARow; + FCellPainter.State := AState; + FCellPainter.CellPos := ARect.TopLeft; + FCellPainter.Canvas := ACanvas; + FCellPainter.CellRect := ARect; + FCellPainter.BlockRect := ABlockRect; + FCellPainter.FPrinting := Printing; + // prepare cell painter and draw cell + FCellPainter.BeginDraw; + try + if Clip or Printing then + FCellPainter.BeginClip; + try +// FCellPainter.Canvas.TextRect(ARect, ARect.Left, ARect.Top, 'debugtest'); + if not DrawCell(FCellPainter.Col, FCellPainter.Row, FCellPainter.CellRect, FCellPainter.State) then + FCellPainter.DrawEmptyCell; // stub function + finally + FCellPainter.EndClip; + end; + finally + FCellPainter.EndDraw; + end; +end; + +procedure TKCustomGrid.InternalQuickSortNR(ByIndex, Left, Right: Integer; + SortedDown: Boolean; Compare: TKGridCompareProc; Exchange: TKGridExchangeProc); +type + TStackItem = record + LIndex, RIndex: Integer; + end; +const + cStackGrow = 100; +var + Key, L, R, LBack, RBack, StackLen, StackPtr: Integer; + Stack: array of TStackItem; +begin + { this is the non recursive quick sort algorithm to avoid stack overflows. + Right parts of divided arrays are stored into a stack-like array + in dynamic memory for later use. } + SetLength(Stack, cStackGrow); + StackPtr := 0; + with Stack[StackPtr] do begin LIndex := Left; RIndex := Right end; + repeat + with Stack[StackPtr] do begin Left := LIndex; Right := RIndex end; + Dec(StackPtr); + repeat + L := Left; + R := Right; + Key := (L + R) div 2; + LBack := Left - 1; + RBack := Right; + repeat + if SortedDown then + begin + while (L < Right) and (Compare(ByIndex, L, Key) < 0) do Inc(L); + while (R > Left) and (Compare(ByIndex, R, Key) > 0) do Dec(R); + end else + begin + while (L < Right) and (Compare(ByIndex, L, Key) > 0) do Inc(L); + while (R > Left) and (Compare(ByIndex, R, Key) < 0) do Dec(R); + end; + if L <= R then + begin + if L < R then + if (L = Key) or (R = Key) then + begin + // preserve Key, exchange later + LBack := L; + RBack := R; + end else + Exchange(L, R); + Dec(R); + Inc(L); + end; + until L >= R; + // exchange anything with former Key + if LBack >= Left then + Exchange(LBack, RBack); + if L < Right then + begin + Inc(StackPtr); + StackLen := Length(Stack); + if StackPtr >= StackLen then + SetLength(Stack, StackLen + cStackGrow); + with Stack[StackPtr] do begin LIndex := L; RIndex := Right end; + end; + Right := R; + until Left >= Right; + until StackPtr < 0; +end; + +procedure TKCustomGrid.InternalSetCell(ACol, ARow: Integer; Value: TKGridCell); +var + TmpClass: TClass; + TmpCell: TKGridCell; + Span: TKGridCellSpan; +begin + if FCells[ARow, ACol] <> nil then + Span := FCells[ARow, ACol].Span + else + Span := MakeCellSpan(1, 1); + FreeAndNil(FCells[ARow, ACol]); + if Value <> nil then + begin + TmpClass := Value.ClassType; + TmpCell := TKGridCellClass(TmpClass).Create(Self); + FlagSet(cGF_GridUpdates); + try + TmpCell.Assign(Value); + TmpCell.Span := Span; + finally + FlagClear(cGF_GridUpdates); + end; + FCells[ARow, ACol] := TmpCell; + end; + InvalidateCell(ACol, ARow); +end; + +procedure TKCustomGrid.InternalSetCells(ACol, ARow: Integer; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +var + Cell, Tmp: TKGridCell; +begin + Cell := InternalGetCell(ACol, ARow); + FlagSet(cGF_GridUpdates); + try + if not (Cell is TKGridTextCell) then + begin + if FCellClass.InheritsFrom(TKGridTextCell) then + Tmp := FCellClass.Create(Self) + else + Tmp := TKGridTextCell.Create(Self); + Tmp.Assign(Cell); + Cell.Free; + FCells[ARow, ACol] := Tmp; + end; + TKGridTextCell(FCells[ARow, ACol]).Text := Text; + finally + FlagClear(cGF_GridUpdates); + end; + InvalidateCell(ACol, ARow); +end; + +function TKCustomGrid.InternalSetCellSpan(ACol, ARow: Integer; + const Value: TKGridCellSpan): TKGridRect; + + procedure Merge(ACol1, ARow1, ACol2, ARow2: Integer); + var + I, J: Integer; + Cell: TKGridCell; + begin + for I := ACol1 to ACol2 - 1 do + for J := ARow1 to ARow2 - 1 do + begin + Cell := InternalGetCell(I, J); + if (I = ACol1) and (J = ARow1) then + Cell.Span := MakeCellSpan(ACol2 - ACol1, ARow2 - ARow1) + else + Cell.Span := MakeCellSpan(ACol1 - I, ARow1 - J); + end; + end; + + procedure Split(ACol1, ARow1, ACol2, ARow2: Integer); + var + I, J: Integer; + RefSpan: TKGridCellSpan; + begin + RefSpan := MakeCellSpan(1, 1); + for I := ACol1 to ACol2 - 1 do + for J := ARow1 to ARow2 - 1 do + InternalGetCell(I, J).Span := RefSpan; + end; + +var + I, J, BaseCol, BaseRow: Integer; + Span: TKGridCellSpan; + Cell: TKGridCell; +begin + Result := GridRect(ACol, ARow, ACol + Value.ColSpan - 1, ARow + Value.ColSpan - 1); + if (ACol >= FFixedCols) and (ARow >= FFixedRows) then + FlagSet(cGF_SelCellsMerged); + Span := InternalGetCell(ACol, ARow).Span; + if (Span.ColSpan > 1) or (Span.RowSpan > 1) then + begin + // destroy previously merged area + Split(ACol, ARow, ACol + Span.ColSpan, ARow + Span.RowSpan); + Result.Col2 := Max(Result.Col2, ACol + Span.ColSpan - 1); + Result.Row2 := Max(Result.Row2, ARow + Span.RowSpan - 1); + end; + for I := ACol to ACol + Value.ColSpan - 1 do + for J := ARow to ARow + Value.RowSpan - 1 do + begin + Cell := InternalGetCell(I, J); + Span := Cell.Span; + if (Span.ColSpan <> 1) or (Span.RowSpan <> 1) then + begin + // adjust all four overlapping spans + InternalFindBaseCell(I, J, BaseCol, BaseRow); + if (BaseCol <> ACol) or (BaseRow <> ARow) then + begin + Span := InternalGetCell(BaseCol, BaseRow).Span; + Split(Max(ACol, BaseCol), Max(ARow, BaseRow), + Min(ACol + Value.ColSpan, BaseCol + Span.ColSpan), Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); + Merge(BaseCol, BaseRow, BaseCol + Span.ColSpan, ARow); + Merge(BaseCol, ARow + Value.RowSpan, BaseCol + Span.ColSpan, BaseRow + Span.RowSpan); + Merge(BaseCol, Max(ARow, BaseRow), ACol, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); + Merge(ACol + Value.ColSpan, Max(ARow, BaseRow), BaseCol + Span.ColSpan, Min(ARow + Value.RowSpan, BaseRow + Span.RowSpan)); + Result.Col1 := Min(Result.Col1, BaseCol); + Result.Row1 := Min(Result.Row1, BaseRow); + Result.Col2 := Max(Result.Col2, BaseCol + Span.ColSpan - 1); + Result.Row2 := Max(Result.Row2, BaseRow + Span.RowSpan - 1); + end; + end; + if (I = ACol) and (J = ARow) then + Cell.Span := Value + else + Cell.Span := MakeCellSpan(ACol - I, ARow - J); + end; +end; + +procedure TKCustomGrid.InternalSetColCount(Value: Integer); +begin + if Value > FColCount then + ChangeDataSize(True, FColCount, Value - FColCount, False, 0, 0) + else if Value < FColCount then + ChangeDataSize(False, Value, FColCount - Value, False, 0, 0); +end; + +procedure TKCustomGrid.InternalSetFixedCols(Value: Integer); +begin + ColCount := Max(ColCount, Value + 1); + FFixedCols := Value; + ResetTopLeft; + SelectionFix(FSelection); + UpdateAxes(True, cAll, False, cAll, []); +end; + +procedure TKCustomGrid.InternalSetFixedRows(Value: Integer); +begin + RowCount := Max(RowCount, Value + 1); + FFixedRows := Value; + ResetTopLeft; + SelectionFix(FSelection); + UpdateAxes(False, cAll, True, cAll, []); +end; + +procedure TKCustomGrid.InternalSetRowCount(Value: Integer); +begin + if Value > FRowCount then + ChangeDataSize(False, 0, 0, True, FRowCount, Value - FRowCount) + else if Value < FRowCount then + ChangeDataSize(False, 0, 0, False, Value, FRowCount - Value); +end; + +function TKCustomGrid.InternalUpdateVirtualGrid: Boolean; +begin + Result := True; +end; + +procedure TKCustomGrid.InternalUnlockUpdate; +begin + ClearSortMode; + UpdateAxes(True, cAll, True, cAll, [afCheckMinExtent]); +end; + +procedure TKCustomGrid.InvalidateCell(ACol, ARow: Integer); +begin + InvalidateGridRect(GridRect(GridPoint(ACol, ARow))); +end; + +procedure TKCustomGrid.InvalidateCol(ACol: Integer); +var + GR: TKGridRect; +begin + if UpdateUnlocked and HandleAllocated then + begin + ACol := MinMax(ACol, 0, FColCount - 1); + GR.Col1 := ACol; + GR.Col2 := ACol; + if FFixedRows > 0 then + begin + GR.Row1 := 0; + GR.Row2 := FFixedRows - 1; + InvalidateGridRect(GR); + end; + GR.Row1 := FFixedRows; + GR.Row2 := LastVisibleRow; + InvalidateGridRect(GR); + end; +end; + +procedure TKCustomGrid.InvalidateCols(FirstCol: Integer); +var + Boundary, FirstRow: Integer; + P: TPoint; + R: TRect; + GR: TKGridRect; +begin + if UpdateUnlocked and HandleAllocated then + begin + FirstCol := MinMax(FirstCol, 0, FColCount - 1); + if FirstCol >= FFixedCols then + FirstCol := Max(FirstCol, FTopLeft.Col); + if FFixedRows > 0 then + begin + GR := GridRect(FirstCol, 0, FirstCol, FFixedRows - 1); + GR := InternalExpandGridRect(GR); + Boundary := GR.Col1; + FirstRow := 0; + end else + begin + Boundary := MaxInt; + FirstRow := FTopLeft.Row; + end; + GR := GridRect(FirstCol, FTopLeft.Row, FirstCol, LastVisibleRow); + GR := InternalExpandGridRect(GR); + FirstCol := Min(Boundary, GR.Col1); + if FirstCol >= FFixedCols then + FirstCol := Max(FirstCol, FTopLeft.Col); + if CellToPoint(FirstCol, FirstRow, P, True) then + begin + if FirstCol >= FFixedCols then + Boundary := GetAxisInfoHorz([aiFixedParams]).FixedBoundary + else + Boundary := 0; + R := Rect(Max(P.X, Boundary), 0, ClientWidth, ClientHeight); + InvalidateRect(Handle, @R, False); + end; + end; +end; + +procedure TKCustomGrid.InvalidateCurrentSelection; +begin + InvalidateSelection(Selection); + if EditorMode and CellInGridRect(Col, Row, Selection) then + FEditor.Invalidate; +end; + +procedure TKCustomGrid.InvalidateGridRect(const GR: TKGridRect; Merged: Boolean); +var + R: TRect; +begin + if UpdateUnlocked and HandleAllocated and GridRectToRect(GR, R, True, Merged) then + InvalidateRect(Handle, @R, False); +end; + +procedure TKCustomGrid.InvalidateRow(ARow: Integer); +var + GR: TKGridRect; +begin + if UpdateUnlocked and HandleAllocated then + begin + ARow := MinMax(ARow, 0, FRowCount - 1); + GR.Row1 := ARow; + GR.Row2 := ARow; + if FFixedCols > 0 then + begin + GR.Col1 := 0; + GR.Col2 := FFixedCols - 1; + InvalidateGridRect(GR); + end; + GR.Col1 := FFixedCols; + GR.Col2 := LastVisibleCol; + InvalidateGridRect(GR); + end; +end; + +procedure TKCustomGrid.InvalidateRows(FirstRow: Integer); +var + Boundary, FirstCol: Integer; + P: TPoint; + R: TRect; + GR: TKGridRect; +begin + if UpdateUnlocked and HandleAllocated then + begin + FirstRow := MinMax(FirstRow, 0, FRowCount - 1); + if FirstRow >= FFixedRows then + FirstRow := Max(FirstRow, FTopLeft.Row); + if FFixedCols > 0 then + begin + GR := GridRect(0, FirstRow, FFixedCols - 1, FirstRow); + GR := InternalExpandGridRect(GR); + Boundary := GR.Row1; + FirstCol := 0; + end else + begin + Boundary := MaxInt; + FirstCol := FTopLeft.Col; + end; + GR := GridRect(FirstCol, FirstRow, LastVisibleCol, FirstRow); + GR := InternalExpandGridRect(GR); + FirstRow := Min(Boundary, GR.Row1); + if FirstRow >= FFixedRows then + FirstRow := Max(FirstRow, FTopLeft.Row); + if CellToPoint(FirstCol, FirstRow, P, True) then + begin + if FirstRow >= FFixedRows then + Boundary := GetAxisInfoVert([aiFixedParams]).FixedBoundary + else + Boundary := 0; + R := Rect(0, Max(P.Y, Boundary), ClientWidth, ClientHeight); + InvalidateRect(Handle, @R, False); + end; + end; +end; + +procedure TKCustomGrid.InvalidateSelection(ASelection: TKGridRect); +var + R: TRect; +begin + if UpdateUnlocked and HandleAllocated then + begin + ASelection := AdjustSelection(ASelection); + if GridRectToRect(ASelection, R, True) then + InvalidateRect(Handle, @R, False); + if goIndicateSelection in FOptions then + begin + // this causes extremely slow painting under GTKx! + // do not use goIndicateSelection here! + if not (goRowSelect in FOptions) and (FFixedRows > 0) and GridRectToRect( + GridRect(ASelection.Col1, 0, ASelection.Col2, FFixedRows - 1), R, True) then + InvalidateRect(Handle, @R, False); + if (FFixedCols > 0) and GridRectToRect( + GridRect(0, ASelection.Row1, FFixedCols - 1, ASelection.Row2), R, True) then + InvalidateRect(Handle, @R, False); + end; + end; +end; + +function TKCustomGrid.IsDoubleBuffered: Boolean; +begin + Result := DoubleBuffered or (goDoubleBufferedCells in FOptions); +end; + +function TKCustomGrid.IsThemed: Boolean; +begin + Result := goThemes in FOptions; +end; + +procedure TKCustomGrid.KeyDown(var Key: Word; Shift: TShiftState); +var + ACol, ARow, ATopRow, SelCol, SelRow: Integer; + Stage: TKGridSelectionStage; + Expanding: Boolean; +begin + inherited; + SelCol := FSelection.Col1; + SelRow := FSelection.Row1; + Expanding := False; + if ssShift in Shift then + begin + Stage := ssExpand; + if (goRangeSelect in FOptions) and (FRangeSelectStyle = rsMS_Excel) then + begin + SelCol := FSelection.Col2; + SelRow := FSelection.Row2; + Expanding := True; + end; + end else + Stage := ssInit; + ACol := SelCol; + ARow := SelRow; + ATopRow := FTopLeft.Row; + if ssCtrl in Shift then + case Key of + VK_UP: Dec(ATopRow); + VK_DOWN: Inc(ATopRow); + VK_LEFT: InternalMove(ACol, ARow, mcPageLeft, False, Expanding); + VK_RIGHT: InternalMove(ACol, ARow, mcPageRight, False, Expanding); + VK_PRIOR: InternalMove(Acol, ARow, mcMoveUp, False, Expanding); + VK_NEXT: InternalMove(Acol, ARow, mcMoveDown, False, Expanding); + VK_HOME: InternalMove(Acol, ARow, mcTop, False, Expanding); + VK_END: InternalMove(Acol, ARow, mcBottom, False, Expanding); + end + else + case Key of + VK_RETURN: + begin + FlagSet(cGF_EnterPressed); + if goEnterMoves in FOptions then + begin + if (ACol = FColCount - 1) and (ARow = FRowCount - 1) and (gxEnterAppendsRow in FOptionsEx) then + begin + InsertRow(FRowCount); + InternalMove(ACol, ARow, DirectionToCommand(FMoveDirection), True, Expanding); + end else + InternalMove(ACol, ARow, DirectionToCommand(FMoveDirection), (gxEnterWraps in FOptionsEx), Expanding); + end else + EditorMode := not EditorMode; + end; + VK_ESCAPE: + begin + CancelMode; + if EditorMode then + begin + EditorDataFromGrid(FEditor, FEditorCell.Col, FEditorCell.Row); + EditorMode := False; + end; + end; + VK_UP: InternalMove(ACol, ARow, mcUp, False, Expanding); + VK_DOWN: InternalMove(ACol, ARow, mcDown, False, Expanding); + VK_LEFT: InternalMove(ACol, ARow, mcLeft, False, Expanding); + VK_RIGHT: InternalMove(ACol, ARow, mcRight, False, Expanding); + VK_NEXT: InternalMove(ACol, ARow, mcPageDown, False, Expanding); + VK_PRIOR: InternalMove(ACol, ARow, mcPageUp, False, Expanding); + VK_HOME: InternalMove(ACol, ARow, mcHome, False, Expanding); + VK_END: InternalMove(ACol, ARow, mcEnd, False, Expanding); + VK_TAB: + begin + if goTabs in FOptions then + begin + if not (ssAlt in Shift) then + repeat + if ssShift in Shift then + begin + InternalMove(ACol, ARow, mcLeft, gxTabWraps in FOptionsEx, Expanding); + Stage := ssInit; + end else + begin + if (ACol = FColCount - 1) and (ARow = FRowCount - 1) and (gxTabAppendsRow in FOptionsEx) then + begin + InsertRow(FRowCount); + InternalMove(ACol, ARow, mcRight, True, Expanding); + end else + InternalMove(ACol, ARow, mcRight, gxTabWraps in FOptionsEx, Expanding); + end; + until TabStops[ACol] or (ACol = FSelection.Col1); + end; + end; + VK_F2: EditorMode := True; + end; + DefaultSetCaretToLeft(Key, Shift); + // aki: + if (gxEditFixedCols in FOptionsEx) and (gxEditFixedRows in FOptionsEx) then + begin + ACol := MinMax(ACol, 0, FColCount - 1); + ARow := MinMax(ARow, 0, FRowCount - 1); + end + else if (gxEditFixedCols in FOptionsEx) then + begin + ACol := MinMax(ACol, 0, FColCount - 1); + ARow := MinMax(ARow, FFixedRows, FRowCount - 1); + end + else if (gxEditFixedRows in FOptionsEx) and (ARow < FFixedRows) then + begin + ACol := MinMax(ACol, 0, FColCount - 1); + ARow := MinMax(ARow, 0, FRowCount - 1); + end else + begin + ACol := MinMax(ACol, FFixedCols, FColCount - 1); + ARow := MinMax(ARow, FFixedRows, FRowCount - 1); + end; + if (ACol <> SelCol) or (ARow <> SelRow) then + begin + if SelectionMove(ACol, ARow, Stage, [sfMustUpdate, sfClampInView, sfDontCallSelectCell, sfNoMemPos]) then + begin + Click; + if not (goAlwaysShowEditor in FOptions) then + EditorMode := False; + Key := 0; + end; + end + else if ATopRow <> FTopLeft.Row then + TopRow := MinMax(ATopRow, FFixedRows, FRowCount - 1); + // whenever set, this flag is only valid for the nearest KeyDown call + FlagClear(cGF_CaretToLeft or cGF_EnterPressed); +end; + +procedure TKCustomGrid.Loaded; +begin + inherited; + FColors.ClearBrightColors; + FColors.BrightRangeBkGnds; +end; + +procedure TKCustomGrid.LateUpdate(var Msg: TLMessage); +begin + inherited; + case Msg.Msg of + CN_KEYDOWN: + begin + KeyDown(TLMKey(Msg).CharCode, KeyDataToShiftState(TLMKey(Msg).KeyData)); + end; + LM_SETFOCUS: + begin + InvalidateCurrentSelection; + SafeSetFocus; + end; + end; +end; + +procedure TKCustomGrid.LockSortMode; +begin + Inc(FSortModeLock); +end; + +function TKCustomGrid.MeasureCell(ACol, ARow: Integer; const ARect: TRect; + AState: TKGridDrawState; Priority: TKGridMeasureCellPriority): TPoint; +begin + FCellPainter.Col := ACol; + FCellPainter.Row := ARow; + FCellPainter.State := AState; + FCellPainter.CellPos := ARect.TopLeft; + FCellPainter.Canvas := Canvas; + FCellPainter.CellRect := ARect; + FCellPainter.FPrinting := False; + // prepare cell painter and measure cell data + FCellPainter.BeginDraw; + try + Result.X := ARect.Right - ARect.Left; + Result.Y := ARect.Bottom - ARect.Top; + if Assigned(FOnMeasureCell) then + FOnMeasureCell(Self, ACol, ARow, ARect, AState, Priority, Result) + else if Assigned(FCells) then with InternalGetCell(ACol, ARow) do + begin + ApplyDrawProperties; + MeasureCell(ACol, ARow, ARect, AState, Priority, Result) + end else + Result := FCellPainter.DefaultMeasure(Priority); + finally + FCellPainter.EndDraw; + end; +end; + + +procedure TKCustomGrid.MeasurePages(var Info: TKPrintMeasureInfo); + + procedure Axis(const Info: TKGridAxisInfo; CanvasExtent, SelStart, SelEnd: Integer; + SelOnly, FitToPage: Boolean; out Pages, OutlineExtent: Integer); + var + I, StartIndex, EndIndex, Extent, PageExtent: Integer; + begin + Pages := 1; + PageExtent := 0; + OutlineExtent := 0; + if SelOnly then + begin + StartIndex := SelStart; + EndIndex := SelEnd; + end else + begin + StartIndex := 0; + EndIndex := Info.TotalCellCount - 1; + end; + for I := StartIndex to EndIndex do + begin + Extent := Info.CellExtent(I) + Info.EffectiveSpacing(I); + if FitToPage or (PageExtent + Extent < CanvasExtent) or (I = 0) then + Inc(PageExtent, Extent) + else + begin + Inc(Pages); + OutlineExtent := Max(OutlineExtent, PageExtent); + PageExtent := Extent; + end; + end; + OutlineExtent := Max(OutlineExtent, PageExtent); + end; + +var + ColPages, RowPages: Integer; + Scale: Double; + FitToPage, SelOnly: Boolean; + R: TKGridRect; + APageSetup: TKPrintPageSetup; +begin + R := InternalExpandGridRect(Selection); + NormalizeGridRect(R); + APageSetup := PageSetup; + FitToPage := poFitToPage in APageSetup.Options; + SelOnly := APageSetup.Range = prSelectedOnly; + Scale := APageSetup.Scale / 100; + Axis(GetAxisInfoHorz([]), Round(APageSetup.PaintAreaWidth / Scale), R.Col1, R.Col2, + SelOnly, FitToPage, ColPages, Info.OutlineWidth); + if FitToPage then + Scale := APageSetup.PaintAreaWidth / Info.OutlineWidth; + Axis(GetAxisInfoVert([]), Round(APageSetup.PaintAreaHeight / Scale), R.Row1, R.Row2, + SelOnly, False, RowPages, Info.OutlineHeight); + Info.HorzPageCount := ColPages; + Info.VertPageCount := RowPages; + Info.PageCount := ColPages * RowPages; +end; + +procedure TKCustomGrid.MouseCellHint(ACol, ARow: Integer; AShow: Boolean); +begin + if Assigned(FOnMouseCellHint) then + FOnMouseCellHint(Self, ACol, ARow, AShow) + else + DefaultMouseCellHint(ACol, ARow, AShow); +end; + +procedure TKCustomGrid.MouseClickCell(ACol, ARow: Integer); +begin + if (gxFixedCellClickSelect in FOptionsEx) and ((ARow < FFixedRows) or (ACol < FFixedCols)) and (ssShift in GetShiftState) then + begin + if (ARow < FFixedRows) and (ACol < FFixedCols) then + begin + if AllCellsSelected then + UnselectRange + else + SelectAll; + end else + begin + if ACol >= FFixedCols then + begin + if EntireColSelected[ACol] then + UnselectRange + else + SelectCol(ACol); + end else + begin + if EntireRowSelected[ARow] then + UnselectRange + else + SelectRow(ARow); + end; + end; + end; + if Assigned(FOnMouseClickCell) then + FOnMouseClickCell(Self, ACol, ARow); +end; + +procedure TKCustomGrid.MouseDblClickCell(ACol, ARow: Integer); +begin + if Assigned(FOnMouseDblClickCell) then + FOnMouseDblClickCell(Self, ACol, ARow); +end; + +procedure TKCustomGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + BaseCol, BaseRow: Integer; + CellFound: Boolean; + State: TKGridState; +begin + inherited; + if (Button = mbLeft) and not FScrollTimer.Enabled then + begin + SafeSetFocus; + if ssDouble in Shift then + DblClick; + FHitPos := Point(X, Y); + State := gsNormal; + CellFound := PointToCell(FHitPos, False, icNone, FHitCell.Col, FHitCell.Row, BaseCol, BaseRow); + if CellFound then + InternalFindBaseCell(FHitCell.Col, FHitCell.Row, BaseCol, BaseRow); + if PointToSizing(FHitPos, State, FSizingIndex, FSizingDest) then + begin + if (State = gsColSizing) and + BeginColSizing(FSizingIndex, FSizingDest) or + (State = gsRowSizing) and + BeginRowSizing(FSizingIndex, FSizingDest) then + begin + FGridState := State; + if CellFound then + InvalidateCell(BaseCol, BaseRow); + Update; + SuggestSizing(csStart); + end; + end + else if CellFound then + begin + if FMouseOver.Col >= 0 then + begin + MouseCellHint(FMouseOver.Col, FMouseOver.Row, False); + FCellHintTimer.Enabled := False; + end; + // aki: row for greater than fixed cols: + if (FHitCell.Row < FFixedRows) and (FHitCell.Col >= FFixedCols) and (not (gxEditFixedRows in FOptionsEx)) then + begin + if goColMoving in FOptions then + FGridState := gsColMoveWaiting + else if goRowSorting in FOptions then + FGridState := gsRowSortWaiting; + end + // aki: col + else if ((FHitCell.Col < FFixedCols) and (FHitCell.Row >= FFixedRows)) and (not (gxEditFixedCols in FOptionsEx)) then + begin + if goRowMoving in FOptions then + FGridState := gsRowMoveWaiting + else if goColSorting in FOptions then + FGridState := gsColSortWaiting; + end + // aki: row for greater than fixed row: + else if ((FHitCell.Col < FFixedCols) and (FHitCell.Row < FFixedRows)) and (not (gxEditFixedRows in FOptionsEx)) then + begin + FGridState := gsClickWaiting; + end else + begin + FlagSet(cGF_SelectedByMouse); + try + if SelectionMove(BaseCol, BaseRow, ssInit, [sfMustUpdate, sfClampInView]) then + begin + FGridState := gsSelecting; + EditorMode := (goAlwaysShowEditor in FOptions) or (ssDouble in Shift); + end; + finally + FlagClear(cGF_SelectedByMouse); + end; + end; + InvalidateCell(BaseCol, BaseRow); + if ssDouble in Shift then + MouseDblClickCell(BaseCol, BaseRow); + end; + end; +end; + +procedure TKCustomGrid.MouseEnterCell(ACol, ARow: Integer); +begin + if Assigned(FOnMouseEnterCell) then + FOnMouseEnterCell(Self, ACol, ARow); +end; + +procedure TKCustomGrid.MouseFormLeave; +var + P: TPoint; +begin + inherited; + if EditorMode then + begin + P := FEditor.ScreenToClient(Mouse.CursorPos); + if PtInRect(FEditor.ClientRect, P) then + FEditor.Perform(CM_MOUSEENTER, 0, 0) + else + MouseOverCells; + end else + MouseOverCells; +end; + +procedure TKCustomGrid.MouseLeaveCell(ACol, ARow: Integer); +begin + if Assigned(FOnMouseLeaveCell) then + FOnMouseLeaveCell(Self, ACol, ARow); +end; + +procedure TKCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer); + + function CanDrag: Boolean; + begin + Result := + (X > FHitPos.X + 8) or + (X < FHitPos.X - 8) or + (Y > FHitPos.Y + 8) or + (Y < FHitPos.Y - 8); + end; + +var + MustScroll: Boolean; + DeltaHorz, DeltaVert, HitCol, HitRow, SelCol, SelRow: Integer; + MousePt: TPoint; +begin + inherited; + MousePt := Point(X, Y); + if MouseCapture then + begin + case FGridState of + gsColSizing: + begin + SuggestSizing(csHide); + FSizingDest := X; + SuggestSizing(csShow); + end; + gsRowSizing: + begin + SuggestSizing(csHide); + FSizingDest := Y; + SuggestSizing(csShow); + end; + gsColMoveWaiting: if CanDrag then + begin + FDragOrigin := FHitCell.Col; + if BeginColDrag(FDragOrigin, MousePt) then + begin + ProcessDragWindow(FHitPos, MousePt, FDragOrigin, True, False); + FGridState := gsColMoving; + FDragDest := FDragOrigin; + SuggestDrag(csStart); + end; + end; + gsRowMoveWaiting: if CanDrag then + begin + FDragOrigin := FHitCell.Row; + if BeginRowDrag(FDragOrigin, MousePt) then + begin + ProcessDragWindow(FHitPos, MousePt, FDragOrigin, False, False); + FGridState := gsRowMoving; + FDragDest := FDragOrigin; + SuggestDrag(csStart); + end; + end; + gsSelecting, gsColMoving, gsRowMoving: + begin + if FGridState <> gsSelecting then + ProcessDragWindow(FHitPos, MousePt, cInvalidIndex, FGridState = gsColMoving, False); + if not FScrollTimer.Enabled and PointToCell(MousePt, True, + GridStateToInvisibleCells, HitCol, HitRow, SelCol, SelRow) then + begin + MustScroll := ScrollNeeded(HitCol, HitRow, DeltaHorz, DeltaVert); + if MustScroll then + begin + Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False); + FScrollTimer.Enabled := True; + end; + if FGridState = gsSelecting then + begin + InternalFindBaseCell(SelCol, SelRow, SelCol, SelRow); + SelectionMove(SelCol, SelRow, ssExpand, [sfMustUpdate]) + end else + DragMove(HitCol, HitRow, MousePt); + end; + end; + end; + end; + MouseOverCells; +end; + +procedure TKCustomGrid.MouseOverCells; +var + MousePt: TPoint; + HitCol, HitRow, BaseCol, BaseRow: Integer; +begin + MousePt := ScreenToClient(Mouse.CursorPos); + if not (FGridState in [gsColMoving, gsRowMoving]) and + ((goMouseOverCells in FOptions) or (FGridState <> gsNormal)) and + PtInRect(ClientRect, MousePt) and + PointToCell(MousePt, False, icNone, HitCol, HitRow, BaseCol, BaseRow) then + begin + InternalFindBaseCell(HitCol, HitRow, BaseCol, BaseRow); + if (BaseCol <> FMouseOver.Col) or (BaseRow <> FMouseOver.Row) then + begin + if FMouseOver.Col >= 0 then + begin + InvalidateCell(FMouseOver.Col, FMouseOver.Row); + MouseCellHint(FMouseOver.Col, FMouseOver.Row, False); + MouseLeaveCell(FMouseOver.Col, FMouseOver.Row); + end; + InvalidateCell(BaseCol, BaseRow); + if EditorMode and ( + (FMouseOver.Col = FEditorCell.Col) and (FMouseOver.Row = FEditorCell.Row) and + ((BaseCol <> FEditorCell.Col) or (BaseRow <> FEditorCell.Row)) + or + (BaseCol = FEditorCell.Col) and (BaseRow = FEditorCell.Row) and + ((FMouseOver.Col <> FEditorCell.Col) or (FMouseOver.Row <> FEditorCell.Row)) + ) then + FEditor.Invalidate; + FMouseOver := GridPoint(BaseCol, BaseRow); + MouseEnterCell(FMouseOver.Col, FMouseOver.Row); + if not MouseCapture then + begin + FHintCell := FMouseOver; + FCellHintTimer.Enabled := False; + FCellHintTimer.Interval := FMouseCellHintTime; + FCellHintTimer.Enabled := True; + end; + end; + end + else if FMouseOver.Col >= 0 then + begin + if EditorMode and (FMouseOver.Col = FEditorCell.Col) and (FMouseOver.Row = FEditorCell.Row) then + FEditor.Invalidate; + InvalidateCell(FMouseOver.Col, FMouseOver.Row); + MouseCellHint(FMouseOver.Col, FMouseOver.Row, False); + MouseLeaveCell(FMouseOver.Col, FMouseOver.Row); + FMouseOver := GridPoint(-1, -1); + end; +end; + +procedure TKCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + + function NextSortMode(ASortMode: TKGridSortMode): TKGridSortMode; + begin + case FSortStyle of + ssDownUp: if ASortMode = smDown then Result := smUp else Result := smDown; + ssDownUpNone: + case ASortMode of + smDown: Result := smUp; + smUp: Result := smNone; + else + Result := smDown; + end; + else + case ASortMode of + smUp: Result := smDown; + smDown: Result := smNone; + else + Result := smUp; + end; + end; + end; + +var + BaseCol, BaseRow, BaseHitCol, BaseHitRow, HitCol, HitRow, Tmp: Integer; + CellFound: Boolean; + CellPt, MousePt: TPoint; +begin + inherited; + if Button = mbLeft then + begin + MousePt := Point(X, Y); + case FGridState of + gsColMoving, gsRowMoving: + begin + ProcessDragWindow(FHitPos, MousePt, -1, FGridState = gsColMoving, True); + SuggestDrag(csStop); + end; + gsColSizing, gsRowSizing: + SuggestSizing(csStop); + end; + if ColValid(FHitCell.Col) and RowValid(FHitCell.Row) and + PointToCell(MousePt, False, icNone, HitCol, HitRow, BaseCol, BaseRow) then + begin + InternalFindBaseCell(HitCol, HitRow, BaseCol, BaseRow); + InternalFindBaseCell(FHitCell.Col, FHitCell.Row, BaseHitCol, BaseHitRow); + CellFound := (BaseHitCol = BaseCol) and (BaseHitRow = BaseRow); + end else + CellFound := False; + case FGridState of + gsSelecting: + begin + ClampInView(Col, Row); + if CellFound then + MouseClickCell(BaseCol, BaseRow); + Click; + end; + gsColSortWaiting, gsRowSortWaiting, gsColMoveWaiting, gsRowMoveWaiting: + if CellFound then + begin + if not (ssShift in Shift) and ((FGridState = gsColSortWaiting) or (FGridState = gsRowMoveWaiting)) and + (goColSorting in FOptions) and (BaseCol = FRows[BaseRow].SortArrowIndex) then + SortCols(BaseRow, NextSortMode(Rows[BaseRow].SortMode)) + else if not (ssShift in Shift) and ((FGridState = gsRowSortWaiting) or (FGridState = gsColMoveWaiting)) and + (goRowSorting in FOptions) and (BaseRow = FCols[BaseCol].SortArrowIndex) then + SortRows(BaseCol, NextSortMode(Cols[BaseCol].SortMode)) + else + begin + InvalidateCell(BaseCol, BaseRow); + MouseClickCell(BaseCol, BaseRow); + Click; + end; + end; + gsClickWaiting: + if CellFound then + begin + InvalidateCell(BaseCol, BaseRow); + MouseClickCell(BaseCol, BaseRow); + Click; + end; + gsColMoving: + if EndColDrag(FDragOrigin, FDragDest, MousePt) and (FDragOrigin <> FDragDest) then + MoveCol(FDragOrigin, FDragDest) + else + InvalidateCol(FDragOrigin); + gsRowMoving: + if EndRowDrag(FDragOrigin, FDragDest, MousePt) and (FDragOrigin <> FDragDest) then + MoveRow(FDragOrigin, FDragDest) + else + InvalidateRow(FDragOrigin); + gsColSizing: + begin + case FSizingStyle of + ssLine, ssXORLine: + if EndColSizing(FSizingIndex, FSizingDest) and CellToPoint(FSizingIndex, 0, CellPt) then + begin + Tmp := FSizingDest - CellPt.X; + if not (goMouseCanHideCells in FOptions) then + Tmp := Max(Tmp, InternalGetMinColWidth(FSizingIndex)); + ColWidths[FSizingIndex] := Tmp; + end; + end; + UpdateDesigner; + end; + gsRowSizing: + begin + case FSizingStyle of + ssLine, ssXORLine: + if EndRowSizing(FSizingIndex, FSizingDest) and CellToPoint(0, FSizingIndex, CellPt) then + begin + Tmp := FSizingDest - CellPt.Y; + if not (goMouseCanHideCells in FOptions) then + Tmp := Max(Tmp, InternalGetMinRowHeight(FSizingIndex)); + RowHeights[FSizingIndex] := Tmp; + end; + end; + UpdateDesigner; + end + else + if CellFound then + InvalidateCell(BaseCol, BaseRow); + end; + FlagClear(cGF_ThroughClick); + FGridState := gsNormal; + end; +end; + +function TKCustomGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Integer): Boolean; +var + DummyCol, DummyRow: Integer; +begin + Result := PointToCell(Point(X, Y), False, icNone, ACol, ARow, DummyCol, DummyRow); + if Result then + InternalFindBaseCell(ACol, ARow, ACol, ARow); +end; + +procedure TKCustomGrid.MoveCol(FromIndex, ToIndex: Integer); +var + I: Integer; +begin + if (FromIndex <> ToIndex) and ColValid(FromIndex) and ColValid(ToIndex) then + begin + if ToIndex > FromIndex then + for I := ToIndex downto FromIndex do + InternalExchangeCols(I, FromIndex) + else + for I := ToIndex to FromIndex do + InternalExchangeCols(I, FromIndex); + SelectionFix(FSelection); + UpdateAxes(True, cAll, False, cAll, []); + UpdateCellSpan; + ClearSortModeVert; + ColMoved(FromIndex, ToIndex); + end; +end; + +procedure TKCustomGrid.MoveRow(FromIndex, ToIndex: Integer); +var + I: Integer; +begin + if (FromIndex <> ToIndex) and RowValid(FromIndex) and RowValid(ToIndex) then + begin + if ToIndex > FromIndex then + for I := ToIndex downto FromIndex do + InternalExchangeRows(I, FromIndex) + else + for I := ToIndex to FromIndex do + InternalExchangeRows(I, FromIndex); + SelectionFix(FSelection); + UpdateAxes(False, cAll, True, cAll, []); + UpdateCellSpan; + ClearSortModeHorz; + RowMoved(FromIndex, ToIndex); + end; +end; + +procedure TKCustomGrid.MoveToNextCell; +var + ACol , ARow : Integer; +begin + ACol := FSelection.Col1; + ARow := FSelection.Row1; + InternalMove(ACol, ARow, DirectionToCommand(FMoveDirection), True, False); + if SelectionMove(ACol, ARow, ssInit, [sfMustUpdate, sfClampInView, sfDontCallSelectCell]) then + Click; +end; + +function TKCustomGrid.PageHeight: Integer; +var + Info: TKGridAxisInfo; +begin + Info := GetAxisInfoVert([aiFullVisBoundary]); + Result := Max(Info.FullVisCells - Info.FirstGridCell, 1); +end; + +function TKCustomGrid.PageWidth: Integer; +var + Info: TKGridAxisInfo; +begin + Info := GetAxisInfoHorz([aiFullVisBoundary]); + Result := Max(Info.FullVisCells - Info.FirstGridCell, 1); +end; + +procedure TKCustomGrid.PaintCell(ACanvas: TCanvas; ACol, ARow: Integer; AX, AY: Integer; APrinting: Boolean; ABlockRect: PRect); +var + R, ClipRect, TmpRect, TmpBlockRect: TRect; + CellBitmap: TBitmap; + TmpCanvas: TCanvas; + ClipCells: Boolean; + Info: TKGridAxisInfoBoth; +begin + if (ColWidths[ACol] > 0) and (RowHeights[ARow] > 0) then + if CellRect(ACol, ARow, R, True) then + begin + if not APrinting and ((goDoubleBufferedCells in FOptions) or DoubleBuffered) then + CellBitmap := TBitmap.Create + else + CellBitmap := nil; + try + if CellBitmap <> nil then + begin + TmpRect := Rect(0, 0, R.Right - R.Left, R.Bottom - R.Top); + CellBitmap.Width := TmpRect.Right; // SetSize not supported prior Delphi 2006 + CellBitmap.Height := TmpRect.Bottom; + TmpCanvas := CellBitmap.Canvas; + SelectClipRect(TmpCanvas.Handle, TmpRect); + ClipCells := False; + end else + begin + if ACanvas <> nil then + begin + TmpRect := Rect(AX, AY, AX + R.Right - R.Left, AY + R.Bottom - R.Top); + TmpCanvas := ACanvas; + SelectClipRect(TmpCanvas.Handle, TmpRect); + end else + begin + TmpRect := R; + TmpCanvas := Canvas; + end; + ClipCells := goClippedCells in FOptions; + end; + if ABlockRect <> nil then + TmpBlockRect := ABlockRect^ + else + TmpBlockRect := SelectionRect; + if CellBitmap <> nil then + OffsetRect(TmpBlockRect, -R.Left, -R.Top); + if (ACanvas = nil) or (ACanvas = Canvas) then + begin + Info := GetAxisInfoBoth([aiFixedParams]); + if (ARow >= FFixedRows) and (ACol < FFixedCols) then + ClipRect := Rect(0, Info.Vert.FixedBoundary, Info.Horz.FixedBoundary, Info.Vert.ClientExtent) + else if (ARow < FFixedRows) and (ACol >= FFixedCols) then + ClipRect := Rect(Info.Horz.FixedBoundary, 0, Info.Horz.ClientExtent, Info.Vert.FixedBoundary) + else if (ARow >= FFixedRows) and (ACol >= FFixedCols) then + ClipRect := Rect(Info.Horz.FixedBoundary, Info.Vert.FixedBoundary, Info.Horz.ClientExtent, Info.Vert.ClientExtent) + else + ClipRect := Rect(0, 0, Info.Horz.FixedBoundary, Info.Vert.FixedBoundary); + SelectClipRect(Canvas.Handle, ClipRect); + end; + InternalPaintCell(ACol, ARow, GetDrawState(ACol, ARow, HasFocus), TmpRect, TmpBlockRect, TmpCanvas, ClipCells, False); + if CellBitmap <> nil then + begin + Canvas.Lock; + try + Canvas.Draw(R.Left, R.Top, CellBitmap); + finally + Canvas.Unlock; + end; + end; + finally + CellBitmap.Free; + end; + end; +end; + +function TKCustomGrid.PaintCells(ACanvas: TCanvas; CellBitmap: TBitmap; MainClipRgn: HRGN; + FirstCol, LastCol, FirstRow, LastRow, X, Y, MaxX, MaxY: Integer; Printing, PaintSelection: Boolean; + const ABlockRect: TRect): TPoint; +var + I, J, I1, J1, XBack, YBack, + CHExtent, CHSpacing, CVExtent, CVSpacing, + HExtent, HSpacing, VExtent, VSpacing: Integer; + ClipCells, DrawLinesHorz, DrawLinesVert, GridFocused, HasHeader, HasFixedThemedCells, UseThemedCells: Boolean; + CellState: TKGridDrawState; + Span: TKGridCellSpan; + BorderRect, CellRect, TmpRect, TmpBlockRect: TRect; + TmpCanvas: TCanvas; +begin + GridFocused := Printing or HasFocus; + UseThemedCells := ThemedCells; + YBack := Y; + XBack := X; + // search for hidden merged cells first and update the FirstCol and FirstRow + // this is supposed to be faster for huge grids than to parse entire grid all the time + HExtent := FirstCol; + VExtent := FirstRow; + if FirstCol > 0 then // not for fixed cells + begin + I := FirstRow; + while (I <= LastRow) and (Y <= MaxY) do + begin + InternalFindBaseCell(FirstCol, I, I1, J1); + HExtent := Min(HExtent, I1); + VExtent := Min(VExtent, J1); + Inc(Y, InternalGetRowHeights(I) + InternalGetEffectiveRowSpacing(I)); + Inc(I); + end; + end; + if FirstRow > 0 then // not for fixed cells + begin + I := FirstCol; + while (I <= LastCol) and (X <= MaxX) do + begin + InternalFindBaseCell(I, FirstRow, I1, J1); + HExtent := Min(HExtent, I1); + VExtent := Min(VExtent, J1); + Inc(X, InternalGetColWidths(I) + InternalGetEffectiveColSpacing(I)); + Inc(I); + end; + end; + while FirstCol > HExtent do + begin + Dec(FirstCol); + Dec(XBack, InternalGetColWidths(FirstCol) + InternalGetEffectiveColSpacing(FirstCol)); + end; + while FirstRow > VExtent do + begin + Dec(FirstRow); + Dec(YBack, InternalGetRowHeights(FirstRow) + InternalGetEffectiveRowSpacing(FirstRow)); + end; + // now draw the grid + Y := YBack; + I := FirstRow; + while (I <= LastRow) and (Y <= MaxY) do + begin + X := XBack; + VExtent := InternalGetRowHeights(I); + VSpacing := InternalGetEffectiveRowSpacing(I); + J := FirstCol; + while (J <= LastCol) and (X <= MaxX) do + begin + HExtent := InternalGetColWidths(J); + HSpacing := InternalGetEffectiveColSpacing(J); + Span := InternalGetCellSpan(J, I); + if (Span.ColSpan > 0) and (Span.RowSpan > 0) then + begin + InternalGetHExtent(J, Span.ColSpan, CHExtent, CHSpacing); + InternalGetVExtent(I, Span.RowSpan, CVExtent, CVSpacing); + CellRect := Rect(X, Y, X + CHExtent, Y + CVExtent); + BorderRect := CellRect; + Inc(BorderRect.Bottom, CVSpacing); + Inc(BorderRect.Right, CHSpacing); + TmpRect := BorderRect; + if not Printing then + TranslateRectToDevice(ACanvas.Handle, TmpRect); + if Printing or RectInRegion(MainClipRgn, TmpRect) then + begin + if (CHExtent > 0) and (CVExtent > 0) then + begin + CellState := GetDrawState(J, I, GridFocused); + if Printing then + begin + CellState := CellState - [gdEdited, gdMouseDown, gdMouseOver]; + if not PaintSelection then + CellState := CellState - [gdSelected, gdFocused]; + end; + // default brush style for lines + ACanvas.Brush.Style := bsSolid; + // draw default grid + if (CHSpacing > 0) or (CVSpacing > 0) then + begin + DrawLinesHorz := CVSpacing > 0; + DrawLinesVert := CHSPacing > 0; + if gdFixed in CellState then + begin + HasHeader := (I < FFixedRows) and (goHeader in FOptions) and UseThemedCells; + HasFixedThemedCells := ((I < FFixedRows) or (J < FFixedCols)) and (gxFixedThemedCells in FOptionsEx) and UseThemedCells; + DrawLinesHorz := DrawLinesHorz and (goFixedHorzLine in FOptions) and not HasFixedThemedCells; + DrawLinesVert := DrawLinesVert and (goFixedVertLine in FOptions) and not (HasHeader or HasFixedThemedCells); + if UseThemedCells then + ACanvas.Brush.Color := FColors.FixedThemedCellLines + else + ACanvas.Brush.Color := FColors.FixedCellLines; + end else + begin + ACanvas.Brush.Color := FColors.CellLines; + DrawLinesHorz := DrawLinesHorz and (goHorzLine in FOptions); + DrawLinesVert := DrawLinesVert and (goVertLine in FOptions); + end; + if DrawLinesHorz then + begin + TmpRect := Rect(CellRect.Left, CellRect.Bottom, BorderRect.Right, BorderRect.Bottom); + ACanvas.FillRect(TmpRect); + end else + CellRect.Bottom := BorderRect.Bottom; + if DrawLinesVert then + begin + TmpRect := Rect(CellRect.Right, CellRect.Top, BorderRect.Right, CellRect.Bottom); + ACanvas.FillRect(TmpRect); + end else + CellRect.Right := BorderRect.Right; + end; + TmpBlockRect := ABlockRect; + if CellBitmap <> nil then + begin + TmpRect := Rect(0, 0, CellRect.Right - CellRect.Left, CellRect.Bottom - CellRect.Top); + CellBitmap.Width := TmpRect.Right; // SetSize not supported prior Delphi 2006 + CellBitmap.Height := TmpRect.Bottom; + TmpCanvas := CellBitmap.Canvas; + SelectClipRect(TmpCanvas.Handle, TmpRect); + ClipCells := False; + OffsetRect(TmpBlockRect, -CellRect.Left, -CellRect.Top); + end else + begin + TmpRect := CellRect; + TmpCanvas := ACanvas; + ClipCells := goClippedCells in FOptions; + end; + InternalPaintCell(J, I, CellState, TmpRect, TmpBlockRect, TmpCanvas, ClipCells, Printing); + if CellBitmap <> nil then + ACanvas.Draw(CellRect.Left, CellRect.Top, CellBitmap); + end + else if goIndicateHiddenCells in FOptions then + begin + TmpRect := BorderRect; + if (HExtent = 0) and (HSpacing > 0) then + begin + if (I = 0) and (CVExtent > FHCI.VBegin.Height) then + begin + ACanvas.Draw(TmpRect.Left, TmpRect.Top, FHCI.VBegin); + Inc(TmpRect.Top, FHCI.VBegin.Height); + end; + if (I = FRowCount - 1) and (CVExtent > FHCI.VEnd.Height) then + begin + Dec(TmpRect.Bottom, FHCI.VEnd.Height); + ACanvas.Draw(TmpRect.Left, TmpRect.Bottom, FHCI.HEnd); + end; + ACanvas.StretchDraw(TmpRect, FHCI.VCenter); + end; + if (VExtent = 0) and (VSpacing > 0) then + begin + if (J = 0) and (CHExtent > FHCI.HBegin.Width) then + begin + ACanvas.Draw(TmpRect.Left, TmpRect.Top, FHCI.HBegin); + Inc(TmpRect.Left, FHCI.HBegin.Width); + end; + if (J = FColCount - 1) and (CHExtent > FHCI.HEnd.Width) then + begin + Dec(TmpRect.Right, FHCI.HEnd.Width); + ACanvas.Draw(TmpRect.Right, TmpRect.Top, FHCI.HEnd); + end; + ACanvas.StretchDraw(TmpRect, FHCI.HCenter); + end; + end; + end; + end; + Inc(X, HExtent + HSpacing); + Inc(J); + end; + Inc(Y, VExtent + VSpacing); + Inc(I); + end; + Result := Point(X, Y); +end; + +procedure TKCustomGrid.PaintDragSuggestion(ACanvas: TCanvas); + + procedure DragSuggLine(X, Y, W, H: Integer); + begin + with ACanvas do + begin + Pen.Color := FColors.DragSuggestionLine; + Pen.Style := psSolid; + Pen.Width := 1; + Brush.Color := FColors.DragSuggestionBkGnd; + Brush.Style := bsSolid; + Rectangle(X, Y, X + W, Y + H); + end; + end; + +var + Len: Integer; + ArrowCopy: TKAlphaBitmap; + R: TRect; +begin + if GetDragRect(GetAxisInfoBoth([aiGridBoundary]), R) then + begin + case FDragStyle of + dsLayeredConst, dsLayeredFaded: + begin + ArrowCopy := TKAlphaBitmap.Create; + try + if FGridState = gsColMoving then + begin + ArrowCopy.CopyFrom(FDragArrow); + ArrowCopy.AlphaDrawTo(ACanvas, R.Left, R.Top); + Len := R.Bottom - R.Top - ArrowCopy.Height shl 1; + if Len > 0 then + begin + ArrowCopy.MirrorVert; + ArrowCopy.AlphaDrawTo(ACanvas, R.Left, R.Bottom - ArrowCopy.Height); + if Len > 6 then + DragSuggLine(R.Left + ArrowCopy.Width shr 1 - 1, + R.Top + ArrowCopy.Height + 1, 3, Len - 2); + end; + end else + begin + ArrowCopy.CopyFromRotated(FDragArrow); + ArrowCopy.AlphaDrawTo(ACanvas, R.Left, R.Top); + Len := R.Right - R.Left - ArrowCopy.Width shl 1; + if Len > 0 then + begin + ArrowCopy.MirrorHorz; + ArrowCopy.AlphaDrawTo(ACanvas, R.Right - ArrowCopy.Width, R.Top); + if Len > 6 then + DragSuggLine(R.Left + ArrowCopy.Width + 1, + R.Top + ArrowCopy.Height shr 1 - 1, Len - 2, 3); + end; + end; + finally + ArrowCopy.Free; + end; + end; + dsLine, dsXORLine: + begin + with ACanvas do + begin + // prevent rounded caps + Pen.Width := 1; + if FDragStyle = dsLine then + Pen.Color := clRed + else + begin + Pen.Mode := pmXOR; + Pen.Color := clWhite; + end; + try + if FGridState = gsColMoving then + begin + for Len := 0 to 4 do + begin + ACanvas.MoveTo(R.Left + Len, R.Top); + ACanvas.LineTo(R.Left + Len, R.Bottom); + end; + end else + begin + for Len := 0 to 4 do + begin + ACanvas.MoveTo(R.Left, R.Top + Len); + ACanvas.LineTo(R.Right, R.Top + Len); + end; + end; + finally + Pen.Mode := pmCopy; + end; + end; + end; + end; + end; +end; + +procedure TKCustomGrid.PaintHeaderAlignment(ACanvas: TCanvas; ARect: TRect); +begin + {$IFDEF USE_THEMES} + if ThemedCells then with ThemeServices do + begin + Inc(ARect.Bottom); + DrawElement(ACanvas.Handle, GetElementDetails(thHeaderItemRightNormal), ARect) + end else + {$ENDIF} + begin + ACanvas.Brush.Color := FColors.FixedCellBkGnd; + Dec(ARect.Bottom); + ACanvas.FillRect(ARect); + if {$IFDEF FPC}not Flat{$ELSE}Ctl3D{$ENDIF} then + {$IFDEF USE_WINAPI} + // looks somewhat better though + DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_LEFT or BF_TOP or BF_BOTTOM or BF_SOFT); + {$ELSE} + DrawEdges(ACanvas, ARect, cl3DHilight, cl3DShadow, BF_LEFT or BF_TOP or BF_BOTTOM); + {$ENDIF} + ACanvas.Brush.Color := FColors.FixedCellLines; + ACanvas.FillRect(Rect(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom + 1)); + end; +end; + +procedure TKCustomGrid.PaintPage; + + procedure Axis(const Info: TKGridAxisInfo; CanvasExtent, Page, SelStart, SelEnd: Integer; + SelOnly, FitToPage: Boolean; out FirstIndex, LastIndex, PageExtent: Integer); + var + I, Extent, StartIndex, EndIndex, Pages: Integer; + begin + Pages := 1; + PageExtent := 0; + if SelOnly then + begin + StartIndex := SelStart; + EndIndex := SelEnd; + end else + begin + StartIndex := 0; + EndIndex := Info.TotalCellCount - 1; + end; + FirstIndex := StartIndex; + LastIndex := StartIndex; + for I := StartIndex to EndIndex do + begin + Extent := Info.CellExtent(I) + Info.EffectiveSpacing(I); + if FitToPage or (PageExtent + Extent < CanvasExtent) or (I = 0) then + Inc(PageExtent, Extent) + else + begin + FirstIndex := LastIndex; + LastIndex := I; + if Page = Pages then + begin + Dec(LastIndex); + Exit; + end; + Inc(Pages); + PageExtent := Extent; + end; + end; + FirstIndex := LastIndex; + LastIndex := EndIndex; + end; + +var + FirstCol, FirstRow, LastCol, LastRow, OutlineWidth, OutlineHeight, AreaWidth, AreaHeight: Integer; + FitToPage, SelOnly{$IFDEF LCLQT}, AThemedCells{$ENDIF}: Boolean; + TmpRect, TmpRect1: TRect; + MainClipRgn: HRGN; + R: TKGridRect; + APageSetup: TKPrintPageSetup; +// CellBitmap: TBitmap; +begin + R := InternalExpandGridRect(Selection); + NormalizeGridRect(R); + APageSetup := PageSetup; + FitToPage := poFitToPage in APageSetup.Options; + SelOnly := APageSetup.Range = prSelectedOnly; + AreaWidth := Round(APageSetup.PaintAreaWidth / APageSetup.CurrentScale); + AreaHeight := Round(APageSetup.PaintAreaHeight / APageSetup.CurrentScale); + Axis(GetAxisInfoHorz([]), AreaWidth, (APageSetup.CurrentPage - 1) mod APageSetup.HorzPageCount + 1, + R.Col1, R.Col2, SelOnly, FitToPage, FirstCol, LastCol, OutlineWidth); + Axis(GetAxisInfoVert([]), AreaHeight, (APageSetup.CurrentPage - 1) div APageSetup.HorzPageCount + 1, + R.Row1, R.Row2, SelOnly, False, FirstRow, LastRow, OutlineHeight); + if poUseColor in APageSetup.Options then + FColors.ColorScheme := csNormal + else + FColors.ColorScheme := csGrayScale; + TmpRect := Rect(0, 0, OutlineWidth, OutlineHeight); + TmpRect1 := Rect(0, 0, AreaWidth, AreaHeight); + IntersectRect(TmpRect, TmpRect, TmpRect1); + TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect); +{$IFDEF LCLQT} + AThemedCells := goThemedCells in FOptions; + Exclude(FOptions, goThemedCells); +{$ENDIF} + MainClipRgn := CreateRectRgnIndirect(TmpRect); +// if goDoubleBufferedCells in FOptions then +// CellBitmap := TBitmap.Create +// else +// CellBitmap := nil; + try + SelectClipRgn(APageSetup.Canvas.Handle, MainClipRgn); + TmpRect := SelectionRect; + if SelOnly then + OffsetRect(TmpRect, -TmpRect.Left, -TmpRect.Top); + PaintCells(PageSetup.Canvas, nil, MainClipRgn, FirstCol, LastCol, FirstRow, LastRow, + 0, 0, OutlineWidth, OutlineHeight, True, poPaintSelection in APageSetup.Options, TmpRect); + finally + DeleteObject(MainClipRgn); +// CellBitmap.Free; + {$IFDEF LCLQT} + if AThemedCells then + Include(FOptions, goThemedCells); + {$ENDIF} + end; +end; + +procedure TKCustomGrid.PaintSizingSuggestion(ACanvas: TCanvas); +var + Info: TKGridAxisInfo; + I: Integer; +begin + case FSizingStyle of + ssLine, ssXORLine: + begin + with ACanvas do + begin + Pen.Width := 1; + if FSizingStyle = ssLine then + Pen.Color := clRed + else + begin + Pen.Mode := pmXOR; + Pen.Color := clWhite; + end; + try + case FGridState of + gsColSizing: + begin + Info := GetAxisInfoVert([aiGridBoundary]); + for I := 0 to 1 do + begin + ACanvas.MoveTo(FSizingDest + I, 0); + ACanvas.LineTo(FSizingDest + I, Info.GridBoundary); + end; + end; + gsRowSizing: + begin + Info := GetAxisInfoHorz([aiGridBoundary]); + for I := 0 to 1 do + begin + ACanvas.MoveTo(0, FSizingDest + I); + ACanvas.LineTo(Info.GridBoundary, FSizingDest + I); + end; + end; + end; + finally + Pen.Mode := pmCopy; + end; + end; + end; + end; +end; + +procedure TKCustomGrid.PaintToCanvas(ACanvas: TCanvas); +var + I, Bottom, ClientH, ClientW, GridW, GridH, SaveIndex: Integer; + TmpExtent: TPoint; + TmpRect: TRect; + CurClipRgn, MainClipRgn: HRGN; + DC: HDC; + CellBitmap: TBitmap; + Info: TKGridAxisInfoBoth; + TmpBlockRect: TRect; +begin + DC := ACanvas.Handle; + SaveIndex := SaveDC(DC); // don't delete + ACanvas.Lock; + try + if Enabled or (FDisabledDrawStyle = ddNormal) then + FColors.ColorScheme := csNormal + else if FDisabledDrawStyle = ddGrayed then + FColors.ColorScheme := csGrayed + else + FColors.ColorScheme := csBright; + ClientH := ClientHeight; + ClientW := ClientWidth; + Info := GetAxisInfoBoth([aiFixedParams]); + GridW := 0; GridH := 0; + TmpExtent := Point(0, 0); + if (goDoubleBufferedCells in FOptions) and not DoubleBuffered then + CellBitmap := TBitmap.Create + else + CellBitmap := nil; + MainClipRgn := CreateEmptyRgn; + CurClipRgn := CreateEmptyRgn; + try + TmpBlockRect := SelectionRect; + if GetClipRgn(DC, MainClipRgn) <> 1 then + begin + DeleteObject(MainClipRgn); + TmpRect := Rect(0, 0, ClientW, ClientH); + TranslateRectToDevice(DC, TmpRect); + MainClipRgn := CreateRectRgnIndirect(TmpRect); + end; + // draw clipped selectable cells first (to avoid some GTK clipping problems) + TmpRect := Rect(Info.Horz.FixedBoundary, Info.Vert.FixedBoundary, ClientW, ClientH); + if not IsRectEmpty(TmpRect) then + begin + TranslateRectToDevice(DC, TmpRect); + if ExtSelectClipRectEx(DC, TmpRect, RGN_AND, CurClipRgn, MainClipRgn) then + begin + TmpExtent := PaintCells(ACanvas, CellBitmap, CurClipRgn, FTopLeft.Col, FColCount - 1, FTopLeft.Row, FRowCount - 1, + Info.Horz.FixedBoundary - FScrollOffset.X, Info.Vert.FixedBoundary - FScrollOffset.Y, ClientW, ClientH, False, True, TmpBlockRect); + end; + end; + GridW := Max(GridW, TmpExtent.X); GridH := Max(GridH, TmpExtent.Y); + // clipped fixed rows + TmpRect := Rect(Info.Horz.FixedBoundary, 0, ClientW, Info.Vert.FixedBoundary); + if not IsRectEmpty(TmpRect) then + begin + TranslateRectToDevice(DC, TmpRect); + if ExtSelectClipRectEx(DC, TmpRect, RGN_AND, CurClipRgn, MainClipRgn) then + TmpExtent := PaintCells(ACanvas, CellBitmap, CurClipRgn, FTopLeft.Col, FColCount - 1, 0, FFixedRows - 1, + Info.Horz.FixedBoundary - FScrollOffset.X, 0, ClientW, ClientH, False, True, TmpBlockRect); + end; + GridW := Max(GridW, TmpExtent.X); GridH := Max(GridH, TmpExtent.Y); + // clipped fixed columns + TmpRect := Rect(0, Info.Vert.FixedBoundary, Info.Horz.FixedBoundary, ClientH); + if not IsRectEmpty(TmpRect) then + begin + TranslateRectToDevice(DC, TmpRect); + if ExtSelectClipRectEx(DC, TmpRect, RGN_AND, CurClipRgn, MainClipRgn) then + TmpExtent := PaintCells(ACanvas, CellBitmap, CurClipRgn, 0, FFixedCols - 1, FTopLeft.Row, FRowCount - 1, 0, + Info.Vert.FixedBoundary - FScrollOffset.Y, ClientW, ClientH, False, True, TmpBlockRect); + end; + GridW := Max(GridW, TmpExtent.X); GridH := Max(GridH, TmpExtent.Y); + // non-clipped fixed cells + TmpRect := Rect(0, 0, Info.Horz.FixedBoundary, Info.Vert.FixedBoundary); + if not IsRectEmpty(TmpRect) then + begin + TranslateRectToDevice(DC, TmpRect); + if ExtSelectClipRectEx(DC, TmpRect, RGN_AND, CurClipRgn, MainClipRgn) then + TmpExtent := PaintCells(ACanvas, CellBitmap, CurClipRgn, 0, FFixedCols - 1, 0, FFixedRows - 1, + 0, 0, ClientW, ClientH, False, True, TmpBlockRect); + end; + GridW := Max(GridW, TmpExtent.X); GridH := Max(GridH, TmpExtent.Y); + finally + FinalizePrevRgn(DC, MainClipRgn); + DeleteObject(CurClipRgn); + CellBitmap.Free; + end; + // draw a focus rectangle around cells in goRangeSelect and goRowSelect mode + if not (csDesigning in ComponentState) and (goDrawFocusSelected in FOptions) and + (FOptions * [goRangeSelect, goRowSelect] <> []) and Focused and not EditorMode then + begin + // to ensure coming DrawFocusRect will be painted correctly: + SetBkColor(DC, $FFFFFF); + SetTextColor(DC, 0); + ACanvas.DrawFocusRect(TmpBlockRect); + end; + // default color for client area parts not consumed by cells + ACanvas.Brush.Style := bsSolid; + // fill window client area parts not consumed by cells + if GridH < ClientH then + begin + ACanvas.Brush.Color := Color; + ACanvas.FillRect(Rect(0, GridH, GridW, ClientH)); + end; + if GridW < ClientW then + begin + if (goHeader in FOptions) and (goHeaderAlignment in FOptions) and (FFixedRows > 0) then + begin + Bottom := 0; + for I := 0 to FFixedRows - 1 do + Inc(Bottom, InternalGetRowHeights(I) + InternalGetEffectiveRowSpacing(I)); + PaintHeaderAlignment(ACanvas, Rect(GridW, 0, ClientW, Bottom)); + end else + Bottom := 0; + ACanvas.Brush.Color := Color; + ACanvas.FillRect(Rect(GridW, Bottom, ClientW, ClientH)); + end; + if FGridState in [gsColMoving, gsRowMoving] then PaintDragSuggestion(ACanvas); + if FGridState in [gsColSizing, gsRowSizing] then PaintSizingSuggestion(ACanvas); + finally + RestoreDC(DC, SaveIndex); + Canvas.Unlock; + end; +end; + +function TKCustomGrid.PointToCell(Point: TPoint; OutSide: Boolean; + InvisibleCells: TKGridInvisibleCells; out HitCol, HitRow, SelCol, SelRow: Integer): Boolean; + + function Axis1(const Info: TKGridAxisInfo; Coord: Integer; InVis1, InVis2: TKGridInvisibleCells): Integer; + var + I, PtBegin, PtEnd, PtEOFixed: Integer; + begin + Result := -1; + // check fixed cells + I := 0; + PtBegin := 0; + while (I < Info.FixedCellCount) and (Result < 0) do + begin + PtEnd := PtBegin + Info.CellExtent(I) + Info.EffectiveSpacing(I); + if (InvisibleCells in [icNone, InVis1]) {or (Info.FixedSelectable and (Info.FirstGridCell = Info.FixedCellCount)) } and + (Coord >= PtBegin) and (Coord < PtEnd) then + Result := I; + PtBegin := PtEnd; + Inc(I); + end; + if (Result < 0) then + begin + PtEOFixed := PtBegin - Info.ScrollOffset; + I := Info.FirstGridCell; + if (Coord < PtEOFixed) and (InvisibleCells in [InVis2, icCells]) then + begin + // check the invisible cells to the left or top + PtEnd := PtEOFixed; + while (I > Info.FixedCellCount) and (Result < 0) do + begin + Dec(I); + PtBegin := PtEnd - Info.CellExtent(I) - Info.EffectiveSpacing(I); + if (Coord >= PtBegin) and (Coord < PtEnd) then + Result := I; + PtEnd := PtBegin; + end; + if OutSide and (Result < 0) then + if Info.FixedSelectable then + Result := 0 + else + Result := Info.FixedCellCount; + end else + begin + // check visible cells and invisible ones to the right or bottom + PtBegin := PtEOFixed; + while (I < Info.TotalCellCount) and (Result < 0) do + begin + PtEnd := PtBegin + Info.CellExtent(I) + Info.EffectiveSpacing(I); + if (Coord >= PtBegin) and (Coord < PtEnd) then + Result := I; + PtBegin := PtEnd; + Inc(I); + end; + if OutSide and (Result < 0) then + Result := Info.TotalCellCount - 1; + end; + end; + end; + + function Axis2(const Info: TKGridAxisInfo; Index: Integer): Integer; + begin + if Index = Info.FixedCellCount then + begin + // some first nonfixed columns or rows may be hidden, so take first visible column/row + while (Index < Info.TotalCellCount) and (Info.CellExtent(Index) = 0) do + Inc(Index); + if Index >= Info.TotalCellCount then + Index := Info.FixedCellCount; + end + else if Index = Info.TotalCellCount - 1 then + begin + // some last columns or rows may be hidden, so take last visible column/row + while (Index >= Info.FixedCellCount) and (Info.CellExtent(Index) = 0) do + Dec(Index); + if Index < Info.FixedCellCount then + Index := Info.TotalCellCount - 1; + end; + Result := Index; + end; + +var + Info: TKGridAxisInfo; +begin + Result := False; + Info := GetAxisInfoHorz([]); + HitCol := Axis1(Info, Point.X, icFixedRows, icFixedCols); + if HitCol >= 0 then + begin + if OutSide then SelCol := Axis2(Info ,HitCol) else SelCol := HitCol; + Info := GetAxisInfoVert([]); + HitRow := Axis1(Info, Point.Y, icFixedCols, icFixedRows); + if HitRow >= 0 then + begin + if OutSide then SelRow := Axis2(Info, HitRow) else SelRow := HitRow; + Result := True; + end; + end +end; + +function TKCustomGrid.PointToSizing(Point: TPoint; var State: TKGridState; + var Index, Pos: Integer): Boolean; + + function AxisSizing(const Info: TKGridAxisInfo; Coord: Integer; + var Index, Pos: Integer): Boolean; + const + cDelta = 3; + var + I, ICopy, Dummy, ES, Line, StartCell: Integer; + begin + Result := False; + if (Info.FullVisCells < Info.GridCells) and + (Coord >= Info.ClientExtent - cDelta) and (Coord <= Info.ClientExtent) then + begin + Index := Info.FullVisCells; + Pos := Info.ClientExtent; + Result := True; + end else + begin + Line := Info.FullVisBoundary; + StartCell := Info.FullVisCells - 1; + for I := StartCell downto Info.FirstGridCell do + begin + ES := Info.EffectiveSpacing(I); + ICopy := I; + if ((I < StartCell) or not Info.AlignLastCell) and + ({(Info.CellExtent(I) <> 0) or (I = StartCell) and} Info.CanResize(ICopy, Dummy)) and + (Coord >= Line - ES - cDelta) and (Coord <= Line + cDelta) then + begin + Index := I; + Pos := Line; + Result := True; + Break; + end; + Dec(Line, Info.CellExtent(I) + ES); + end; + if not Result then + begin + Line := Info.FixedBoundary; + for I := Info.FixedCellCount - 1 downto 0 do + begin + ES := Info.EffectiveSpacing(I); + ICopy := I; + if (Coord >= Line - ES - cDelta) and (Coord <= Line + cDelta) and Info.CanResize(ICopy, Dummy) then + begin + Index := I; + Pos := Line; + Result := True; + Break; + end; + Dec(Line, Info.CellExtent(I) + ES); + end; + end; + end; + end; + +var + EffColSizing, EffRowSizing: Boolean; + Info: TKGridAxisInfoBoth; +begin + Result := False; + EffColSizing := (goColSizing in FOptions) or (csDesigning in ComponentState); + EffRowSizing := (goRowSizing in FOptions) or (csDesigning in ComponentState); + if EffColSizing or EffRowSizing then + begin + Info := GetAxisInfoBoth([aiFullVisBoundary, aiGridBoundary]); + if EffColSizing and AxisSizing(Info.Horz, Point.X, Index, Pos) and + ((Point.Y < Info.Vert.FixedBoundary) or (Point.Y < Info.Vert.GridBoundary) and + (InternalGetColWidths(Index) = 0)) then + begin + Result := True; + State := gsColSizing; + end + else if EffRowSizing and AxisSizing(Info.Vert, Point.Y, Index, Pos) and + ((Point.X < Info.Horz.FixedBoundary) or (Point.X < Info.Horz.GridBoundary) and + (InternalGetRowHeights(Index) = 0)) then + begin + Result := True; + State := gsRowSizing; + end; + end; +end; + +procedure TKCustomGrid.ProcessDragWindow(const PtIni, PtCur: TPoint; Index: Integer; ColDrag, Hide: Boolean); +var + MaxWidth, MaxHeight: Integer; + Alpha: Byte; + Gradient: Boolean; + RClip, RSrc, RDest: TRect; + P: TKGridCoord; + Form: TCustomForm; + Info: TKGridAxisInfoBoth; +begin + if FDragStyle in [dsLayeredConst, dsLayeredFaded] then + begin + if Index >= 0 then + begin + // (re)initialize drag image bitmaps + if ColDrag then + P := GridPoint(Index, 0) + else + P := GridPoint(0, Index); + if CellToPoint(P.Col, P.Row, RSrc.TopLeft) then + begin + Form := GetParentForm(Self); + if Form <> nil then + begin + MaxWidth := Min(ClientWidth, Form.ClientWidth - Left); + MaxHeight := Min(ClientHeight, Form.ClientHeight - Top); + end else + begin + MaxWidth := ClientWidth; + MaxHeight := ClientHeight; + end; + Info := GetAxisInfoBoth([aiGridBoundary]); + if ColDrag then + begin + RSrc.Right := RSrc.Left + GetColWidths(Index); + RSrc.Bottom := Info.Vert.GridBoundary; + RClip := Rect(Info.Horz.FixedBoundary, 0, MaxWidth, MaxHeight); + end else + begin + RSrc.Bottom := RSrc.Top + GetRowHeights(Index); + RSrc.Right := Info.Horz.GridBoundary; + RClip := Rect(0, Info.Vert.FixedBoundary, MaxWidth, MaxHeight); + end; + if IntersectRect(RDest, RSrc, RClip) then + begin + if FDragWindow = nil then FDragWindow := TKDragWindow.Create; + if FDragStyle = dsLayeredFaded then + begin + Alpha := $E0; + Gradient := True; + end else + begin + Alpha := $80; + Gradient := False; + end; + EditorMode := False; + Update; + FDragWindow.Show(Self, RDest, PtIni, PtCur, Alpha, Gradient); + end; + end; + end + else if FDragWindow <> nil then + begin + if Hide then + FDragWindow.Hide + else + FDragWindow.Move(PtCur); + end; + end; +end; + +procedure TKCustomGrid.RealizeCellClass; +var + I, J: Integer; + Cell, TmpCell: TKGridCell; + UpdateNeeded: Boolean; +begin + if Assigned(FCells) then + begin + UpdateNeeded := False; + for I := 0 to FColCount - 1 do + for J := 0 to FRowCount - 1 do + begin + Cell := FCells[J, I]; + if (Cell <> nil) and (Cell.ClassType <> FCellClass) then + begin + TmpCell := FCellClass.Create(Self); + FlagSet(cGF_GridUpdates); + try + TmpCell.Assign(Cell); // copy known properties + finally + FlagClear(cGF_GridUpdates); + end; + Cell.Free; + FCells[J, I] := TmpCell; + UpdateNeeded := True; + end; + end; + if UpdateNeeded then + Invalidate; + end; +end; + +procedure TKCustomGrid.RealizeColClass; +var + I: Integer; + TmpItem: TKGridAxisItem; + UpdateNeeded: Boolean; +begin + UpdateNeeded := False; + for I := 0 to FColCount - 1 do + if FCols[I].ClassType <> FColClass then + begin + TmpItem := FColClass.Create(Self); + FlagSet(cGF_GridUpdates); + try + TmpItem.Assign(FCols[I]); + TmpItem.InitialPos := FCols[I].InitialPos; + finally + FlagClear(cGF_GridUpdates); + end; + FCols[I].Free; + FCols[I] := TmpItem; + UpdateNeeded := True; + end; + if UpdateNeeded then + UpdateAxes(True, cAll, False, cAll, []); +end; + +procedure TKCustomGrid.RealizeRowClass; +var + I: Integer; + TmpItem: TKGridAxisItem; + UpdateNeeded: Boolean; +begin + UpdateNeeded := False; + for I := 0 to FRowCount - 1 do + if FRows[I].ClassType <> FRowClass then + begin + TmpItem := FRowClass.Create(Self); + FlagSet(cGF_GridUpdates); + try + TmpItem.Assign(FRows[I]); + TmpItem.InitialPos := FRows[I].InitialPos; + finally + FlagClear(cGF_GridUpdates); + end; + FRows[I].Free; + FRows[I] := TmpItem; + UpdateNeeded := True; + end; + if UpdateNeeded then + UpdateAxes(False, cAll, True, cAll, []); +end; + +procedure TKCustomGrid.ReadColWidths(Reader: TReader); +var + I: Integer; +begin + with Reader do + begin + ReadListBegin; + for I := 0 to FColCount - 1 do ColWidths[I] := ReadInteger; + ReadListEnd; + end; +end; + +procedure TKCustomGrid.ReadRowHeights(Reader: TReader); +var + I: Integer; +begin + with Reader do + begin + ReadListBegin; + for I := 0 to FRowCount - 1 do RowHeights[I] := ReadInteger; + ReadListEnd; + end; +end; + +procedure TKCustomGrid.ResetTopLeft; +begin + if (FTopLeft.Col <> FFixedCols) or (FTopLeft.Row <> FFixedRows) then + begin + FTopLeft := GridPoint(FFixedCols, FFixedRows); + Invalidate; + TopLeftChanged; + end; +end; + +procedure TKCustomGrid.RowHeightsChanged(ARow: Integer); +begin + if Assigned(FOnRowHeightsChanged) then + FOnRowHeightsChanged(Self) + else if Assigned(FOnRowHeightsChangedEx) then + FOnRowHeightsChangedEx(Self, ARow) +end; + +procedure TKCustomGrid.RowMoved(FromIndex, ToIndex: Integer); +begin + if Assigned(FOnRowMoved) then + FOnRowMoved(Self, FromIndex, ToIndex); +end; + +function TKCustomGrid.RowSelectable(ARow: Integer): Boolean; +begin + Result := (ARow >= FFixedRows) and (ARow < FRowCount); +end; + +function TKCustomGrid.RowSelected(ARow: Integer): Boolean; +begin + Result := RowInGridRect(ARow, FSelection); +end; + +function TKCustomGrid.RowValid(ARow: Integer): Boolean; +begin + Result := (ARow >= 0) and (ARow < FRowCount); +end; + +procedure TKCustomGrid.SafeSetFocus; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if (Form <> nil) and Form.Visible and Form.Enabled and not (csDestroying in Form.ComponentState) then + if EditorMode and FEditor.Enabled then + Form.ActiveControl := FEditor + else if Visible and Enabled then + Form.ActiveControl := Self; +end; + +procedure TKCustomGrid.Scroll(CodeHorz, CodeVert, DeltaHorz, DeltaVert: Integer; + CallUpdateEditor: Boolean); + + function Axis(Code: Cardinal; HasScrollBar: Boolean; ScrollCode: Cardinal; Delta: Integer; + ScrollMode: TKGridScrollMode; const Info: TKGridAxisInfo; + var FirstGridCell, ScrollPos, ScrollOffset: Integer): Boolean; + + procedure DoScroll(ADelta: Integer; OnlyIfGreater: Boolean = False); + var + I, TotalExtent: Integer; + begin + I := 0; + ScrollOffset := 0; + if ADelta > 0 then + begin + while (I < ADelta) and (FirstGridCell < Info.FirstGridCellExtent) do + begin + TotalExtent := Info.CellExtent(FirstGridCell) + Info.EffectiveSpacing(FirstGridCell); + if OnlyIfGreater then + if I + TotalExtent > ADelta then + begin + if ScrollMode = smSmooth then + ScrollOffset := ADelta - I; + Break; + end; + Inc(I, TotalExtent); + Inc(FirstGridCell); + end; + end + else if ADelta < 0 then + begin + while (I > ADelta) and (FirstGridCell > Info.FixedCellCount) do + begin + Dec(FirstGridCell); + TotalExtent := Info.CellExtent(FirstGridCell) + Info.EffectiveSpacing(FirstGridCell); + if OnlyIfGreater then + if I - TotalExtent < ADelta then + begin + if ScrollMode = smSmooth then + begin + ScrollOffset := ADelta - I + TotalExtent; + Dec(ScrollPos, TotalExtent); + end else + Inc(FirstGridCell); + Break; + end; + Dec(I, TotalExtent); + end; + end; + Inc(ScrollPos, I); + end; + + var + OldScrollPos, OldScrollOffset: Integer; + SI: TScrollInfo; + begin + Result := False; + if HasScrollBar then + begin + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_PAGE or SIF_RANGE or SIF_TRACKPOS; + GetScrollInfo(Handle, Code, SI); + {$IF DEFINED(LCLGTK2)} + {.$WARNING "scrollbar arrows still not working properly on GTK2 in some cases!"} + SI.nTrackPos := Delta; + {$IFEND} + end; + OldScrollPos := ScrollPos; + OldScrollOffset := ScrollOffset; + if ScrollCode = Cardinal(cScrollDelta) then + DoScroll(Delta) // in Pixels! + else if HasScrollBar then + case ScrollCode of + SB_TOP: + begin + FirstGridCell := Info.FixedCellCount; + ScrollPos := SI.nMin; + ScrollOffset := 0; + end; + SB_BOTTOM: + begin + FirstGridCell := Info.FirstGridCellExtent; + ScrollPos := SI.nMax - Max(SI.nPage - 1, 0); + ScrollOffset := 0; + end; + SB_LINEUP: DoScroll(ScrollDeltaFromDelta(Info, -1)); + SB_LINEDOWN: DoScroll(ScrollDeltaFromDelta(Info, 1)); + SB_PAGEUP: DoScroll(-SI.nPage); + SB_PAGEDOWN: DoScroll(SI.nPage); + SB_THUMBTRACK, SB_THUMBPOSITION: DoScroll(SI.nTrackPos - ScrollPos, True); + end; + FirstGridCell := MinMax(FirstGridCell, Info.FixedCellCount, Info.FirstGridCellExtent); + if (ScrollPos <> OldScrollPos) or (ScrollOffset <> OldScrollOffset) then + begin + if HasScrollBar then + begin + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_POS; + SI.nPos := ScrollPos + ScrollOffset; + SetScrollInfo(Handle, Code, SI, True); + end; + Result := True; + end; + end; + +var + Horz, Vert: Boolean; //because of $B- + OldTopLeft: TKGridCoord; +begin + OldTopLeft := FTopLeft; + Horz := Axis(SB_HORZ, FScrollBars in [ssHorizontal, ssBoth], CodeHorz, DeltaHorz, + FScrollModeHorz, GetAxisInfoHorz([]), FTopLeft.Col, FScrollPos.x, FScrollOffset.X); + Vert := Axis(SB_VERT, FScrollBars in [ssVertical, ssBoth], CodeVert, DeltaVert, + FScrollModeVert, GetAxisInfoVert([]), FTopLeft.Row, FScrollPos.y, FScrollOffset.Y); + if Horz or Vert then + begin + if Horz then + InvalidateCols(FFixedCols); + if Vert then + InvalidateRows(FFixedRows); + if CallUpdateEditor then + UpdateEditor(Flag(cGF_EditorModeActive)); + if (OldTopLeft.Col <> FTopLeft.Col) or (OldTopLeft.Row <> FTopLeft.Row) then + TopLeftChanged; + end; +end; + +procedure TKCustomGrid.ScrollBy(AColCount, ARowCount: Integer); +begin + Scroll(cScrollDelta, cScrollDelta, + ScrollDeltaFromDelta(GetAxisInfoHorz([]), AColCount), + ScrollDeltaFromDelta(GetAxisInfoVert([]), ARowCount), + True); +end; + +function TKCustomGrid.ScrollDeltaFromDelta(const Info: TKGridAxisInfo; ADelta: Integer): Integer; +var + I, CellExtent, MaxIndex: Integer; +begin + Result := 0; + I := Info.FirstGridCell; + MaxIndex := Info.FirstGridCell + ADelta; + if ADelta > 0 then + begin + while (I < Info.FirstGridCellExtent) do + begin + CellExtent := Info.CellExtent(I); + Inc(Result, CellExtent + Info.EffectiveSpacing(I)); + Inc(I); + if (CellExtent > 0) and (I >= MaxIndex) then + Break; + end; + end + else if ADelta < 0 then + begin + while (I > Info.FixedCellCount) do + begin + Dec(I); + CellExtent := Info.CellExtent(I); + Dec(Result, CellExtent + Info.EffectiveSpacing(I)); + if (CellExtent > 0) and (I <= MaxIndex) then + Break; + end; + end; +end; + +function TKCustomGrid.ScrollNeeded(ACol, ARow: Integer; + out DeltaHorz, DeltaVert: Integer): Boolean; + + function Axis(Info: TKGridAxisInfo; Index, Span: Integer; var Delta: Integer): Boolean; + var + I, Extent: Integer; + begin + Result := False; + Delta := 0; + if Index < Info.FixedCellCount then Exit; + if Index = Info.FirstGridCell then + begin + if Info.ScrollOffset <> 0 then + Result := True; + end; + if Index < Info.FirstGridCell then + begin + for I := Info.FirstGridCell - 1 downto Index do + Dec(Delta, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + Result := True; + end else + begin + Extent := Info.FixedBoundary - Info.ScrollOffset; + for I := Info.FirstGridCell to Index - 1 do + Inc(Extent, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + Delta := Extent; + for I := Index to Index + Span - 1 do + Inc(Delta, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + if Delta > Info.ClientExtent then + begin + Delta := Min(Extent - Info.FixedBoundary, Delta + Info.ScrollOffset - Info.ClientExtent); + if Delta > 0 then + Result := True; + end else + Delta := 0; + end; + end; + +var + Horz, Vert: Boolean; + Span: TKGridCellSpan; +begin + DeltaHorz := 0; DeltaVert := 0; + Span := InternalGetCellSpan(ACol, ARow); + Horz := (FGridState <> gsRowMoving) and Axis(GetAxisInfoHorz([aiFixedParams]), ACol, Span.ColSpan, DeltaHorz); + Vert := (FGridState <> gsColMoving) and Axis(GetAxisInfoVert([aiFixedParams]), ARow, Span.RowSpan, DeltaVert); + Result := Horz or Vert; +end; + +procedure TKCustomGrid.ScrollTimerHandler(Sender: TObject); +var + DeltaHorz, DeltaVert, HitCol, HitRow, SelCol, SelRow: Integer; + MousePt: TPoint; +begin + MousePt := ScreenToClient(Mouse.CursorPos); + if MouseCapture and not Dragging and + PointToCell(MousePt, True, GridStateToInvisibleCells, HitCol, HitRow, + SelCol, SelRow) and ScrollNeeded(HitCol, HitRow, DeltaHorz, DeltaVert) then + begin + Scroll(cScrollDelta, cScrollDelta, DeltaHorz, DeltaVert, False); + if FGridState = gsSelecting then + begin + InternalFindBaseCell(SelCol, SelRow, SelCol, SelRow); + SelectionMove(SelCol, SelRow, ssExpand, [sfMustUpdate]) + end else + DragMove(HitCol, HitRow, MousePt); + end else + begin + FScrollTimer.Enabled := False; + UpdateEditor(Flag(cGF_EditorModeActive)); + end; +end; + +procedure TKCustomGrid.SelectAll; +begin + if goRangeSelect in Options then + // aki: + if (gxEditFixedRows in FOptionsEx) and (gxEditFixedCols in FOptionsEx) then + Selection := GridRect(0, 0, FColCount - 1, FRowCount - 1) + else if gxEditFixedRows in FOptionsEx then + Selection := GridRect(FFixedCols, 0, FColCount - 1, FRowCount - 1) + else if gxEditFixedCols in FOptionsEx then + Selection := GridRect(0, FFixedRows, FColCount - 1, FRowCount - 1) + else + Selection := GridRect(FFixedCols, FFixedRows, FColCount - 1, FRowCount - 1); +end; + +function TKCustomGrid.SelectCell(ACol, ARow: Integer): Boolean; +begin + // aki: + if (ColWidths[ACol] = 0) or (RowHeights[ARow] = 0) then + Result := False + else if (ARow < FFixedRows) and (not(gxEditFixedRows in FOptionsEx)) then + Result := False + else if not (gxEditFixedCols in FOptionsEx) and not (gxEditFixedRows in FOptionsEx) and (ACol < FFixedCols) then + Result := False + else + begin + Result := True; + if Assigned(FOnSelectCell) then + FOnSelectCell(Self, ACol, ARow, Result) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).SelectCell(ACol, ARow, Result); + end; +end; + +procedure TKCustomGrid.SelectCol(ACol: Integer); +begin + if goRangeSelect in Options then + // aki: + if gxEditFixedRows in FOptionsEx then + Selection := GridRect(ACol, 0, ACol, FRowCount - 1) + else + Selection := GridRect(ACol, FFixedRows, ACol, FRowCount - 1); +end; + +procedure TKCustomGrid.SelectCols(FirstCol, Count: Integer); +begin + if goRangeSelect in Options then + // aki: + if gxEditFixedRows in FOptionsEx then + Selection := GridRect(FirstCol, 0, FirstCol + Count, FRowCount - 1) + else + Selection := GridRect(FirstCol, FFixedRows, FirstCol + Count, FRowCount - 1); +end; + +procedure TKCustomGrid.SelectionChanged(NewSelection: TKGridRect; + Flags: TKGridSelectionFlags); +var + ICol, IRow: Integer; +begin + SelectionFix(NewSelection); + if FRangeSelectStyle = rsMS_Excel then + begin + ICol := NewSelection.Col2; + IRow := NewSelection.Row2; + end else + begin + ICol := NewSelection.Col1; + IRow := NewSelection.Row1; + end; + if (sfMustUpdate in Flags) and not GridRectEqual(FSelection, NewSelection) then + begin + InvalidateCurrentSelection; + FSelection := NewSelection; + if not (sfClampInView in Flags) or not ClampInView(ICol, IRow) then + InvalidateCurrentSelection; + end else + FSelection := NewSelection; + InvalidatePageSetup; + if not (sfNoMemPos in Flags) then + begin + FMemCol := ICol; + FMemRow := IRow; + end; + if sfMustUpdate in Flags then + UpdateEditor(Flag(cGF_EditorModeActive)); +end; + +function TKCustomGrid.SelectionExpand(ACol, ARow: Integer): Boolean; +begin + Result := True; + if Assigned(FOnSelectionExpand) then + FOnSelectionExpand(Self, ACol, ARow, Result) + else if Assigned(FCells) then + InternalGetCell(ACol, ARow).SelectionExpand(ACol, ARow, Result); +end; + +procedure TKCustomGrid.SelectionFix(var Sel: TKGridRect); +begin + //aki: + if (not (gxEditFixedCols in FOptionsEx) and (Sel.Row1 >= FFixedRows)) or (not (gxEditFixedRows in FOptionsEx) and (Sel.Row1 < FFixedRows)) then + begin + Sel.Col1 := MinMax(Sel.Col1, FFixedCols, FColCount - 1); + Sel.Col2 := MinMax(Sel.Col2, FFixedCols, FColCount - 1); + end else + begin + Sel.Col1 := MinMax(Sel.Col1, 0, FColCount - 1); + Sel.Col2 := MinMax(Sel.Col2, 0, FColCount - 1); + end; + if not (gxEditFixedRows in FOptionsEx) then + begin + Sel.Row1 := MinMax(Sel.Row1, FFixedRows, FRowCount - 1); + Sel.Row2 := MinMax(Sel.Row2, FFixedRows, FRowCount - 1); + end else + begin + Sel.Row1 := MinMax(Sel.Row1, 0, FRowCount - 1); + Sel.Row2 := MinMax(Sel.Row2, 0, FRowCount - 1); + end; + if not (goRangeSelect in FOptions) then + Sel.Cell2 := Sel.Cell1 +end; + +function TKCustomGrid.SelectionMove(ACol, ARow: Integer; + Stage: TKGridSelectionStage; + Flags: TKGridSelectionFlags): Boolean; +var + NewSelection: TKGridRect; +begin + Result := False; + if (Stage = ssExpand) and not (goRangeSelect in FOptions) then + Stage := ssInit; + case Stage of + ssInit: + begin + NewSelection := GridRect(ACol, ARow, ACol, ARow); + if not GridRectEqual(FSelection, NewSelection) and + ((sfDontCallSelectCell in Flags) or SelectCell(ACol, ARow)) then + Result := True; + end; + ssExpand: + begin + NewSelection := FSelection; + if FRangeSelectStyle = rsMS_Excel then + begin + NewSelection.Cell2 := GridPoint(ACol, ARow); + if not GridRectEqual(FSelection, NewSelection) and + ((sfDontCallSelectCell in Flags) or SelectionExpand(ACol, ARow)) then + Result := True; + end else + begin + NewSelection.Cell1 := GridPoint(ACol, ARow); + if not GridRectEqual(FSelection, NewSelection) and + ((sfDontCallSelectCell in Flags) or SelectCell(ACol, ARow)) then + Result := True; + end; + end; + end; + if Result then + SelectionChanged(NewSelection, Flags); + if not Result and GridRectEqual(NewSelection, FSelection) then + Result := True; +end; + +procedure TKCustomGrid.SelectionNormalize; +var + R: TKGridRect; +begin + R := Selection; + NormalizeGridRect(R); + Selection := R; +end; + +function TKCustomGrid.SelectionSet(const NewSelection: TKGridRect): Boolean; +begin + Result := False; + if not GridRectEqual(FSelection, NewSelection) then + begin + if ((FSelection.Col1 <> NewSelection.Col1) or (FSelection.Row1 <> NewSelection.Row1) + and SelectCell(NewSelection.Col1, NewSelection.Row1)) or + ((FSelection.Col2 <> NewSelection.Col2) or (FSelection.Row2 <> NewSelection.Row2) + and SelectionExpand(NewSelection.Col2, NewSelection.Row2)) then + Result := True; + end; + if Result then + SelectionChanged(NewSelection, [sfMustUpdate, sfClampInView]); +// if not Result and GridRectEqual(NewSelection, FSelection) then +// Result := True; +end; + +procedure TKCustomGrid.SelectRow(ARow: Integer); +begin + if goRangeSelect in Options then + Selection := GridRect(FFixedCols, ARow, FColCount - 1, ARow); +end; + +procedure TKCustomGrid.SelectRows(FirstRow, Count: Integer); +begin + if goRangeSelect in Options then + Selection := GridRect(FFixedCols, FirstRow, FColCount - 1, FirstRow + Count); +end; + +procedure TKCustomGrid.SetCell(ACol, ARow: Integer; Value: TKGridCell); +begin + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + InternalSetCell(ACol, ARow, Value); +end; + +procedure TKCustomGrid.SetCellPainterClass(Value: TKGridCellPainterClass); +begin + if Value <> FCellPainterClass then + begin + FCellPainterClass := Value; + FCellPainter.Free; + FCellPainter := FCellPainterClass.Create(Self); + end; +end; + +procedure TKCustomGrid.SetCells(ACol, ARow: Integer; const Text: {$IFDEF STRING_IS_UNICODE}string{$ELSE}WideString{$ENDIF}); +begin + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + InternalSetCells(ACol, ARow, Text); +end; + +procedure TKCustomGrid.SetCellSpan(ACol, ARow: Integer; Value: TKGridCellSpan); +var + I: Integer; +begin + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + begin + // cells cannot be merged across fixed area boundaries + if ACol >= FFixedCols then I := FColCount else I := FFixedCols; + Value.ColSpan := MinMax(Value.ColSpan, 1, I - ACol); + if ARow >= FFixedRows then I := FRowCount else I := FFixedRows; + Value.RowSpan := MinMax(Value.RowSpan, 1, I - ARow); + with InternalGetCell(ACol, ARow) do + if (ColSpan <> Value.ColSpan) or (RowSpan <> Value.RowSpan) then + begin + EditorMode := False; + FlagSet(cGF_GridUpdates); + try + InvalidateGridRect(InternalSetCellSpan(ACol, ARow, Value), False); + finally + FlagClear(cGF_GridUpdates); + end; + end; + end; +end; + +procedure TKCustomGrid.SetCol(Value: Integer); +begin + if ColSelectable(Value) and ((Value <> FSelection.Col1) or (FSelection.Col1 <> FSelection.Col2)) then + FocusCell(Value, Row); +end; + +procedure TKCustomGrid.SetColCount(Value: Integer); +begin + if Value < 1 then Value := 1; + InternalSetColCount(Value); +end; + +procedure TKCustomGrid.SetColWidths(Index: Integer; Value: Integer); +begin + if ColValid(Index) then + begin + if Value < InternalGetMinColWidth(Index) then + Value := 0 + else + Value := Min(Value, InternalGetMaxColWidth(Index)); + if Value <> FCols[Index].Extent then + begin + FlagSet(cGF_GridUpdates); + try + FCols[Index].Extent := Value; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(True, Index, False, cAll, [afCallEvent, afCheckMinExtent]); + end; + end; +end; + +procedure TKCustomGrid.SetColors(Value: TKGridColors); +begin + FColors.Assign(Value); +end; + +{$IFDEF FPC} +procedure TKCustomGrid.SetCursor(Value: TCursor); +begin + FTmpCursor := Value; + if (FCursor <> crHSplit) and (FCursor <> crVSplit) and + (FCursor <> crHResize) and (FCursor <> crVResize) then + inherited; +end; +{$ENDIF} + +procedure TKCustomGrid.SetDefaultColWidth(Value: Integer); +begin + if Value <> FDefaultColWidth then + begin + FDefaultColWidth := Value; + DefaultColWidthChanged; + end; +end; + +procedure TKCustomGrid.SetDefaultDrawing(Value: Boolean); +begin + // does nothing +end; + +procedure TKCustomGrid.SetDefaultRowHeight(Value: Integer); +begin + if Value <> FDefaultRowHeight then + begin + FDefaultRowHeight := Value; + DefaultRowHeightChanged; + end; +end; + +procedure TKCustomGrid.SetDisabledDrawStyle(Value: TKGridDisabledDrawStyle); +begin + if Value <> FDisabledDrawStyle then + begin + FDisabledDrawStyle := Value; + if not Enabled then + Invalidate; + end; +end; + +procedure TKCustomGrid.SetDragStyle(Value: TKGridDragStyle); +begin + if Value <> FDragStyle then + begin + CancelMode; + FDragStyle := Value; + end; +end; + +procedure TKCustomGrid.SetEditorMode(Value: Boolean); +begin + if Value <> EditorMode then + UpdateEditor(Value); + FlagAssign(cGF_EditorModeActive, Value); +end; + +procedure TKCustomGrid.SetEditorTransparency(Value: TKGridEditorTransparency); +begin + if Value <> FEditorTransparency then + begin + FEditorTransparency := Value; + if EditorMode then + FEditor.Invalidate; + end; +end; + +procedure TKCustomGrid.SetFixedCols(Value: Integer); +begin + if (Value <> FFixedCols) and (FFixedCols >= 0) then + InternalSetFixedCols(Value); +end; + +procedure TKCustomGrid.SetFixedRows(Value: Integer); +begin + if (Value <> FFixedRows) and (FFixedRows >= 0) then + InternalSetFixedRows(Value); +end; + +{$IFDEF FPC} +procedure TKCustomGrid.SetFlat(Value: Boolean); +begin + if Value <> FFlat then + begin + FFlat := Value; + Invalidate; + end; +end; +{$ENDIF} + +procedure TKCustomGrid.SetGridLineWidth(Value: Integer); +begin + if FGridLineWidth <> Value then + begin + FGridLineWidth := Value; + UpdateAxes(FOptions * [goFixedHorzLine, goHorzLine] <> [], cAll, + FOptions * [goFixedVertLine, goVertLine] <> [], cAll, []); + end; +end; + +procedure TKCustomGrid.SetLeftCol(Value: Integer); +begin + if ColValid(Value) and (Value <> FTopLeft.Col) then + ScrollBy(Value - FTopLeft.Col, 0); +end; + +procedure TKCustomGrid.SetMinColWidth(Value: Integer); +var + I, Extent, MinColWidth: Integer; +begin + Value := Max(Value, cMinColWidthMin); + if Value <> FMinColWidth then + begin + FMinColWidth := Value; + if FMinColWidth > FDefaultColWidth then + begin + FDefaultColWidth := FMinColWidth; + DefaultColWidthChanged; + end else + begin + FlagSet(cGF_GridUpdates); + try + for I := 0 to FColCount - 1 do + begin + Extent := FCols[I].Extent; + MinColWidth := InternalGetMinColWidth(I); + if (Extent > 0) and (Extent < MinColWidth) then + FCols[I].Extent := MinColWidth; + end; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(True, cAll, False, cAll, []); + end; + end; +end; + +procedure TKCustomGrid.SetMinRowHeight(Value: Integer); +var + I, Extent, MinRowHeight: Integer; +begin + Value := Max(Value, cMinRowHeightMin); + if Value <> FMinRowHeight then + begin + FMinRowHeight := Value; + if FMinRowHeight > FDefaultRowHeight then + begin + FDefaultRowHeight := FMinRowHeight; + DefaultRowHeightChanged; + end else + begin + FlagSet(cGF_GridUpdates); + try + for I := 0 to FRowCount - 1 do + begin + Extent := FRows[I].Extent; + MinRowHeight := InternalGetMinRowHeight(I); + if (Extent > 0) and (Extent < MinRowHeight) then + FRows[I].Extent := MinRowHeight; + end; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(False, cAll, True, cAll, []); + end; + end; +end; + +procedure TKCustomGrid.SetMouseCellHintTime(const AValue: Cardinal); +begin + FMouseCellHintTime := MinMax(AValue, cMouseCellHintTimeMin, cMouseCellHintTimeMax); +end; + +function TKCustomGrid.SetMouseCursor(X, Y: Integer): Boolean; +var + ACursor: TCursor; + Index, Pos: Integer; + State: TKGridState; +begin +{$IFDEF FPC} + ACursor := FTmpCursor; +{$ELSE} + ACursor := Cursor; +{$ENDIF} + State := gsNormal; + Index := 0; Pos := 0; + PointToSizing(Point(X, Y), State, Index, Pos); + case State of + gsColSizing: + begin + FlagSet(cGF_DesignHitTest); + if (FCols[Index].Extent = 0) or (csDesigning in ComponentState) then + ACursor := crHSplit + else + ACursor := crHResize + end; + gsRowSizing: + begin + FlagSet(cGF_DesignHitTest); + if (FRows[Index].Extent = 0) or (csDesigning in ComponentState) then + ACursor := crVSplit + else + ACursor := crVResize; + end; + else + FlagClear(cGF_DesignHitTest); + end; +{$IFDEF FPC} + FCursor := ACursor; + SetTempCursor(ACursor); +{$ELSE} + Windows.SetCursor(Screen.Cursors[ACursor]); +{$ENDIF} + Result := True; +end; + +procedure TKCustomGrid.SetObjects(ACol, ARow: Integer; Value: TObject); +var + Cell, Tmp: TKGridCell; +begin + if Assigned(FCells) and ColValid(ACol) and RowValid(ARow) then + begin + FlagSet(cGF_GridUpdates); + try + Cell := InternalGetCell(ACol, ARow); + if not (Cell is TKGridObjectCell) then + begin + if FCellClass.InheritsFrom(TKGridObjectCell) then + Tmp := FCellClass.Create(Self) + else + Tmp := TKGridObjectCell.Create(Self); + Tmp.Assign(Cell); + Cell.Free; + FCells[ARow, ACol] := Tmp; + end; + TKGridObjectCell(FCells[ARow, ACol]).CellObject := Value; + finally + FlagClear(cGF_GridUpdates); + end; + InvalidateCell(ACol, ARow); + end +end; + +procedure TKCustomGrid.SetOptions(Value: TKGridOptions); +const + UpdatePaintSet = [goClippedCells, goDrawFocusSelected, goDoubleBufferedCells, + goFixedHorzLine, goFixedVertLine, goHeader, goHeaderAlignment, goHorzLine, + goIndicateSelection, goIndicateHiddenCells, goThemedCells, goThemes, goVertLine]; + UpdateScrollBarsSet = [goAlignLastCol, goAlignLastRow]; + UpdateSelectionSet = [goRangeSelect, goRowSelect]; + UpdateSortingSet = [goColSorting, goRowSorting]; +var + UpdateCols, UpdatePaint, UpdateRows, UpdateScrollBars, + UpdateSelection, UpdateSorting, UpdateThemes, UpdateThemedCells, + UpdateVirtualGrid, WasVirtual: Boolean; +begin + if FOptions <> Value then + begin + UpdateCols := ((Value * [goHorzLine, goFixedHorzLine] = []) xor + (FOptions * [goHorzLine, goFixedHorzLine] = [])) or + ((goIndicateHiddenCells in Value) <> (goIndicateHiddenCells in FOptions)); + UpdateRows := ((Value * [goVertLine, goFixedVertLine] = []) xor + (FOptions * [goVertLine, goFixedVertLine] = [])) or + ((goIndicateHiddenCells in Value) <> (goIndicateHiddenCells in FOptions)); + UpdatePaint := Value * UpdatePaintSet <> FOptions * UpdatePaintSet; + UpdateScrollBars := Value * UpdateScrollBarsSet <> FOptions * UpdateScrollBarsSet; + UpdateSelection := Value * UpdateSelectionSet <> FOptions * UpdateSelectionSet; + UpdateSorting := Value * UpdateSortingSet <> FOptions * UpdateSortingSet; + UpdateThemes := (goThemes in Value) <> (goThemes in FOptions); + UpdateThemedCells := (goThemedCells in Value) <> (goThemedCells in FOptions); + UpdateVirtualGrid := (goVirtualGrid in Value) <> (goVirtualGrid in FOptions); + WasVirtual := goVirtualGrid in FOptions; + FOptions := Value; + if UpdateSelection then + SelectionFix(FSelection); + if UpdateCols or UpdateRows then + UpdateAxes(UpdateCols, cAll, UpdateRows, cAll, []); + if UpdateScrollBars or UpdateThemes then + {$IFDEF FPC} + UpdateSize; + {$ELSE} + RecreateWnd; + {$ENDIF} + if UpdateSorting then + ClearSortMode; + if UpdateVirtualGrid then + begin + if InternalUpdateVirtualGrid then + ChangeDataSize(False, 0, 0, False, 0, 0) + else if WasVirtual then + Include(FOptions, goVirtualGrid) + else + Exclude(FOptions, goVirtualGrid); + end; + if UpdatePaint or UpdateSelection or UpdateVirtualGrid then + begin + Invalidate; + InvalidatePageSetup; + end; + if UpdateThemedCells then + Include(FOptions, goMouseOverCells); + if not (goEditing in FOptions) then + EditorMode := False; + end; +end; + +procedure TKCustomGrid.SetOptionsEx(Value: TKGridOptionsEx); +const + UpdatePaintSet = [gxFixedThemedCells]; +var + UpdatePaint: Boolean; +begin + if FOptionsEx <> Value then + begin + UpdatePaint := Value * UpdatePaintSet <> FOptionsEx * UpdatePaintSet; + FOptionsEx := Value; + if UpdatePaint then + Invalidate; + end; +end; + +procedure TKCustomGrid.SetRow(Value: Integer); +begin + if RowSelectable(Value) and ((Value <> FSelection.Row1) or (FSelection.Row1 <> FSelection.Row2)) then + FocusCell(Col, Value); +end; + +procedure TKCustomGrid.SetRowCount(Value: Integer); +begin + if Value < 1 then Value := 1; + InternalSetRowCount(Value); +end; + +procedure TKCustomGrid.SetRowHeights(Index: Integer; Value: Integer); +begin + if RowValid(Index) then + begin + if Value < InternalGetMinRowHeight(Index) then + Value := 0 + else + Value := Min(Value, InternalGetMaxRowHeight(Index)); + if Value <> FRows[Index].Extent then + begin + FlagSet(cGF_GridUpdates); + try + FRows[Index].Extent := Value; + finally + FlagClear(cGF_GridUpdates); + end; + UpdateAxes(False, cAll, True, Index, [afCallEvent, afCheckMinExtent]); + end; + end; +end; + +procedure TKCustomGrid.SetScrollBars(Value: TScrollStyle); +begin + if FScrollBars <> Value then + begin + FScrollBars := Value; + {$IFDEF FPC} + UpdateSize; + {$ELSE} + RecreateWnd; + {$ENDIF} + end; +end; + +procedure TKCustomGrid.SetScrollModeHorz(const Value: TKGridScrollMode); +begin + if Value <> FScrollModeHorz then + begin + FScrollModeHorz := Value; + UpdateScrollRange(True, False, True); + end; +end; + +procedure TKCustomGrid.SetScrollModeVert(const Value: TKGridScrollMode); +begin + if Value <> FScrollModeVert then + begin + FScrollModeVert := Value; + UpdateScrollRange(False, True, True); + end; +end; + +procedure TKCustomGrid.SetScrollSpeed(Value: Cardinal); +begin + Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); + if Value <> FScrollSpeed then + begin + FScrollSpeed := Value; + FScrollTimer.Enabled := False; + FScrollTimer.Interval := FScrollSpeed; + end; +end; + +procedure TKCustomGrid.SetSelection(const Value: TKGridRect); +var + G: TKGridRect; +begin + if GridRectSelectable(Value) and not GridRectEqual(Value, FSelection) then + begin + InternalFindBaseCell(Value.Col1, Value.Row1, G.Col1, G.Row1); + InternalFindBaseCell(Value.Col2, Value.Row2, G.Col2, G.Row2); + SelectionSet(G); + end; +end; + +procedure TKCustomGrid.SetSelections(Index: Integer; const Value: TKGridRect); +begin + if (Index >= 0) and (Index < SelectionCount) then + begin + //TODO! + end; +end; + +procedure TKCustomGrid.SetSizingStyle(Value: TKGridSizingStyle); +begin + if Value <> FSizingStyle then + begin + CancelMode; + FSizingStyle := Value; + end; +end; + +procedure TKCustomGrid.SetTabStops(Index: Integer; Value: Boolean); +begin + if ColValid(Index) and (FCols[Index] is TKGridCol) then + TKGridCol(FCols[Index]).TabStop := Value; +end; + +procedure TKCustomGrid.SetTopRow(Value: Integer); +begin + if RowValid(Value) and (Value <> FTopLeft.Row) then + ScrollBy(0, Value - FTopLeft.Row); +end; + +procedure TKCustomGrid.ShowCellHint; +begin + DefaultMouseCellHint(FHintCell.Col, FHintCell.Row, True); +end; + +procedure TKCustomGrid.SizeChanged(Change: TKGridSizeChange; + Index, Count: Integer); +begin + if Assigned(FOnSizeChanged) then + FOnSizeChanged(Self, Change, Index, Count); +end; + +procedure TKCustomGrid.SortCols(ByRow: Integer; SortMode: TKGridSortMode); +var + Sorted: Boolean; + OldSortMode: TKGridSortMode; +begin + if SortModeUnlocked and RowValid(ByRow) and (FRows[ByRow].SortMode <> SortMode) then + begin + OldSortMode := FRows[ByRow].SortMode; + ClearSortModeVert; + if FColCount > 1 then + begin + EditorMode := False; + Sorted := CustomSortCols(ByRow, SortMode); + if not Sorted and (SortMode <> smNone) then + begin + if OldSortMode <> smNone then + InternalFlip(FFixedCols, FColCount - 1, InternalExchangeCols) + else + InternalQuickSortNR(ByRow, FFixedCols, FColCount - 1, SortMode = smDown, + CompareCols, InternalExchangeCols); + end; + if Sorted or (SortMode <> smNone) then + begin + UpdateScrollRange(True, False, False); + UpdateCellSpan; + if not ClampInView(Col, Row) then + InvalidateCols(FFixedCols); + end; + if SortMode <> smNone then + begin + FlagSet(cGF_GridUpdates); + try + FRows[ByRow].SortMode := SortMode; + finally + FlagClear(cGF_GridUpdates); + end; + Row := ByRow; + end; + InvalidateGridRect(GridRect(0, ByRow, FFixedCols - 1, ByRow)); + end; + end; +end; + +function TKCustomGrid.SortModeUnlocked: Boolean; +begin + Result := FSortModeLock = 0; +end; + +procedure TKCustomGrid.SortRows(ByCol: Integer; SortMode: TKGridSortMode); +var + Sorted: Boolean; + OldSortMode: TKGridSortMode; +begin + if SortModeUnlocked and ColValid(ByCol) and (FCols[ByCol].SortMode <> SortMode) then + begin + OldSortMode := FCols[ByCol].SortMode; + ClearSortModeHorz; + if FRowCount > 1 then + begin + EditorMode := False; + Sorted := CustomSortRows(ByCol, SortMode); + if not Sorted and (SortMode <> smNone) then + begin + if OldSortMode <> smNone then + InternalFlip(FFixedRows, FRowCount - 1, InternalExchangeRows) + else + InternalQuickSortNR(ByCol, FFixedRows, FRowCount - 1, SortMode = smDown, + CompareRows, InternalExchangeRows); + end; + if Sorted or (SortMode <> smNone) then + begin + UpdateScrollRange(False, True, False); + UpdateCellSpan; + if not ClampInView(Col, Row) then + InvalidateRows(FFixedRows); + end; + if SortMode <> smNone then + begin + FlagSet(cGF_GridUpdates); + try + FCols[ByCol].SortMode := SortMode; + finally + FlagClear(cGF_GridUpdates); + end; + Col := ByCol; + end; + InvalidateGridRect(GridRect(ByCol, 0, ByCol, FFixedRows - 1)); + end; + end; +end; + +procedure TKCustomGrid.SuggestDrag(State: TKGridCaptureState); +var + R: TRect; +begin + if HandleAllocated and GetDragRect(GetAxisInfoBoth([aiGridBoundary]), R) then + begin + if State = csStart then + begin + InvalidateCell(FHitCell.Col, FHitCell.Row); + Update; + end; + InvalidateRect(Handle, @R, False); + end; +end; + +procedure TKCustomGrid.SuggestSizing(State: TKGridCaptureState); + + function Axis(const Info: TKGridAxisInfo; CellPt: Integer; AxisItems: TKGridAxisItems): Integer; + var + Tmp, MinExtent: Integer; + begin + Result := Info.CellExtent(FSizingIndex); + MinExtent := Info.MinCellExtent(FSizingIndex); + if goMouseCanHideCells in FOptions then + begin + if Result > 0 then + begin + if FSizingDest - CellPt > Max(MinExtent div 2, MinExtent - 5) then + Result := Max(FSizingDest - CellPt, MinExtent) + else + Result := 0; + end else + begin + Tmp := FSizingIndex; + while (Tmp > 0) and (Info.CellExtent(Tmp - 1) = 0) do + Dec(Tmp); + if Tmp <> FSizingIndex then + Inc(CellPt, Info.EffectiveSpacing(Tmp)); + if FSizingDest - CellPt >= MinExtent then + Result := FSizingDest - CellPt; + end; + end else + Result := Max(FSizingDest - CellPt, MinExtent); + end; + +var + R: TRect; + Info: TKGridAxisInfo; +begin + if HandleAllocated then + begin + case FGridState of + gsColSizing: + begin + case FSizingStyle of + ssLine, ssXORLine: + begin + Info := GetAxisInfoVert([aiGridBoundary]); + R := Rect(FSizingDest, 0, FSizingDest + 2, Info.GridBoundary); + InvalidateRect(Handle, @R, False); + end; + ssUpdate: + begin + if (State = csShow) and CellToPoint(FSizingIndex, 0, R.TopLeft) then + ColWidths[FSizingIndex] := Axis(GetAxisInfoHorz([]), R.Left, FCols); + end; + end; + end; + gsRowSizing: + begin + case FSizingStyle of + ssLine, ssXORLine: + begin + Info := GetAxisInfoHorz([aiGridBoundary]); + R := Rect(0, FSizingDest, Info.GridBoundary, FSizingDest + 2); + InvalidateRect(Handle, @R, False); + end; + ssUpdate: + begin + if (State = csShow) and CellToPoint(0, FSizingIndex, R.TopLeft) then + RowHeights[FSizingIndex] := Axis(GetAxisInfoVert([]), R.Top, FRows); + end; + end; + end; + end; + end; +end; + +procedure TKCustomGrid.TopLeftChanged; +begin + if Assigned(FOnTopLeftChanged) then + FOnTopLeftChanged(Self); +end; + +procedure TKCustomGrid.UnlockSortMode; +begin + if FSortModeLock > 0 then + Dec(FSortModeLock); +end; + +procedure TKCustomGrid.UnselectRange; +begin + Selection := GridRect(FSelection.Cell1); +end; + +procedure TKCustomGrid.UpdateAxes(Horz: Boolean; FirstCol: Integer; + Vert: Boolean; FirstRow: Integer; Flags: TKGridAxisUpdateFlags); + + procedure Axis1(Info: TKGridAxisInfo; AxisItems: TKGridAxisItems; + var FirstIndex: Integer); + var + I, AExtent: Integer; + begin + FlagSet(cGF_GridUpdates); + try + for I := 0 to Info.TotalCellCount - 1 do + begin + AExtent := Info.CellExtent(I); + if (AExtent > 0) and (AExtent < Info.MinCellExtent(I)) then + begin + AxisItems[I].Extent := 0; + FirstIndex := Min(FirstIndex, I); + end + else if AExtent > Info.MaxCellExtent(I) then + begin + AxisItems[I].Extent := Info.MaxCellExtent(I); + FirstIndex := Min(FirstIndex, I); + end; + end; + finally + FlagClear(cGF_GridUpdates); + end; + end; + + procedure Axis2(Info: TKGridAxisInfo; AxisItems: TKGridAxisItems; + var FirstIndex: Integer); + + function CalcGridExtent(FixedExtent: Integer): Integer; + var + I: Integer; + begin + Result := FixedExtent; + for I := Info.FixedCellCount to Info.TotalCellCount - 1 do + Inc(Result, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + end; + + var + I, CellExtent, Delta, FixedExtent, GridExtent: Integer; + begin + FlagSet(cGF_GridUpdates); + try + FixedExtent := 0; + for I := 0 to Info.FixedCellCount - 1 do + Inc(FixedExtent, Info.CellExtent(I) + Info.EffectiveSpacing(I)); + GridExtent := CalcGridExtent(FixedExtent); + if GridExtent <> Info.ClientExtent then + begin + if GridExtent < Info.ClientExtent then + begin + // cells would occupy a smaller area than Info.ClientExtent + // try to enlarge the last cell if visible: + I := Info.TotalCellCount - 1; + while (I >= Info.FixedCellCount) and (GridExtent < Info.ClientExtent) do + begin + CellExtent := Info.CellExtent(I); + if CellExtent <> 0 then + begin + Delta := Info.ClientExtent - GridExtent; + AxisItems[I].Extent := CellExtent + Delta; + Inc(GridExtent, Delta); + FirstIndex := Min(FirstIndex, I); + end; + Dec(I); + end; + if I < Info.FixedCellCount then + begin + // apparently all cells are hidden. Try to unhide last cell + I := Info.TotalCellCount - 1; + AxisItems[I].Extent := Info.MinCellExtent(I); + GridExtent := CalcGridExtent(FixedExtent); + if GridExtent > Info.ClientExtent then + AxisItems[I].Extent := 0 //oops, does not fit, hide again, leave empty area + else + AxisItems[I].Extent := Info.CellExtent(I) + Info.ClientExtent - GridExtent; + end; + end else + begin + // cells would occupy a greater area than Info.ClientExtent + // try to decrease the extents of not fully visible cells + I := Info.TotalCellCount - 1; + while (I >= Info.FixedCellCount) and (GridExtent > Info.ClientExtent) do + begin + CellExtent := Info.CellExtent(I); + if CellExtent > Info.MinCellExtent(I) then + begin + Delta := Min(GridExtent - Info.ClientExtent, CellExtent - Info.MinCellExtent(I)); + AxisItems[I].Extent := CellExtent - Delta; + Dec(GridExtent, Delta); + FirstIndex := Min(FirstIndex, I); + end; + Dec(I); + end; + if GridExtent > Info.ClientExtent then + begin + // still everything not visible, hide some cells + I := Info.TotalCellCount - 1; + while (I >= Info.FixedCellCount) and (GridExtent > Info.ClientExtent) do + begin + CellExtent := Info.CellExtent(I); + if CellExtent > 0 then + begin + AxisItems[I].Extent := 0; + FirstIndex := Min(FirstIndex, I); + GridExtent := CalcGridExtent(FixedExtent); + end; + Dec(I); + end; + if (GridExtent < Info.ClientExtent) and (I >= Info.FixedCellCount) then + begin + // cells would occupy a smaller area than Info.ClientExtent - 2nd test + I := Info.TotalCellCount - 1; + while (I >= Info.FixedCellCount) and (GridExtent < Info.ClientExtent) do + begin + CellExtent := Info.CellExtent(I); + if CellExtent <> 0 then + begin + Delta := Info.ClientExtent - GridExtent; + AxisItems[I].Extent := CellExtent + Delta; + Inc(GridExtent, Delta); + FirstIndex := Min(FirstIndex, I); + end; + Dec(I); + end; + end; + end; + end; + end; + finally + FlagClear(cGF_GridUpdates); + end; + end; + +var + ColIndex, RowIndex: Integer; + Info: TKGridAxisInfo; +begin + if not UpdateUnlocked then Exit; + if Horz then + begin + Info := GetAxisInfoHorz([]); + if FirstCol >= 0 then ColIndex := FirstCol else ColIndex := FColCount; + if afCheckMinExtent in Flags then + Axis1(Info, FCols, ColIndex); + if (goAlignLastCol in FOptions) then + begin + if FTopLeft.Col <> FFixedCols then + begin + FTopLeft.Col := FFixedCols; + TopLeftChanged; + end; + Axis2(Info, FCols, ColIndex); + end; + end; + if Vert then + begin + Info := GetAxisInfoVert([]); + if FirstRow >= 0 then RowIndex := FirstRow else RowIndex := FRowCount; + if afCheckMinExtent in Flags then + Axis1(Info, FRows, RowIndex); + if (goAlignLastRow in FOptions) then + begin + if FTopLeft.Row <> FFixedRows then + begin + FTopLeft.Row := FFixedRows; + TopLeftChanged; + end; + Axis2(Info, FRows, RowIndex); + end; + end; + UpdateScrollRange(Horz, Vert, False); + UpdateEditor(Flag(cGF_EditorModeActive)); + if Horz then + begin + if ColIndex < FColCount then + ColWidthsChanged(ColIndex); + if FirstCol = cAll then + Invalidate + else if ColIndex < FColCount then + InvalidateCols(ColIndex); + end; + if Vert then + begin + if RowIndex < FRowCount then + RowHeightsChanged(RowIndex); + if FirstRow = cAll then + Invalidate + else if RowIndex < FRowCount then + InvalidateRows(RowIndex); + end; +end; + +procedure TKCustomGrid.UpdateCellSpan; + + function DoUpdate(FirstCol, FirstRow, LastCol, LastRow: Integer): Boolean; + var + I, J: Integer; + Span, RefSpan: TKGridCellSpan; + begin + Result := False; + RefSpan := MakeCellSpan(1, 1); + // don't make this too complicated, but maybe it is little bit slower: + // reset all negative spans + for I := FirstCol to LastCol - 1 do + for J := FirstRow to LastRow - 1 do + if FCells[J, I] <> nil then + begin + with FCells[J, I].Span do + if (ColSpan <= 0) or (RowSpan <= 0) then + FCells[J, I].Span := RefSpan; + end; + // create all spans + for I := FirstCol to LastCol - 1 do + for J := FirstRow to LastRow - 1 do + if FCells[J, I] <> nil then + begin + with FCells[J, I].Span do + if (ColSpan > 1) or (RowSpan > 1) then + begin + Result := True; + Span := MakeCellSpan(Min(ColSpan, LastCol - I), Min(RowSpan, LastRow - J)); + FCells[J, I].Span := RefSpan; + InternalSetCellSpan(I, J, Span); + end; + end; + end; + +begin + if Assigned(FCells) then + begin + FlagSet(cGF_GridUpdates); + try + // cells cannot be merged across fixed area boundaries + DoUpdate(0, 0, FFixedCols, FFixedRows); + DoUpdate(FFixedCols, 0, FColCount, FFixedRows); + DoUpdate(0, FFixedRows, FFixedCols, FRowCount); + if Flag(cGF_SelCellsMerged) then + if not DoUpdate(FFixedCols, FFixedRows, FColCount, FRowCount) then + FlagClear(cGF_SelCellsMerged); + finally + FlagClear(cGF_GridUpdates); + end; + end; +end; + +procedure TKCustomGrid.UpdateDesigner; +var + ParentForm: TCustomForm; +begin + if (csDesigning in ComponentState) and HandleAllocated and + not (csUpdating in ComponentState) then + begin + ParentForm := GetParentForm(Self); + if Assigned(ParentForm) and Assigned(ParentForm.Designer) then + ParentForm.Designer.Modified; + end; +end; + +procedure TKCustomGrid.UpdateEditor(Show: Boolean); + + procedure InternalEditorSetPos(R: TRect; CallResize: Boolean); + begin + // aki: + if ((FEditorCell.Col >= FTopLeft.Col) and ((FScrollOffset.X = 0) or (FEditorCell.Col > FTopLeft.Col)) or + (gxEditFixedCols in FOptionsEx) and (FEditorCell.Col < FFixedCols)) and + ((FEditorCell.Row >= FTopLeft.Row) and ((FScrollOffset.Y = 0) or (FEditorCell.Row > FTopLeft.Row)) or + (gxEditFixedRows in FOptionsEx) and (FEditorCell.Row < FFixedRows)) then + begin + if CallResize then + EditorResize(FEditor, FEditorCell.Col, FEditorCell.Row, R); + with R do + begin + FEditor.Constraints.MaxWidth := Right - Left + 1; + FEditor.Constraints.MaxHeight := Bottom - Top + 1; + FEditor.Height := Bottom - Top; + FEditor.Width := Right - Left; + if gxEditorVCenter in FOptionsEx then + Inc(Top, (Bottom - Top - FEditor.Height) div 2); + if gxEditorHCenter in FOptionsEx then + Inc(Left, (Right - Left - FEditor.Width) div 2); + FEditor.SetBounds(Left, Top, FEditor.Width, FEditor.Height); + end; + end else + begin + // hide the editor in some way + FEditor.Left := - 10 - FEditor.Width; + FEditor.Top := - 10 - FEditor.Height; + end; + end; + + procedure InternalEditorMove; + var + R: TRect; + begin + if (FEditor <> nil) and CellRect(FEditorCell.Col, FEditorCell.Row, R) then + begin + if not EqualRect(FEditorRect, R) then with R do + begin + FEditorRect := R; + InternalEditorSetPos(R, True); + SetControlClipRect(FEditor, R); + end; + end; + end; + + procedure InternalEditorCreate; + var + R: TRect; + PropInfo: PPropInfo; + P: TPoint; + ACell: TKGridCell; + begin + if (FEditor = nil) and HandleAllocated and Enabled and Visible then + begin + if CellRect(Col, Row, R) and SelectCell(Col, Row) then + begin + FEditorCell.Col := Col; + FEditorCell.Row := Row; + FEditor := EditorCreate(FEditorCell.Col, FEditorCell.Row); + if FEditor <> nil then + begin + if Assigned(FCells) then + begin + ACell := Cell[FEditorCell.Col, FEditorCell.Row]; + if FEditedCell = nil then FEditedCell := TKGridCellClass(ACell.ClassType).Create(nil); + FEditedCell.Assign(ACell); + end; + FThroughClick := False; + FEditorRect := R; + TabStop := False; + FEditor.Visible := False; + FEditor.Align := alNone; + FEditor.Constraints.MinWidth := 0; + FEditor.Constraints.MinHeight := 0; + PropInfo := GetPropInfo(FEditor, 'AutoSize'); + if PropInfo <> nil then + SetOrdProp(FEditor, PropInfo, Integer(False)); + // I hope no other steps to delimit inplace editor's size + // some controls as TComboBox on Win cannot be arbitrary resized :-( + FEditor.ControlStyle := FEditor.ControlStyle - [csAcceptsControls, csFramed, csFixedWidth, csFixedHeight] {$IFDEF COMPILER7_UP} - [csParentBackground] {$ENDIF}; + FEditor.TabStop := True; + InternalEditorSetPos(R, True); // call this here too to be compatible with all LCL widget sets + FEditor.Parent := Self; + FEditor.HandleNeeded; + InternalEditorSetPos(R, True); + SetControlClipRect(FEditor, R); + EditorDataFromGrid(FEditor, FEditorCell.Col, FEditorCell.Row); + FEditor.Visible := True; // Remark: don't set DoubleBuffered because not all editors support it! + EditorSelect(FEditor, FEditorCell.Col, FEditorCell.Row, + not (goNoSelEditText in FOptions), Flag(cGF_CaretToLeft), Flag(cGF_SelectedByMouse)); + FlagClear(cGF_CaretToLeft); + SafeSetFocus; + if FThroughClick then + begin + P := FEditor.ScreenToClient(Mouse.CursorPos); + PostMessage(FEditor.Handle, LM_LBUTTONDOWN, 1, MakeLong(P.X, P.Y)); + MouseCapture := False; + FlagSet(cGF_ThroughClick); + FThroughClick := False; + end; + InvalidateCurrentSelection; + FEditorWindowProc := FEditor.WindowProc; + FEditor.WindowProc := EditorWindowProc; + end; + end; + end; + end; + + procedure InternalEditorDestroy; + var + Form: TCustomForm; + begin + if FEditor <> nil then + begin + FEditor.WindowProc := FEditorWindowProc; + Form := GetParentForm(Self); + if Assigned(Form) and (csDestroying in Form.ComponentState) then + Form := nil; + if FEditor.HandleAllocated then + EditorDataToGrid(FEditor, FEditorCell.Col, FEditorCell.Row); + TabStop := True; + if Assigned(Form) and (Form.ActiveControl = FEditor) then + Form.ActiveControl := Self; + FEditor.Visible := False; + FEditor.Parent := nil; + EditorDestroy(FEditor, FEditorCell.Col, FEditorCell.Row); + FreeAndNil(FEditor); + if Assigned(FCells) then + if CompareCellInstances(FEditedCell, InternalGetCell(FEditorCell.Col, FEditorCell.Row)) <> 0 then + Changed; + FEditorCell := GridPoint(-1, -1); + if Assigned(Form) and (Form.ActiveControl = nil) then + Form.ActiveControl := Self; + InvalidateCurrentSelection; + end; + end; + +var + PosChanged: Boolean; +begin + if not Flag(cGF_EditorUpdating) then + begin + FlagSet(cGF_EditorUpdating); + try + if (goEditing in FOptions) and Show and (InternalGetColWidths(Col) > 0) and (InternalGetRowHeights(Row) > 0) then + begin + PosChanged := (FEditorCell.Col <> Col) or (FEditorCell.Row <> Row); + if (FEditor = nil) or PosChanged then + begin + InternalEditorDestroy; + InternalEditorCreate; + end else + InternalEditorMove; + end else + InternalEditorDestroy; + finally + FlagClear(cGF_EditorUpdating); + end; + end; +end; + +procedure TKCustomGrid.UpdateScrollRange(Horz, Vert, UpdateNeeded: Boolean); + + function Axis(Code: Cardinal; HasScrollBar: Boolean; ScrollMode: TKGridScrollMode; + Info: TKGridAxisInfo; out FirstGridCell, FirstGridCellExtent, ScrollPos: Integer; + var ScrollOffset: Integer): Boolean; + var + I, CellExtent, MaxExtent, PageExtent, ScrollExtent: Integer; + CheckFirstGridCell: Boolean; + SI: TScrollInfo; + begin + Result := False; + CheckFirstGridCell := True; + ScrollExtent := 0; + PageExtent := 0; + MaxExtent := Info.ClientExtent - Info.FixedBoundary; + I := Info.TotalCellCount - 1; + FirstGridCellExtent := I; + while I >= Info.FixedCellCount do + begin + CellExtent := Info.CellExtent(I); + Inc(ScrollExtent, CellExtent + Info.EffectiveSpacing(I)); + if CheckFirstGridCell then + begin + if (ScrollExtent <= MaxExtent) then + begin + PageExtent := ScrollExtent; + FirstGridCellExtent := I; + if (Info.FirstGridCell > I) or (Info.FirstGridCell = I) and (ScrollOffset <> 0) then + begin + FirstGridCell := I; + Result := True; + end; + end else + begin + if PageExtent = 0 then + PageExtent := ScrollExtent; + CheckFirstGridCell := False; + end; + end; + if I = FirstGridCell then + ScrollPos := ScrollExtent; + Dec(I); + end; + ScrollPos := ScrollExtent - ScrollPos; + if Result or ((ScrollMode = smCell) or not HasScrollBar) and (ScrollOffset <> 0) then + begin + ScrollOffset := 0; + Result := True; + end; + if HandleAllocated then + if HasScrollBar then + begin + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; + SI.nMin := 0; + SI.nMax := ScrollExtent {$IFNDEF FPC}- 1{$ENDIF}; + SI.nPos := ScrollPos + ScrollOffset; + SI.nPage := PageExtent; + {$IFDEF UNIX} + SI.ntrackPos := SB_POLICY_CONTINUOUS; + {$ENDIF} + SetScrollInfo(Handle, Code, SI, True); + ShowScrollBar(Handle, Code, PageExtent < ScrollExtent); + end else + ShowScrollBar(Handle, Code, False); + end; + +var + UpdateHorz, UpdateVert: Boolean; +begin + if not UpdateUnlocked then Exit; + UpdateHorz := Horz and Axis(SB_HORZ, HasHorzScrollBar, FScrollModeHorz, + GetAxisInfoHorz([aiFixedParams]), FTopLeft.Col, FTopLeftExtent.Col, FScrollPos.X, FScrollOffset.X); + UpdateVert := Vert and Axis(SB_VERT, HasVertScrollBar, FScrollModeVert, + GetAxisInfoVert([aiFixedParams]), FTopLeft.Row, FTopLeftExtent.Row, FScrollPos.Y, FScrollOffset.Y); + if UpdateNeeded or UpdateHorz then + InvalidateCols(FFixedCols); + if UpdateNeeded or UpdateVert then + InvalidateRows(FFixedRows); + if UpdateNeeded or UpdateHorz or UpdateVert then + begin + UpdateEditor(Flag(cGF_EditorModeActive)); + if UpdateHorz or UpdateVert then + TopLeftChanged; + if FOptions * [goRowSelect, goRangeSelect] <> [] then + InvalidateCurrentSelection; + end; + InvalidatePageSetup; +end; + +procedure TKCustomGrid.UpdateSize; +begin + inherited; + UpdateAxes(True, FColCount, True, FRowCount, [afCheckMinExtent]); +end; + +procedure TKCustomGrid.UpdateSortMode(ACol, ARow: Integer); +var + Index: Integer; +begin + LockSortMode; + try + if FCols[ACol].SortMode <> smNone then + begin + Index := InternalInsertIfCellModifiedNR(ACol, ARow, FFixedRows, FRowCount - 1, FCols[ACol].SortMode = smUp, CompareRows); + if Index <> ARow then + begin + MoveRow(ARow, Index); + ClampInView(ACol, Index); + end; + end; + if FRows[ARow].SortMode <> smNone then + begin + Index := InternalInsertIfCellModifiedNR(ARow, ACol, FFixedCols, FColCount - 1, FRows[ARow].SortMode = smUp, CompareCols); + if Index <> ACol then + begin + MoveCol(ACol, Index); + ClampInView(Index, ARow); + end; + end; + finally + UnlockSortMode; + end; +end; + +procedure TKCustomGrid.WMChar(var Msg: {$IFDEF FPC}TLMChar{$ELSE}TWMChar{$ENDIF}); +begin + if (goEditing in Options) and CharInSetEx(Char(Msg.CharCode), [^H, #32..#255]) then + begin + EditorMode := True; + if EditorMode then + PostMessage(FEditor.Handle, LM_CHAR, Word(Msg.CharCode), 0); + Msg.Result := 1; + end else + inherited; +end; + +procedure TKCustomGrid.WMEraseBkGnd(var Msg: TLMEraseBkGnd); +begin + if Flag(cGF_EditorUpdating) or not (goEraseBackground in FOptions) then + Msg.Result := 1 + else + inherited; +end; + +procedure TKCustomGrid.WMGetDlgCode(var Msg: TLMNoParams); +begin + Msg.Result := DLGC_WANTARROWS; + if goTabs in FOptions then Msg.Result := Msg.Result or DLGC_WANTTAB; + if goEditing in FOptions then Msg.Result := Msg.Result or DLGC_WANTCHARS; +end; + +procedure TKCustomGrid.WMHScroll(var Msg: TLMHScroll); +begin + if not EditorMode or (Msg.ScrollBar <> FEditor.Handle) then + begin + SafeSetFocus; + Scroll(Msg.ScrollCode, cScrollNoAction, Msg.Pos, 0, True); + end else + inherited; +end; + +procedure TKCustomGrid.WMKillFocus(var Msg: TLMKillFocus); +begin + inherited; + // focus moves to another control including inplace editor + if not Flag(cGF_EditorUpdating) then + InvalidateCurrentSelection; +end; + +procedure TKCustomGrid.WMSetFocus(var Msg: TLMSetFocus); +begin + // focus moves to the grid - post message + if not Flag(cGF_EditorUpdating) then + PostLateUpdate(FillMessage(LM_SETFOCUS, 0, 0), True); +end; + +procedure TKCustomGrid.WMVScroll(var Msg: TLMVScroll); +begin + if not EditorMode or (Msg.ScrollBar <> FEditor.Handle) then + begin + SafeSetFocus; + Scroll(cScrollNoAction, Msg.ScrollCode, 0, Msg.Pos, True); + end else + inherited; +end; + +{$IFNDEF FPC} +procedure TKCustomGrid.WndProc(var Msg: TMessage); + + procedure PaintCellBackground(ACanvas: TCanvas; R: TRect); + var + TmpBlockRect: TRect; + begin + R := Rect(0, 0, R.Right - R.Left, R.Bottom - R.Top); + TmpBlockRect := SelectionRect; + OffsetRect(TmpBlockRect, -R.Left, -R.Top); + InternalPaintCell(Col, Row, GetDrawState(Col, Row, HasFocus), + R, TmpBlockRect, ACanvas, False, False); + end; + +var + R: TRect; + SaveIndex: Integer; + ACanvas: TCanvas; +begin + case Msg.Msg of + WM_CTLCOLORBTN..WM_CTLCOLORSTATIC: + begin + if EditorMode and EditorIsTransparent and + CellRect(Col, Row, R) then + begin + if Themes then + begin + ACanvas := TCanvas.Create; + SaveIndex := SaveDC(Msg.WParam); + try + ACanvas.Handle := Msg.WParam; + PaintCellBackground(ACanvas, R); + finally + RestoreDC(Msg.WParam, SaveIndex); + ACanvas.Free; + end; + Msg.Result := GetStockObject(NULL_BRUSH); + end else + begin + PaintCellBackground(FTmpBitmap.Canvas, R); + SetTextColor(Msg.WParam, ColorToRGB(TCheckBox(FEditor).Font.Color)); + SetBkColor(Msg.WParam, ColorToRGB(FTmpBitmap.Canvas.Brush.Color)); + Msg.Result := FTmpBitmap.Canvas.Brush.Handle; + end; + end else + inherited; + end; + else + inherited; + end +end; +{$ENDIF} + +procedure TKCustomGrid.WriteColWidths(Writer: TWriter); +var + I: Integer; +begin + with Writer do + begin + WriteListBegin; + for I := 0 to FColCount - 1 do WriteInteger(ColWidths[I]); + WriteListEnd; + end; +end; + +procedure TKCustomGrid.WriteRowHeights(Writer: TWriter); +var + I: Integer; +begin + with Writer do + begin + WriteListBegin; + for I := 0 to FRowCount - 1 do WriteInteger(RowHeights[I]); + WriteListEnd; + end; +end; + +{$IFDEF FPC} +initialization + {$i kgrids.lrs} +{$ELSE} + {$R kgrids.res} +{$ENDIF} +end. diff --git a/components/kcontrols/source/kgrids.res b/components/kcontrols/source/kgrids.res new file mode 100755 index 000000000..bc30efc03 Binary files /dev/null and b/components/kcontrols/source/kgrids.res differ diff --git a/components/kcontrols/source/khexeditor.pas b/components/kcontrols/source/khexeditor.pas new file mode 100755 index 000000000..771558e66 --- /dev/null +++ b/components/kcontrols/source/khexeditor.pas @@ -0,0 +1,5118 @@ +{ @abstract(This unit contains the TKHexEditor component and all supporting classes) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(12 Oct 2005) + @lastmod(20 Jun 2010) + + This unit provides a powerfull hexadecimal editor component @link(TKHexEditor) + with following major features: + + + Copyright © 2006 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KHexEditor; + +{$include kcontrols.inc} +{$WEAKPACKAGEUNIT ON} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LMessages, LCLProc, LResources, +{$ELSE} + Windows, Messages, +{$ENDIF} + SysUtils, Classes, Graphics, Controls, + ExtCtrls, StdCtrls, Forms, KFunctions, KControls, KEditCommon; + +resourcestring + { @exclude } + sAddressText = 'Address area text'; + { @exclude } + sAddressBkGnd = 'Address area background'; + { @exclude } + sBkGnd = 'Editor background'; + { @exclude } + sDigitTextEven = 'Digit area even column'; + { @exclude } + sDigitTextOdd = 'Digit area odd column'; + { @exclude } + sDigitBkgnd = 'Digit area background'; + { @exclude } + sHorzLines = 'Horizontal lines'; + { @exclude } + sInactiveCaretBkGnd = 'Inactive caret background'; + { @exclude } + sInactiveCaretSelBkGnd = 'Selected inactive caret background'; + { @exclude } + sInactiveCaretSelText = 'Selected inactive caret text'; + { @exclude } + sInactiveCaretText = 'Inactive caret text'; + { @exclude } + sLinesHighLight = 'Lines highlight'; + { @exclude } + sSelBkGnd = 'Selection background'; + { @exclude } + sSelBkGndFocused = 'Focused selection background'; + { @exclude } + sSelText = 'Selection text'; + { @exclude } + sSelTextFocused = 'Focused selection text'; + { @exclude } + sSeparators = 'Area separating lines'; + { @exclude } + sTextText = 'Text area text'; + { @exclude } + sTextBkGnd = 'Text area background'; + { @exclude } + sVertLines = 'Vertical lines'; + +type + { Declares possible values for the @link(TKCustomHexEditor.AddressMode) property } + TKHexEditorAddressMode = ( + { Address will be shown in decimal format } + eamDec, + { Address will be shown in hexadecimal format } + eamHex + ); + + { Declares possible values e.g. for the @link(TKCustomHexEditor.EditArea) property } + TKHexEditorArea = ( + { No area is selected, e.g. when clicked outside of visible text } + eaNone, + { Address area selected/used } + eaAddress, + { Digits area selected/used } + eaDigits, + { Text area selected/used } + eaText + ); + + { @abstract(Contains dimensions of all areas in characters) + + } + TKHexEditorAreaDimensions = record + Address, + AddressOut, + Digits, + DigitsIn, + DigitsOut, + Text, + TextIn, + TotalHorz, + TotalVert: Integer; + end; + + { Declares possible indexes e.g. for the @link(TKHexEditorColors.Color) property. } + TKHexEditorColorIndex = Integer; + + { @abstract(Declares @link(TKHexEditorColors) color item description) + + } + TKHexEditorColorSpec = record + Def: TColor; + Name: string; + end; + + { Declares possible values for the @link(TKCustomHexEditor.DisabledDrawStyle) property } + TKHexEditorDisabledDrawStyle = ( + { The lines will be painted with brighter colors when editor is disabled } + eddBright, + { The lines will be painted with gray text and white background when editor is disabled } + eddGrayed, + { The lines will be painted normally when editor is disabled } + eddNormal + ); + + { Declares drawing styles - possible values for the @link(TKCustomHexEditor.DrawStyles) property } + TKHexEditorDrawStyle = ( + { Show adress area } + edAddress, + { Show digits area } + edDigits, + { Show text area } + edText, + { Show horizontal leading lines } + edHorzLines, + { Show caret position when editor is inactive (has no input focus) } + edInactiveCaret, + { Show vertical area separating lines } + edSeparators, + { Show vertical leading lines (digits area only) } + edVertLines, + { @link(TKHexEditorColors.BkGnd) is used for all areas if included } + edSingleBkGnd + ); + + { Drawing styles can be arbitrary combined } + TKHexEditorDrawStyles = set of TKHexEditorDrawStyle; + + { @abstract(Declares the paint data structure for the @link(TKCustomHexEditor.PaintLines) method) + + } + TKHexEditorPaintData = record + Canvas: TCanvas; + PaintRect: TRect; + TopLine, + BottomLine, + LeftChar, + CharWidth, + CharHeight, + CharSpacing: Integer; + Printing, + PaintAll, + PaintColors, + PaintSelection, + CaretShown: Boolean; + end; + + { @abstract(Declares the selection structure) + + } + TKHexEditorSelection = record + Index: Integer; + Digit: Integer; + end; + + { @abstract(Declares the structure for the @link(TKCustomHexEditor.SelText) property) + + } + TKHexEditorSelText = record + AsBinaryRaw, + AsBinaryMapped, + AsDigits, + AsDigitsByteAligned: AnsiString; + end; + + { Declares hex editor states - possible values for the @link(TKCustomHexEditor.States) property + (protected) } + TKHexEditorState = ( + { Caret is visible } + elCaretVisible, + { Caret is being updated } + elCaretUpdate, + { Ignore following WM_CHAR message } + elIgnoreNextChar, + { Buffer modified } + elModified, + { Mouse captured } + elMouseCapture, + { Overwrite mode active } + elOverwrite, + { Read only editor } + elReadOnly + ); + + { Hex editor states can be arbitrary combined } + TKHexEditorStates = set of TKHexEditorState; + + { @abstract(Declares the color description structure returned by @link(TKHexEditorColors.ColorData) property) + + } + TKHexEditorColorData = record + Index: TKHexEditorColorIndex; + Color: TColor; + Default: TColor; + Name: string; + end; + + { Declares possible values for the @link(TKHexEditorColors.ColorScheme) property } + TKHexEditorColorScheme = ( + { GetColor returns normal color currently defined for each item } + ecsNormal, + { GetColor returns gray for text and line colors and white for background colors } + ecsGrayed, + { GetColor returns brighter version of normal color } + ecsBright, + { GetColor returns grayscaled color versions } + ecsGrayScale + ); + +const + { Minimum for the @link(TKCustomHexEditor.AddressSize) property } + cAddressSizeMin = 2; + { Maximum for the @link(TKCustomHexEditor.AddressSize) property } + cAddressSizeMax = 10; + { Default value for the @link(TKCustomHexEditor.AddressSize) property } + cAddressSizeDef = 8; + + { Minimum for the @link(TKCustomHexEditor.AreaSpacing) property } + cAreaSpacingMin = 1; + { Maximum for the @link(TKCustomHexEditor.AreaSpacing) property } + cAreaSpacingMax = 20; + { Default value for the @link(TKCustomHexEditor.AreaSpacing) property } + cAreaSpacingDef = 1; + + { Minimum for the @link(TKCustomHexEditor.CharSpacing) property } + cCharSpacingMin = 0; + { Maximum for the @link(TKCustomHexEditor.CharSpacing) property } + cCharSpacingMax = 100; + { Default value for the @link(TKCustomHexEditor.CharSpacing) property } + cCharSpacingDef = 0; + + { Minimum for the @link(TKCustomHexEditor.DigitGrouping) property } + cDigitGroupingMin = 1; + { Maximum for the @link(TKCustomHexEditor.DigitGrouping) property } + cDigitGroupingMax = 8; + { Default value for the @link(TKCustomHexEditor.DigitGrouping) property } + cDigitGroupingDef = 2; + + { Minimum for the @link(TKCustomHexEditor.LineHeightPercent) property } + cLineHeightPercentMin = 10; + { Maximum for the @link(TKCustomHexEditor.LineHeightPercent) property } + cLineHeightPercentMax = 1000; + { Default value for the @link(TKCustomHexEditor.LineHeightPercent) property } + cLineHeightPercentDef = 130; + + { Minimum for the @link(TKCustomHexEditor.UndoLimit) property } + cUndoLimitMin = 100; + { Maximum for the @link(TKCustomHexEditor.UndoLimit) property } + cUndoLimitMax = 10000; + { Default value for the @link(TKCustomHexEditor.UndoLimit) property } + cUndoLimitDef = 1000; + + { Minimum for the @link(TKCustomHexEditor.LineSize) property } + cLineSizeMin = 1; + { Maximum for the @link(TKCustomHexEditor.LineSize) property } + cLineSizeMax = 128; + { Default value for the @link(TKCustomHexEditor.LineSize) property } + cLineSizeDef = 16; + + { Minimum for the @link(TKCustomHexEditor.ScrollSpeed) property } + cScrollSpeedMin = 50; + { Maximum for the @link(TKCustomHexEditor.ScrollSpeed) property } + cScrollSpeedMax = 1000; + { Default value for the @link(TKCustomHexEditor.ScrollSpeed) property } + cScrollSpeedDef = 100; + + { Minimum for the @link(TKHexEditor.Font).Size property } + cFontSizeMin = 8; + { Maximum for the @link(TKHexEditor.Font).Size property } + cFontSizeMax = 100; + { Default value for the @link(TKHexEditor.Font).Size property } + cFontSizeDef = 11; + + { Default value for the @link(TKHexEditorColors.AddressText) color property } + cAddressTextDef = clWindowText; + { Default value for the @link(TKHexEditorColors.AddressBkGnd) color property } + cAddressBkgndDef = clWindow; + { Default value for the @link(TKHexEditorColors.BkGnd) color property } + cBkGndDef = clWindow; + { Default value for the @link(TKHexEditorColors.DigitTextEven) color property } + cDigitTextEvenDef = clMaroon; + { Default value for the @link(TKHexEditorColors.DigitTextOdd) color property } + cDigitTextOddDef = clRed; + { Default value for the @link(TKHexEditorColors.DigitBkGnd) color property } + cDigitBkGndDef = clWindow; + { Default value for the @link(TKHexEditorColors.HorzLines) color property } + cHorzLinesDef = clWindowText; + { Default value for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } + cInactiveCaretBkGndDef = clBlack; + { Default value for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } + cInactiveCaretSelBkGndDef = clBlack; + { Default value for the @link(TKHexEditorColors.InactiveCaretSelText) color property } + cInactiveCaretSelTextDef = clYellow; + { Default value for the @link(TKHexEditorColors.InactiveCaretText) color property } + cInactiveCaretTextDef = clYellow; + { Default value for the @link(TKHexEditorColors.LinesHighLight) color property } + cLinesHighLightDef = clHighLightText; + { Default value for the @link(TKHexEditorColors.SelBkGnd) color property } + cSelBkGndDef = clGrayText; + { Default value for the @link(TKHexEditorColors.SelBkGndFocused) color property } + cSelBkGndFocusedDef = clHighlight; + { Default value for the @link(TKHexEditorColors.SelText) color property } + cSelTextDef = clHighlightText; + { Default value for the @link(TKHexEditorColors.SelTextFocused) color property } + cSelTextFocusedDef = clHighlightText; + { Default value for the @link(TKHexEditorColors.Separators) color property } + cSeparatorsDef = clWindowText; + { Default value for the @link(TKHexEditorColors.TextText) color property } + cTextTextDef = clWindowText; + { Default value for the @link(TKHexEditorColors.TextBkgnd) color property } + cTextBkgndDef = clWindow; + { Default value for the @link(TKHexEditorColors.VertLines) color property } + cVertLinesDef = clWindowText; + + { Index for the @link(TKHexEditorColors.AddressText) color property } + ciAddressText = TKHexEditorColorIndex(0); + { Index for the @link(TKHexEditorColors.AddressBkGnd) color property } + ciAddressBkGnd = TKHexEditorColorIndex(1); + { Index for the @link(TKHexEditorColors.BkGnd) color property } + ciBkGnd = TKHexEditorColorIndex(2); + { Index for the @link(TKHexEditorColors.DigitTextEven) color property } + ciDigitTextEven = TKHexEditorColorIndex(3); + { Index for the @link(TKHexEditorColors.DigitTextOdd) color property } + ciDigitTextOdd = TKHexEditorColorIndex(4); + { Index for the @link(TKHexEditorColors.DigitBkGnd) color property } + ciDigitBkGnd = TKHexEditorColorIndex(5); + { Index for the @link(TKHexEditorColors.HorzLines) color property } + ciHorzLines = TKHexEditorColorIndex(6); + { Index for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property } + ciInactiveCaretBkGnd = TKHexEditorColorIndex(7); + { Index for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property } + ciInactiveCaretSelBkGnd = TKHexEditorColorIndex(8); + { Index for the @link(TKHexEditorColors.InactiveCaretSelText) color property } + ciInactiveCaretSelText = TKHexEditorColorIndex(9); + { Index for the @link(TKHexEditorColors.InactiveCaretText) color property } + ciInactiveCaretText = TKHexEditorColorIndex(10); + { Index for the @link(TKHexEditorColors.LinesHighLight) color property } + ciLinesHighLight = TKHexEditorColorIndex(11); + { Index for the @link(TKHexEditorColors.SelBkGnd) color property } + ciSelBkGnd = TKHexEditorColorIndex(12); + { Index for the @link(TKHexEditorColors.SelBkGndFocused) color property } + ciSelBkGndFocused = TKHexEditorColorIndex(13); + { Index for the @link(TKHexEditorColors.SelText) color property } + ciSelText = TKHexEditorColorIndex(14); + { Index for the @link(TKHexEditorColors.SelTextFocused) color property } + ciSelTextFocused = TKHexEditorColorIndex(15); + { Index for the @link(TKHexEditorColors.Separators) color property } + ciSeparators = TKHexEditorColorIndex(16); + { Index for the @link(TKHexEditorColors.TextText) color property } + ciTextText = TKHexEditorColorIndex(17); + { Index for the @link(TKHexEditorColors.TextBkgnd) color property } + ciTextBkGnd = TKHexEditorColorIndex(18); + { Index for the @link(TKHexEditorColors.VertLines) color property } + ciVertLines = TKHexEditorColorIndex(19); + { Maximum color array index } + ciHexEditorColorsMax = ciVertLines; + + { Default value for the @link(TKCustomHexEditor.AddressMode) property } + cAddressModeDef = eamHex; + + { Default value for the @link(TKCustomHexEditor.Addressoffset) property } + cAddressOffsetDef = 0; + + { Default value for the @link(TKCustomHexEditor.DisabledDrawStyle) property } + cDisabledDrawStyleDef = eddBright; + + { Default value for the @link(TKCustomHexEditor.DrawStyles) property } + cDrawStylesDef = [edAddress, edDigits, edText, edInactiveCaret, edSeparators]; + + { Default value for the @link(TKCustomHexEditor.AddressPrefix) property } + cAddressPrefixDef = '0x'; + + { Default value for the @link(TKHexEditor.Font).Name property } + cFontNameDef = {$IFDEF MSWINDOWS}'Courier New'{$ELSE}'Courier'{$ENDIF}; + + { Default value for the @link(TKHexEditor.Font).Style property } + cFontStyleDef = [fsBold]; + + { Declares the Index member of the @link(TKHexEditorSelection) record invalid} + cInvalidIndex = -1; + + { Default value for the @link(TKCustomHexEditor.AddressCursor) property } + cAddressCursorDef = crHandPoint; + + { Default value for the @link(TKHexEditor.Height) property } + cHeight = 300; + + { Default value for the @link(TKHexEditor.Width) property } + cWidth = 400; + +type + TKCustomHexEditor = class; + + { @abstract(Container for all colors used by @link(TKCustomHexEditor) class) + This container allows to group many colors into one item in object inspector. + Colors are accessible via published properties or several public Color* + properties. + } + TKHexEditorColors = class(TPersistent) + private + FOwner: TKCustomHexEditor; + FBrightColors: TKColorArray; + FColors: TKColorArray; + FColorScheme: TKHexEditorColorScheme; + FSingleBkGnd: Boolean; + function GetColor(Index: TKHexEditorColorIndex): TColor; + function GetColorData(Index: TKHexEditorColorIndex): TKHexEditorColorData; + function GetColorEx(Index: TKHexEditorColorIndex): TColor; + function GetColorName(Index: TKHexEditorColorIndex): string; + procedure SetColor(Index: TKHexEditorColorIndex; Value: TColor); + procedure SetColorEx(Index: TKHexEditorColorIndex; Value: TColor); + procedure SetColors(const Value: TKColorArray); + public + { Performs necessary initializations } + constructor Create(AOwner: TKCustomHexEditor); + { Takes property values from another TKHexEditorColors class } + procedure Assign(Source: TPersistent); override; + { Clears cached brighter colors } + procedure ClearBrightColors; + { Initializes the color array. } + procedure Initialize; virtual; + { Specifies color scheme for reading of published properties - see GetColor in source code} + property ColorScheme: TKHexEditorColorScheme read FColorScheme write FColorScheme; + { Returns always normal color - regardless of the ColorScheme setting } + property Color[Index: TKHexEditorColorIndex]: TColor read GetColorEx write SetColorEx; + { Returns always a complete color description } + property ColorData[Index: TKHexEditorColorIndex]: TKHexEditorColorData read GetColorData; + { Returns (localizable) color name } + property ColorName[Index: TKHexEditorColorIndex]: string read GetColorName; + { Returns array of normal colors } + property Colors: TKColorArray read FColors write SetColors; + { @link(TKHexEditorColors.BkGnd) is used for all areas if True - @link(edSingleBkGnd) forward } + property SingleBkGnd: Boolean read FSingleBkGnd write FSingleBkGnd; + published + { Address area text color } + property AddressText: TColor index ciAddressText read GetColor write SetColor default cAddressTextDef; + { Address area background color } + property AddressBkGnd: TColor index ciAddressBkgnd read GetColor write SetColor default cAddressBkGndDef; + { Hex editor client area background } + property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef; + { Digits area text color - even digit group } + property DigitTextEven: TColor index ciDigitTextEven read GetColor write SetColor default cDigitTextEvenDef; + { Digits area text color - odd digit group } + property DigitTextOdd: TColor index ciDigitTextOdd read GetColor write SetColor default cDigitTextOddDef; + { Digits area background color } + property DigitBkGnd: TColor index ciDigitBkGnd read GetColor write SetColor default cDigitBkGndDef; + { Color of the horizontal leading lines } + property HorzLines: TColor index ciHorzLines read GetColor write SetColor default cHorzLinesDef; + { Inactive (hex editor without focus) caret background color - caret mark is not part of a selection } + property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef; + { Inactive (hex editor without focus) caret background color - caret mark is part of a selection } + property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef; + { Inactive (hex editor without focus) caret text color - caret mark is part of a selection } + property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef; + { Inactive (hex editor without focus) caret text color - caret mark is not part of a selection } + property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef; + { Color of horizontal leading lines involved into a selection } + property LinesHighLight: TColor index ciLinesHighLight read GetColor write SetColor default cLinesHighLightDef; + { Selection background - inactive edit area } + property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef; + { Selection background - active edit area } + property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef; + { Selection text - inactive edit area } + property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef; + { Selection text - active edit area } + property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef; + { Color of the vertical area separating lines } + property Separators: TColor index ciSeparators read GetColor write SetColor default cSeparatorsDef; + { Text area text color } + property TextText: TColor index ciTextText read GetColor write SetColor default cTextTextDef; + { Text area background color } + property TextBkgnd: TColor index ciTextBkgnd read GetColor write SetColor default cTextBkGndDef; + { Color of the vertical leading lines } + property VertLines: TColor index ciVertLines read GetColor write SetColor default cVertLinesDef; + end; + + { Declares possible values for the ItemReason member of the @link(TKHexEditorChangeItem) structure } + TKHexEditorChangeReason = ( + { Save caret position only } + crCaretPos, + { Save inserted character to be able to delete it } + crDeleteChar, + { Save inserted hexadecimal digits to be able to delete them } + crDeleteDigits, + { Save inserted binary string to be able to delete it } + crDeleteString, + { Save deleted character to be able to insert it } + crInsertChar, + { Save deleted hexadecimal digits to be able to insert them } + crInsertDigits, + { Save deleted binary string to be able to insert it } + crInsertString + ); + + { @abstract(Declares @link(TKHexEditorChangeList.OnChange) event handler) + + } + TKHexEditorUndoChangeEvent = procedure(Sender: TObject; + ItemReason: TKHexEditorChangeReason) of object; + + { @abstract(Declares the undo/redo item description structure used by the @link(TKHexEditorChangeList) class) + + } + TKHexEditorChangeItem = record + Data: AnsiString; + EditArea: TKHexEditorArea; + Group: Cardinal; + GroupReason: TKHexEditorChangeReason; + Inserted: Boolean; + ItemReason: TKHexEditorChangeReason; + SelEnd: TKHexEditorSelection; + SelStart: TKHexEditorSelection; + end; + + { Pointer to @link(TKHexEditorChangeItem) } + PKHexEditorChangeItem = ^TKHexEditorChangeItem; + + { @abstract(Change (undo/redo item) list manager) } + TKHexEditorChangeList = class(TList) + private + FEditor: TKCustomHexEditor; + FGroup: Cardinal; + FGroupUseLock: Integer; + FGroupReason: TKHexEditorChangeReason; + FIndex: Integer; + FModifiedIndex: Integer; + FLimit: Integer; + FRedoList: TKHexEditorChangeList; + FOnChange: TKHexEditorUndoChangeEvent; + function GetModified: Boolean; + procedure SetLimit(Value: Integer); + procedure SetModified(Value: Boolean); + protected + { Redefined to properly destroy the items } + procedure Notify(Ptr: Pointer; Action: TListNotification); override; + public + { Performs necessary initializations + } + constructor Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList); + { Inserts a undo/redo item + } + procedure AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString = ''; + Inserted: Boolean = True); virtual; + { Tells the undo list a new undo/redo group is about to be created. Each + BeginGroup call must have a corresponding EndGroup call (use try-finally). + BeginGroup calls may be nested, however, only the first call will create an + undo/redo group. Use the GroupReason parameter to specify the reason of this group. } + procedure BeginGroup(GroupReason: TKHexEditorChangeReason); virtual; + { Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo} + function CanPeek: Boolean; + { Clears the entire list - overriden to execute some adjustments } + procedure Clear; override; + { Completes the undo/redo group. See @link(TKHexEditorChangeList.BeginGroup) for details } + procedure EndGroup; virtual; + { Returns the topmost item to handle or inspect it} + function PeekItem: PKHexEditorChangeItem; + { If there is no reason to handle an item returned by PeekItem, it has to be + poked back with this function to become active for next undo/redo command } + procedure PokeItem; + { For redo list only - each undo command creates a redo command with the same + group information - see source } + procedure SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason); + { Specifies maximum number of items - not groups } + property Limit: Integer read FLimit write SetLimit; + { For undo list only - returns True if undo list contains some items with regard + to the eoUndoAfterSave option } + property Modified: Boolean read GetModified write SetModified; + { Allows to call TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) event} + property OnChange: TKHexEditorUndoChangeEvent read FOnChange write FOnChange; + end; + + { @abstract(Hexadecimal editor base component) } + TKCustomHexEditor = class(TKCustomControl) + private + FAddressCursor: TCursor; + FAddressMode: TKHexEditorAddressMode; + FAddressOffset: Integer; + FAddressPrefix: string; + FAddressSize: Integer; + FAreaSpacing: Integer; + FBuffer: PBytes; + FCharHeight: Integer; + FCharMapping: TKEditCharMapping; + FCharSpacing: Integer; + FCharWidth: Integer; + FClipboardFormat: Word; + FColors: TKHexEditorColors; + FDigitGrouping: Integer; + FDisabledDrawStyle: TKHexEditorDisabledDrawStyle; + FDrawStyles: TKHexEditorDrawStyles; + FEditArea: TKHexEditorArea; + FKeyMapping: TKEditKeyMapping; + FLeftChar: Integer; + FLineHeightPercent: Integer; + FLineSize: Integer; + FMouseWheelAccumulator: Integer; + FOptions: TKEditOptions; + FRedoList: TKHexEditorChangeList; + FScrollBars: TScrollStyle; + FScrollDeltaX: Integer; + FScrollDeltaY: Integer; + FScrollSpeed: Cardinal; + FScrollTimer: TTimer; + FSelEnd: TKHexEditorSelection; + FSelStart: TKHexEditorSelection; + FSize: Integer; + FStates: TKHexEditorStates; + FTopLine: Integer; + FTotalCharSpacing: Integer; + FUndoList: TKHexEditorChangeList; + FOnChange: TNotifyEvent; + FOnDropFiles: TKEditDropFilesEvent; + FOnReplaceText: TKEditReplaceTextEvent; + function GetCommandKey(Index: TKEditCommand): TKEditKey; + function GetCaretVisible: Boolean; + function GetData: TDataSize; + function GetEmpty: Boolean; + function GetFirstVisibleIndex: Integer; + function GetInsertMode: Boolean; + function GetLastVisibleIndex: Integer; + function GetLineCount: Integer; + function GetLines(Index: Integer): TDataSize; + function GetModified: Boolean; + function GetReadOnly: Boolean; + function GetSelLength: TKHexEditorSelection; + function GetSelText: TKHexEditorSelText; + function GetUndoLimit: Integer; + function IsAddressPrefixStored: Boolean; + function IsDrawStylesStored: Boolean; + function IsOptionsStored: Boolean; + procedure ScrollTimerHandler(Sender: TObject); + procedure SetAddressCursor(Value: TCursor); + procedure SetAddressMode(Value: TKHexEditorAddressMode); + procedure SetAddressOffset(Value: Integer); + procedure SetAddressPrefix(const Value: string); + procedure SetAddressSize(Value: Integer); + procedure SetAreaSpacing(Value: Integer); + procedure SetCharSpacing(Value: Integer); + procedure SetColors(Value: TKHexEditorColors); + procedure SetCommandKey(Index: TKEditCommand; Value: TKEditKey); + procedure SetData(Value: TDataSize); + procedure SetDigitGrouping(Value: Integer); + procedure SetDisabledDrawStyle(Value: TKHexEditorDisabledDrawStyle); + procedure SetDrawStyles(const Value: TKHexEditorDrawStyles); + procedure SetEditArea(Value: TKHexEditorArea); + procedure SetLeftChar(Value: Integer); + procedure SetLineHeightPercent(Value: Integer); + procedure SetLines(Index: Integer; const Value: TDataSize); + procedure SetLineSize(Value: Integer); + procedure SetModified(Value: Boolean); + procedure SetOptions(const Value: TKEditOptions); + procedure SetReadOnly(Value: Boolean); + procedure SetScrollBars(Value: TScrollStyle); + procedure SetScrollSpeed(Value: Cardinal); + procedure SetSelEnd(Value: TKHexEditorSelection); + procedure SetSelLength(Value: TKHexEditorSelection); + procedure SetSelStart(Value: TKHexEditorSelection); + procedure SetTopLine(Value: Integer); + procedure SetUndoLimit(Value: Integer); + procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; + procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE; + {$IFNDEF FPC} + // no way to get filenames in Lazarus inside control (why??) + procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES; + {$ENDIF} + procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND; + procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; + procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; + procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; + procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; + procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; + protected + { Inserts a single crCaretPos item into undo list. Unless Force is set to True, + this change will be inserted only if previous undo item is not crCaretPos. } + procedure AddUndoCaretPos(Force: Boolean = True); + { Inserts a single byte change into undo list. + } + procedure AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; + Inserted: Boolean = True); + { Inserts a byte array change into undo list. + } + procedure AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes; + Length: Integer; Inserted: Boolean = True); + { Inserts a string change into undo list. Has the same functionality as AddUndoBytes + only Data is supplied as a string. } + procedure AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString; + Inserted: Boolean = True); + { Begins a new undo group. Use the GroupReason parameter to label it. } + procedure BeginUndoGroup(GroupReason: TKHexEditorChangeReason); + { Performs necessary adjustments when the buffer is modified programatically + (not by user) } + procedure BufferChanged; + { Determines whether an ecScroll* command can be executed } + function CanScroll(Command: TKEditCommand): Boolean; virtual; + { Clears a character at position At. Doesn't perform any succesive adjustments. } + procedure ClearChar(At: Integer); + { Clears a the digit fields both in SelStart and SelEnd. Doesn't perform any succesive adjustments.} + procedure ClearDigitSelection; + { Clears a string of the Size length at position At. Doesn't perform any succesive adjustments. } + procedure ClearString(At, Size: Integer); + { Overriden method - defines additional styles for the hex editor window (scrollbars etc.)} + procedure CreateParams(var Params: TCreateParams); override; + { Overriden method - adjusts file drag&drop functionality } + procedure CreateWnd; override; + { Overriden method - adjusts file drag&drop functionality } + procedure DestroyWnd; override; + { Calls the @link(TKCustomHexEditor.OnChange) event } + procedure DoChange; virtual; + { Overriden method - handles mouse wheel messages } + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; override; + { Validates the EditArea property after it has been modified } + procedure EditAreaChanged; virtual; + { Closes the undo group created by @link(TKCustomHexEditor.BeginUndoGroup) } + procedure EndUndoGroup; + { Ensures that font pitch is always fpFixed and Font.Size is not too small or big } + procedure FontChange(Sender: TObject); virtual; + { Returns the horizontal page extent for the current edit area. This function is + used by the ecPageLeft and ecPageRight commands. } + function GetPageHorz: Integer; virtual; + { Determines if the editor has input focus. } + function HasFocus: Boolean; virtual; + { Hides the caret. } + procedure HideEditorCaret; virtual; + { Inserts a character at specified position. Doesn't perform any succesive adjustments. + } + procedure InsertChar(At: Integer; Value: Byte); + { Inserts a string at specified position. Doesn't perform any succesive adjustments. + } + procedure InsertString(At: Integer; const Value: AnsiString; Size: Integer); + { Returns True if the control has a selection. } + function InternalGetSelAvail: Boolean; override; + { Moves the caret one position left. Doesn't perform any succesive adjustments.} + procedure InternalMoveLeft; virtual; + { Moves the caret one position right. Doesn't perform any succesive adjustments.} + procedure InternalMoveRight; virtual; + { Overriden method - processes virtual key strokes according to current @link(TKCustomHexEditor.KeyMapping) } + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { Overriden method - processes character key strokes - data editing } + procedure KeyPress(var Key: Char); override; + { Updates information about printed shape. } + procedure MeasurePages(var Info: TKPrintMeasureInfo); override; + { Processes scrollbar messages. + } + procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer; + UpdateNeeded: Boolean); + { Overriden method - updates caret position/selection } + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + { Overriden method - updates caret position/selection and initializes scrolling + when needed. } + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + { Overriden method - releases mouse capture acquired by MouseDown } + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + { Overriden method - calls PaintLines for drawing the hex editor outline + into window client area } + procedure PaintToCanvas(ACanvas: TCanvas); override; + { Paints/prints hex editor outline. This function must retain its reentrancy. + } + procedure PaintLines(const Data: TKHexEditorPaintData); virtual; + { Paints a page to a printer/preview canvas. } + procedure PaintPage; override; + { Grants the input focus to the control when possible and the control has had none before } + procedure SafeSetFocus; + { Performs necessary adjustments after a selection property changed. + } + procedure SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); + { Scrolls the hex editor window horizontaly by HChars characters and/or + vertically by VChars characters } + procedure ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); + { Scrolls the hex editor window to ensure data under defined (mouse) coordinates are visible + } + procedure ScrollTo(Point: TPoint; Timed, AlwaysScroll: Boolean); virtual; + { Updates mouse cursor according to the state determined from current mouse + position. Returns True if cursor has been changed. } + function SetMouseCursor(X, Y: Integer): Boolean; override; + { Shows the caret. } + procedure ShowEditorCaret; virtual; + { Calls the @link(TKCustomHexEditor.DoChange) method} + procedure UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); + { Updates caret position, shows/hides caret according to the input focus + } + procedure UpdateEditorCaret(Recreate: Boolean = False); virtual; + { Updates font based dimensions } + procedure UpdateCharMetrics; virtual; + { Updates mouse cursor } + procedure UpdateMouseCursor; virtual; + { Updates the scrolling range } + procedure UpdateScrollRange; virtual; + { Updates selection according to the supplied coordinates. + } + procedure UpdateSelEnd(Point: TPoint; ClipToClient: Boolean); virtual; + { Updates the control size. } + procedure UpdateSize; override; + { Data buffer - made accessible for descendant classes } + property Buffer: PBytes read FBuffer write FBuffer; + { Redo list manager - made accessible for descendant classes } + property RedoList: TKHexEditorChangeList read FRedoList; + { Data buffer size - made accessible for descendant classes } + property Size: Integer read FSize write FSize; + { States of this class - made accessible for descendant classes } + property States: TKHexEditorStates read FStates write FStates; + { Undo list manager - made accessible for descendant classes } + property UndoList: TKHexEditorChangeList read FUndoList; + public + { Performs necessary initializations - default values to properties, create + undo/redo list managers } + constructor Create(AOwner: TComponent); override; + { Destroy instance, undo/redo list managers, dispose buffer... } + destructor Destroy; override; + { Appends data at current position. Use TKHexEditor.Data.Size for At parameter + to append at the end of the buffer. } + procedure Append(At: Integer; Data: TDataSize); overload; virtual; + { Appends data at current position. Use TKHexEditor.Data.Size for At parameter + to append at the end of the buffer. } + procedure Append(At: Integer; const Data: AnsiString); overload; virtual; + { Takes property values from another TKCustomHexEditor class } + procedure Assign(Source: TPersistent); override; + { Determines whether the caret is visible } + function CaretInView: Boolean; + { Clears entire data buffer. Unlike ecClearAll this method clears everything + inclusive undo a redo lists. } + procedure Clear; + { Clears undo (and redo) list } + procedure ClearUndo; + { Determines whether given command can be executed at this time. Use this + function in TAction.OnUpdate events. + } + function CommandEnabled(Command: TKEditCommand): Boolean; virtual; + { Executes given command. This function first calls CommandEnabled to + assure given command can be executed. + } + function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual; + { Returns dimensions of all 3 possible areas according to current area + definition } + function GetAreaDimensions: TKHexEditorAreaDimensions; virtual; + { Returns current character mapping. } + function GetCharMapping: TKEditCharMapping; + { Returns number of characters that vertically fit into client window } + function GetClientHeightChars: Integer; virtual; + { Returns number of characters that horizontally fit into client window } + function GetClientWidthChars: Integer; virtual; + { Returns the current key stroke mapping scheme. } + function GetKeyMapping: TKEditKeyMapping; + { Returns modified client rect - a window client rect aligned to character width and + character height } + function GetModifiedClientRect: TRect; virtual; + { Returns current maximum value for the @link(TKCustomHexEditor.LeftChar) property + } + function GetMaxLeftChar(Extent: Integer = 0): Integer; virtual; + { Returns current maximum value for the @link(TKCustomHexEditor.TopLine) property + } + function GetMaxTopLine(Extent: Integer = 0): Integer; virtual; + { Returns "real" selection end - with always higher index value than selection + start value } + function GetRealSelEnd: TKHexEditorSelection; + { Returns "real" selection start - with always lower index value than selection + end value } + function GetRealSelStart: TKHexEditorSelection; + { Loads data from a file } + procedure LoadFromFile(const FileName: TFileName); + { Loads data from a stream - stream position remains untouched } + procedure LoadFromStream(Stream: TStream); + { Paints the editor outline to another canvas + } + procedure PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar, ATopLine: Integer); + { Converts window coordinates into a selection + } + function PointToSel(P: TPoint; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; virtual; + { Saves data into a file } + procedure SaveToFile(const FileName: TFileName); + { Saves data into a stream - stream position remains untouched } + procedure SaveToStream(Stream: TStream); + { Determines whether a seletion (not digit selection) is available } + function SelAvail: Boolean; + { Determines whether a given selection is valid for given area + } + function SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; virtual; + { Converts a selection into window coordinates + } + function SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TPoint; virtual; + { Specifies character mapping. The main purpose of this is to avoid non-printable + characters in the text area and in AsText copies. Avoid non-printable characters + when delivering a new character mapping. } + procedure SetCharMapping(const Value: TKEditCharMapping); + { Specifies the current key stroke mapping scheme } + procedure SetKeyMapping(const Value: TKEditKeyMapping); + { Validates a selection for given area + } + procedure ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); virtual; + { Specifies the address area mouse cursor. Other areas have crIBeam - should not + be needed to modify that } + property AddressCursor: TCursor read FAddressCursor write SetAddressCursor default cAddressCursorDef; + { Specifies the radix of addresses } + property AddressMode: TKHexEditorAddressMode read FAddressMode write SetAddressMode default cAddressModeDef; + { Specifies the address offset } + property AddressOffset: Integer read FAddressOffset write SetAddressOffset default cAddressOffsetDef; + { Specifies the address number prefix i.e. 0x or $ - modify together with AddressMode } + property AddressPrefix: string read FAddressPrefix write SetAddressPrefix stored IsAddressPrefixStored; + { Specifies the number of address digits - up to 10 for decimal addresses } + property AddressSize: Integer read FAddressSize write SetAddressSize default cAddressSizeDef; + { Defines space between neighbour areas } + property AreaSpacing: Integer read FAreaSpacing write SetAreaSpacing default cAreaSpacingDef; + { Returns current caret position = selection end } + property CaretPos: TKHexEditorSelection read FSelEnd; + { Returns True if caret is visible } + property CaretVisible: Boolean read GetCaretVisible; + { Returns current character width = not necessarily equal to font character width } + property CharWidth: Integer read FCharWidth; + { Defines additional inter-character spacing } + property CharSpacing: Integer read FCharSpacing write SetCharSpacing default cCharSpacingDef; + { Returns current character height = not equal to font character height } + property CharHeight: Integer read FCharHeight; + { Returns the binary data clipboard format } + property ClipboardFormat: Word read FClipboardFormat; + { Makes it possible to take all color properties from another TKCustomHexEditor class } + property Colors: TKHexEditorColors read FColors write SetColors; + { Specifies a new key stroke combination for given command } + property CommandKey[Index: TKEditCommand]: TKEditKey read GetCommandKey write SetCommandKey; + { This property provides direct access to the data buffer } + property Data: TDataSize read GetData write SetData; + { Specifies the byte grouping in the digits area } + property DigitGrouping: Integer read FDigitGrouping write SetDigitGrouping default cDigitGroupingDef; + { Specifies the style how the outline is drawn when editor is disabled } + property DisabledDrawStyle: TKHexEditorDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cDisabledDrawStyleDef; + { Defines areas to paint, whether to paint horizontal and vertical trailing lines, + area separator lines and caret mark when the editor has no input focus } + property DrawStyles: TKHexEditorDrawStyles read FDrawStyles write SetDrawStyles stored IsDrawStylesStored; + { Specifies the current area for editing } + property EditArea: TKHexEditorArea read FEditArea write SetEditArea default eaDigits; + { Returns True if data buffer is empty } + property Empty: Boolean read GetEmpty; + { Returns the first visible index } + property FirstVisibleIndex: Integer read GetFirstVisibleIndex; + { Returns True if insert mode is on } + property InsertMode: Boolean read GetInsertMode; + { Returns the last visible index } + property LastVisibleIndex: Integer read GetLastVisibleIndex; + { Specifies the horizontal scroll position } + property LeftChar: Integer read FLeftChar write SetLeftChar; + { Determines the number of lines } + property LineCount: Integer read GetLineCount; + { Specifies the line height. 100% is the current font height } + property LineHeightPercent: Integer read FLineHeightPercent write SetLineHeightPercent default cLineHeightPercentDef; + { Allows to modify/add data lines. If greater than LineSize, the Size member + of the supplied TDataSize structure will be always trimmed to LineSize. + If Index points to last incomplete line or even higher, last line will be + extended/completed, i.e new data will be added to the buffer } + property Lines[Index: Integer]: TDataSize read GetLines write SetLines; + { Specifies the size (length) of a single line } + property LineSize: Integer read FLineSize write SetLineSize default cLineSizeDef; + { Returns True if the buffer was modified - eoUndoAfterSave taken into + account } + property Modified: Boolean read GetModified write SetModified; + { Specifies the editor options that do not affect painting } + property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored; + { Specifies whether the editor has to be read only editor } + property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; + { Defines visible scrollbars - horizontal, vertical or both } + property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; + { Specifies how fast the scrolling by timer should be } + property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef; + { Specifies the current selection end } + property SelEnd: TKHexEditorSelection read FSelEnd write SetSelEnd; + { Specifies the current selection length. SelStart remains unchanged, SelEnd will be + updated accordingly. To mark a selection, either set both SelStart and SelEnd properties + or both SelStart and SelLength properties } + property SelLength: TKHexEditorSelection read GetSelLength write SetSelLength; + { Specifies the current selection start } + property SelStart: TKHexEditorSelection read FSelStart write SetSelStart; + { Returns selected text in many different formats } + property SelText: TKHexEditorSelText read GetSelText; + { Specifies the vertical scroll position } + property TopLine: Integer read FTopLine write SetTopLine; + { Specifies the maximum number of undo items. Please note this value + affects the undo item limit, not undo group limit. } + property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef; + { When assigned, this event will be invoked at each buffer change, made either + by the user or programmatically by public functions } + property OnChange: TNotifyEvent read FOnChange write FOnChange; + { When assigned, this event will be invoked when the user drops any files onto + the window } + property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles; + { When assigned, this event will be invoked at each prompt-forced search match } + property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText; + end; + + { @abstract(Hexadecimal editor design-time component) } + TKHexEditor = class(TKCustomHexEditor) + published + { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressCursor) for details } + property AddressCursor; + { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressMode) for details } + property AddressMode; + { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressOffset) for details } + property AddressOffset; + { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressPrefix) for details } + property AddressPrefix; + { See TKCustomHexEditor.@link(TKCustomHexEditor.AddressSize) for details } + property AddressSize; + { Inherited property - see Delphi help } + property Align; + { Inherited property - see Delphi help } + property Anchors; + { See TKCustomControl.@link(TKCustomControl.BorderStyle) for details } + property BorderStyle; + { Inherited property - see Delphi help } + property BorderWidth; + { See TKCustomHexEditor.@link(TKCustomHexEditor.CharSpacing) for details } + property CharSpacing; + { See TKCustomHexEditor.@link(TKCustomHexEditor.Colors) for details } + property Colors; + { Inherited property - see Delphi help } + property Constraints; + {$IFNDEF FPC} + { Inherited property - see Delphi help. } + property Ctl3D; + {$ENDIF} + { See TKCustomHexEditor.@link(TKCustomHexEditor.DigitGrouping) for details } + property DigitGrouping; + { See TKCustomHexEditor.@link(TKCustomHexEditor.DisabledDrawStyle) for details } + property DisabledDrawStyle; + { Inherited property - see Delphi help } + property DragCursor; + { Inherited property - see Delphi help } + property DragKind; + { Inherited property - see Delphi help } + property DragMode; + { See TKCustomHexEditor.@link(TKCustomHexEditor.DrawStyles) for details } + property DrawStyles; + { See TKCustomHexEditor.@link(TKCustomHexEditor.EditArea) for details } + property EditArea; + { Inherited property - see Delphi help } + property Enabled; + { Inherited property - see Delphi help. Font pitch must always remain fpFixed + - specify fixed fonts only. Font.Size will also be trimmed if too small or big } + property Font; + { Inherited property - see Delphi help } + property Height default cHeight; + { See TKCustomHexEditor.@link(TKCustomHexEditor.LineHeightPercent) for details } + property LineHeightPercent; + { See TKCustomHexEditor.@link(TKCustomHexEditor.LineSize) for details } + property LineSize; + { See TKCustomHexEditor.@link(TKCustomHexEditor.Options) for details } + property Options; + { Inherited property - see Delphi help } + property ParentShowHint; + { Inherited property - see Delphi help } + property PopupMenu; + { See TKCustomHexEditor.@link(TKCustomHexEditor.ReadOnly) for details } + property ReadOnly; + { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollBars) for details } + property ScrollBars; + { See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollSpeed) for details } + property ScrollSpeed; + { Inherited property - see Delphi help } + property ShowHint; + { Inherited property - see Delphi help } + property TabOrder; + { Inherited property - see Delphi help } + property TabStop default True; + { See TKCustomHexEditor.@link(TKCustomHexEditor.UndoLimit) for details } + property UndoLimit; + { Inherited property - see Delphi help } + property Visible; + { Inherited property - see Delphi help } + property Width default cWidth; + { See TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) for details } + property OnChange; + { Inherited property - see Delphi help } + property OnClick; + { Inherited property - see Delphi help } + property OnContextPopup; + { Inherited property - see Delphi help } + property OnDblClick; + { Inherited property - see Delphi help } + property OnDockDrop; + { Inherited property - see Delphi help } + property OnDockOver; + { Inherited property - see Delphi help } + property OnDragDrop; + { Inherited property - see Delphi help } + property OnDragOver; + { See TKCustomHexEditor.@link(TKCustomHexEditor.OnDropFiles) for details } + property OnDropFiles; + { Inherited property - see Delphi help } + property OnEndDock; + { Inherited property - see Delphi help } + property OnEndDrag; + { Inherited property - see Delphi help } + property OnEnter; + { Inherited property - see Delphi help } + property OnExit; + { Inherited property - see Delphi help } + property OnGetSiteInfo; + { Inherited property - see Delphi help } + property OnKeyDown; + { Inherited property - see Delphi help } + property OnKeyPress; + { Inherited property - see Delphi help } + property OnKeyUp; + { Inherited property - see Delphi help } + property OnMouseDown; + { Inherited property - see Delphi help } + property OnMouseMove; + { Inherited property - see Delphi help } + property OnMouseUp; + { Inherited property - see Delphi help } + property OnMouseWheel; + { Inherited property - see Delphi help } + property OnMouseWheelDown; + { Inherited property - see Delphi help } + property OnMouseWheelUp; + { See TKCustomControl.@link(TKCustomControl.OnPrintNotify) for details } + property OnPrintNotify; + { See TKCustomControl.@link(TKCustomControl.OnPrintPaint) for details } + property OnPrintPaint; + { See TKCustomHexEditor.@link(TKCustomHexEditor.OnReplaceText) for details } + property OnReplaceText; + { Inherited property - see Delphi help } + property OnResize; + { Inherited property - see Delphi help } + property OnStartDock; + { Inherited property - see Delphi help } + property OnStartDrag; + { Inherited property - see Delphi help } + property OnUnDock; + end; + +{ Creates a selection structure from given Index and Digit parameters } +function MakeSelection(Index, Digit: Integer): TKHexEditorSelection; + +{ Converts a hexadecimal digit character ('0'..'F') to binary value } +function DigitToBin(Value: AnsiChar): Integer; + +{ Examines/converts hexadecimal digit string to binary value string. Returns + True if the digit string is valid. + } +function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; + +{ Converts a binary value string into binary data. If the binary value string + is not divisible by 2, it will be right padded with zero. Example: + '#A#F#0#1#D#C#0#5#3' is converted into '#AF#01#DC#05#30'. } +function BinStrToBinary(const S: AnsiString): AnsiString; + +{ Converts binary data into hexadecimal digit string. + } +function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexEditorSelection): AnsiString; + +{ Converts binary data into text using given character mapping. + } +function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Integer; + CharMapping: PKEditCharMapping): AnsiString; + +{ Replaces a hexadecimal digit in the given binary value. Returns the original + value with a replaced digit. + + Example: Value = $A18D, Digit = $C, Pos = 3: Result = $AC8D } +function ReplaceDigit(Value, Digit, Pos: Integer): Integer; + +{ Returns the instance-independent color specification for + the given color index } +function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; + +implementation + +uses +{$IFDEF USE_THEMES} + Themes, +{$ENDIF} + Math, +{$IFDEF USE_WINAPI} + ShellApi, +{$ENDIF} + ClipBrd, Printers, + Types, KGraphics; + +const + cFmtText = '%.2x'; + cBase = 16; + cDigitCount = 2; + +function MakeSelection(Index, Digit: Integer): TKHexEditorSelection; +begin + Result.Index := Index; + Result.Digit := Digit; +end; + +function DigitToBin(Value: AnsiChar): Integer; +begin + if ((Value >= 'a') and (Value <= 'f')) then Result := Ord(Value) - Ord('a') + 10 + else if ((Value >= 'A') and (Value <= 'F')) then Result := Ord(Value) - Ord('A') + 10 + else if ((Value >= '0') and (Value <= '9')) then Result := Ord(Value) - Ord('0') + else Result := -1; +end; + +function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean; +var + I, J, K: Integer; + T: AnsiString; +begin + // check and convert text characters to hex values 0..15 + Result := True; + if Convert then + SetLength(T, Length(S)); + J := 0; + for I := 1 to Length(S) do if not CharInSetEx(S[I], [#9, #32]) then + begin + K := DigitToBin(S[I]); + if K >= 0 then + begin + if Convert then + begin + Inc(J); + T[J] := AnsiChar(K) + end; + end else + begin + Result := False; + Break; + end; + end; + if Result and Convert then + begin + SetLength(T, J); + S := T; + end; +end; + +function BinStrToBinary(const S: AnsiString): AnsiString; +var + I, J, L: Integer; + B1, B2: Byte; +begin + L := Length(S); + Result := ''; + if L > 0 then + begin + SetLength(Result, DivUp(L, 2)); + if L = 1 then + Result := S + else + begin + J := 1; + for I := 1 to Length(Result) do + begin + B1 := Byte(S[J]); Inc(J); + if J <= L then + begin + B2 := Byte(S[J]); Inc(J); + end else + B2 := 0; + Result[I] := AnsiChar(B1 shl 4 + B2); + end; + end; + end; +end; + +function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexEditorSelection): AnsiString; +var + I, J: Integer; + S: AnsiString; +begin + Result := ''; + S := '%s' + cFmtText; + for I := SelStart.Index to SelEnd.Index do + begin + Result := AnsiString(Format(string(S), [Result, Buffer[I]])); + if I = SelStart.Index then + begin + for J := 0 to SelStart.Digit - 1 do + Delete(Result, 1, 1); + end; + if I = SelEnd.Index then + begin + for J := SelEnd.Digit to cDigitCount - 1 do + Delete(Result, Length(Result), 1); + end; + end; +end; + +function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Integer; + CharMapping: PKEditCharMapping): AnsiString; +var + I: Integer; +begin + if SelEnd > SelStart then + begin + SetLength(Result, SelEnd - SelStart); + System.Move(Buffer[SelStart], Result[1], SelEnd - SelStart); + if CharMapping <> nil then + for I := 1 to Length(Result) do + Result[I] := CharMapping^[Byte(Result[I])]; + end else + Result := ''; +end; + +function ReplaceDigit(Value, Digit, Pos: Integer): Integer; +var + I, Mask, O: Integer; +begin + O := 1; + for I := Pos to cDigitCount - 2 do + O := O * cBase; + Mask := cBase - 1; + Result := (((Value div O) and not Mask) + (Digit and Mask)) * O + Value mod O; +end; + +function OppositeReason(ItemReason: TKHexEditorChangeReason): TKHexEditorChangeReason; +begin + case ItemReason of + crDeleteChar: Result := crInsertChar; + crDeleteDigits: Result := crInsertDigits; + crDeleteString: Result := crInsertString; + crInsertChar: Result := crDeleteChar; + crInsertDigits: Result := crDeleteDigits; + crInsertString: Result := crDeleteString; + else + Result := ItemReason; + end; +end; + +{ TKHexEditorColors } + +constructor TKHexEditorColors.Create(AOwner: TKCustomHexEditor); +begin + FOwner := AOwner; + Initialize; + ClearBrightColors; +end; + +procedure TKHexEditorColors.Assign(Source: TPersistent); +begin + if Source is TKHexEditorColors then + begin + Colors := TKHexEditorColors(Source).Colors; + FOwner.Invalidate; + end + else + inherited; +end; + +procedure TKHexEditorColors.ClearBrightColors; +var + I: TKHexEditorColorIndex; +begin + for I := 0 to Length(FBrightColors) - 1 do + FBrightColors[I] := clNone; +end; + +function TKHexEditorColors.GetColor(Index: TKHexEditorColorIndex): TColor; +const + AreaBkGndSet = [ciAddressBkgnd, ciDigitBkGnd, ciTextBkGnd]; + BkGndSet = [ciAddressBkgnd, ciBkGnd, ciDigitBkGnd, ciInactiveCaretBkGnd, + ciInactiveCaretSelBkGnd, ciSelBkGnd, ciSelBkGndFocused, ciTextBkgnd]; +begin + case FColorScheme of + ecsGrayed: if Index in BkGndSet then Result := clWindow else Result := clGrayText; + ecsBright: + begin + if FBrightColors[Index] = clNone then + FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop); + if FSingleBkGnd and (Index in AreaBkGndSet) then + Result := FBrightColors[ciBkGnd] + else + Result := FBrightColors[Index]; + end; + ecsGrayScale: Result := ColorToGrayScale(FColors[Index]); + else + if FSingleBkGnd and (Index in AreaBkGndSet) then + Result := FColors[ciBkGnd] + else + Result := FColors[Index]; + end; +end; + +function TKHexEditorColors.GetColorData(Index: TKHexEditorColorIndex): TKHexEditorColorData; +var + ColorSpec: TKHexEditorColorSpec; +begin + Result.Index := Index; + Result.Color := FColors[Index]; + ColorSpec := GetColorSpec(Index); + Result.Default := ColorSpec.Def; + Result.Name := ColorSpec.Name; +end; + +function TKHexEditorColors.GetColorEx(Index: TKHexEditorColorIndex): TColor; +begin + Result := FColors[Index]; +end; + +function TKHexEditorColors.GetColorName(Index: TKHexEditorColorIndex): string; +begin + Result := GetColorSpec(Index).Name; +end; + +procedure TKHexEditorColors.Initialize; +var + I: TKHexEditorColorIndex; +begin + SetLength(FColors, ciHexEditorColorsMax + 1); + SetLength(FBrightColors, ciHexEditorColorsMax + 1); + for I := 0 to Length(FColors) - 1 do + FColors[I] := GetColorSpec(I).Def; +end; + +procedure TKHexEditorColors.SetColor(Index: TKHexEditorColorIndex; Value: TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + FBrightColors[Index] := clNone; + if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then + FOwner.Invalidate; + end; +end; + +procedure TKHexEditorColors.SetColorEx(Index: TKHexEditorColorIndex; Value: TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + FBrightColors[Index] := clNone; + end; +end; + +procedure TKHexEditorColors.SetColors(const Value: TKColorArray); +begin + FColors := Value; + ClearBrightColors; +end; + +{ TKHexEditorChangeList } + +constructor TKHexEditorChangeList.Create(AEditor: TKCustomHexEditor; + RedoList: TKHexEditorChangeList); +begin + inherited Create; + FEditor := AEditor; + FGroupUseLock := 0; + FLimit := cUndoLimitDef; + FIndex := -1; + FModifiedIndex := FIndex; + FRedoList := RedoList; + FOnChange := nil; +end; + +procedure TKHexEditorChangeList.AddChange(ItemReason: TKHexEditorChangeReason; + const Data: AnsiString; Inserted: Boolean); +var + P: PKHexEditorChangeItem; +begin + // don't allow succesive crCaretPos + if (ItemReason = crCaretPos) and not Inserted and (FIndex >= 0) and + (PKHexEditorChangeItem(Items[FIndex]).ItemReason = crCaretPos) then + Exit; + if FIndex < FLimit - 1 then + begin + if FIndex < Count - 1 then + Inc(FIndex) + else + FIndex := Add(New(PKHexEditorChangeItem)); + P := Items[FIndex]; + if FGroupUseLock > 0 then + begin + P.Group := FGroup; + P.GroupReason := FGroupReason; + end else + begin + P.Group := 0; + P.GroupReason := ItemReason; + end; + P.ItemReason := ItemReason; + P.EditArea := FEditor.EditArea; + P.SelEnd := FEditor.SelEnd; + P.SelStart := FEditor.SelStart; + P.Data := Data; + P.Inserted := Inserted; + if FRedoList <> nil then + FRedoList.Clear; + if Assigned(FOnChange) then + FOnChange(Self, ItemReason); + end; +end; + +procedure TKHexEditorChangeList.BeginGroup(GroupReason: TKHexEditorChangeReason); +begin + if FGroupUseLock = 0 then + begin + FGroupReason := GroupReason; + Inc(FGroup); + if FGroup = 0 then Inc(FGroup); + end; + Inc(FGroupUseLock); +end; + +function TKHexEditorChangeList.CanPeek: Boolean; +begin + Result := FIndex >= 0; +end; + +procedure TKHexEditorChangeList.Clear; +begin + inherited; + FGroupUseLock := 0; + FIndex := -1; + FModifiedIndex := FIndex; +end; + +procedure TKHexEditorChangeList.EndGroup; +begin + if FGroupUseLock > 0 then + Dec(FGroupUseLock); +end; + +function TKHexEditorChangeList.GetModified: Boolean; + + function CaretPosOnly: Boolean; + var + I: Integer; + begin + Result := True; + for I := FModifiedIndex + 1 to FIndex do + begin + if PKHexEditorChangeItem(Items[I]).ItemReason <> crCaretPos then + begin + Result := False; + Exit; + end; + end; + end; + +begin + Result := (FIndex > FModifiedIndex) and not CaretPosOnly; +end; + +procedure TKHexEditorChangeList.Notify(Ptr: Pointer; Action: TListNotification); +var + P: PKHexEditorChangeItem; +begin + case Action of + lnDeleted: + if Ptr <> nil then + begin + P := Ptr; + Dispose(P); + end; + end; +end; + +function TKHexEditorChangeList.PeekItem: PKHexEditorChangeItem; +begin + if CanPeek then + begin + Result := Items[FIndex]; + Dec(FIndex); + end else + Result := nil; +end; + +procedure TKHexEditorChangeList.PokeItem; +begin + if FIndex < Count - 1 then + Inc(FIndex); +end; + +procedure TKHexEditorChangeList.SetGroupData(Group: Integer; + GroupReason: TKHexEditorChangeReason); +begin + FGroup := Group; + FGroupReason := GroupReason; + FGroupUseLock := 1; +end; + +procedure TKHexEditorChangeList.SetLimit(Value: Integer); +begin + if Value <> FLimit then + begin + FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax); + while Count > FLimit do + Delete(0); + FIndex := Min(FIndex, FLimit - 1); + end; +end; + +procedure TKHexEditorChangeList.SetModified(Value: Boolean); +begin + if not Value then + FModifiedIndex := FIndex; +end; + +{ TKCustomHexEditor } + +constructor TKCustomHexEditor.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Color := clWindow; + ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse]; + Font.Name := cFontNameDef; + Font.Style := cFontStyleDef; + Font.Size := cFontSizeDef; + Font.Pitch := fpFixed; + Font.OnChange := FontChange; + Height := cHeight; + ParentColor := False; + ParentFont := False; + TabStop := True; + Width := cWidth; + FAddressCursor := cAddressCursorDef; + FAddressMode := cAddressModeDef; + FAddressOffset := cAddressOffsetDef; + FAddressPrefix := cAddressPrefixDef; + FAddressSize := cAddressSizeDef; + FAreaSpacing := cAreaSpacingDef; + FBuffer := nil; +{$IFNDEF FPC} + FClipBoardFormat := RegisterClipboardFormat('Any binary data'); +{$ENDIF} + FColors := TKHexEditorColors.Create(Self); + FCharHeight := 8; + FCharMapping := DefaultCharMapping; + FCharSpacing := cCharSpacingDef; + FCharWidth := 6; + FDigitGrouping := cDigitGroupingDef; + FDisabledDrawStyle := cDisabledDrawStyleDef; + FDrawStyles := cDrawStylesDef; + FEditArea := eaDigits; + FLeftChar := 0; + FLineHeightPercent := cLineHeightPercentDef; + FLineSize := cLineSizeDef; + FMouseWheelAccumulator := 0; + FOptions := [eoGroupUndo]; + FKeyMapping := CreateDefaultKeyMapping; + FRedoList := TKHexEditorChangeList.Create(Self, nil); + FScrollBars := ssBoth; + FScrollSpeed := cScrollSpeedDef; + FScrollTimer := TTimer.Create(Self); + FScrollTimer.Enabled := False; + FScrollTimer.Interval := FScrollSpeed; + FScrollTimer.OnTimer := ScrollTimerHandler; + FSelStart := MakeSelection(0, 0); + FSelEnd := MakeSelection(0, 0); + FStates := []; + FTopLine := 0; + FTotalCharSpacing := 0; + FUndoList := TKHexEditorChangeList.Create(Self, FRedoList); + FUndoList.OnChange := UndoChange; + FOnChange := nil; + FOnReplaceText := nil; + UpdateCharMetrics; +end; + +destructor TKCustomHexEditor.Destroy; +begin + inherited; + FOnChange := nil; + FColors.Free; + FUndoList.Free; + FRedoList.Free; + FreeMem(FBuffer); + FBuffer := nil; +end; + +procedure TKCustomHexEditor.AddUndoCaretPos(Force: Boolean); +begin + FUndoList.AddChange(crCaretPos, '', Force); +end; + +procedure TKCustomHexEditor.AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte; + Inserted: Boolean = True); +begin + FUndoList.AddChange(ItemReason, AnsiChar(Data), Inserted); +end; + +procedure TKCustomHexEditor.AddUndoBytes(ItemReason: TKHexEditorChangeReason; + Data: PBytes; Length: Integer; Inserted: Boolean = True); +var + S: AnsiString; +begin + if Length > 0 then + begin + SetLength(S, Length); + Move(Data^, S[1], Length); + FUndoList.AddChange(ItemReason, S, Inserted); + end; +end; + +procedure TKCustomHexEditor.AddUndoString(ItemReason: TKHexEditorChangeReason; + const S: AnsiString; Inserted: Boolean = True); +begin + if S <> '' then + FUndoList.AddChange(ItemReason, S, Inserted); +end; + +procedure TKCustomHexEditor.Append(At: Integer; Data: TDataSize); +var + S: AnsiString; +begin + if (Data.Size > 0) and (Data.Data <> nil) then + begin + SetString(S, PAnsiChar(Data.Data), Data.Size); + InsertString(At, S, Data.Size); + end; +end; + +procedure TKCustomHexEditor.Append(At: Integer; const Data: AnsiString); +begin + InsertString(At, Data, Length(Data)); +end; + +procedure TKCustomHexEditor.Assign(Source: TPersistent); +begin + if Source is TKCustomHexEditor then with Source as TKCustomHexEditor do + begin + Self.AddressCursor := AddressCursor; + Self.AddressMode := AddressMode; + Self.AddressPrefix := AddressPrefix; + Self.AddressSize := AddressSize; + Self.Align := Align; + Self.Anchors := Anchors; + Self.AutoSize := AutoSize; + Self.BiDiMode := BiDiMode; + Self.BorderStyle := BorderStyle; + Self.BorderWidth := BorderWidth; + Self.CharSpacing := CharSpacing; + Self.Color := Color; + Self.Colors := Colors; + Self.Constraints.Assign(Constraints); + {$IFNDEF FPC} + Self.Ctl3D := Ctl3D; + {$ENDIF} + Self.Data := Data; + Self.DigitGrouping := DigitGrouping; + Self.DisabledDrawStyle := DisabledDrawStyle; + Self.DragCursor := DragCursor; + Self.DragKind := DragKind; + Self.DragMode := DragMode; + Self.DrawStyles := DrawStyles; + Self.EditArea := EditArea; + Self.Enabled := Enabled; + Self.Font := Font; + {$IFNDEF FPC} + Self.ImeMode := ImeMode; + Self.ImeName := ImeName; + {$ENDIF} + Self.LineHeightPercent := LineHeightPercent; + Self.LineSize := LineSize; + Self.Modified := False; + Self.Options := Options; + Self.ParentBiDiMode := ParentBiDiMode; + Self.ParentColor := ParentColor; + {$IFNDEF FPC} + Self.ParentCtl3D := ParentCtl3D; + {$ENDIF} + Self.ParentFont := ParentFont; + Self.ParentShowHint := ParentShowHint; + Self.PopupMenu := PopupMenu; + Self.ScrollBars := ScrollBars; + Self.SelEnd := SelEnd; + Self.SelStart := SelStart; + Self.SetCharMapping(GetCharMapping); + Self.SetKeyMapping(GetKeyMapping); + Self.ShowHint := ShowHint; + Self.TabOrder := TabOrder; + Self.TabStop := TabStop; + Self.Visible := Visible; + end + else + inherited; +end; + +procedure TKCustomHexEditor.BeginUndoGroup(GroupReason: TKHexEditorChangeReason); +begin + FUndoList.BeginGroup(GroupReason); +end; + +procedure TKCustomHexEditor.BufferChanged; +begin + FUndoList.Clear; + FRedoList.Clear; + UpdateScrollRange; + SelectionChanged(False); + DoChange; +end; + +function TKCustomHexEditor.CanScroll(Command: TKEditCommand): Boolean; +var + XMax, YMax: Integer; + P: TPoint; + AD: TKHExEditorAreaDimensions; +begin + AD := GetAreaDimensions; + XMax := GetMaxLeftChar(AD.TotalHorz); + YMax := GetMaxTopLine(AD.TotalVert); + case Command of + ecScrollUp: Result := FTopLine > 0; + ecScrollDown: Result := FTopLine < YMax; + ecScrollLeft: Result := FLeftChar > 0; + ecScrollRight: Result := FLeftChar < XMax; + ecScrollCenter: + begin + P := SelToPoint(FSelEnd, FEditArea); + P.X := P.X - ClientWidth div 2; + P.Y := P.Y - ClientHeight div 2; + Result := (FLeftChar > 0) and (P.X < 0) or (FLeftChar < XMax) and (P.X > FCharWidth) or + (FTopLine > 0) and (P.Y < 0) or (FTopLine < YMax) and (P.Y > FCharHeight); + end; + else + Result := False; + end; +end; + +function TKCustomHexEditor.CaretInView: Boolean; +begin + Result := PtInRect(GetModifiedClientRect, SelToPoint(FSelEnd, FEditArea)); +end; + +procedure TKCustomHexEditor.Clear; +begin + if FBuffer <> nil then + begin + FreeMem(FBuffer); + FBuffer := nil; + FSize := 0; + BufferChanged; + end; +end; + +procedure TKCustomHexEditor.ClearChar(At: Integer); +begin + ClearString(At, 1); +end; + +procedure TKCustomHexEditor.ClearDigitSelection; +begin + FSelStart.Digit := 0; + FSelEnd.Digit := 0; +end; + +procedure TKCustomHexEditor.ClearString(At, Size: Integer); +begin + if (FBuffer <> nil) and (Size > 0) and (At >= 0) and (At + Size <= FSize) then + begin + Move(FBuffer[At + Size], FBuffer[At], (FSize - At - Size) * SizeOf(Byte)); + Dec(FSize, Size); + ReallocMem(FBuffer, FSize); + UpdateScrollRange; + Invalidate; + end; +end; + +procedure TKCustomHexEditor.ClearUndo; +begin + FUndoList.Clear; + FRedoList.Clear; +end; + +procedure TKCustomHexEditor.CMEnabledChanged(var Msg: TLMessage); +begin + inherited; + UpdateEditorCaret; + Invalidate; +end; + +procedure TKCustomHexEditor.CMSysColorChange(var Msg: TLMessage); +begin + inherited; + FColors.ClearBrightColors; +end; + +function TKCustomHexEditor.CommandEnabled(Command: TKEditCommand): Boolean; +var + L: TKHexEditorSelection; +begin + if Enabled and Visible and not (csDesigning in ComponentState) then + begin + L := SelLength; + case Command of + // movement commands + ecLeft, ecSelLeft: Result := (FSelEnd.Index > 0) or (FEditArea = eaDigits) and (FSelEnd.Digit > 0); + ecRight, ecSelRight: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); + ecUp, ecSelUp: Result := FSelEnd.Index >= FLineSize; + ecDown, ecSelDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); + ecLineStart, ecSelLineStart: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize > 0); + ecLineEnd, ecSelLineEnd: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); + ecPageUp, ecSelPageUp: Result := FSelEnd.Index >= FlineSize; + ecPageDown, ecSelPageDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize div FLineSize * FLineSize); + ecPageLeft, ecSelPageLeft: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize > 0); + ecPageRight, ecSelPageRight: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize)); + ecPageTop, ecSelPageTop: Result := (FEditArea <> eaNone) and (FSelEnd.Index > 0) and (SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y div FCharHeight <> 0); + ecPageBottom, ecSelPageBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize) and ((ClientHeight - SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y) div FCharHeight - 1 <> 0); + ecEditorTop, ecSelEditorTop: Result := FSelEnd.Index > 0; + ecEditorBottom, ecSelEditorBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize); + ecGotoXY, ecSelGotoXY: Result := True; + // scroll commands + ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command); + // editing commands + ecUndo: Result := not ReadOnly and FUndoList.CanPeek; + ecRedo: Result := not ReadOnly and FRedoList.CanPeek; + ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((L.Index <> 0) or (L.Digit <> 0)); + ecPaste: Result := not ReadOnly and (FEditArea <> eaNone) and (ClipBoard.FormatCount > 0); + ecInsertChar: Result := not ReadOnly and (FEditArea <> eaNone); + ecInsertDigits: Result := not ReadOnly and (FEditArea = eaDigits); + ecInsertString: Result := not ReadOnly and (FEditArea <> eaNone); + ecDeleteLastChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index > 0)); + ecDeleteChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index < FSize)); + ecDeleteBOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0)); + ecDeleteEOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize < Min(FLineSize, FSize))); + ecDeleteLine: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Index < FSize)); + ecSelectAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); + ecClearAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone); + ecClearIndexSelection, ecClearSelection: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and (L.Index > 0); + ecSearch: Result := not Empty; + ecReplace: Result := not (Empty or ReadOnly); + ecInsertMode: Result := elOverwrite in FStates; + ecOverwriteMode: Result := not (elOverwrite in FStates); + else + Result := True; + end; + end else + Result := False; +end; + +procedure TKCustomHexEditor.CreateParams(var Params: TCreateParams); +begin + inherited; + with Params do + begin + if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; + if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; + end; +end; + +procedure TKCustomHexEditor.CreateWnd; +begin + inherited; +{$IFDEF USE_WINAPI} + if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then + DragAcceptFiles(Handle, TRUE); +{$ENDIF} +end; + +procedure TKCustomHexEditor.DestroyWnd; +begin +{$IFDEF USE_WINAPI} + if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then + DragAcceptFiles(Handle, FALSE); +{$ENDIF} + inherited; +end; + +procedure TKCustomHexEditor.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +function TKCustomHexEditor.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +const + WHEEL_DIVISOR = 120; +var + LinesToScroll, WheelClicks: Integer; +begin + Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); + if not Result then + begin + if ssCtrl in Shift then + LinesToScroll := GetModifiedClientRect.Bottom div FCharHeight + else + LinesToScroll := 3; + Inc(FMouseWheelAccumulator, WheelDelta); + WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR; + FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR; + ScrollBy(0, - WheelClicks * LinesToScroll, True); + Result := True; + end; +end; + +procedure TKCustomHexEditor.EditAreaChanged; +begin + if FEditArea = eaNone then + FEditArea := eaDigits; + if not (edAddress in FDrawStyles) and (FEditArea = eaAddress) then + FEditArea := eaDigits; + if not (edDigits in FDrawStyles) and (FEditArea = eaDigits) then + FEditArea := eaText; + if not (edText in FDrawStyles) and (FEditArea = eaText) then + if edDigits in FDrawStyles then + FEditArea := eaDigits + else + FEditArea := eaNone; +end; + +procedure TKCustomHexEditor.EndUndoGroup; +begin + FUndoList.EndGroup; +end; + +function TKCustomHexEditor.ExecuteCommand(Command: TKEditCommand; + Data: Pointer): Boolean; +var + I, J, K, M, N, O: Integer; + CanInsert, MoreBytes, Found, MatchCase: Boolean; + C1, C2, C3: AnsiChar; + S, S_FirstChar, S_LastChar, T: AnsiString; + P: TPoint; + Area: TKHexEditorArea; + L, OldSelStart, OldSelEnd, Sel1, Sel2: TKHexEditorSelection; + PChI, PChI_First, PChI_Next: PKHexEditorChangeItem; + PSD: PKEditSearchData; + ReplaceAction: TKEditReplaceAction; +{$IFNDEF FPC} + BA: PBytes; + H: THandle; +{$ENDIF} +begin + Result := False; + if CommandEnabled(Command) then + begin + Result := True; + L := SelLength; + OldSelEnd := FSelEnd; + OldSelStart := FSelStart; + case Command of + ecLeft..ecSelGotoXY: AddUndoCaretPos(False); + end; + case Command of + ecLeft, ecSelLeft: + begin + InternalMoveLeft; + SelectionChanged(Command <> ecSelLeft); + end; + ecRight, ecSelRight: + begin + InternalMoveRight; + SelectionChanged(Command <> ecSelRight); + end; + ecUp, ecSelUp: + begin + Dec(FSelEnd.Index, FLineSize); + SelectionChanged(Command <> ecSelUp); + end; + ecDown, ecSelDown: + begin + Inc(FSelEnd.Index, FLineSize); + SelectionChanged(Command <> ecSelDown); + end; + ecLineStart, ecSelLineStart: + begin + FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize, 0); + SelectionChanged(Command <> ecSelLineStart); + end; + ecLineEnd, ecSelLineEnd: + begin + FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize + FLineSize - 1, cDigitCount - 1); + SelectionChanged(Command <> ecSelLineEnd); + end; + ecPageUp, ecSelPageUp: + begin + Dec(FSelEnd.Index, Min(ClientHeight div FCharHeight, FSelEnd.Index div FLineSize) * FLineSize); + SelectionChanged(Command <> ecSelPageUp); + end; + ecPageDown, ecSelPageDown: + begin + Inc(FSelEnd.Index, Min(ClientHeight div FCharHeight, (FSize - FSelEnd.Index) div FLineSize) * FLineSize); + SelectionChanged(Command <> ecSelPageDown); + end; + ecPageLeft, ecSelPageLeft: + begin + Dec(FSelEnd.Index, Min(GetPageHorz, FSelEnd.Index mod FLineSize)); + SelectionChanged(Command <> ecSelPageLeft); + end; + ecPageRight, ecSelPageRight: + begin + Inc(FSelEnd.Index, Min(GetPageHorz, FLineSize - 1 - FSelEnd.Index mod FLineSize)); + SelectionChanged(Command <> ecSelPageRight); + end; + ecPageTop, ecSelPageTop: + begin + P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); + Dec(FSelEnd.Index, P.Y div FCharHeight * FLineSize); + SelectionChanged(Command <> ecSelPageTop); + end; + ecPageBottom, ecSelPageBottom: + begin + P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea); + Inc(FSelEnd.Index, ((ClientHeight - P.Y) div FCharHeight - 1) * FLineSize); + SelectionChanged(Command <> ecSelPageBottom); + end; + ecEditorTop, ecSelEditorTop: + begin + FSelEnd := MakeSelection(0, 0); + SelectionChanged(Command <> ecSelEditorTop); + end; + ecEditorBottom, ecSelEditorBottom: + begin + FSelEnd := MakeSelection(FSize, 0); + SelectionChanged(Command <> ecSelEditorBottom); + end; + ecGotoXY, ecSelGotoXY: + begin + Sel1 := PointToSel(PPoint(Data)^, False, Area); + if Area <> eaNone then + begin + FSelEnd := Sel1; + FEditArea := Area; + SelectionChanged(Command <> ecSelGotoXY); + end else + Result := False; + end; + // scroll commands + ecScrollUp: + begin + if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y >= GetModifiedClientRect.Bottom - FCharHeight) then + begin + ScrollBy(0, -1, False); + Dec(FSelEnd.Index, FLineSize); + SelectionChanged(True, False); + Invalidate; + end else + ScrollBy(0, -1, True); + end; + ecScrollDown: + begin + if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y <= GetModifiedClientRect.Top) then + begin + ScrollBy(0, 1, False); + Inc(FSelEnd.Index, FLineSize); + SelectionChanged(True, False); + Invalidate; + end else + ScrollBy(0, 1, True); + end; + ecScrollLeft: + begin + if FEditArea <> eaNone then + begin + // overscroll check + P := SelToPoint(MakeSelection(0, 0), FEditArea); + if P.X < GetModifiedClientRect.Right - FCharWidth then + begin + ScrollBy(-1, 0, True); + P := SelToPoint(FSelEnd, FEditArea); + if (P.X >= GetModifiedClientRect.Right) and ((FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Digit > 0)) then + ExecuteCommand(ecLeft) + end; + end else + ScrollBy(-1, 0, True); + end; + ecScrollRight: + begin + if FEditArea <> eaNone then + begin + // overscroll check + P := SelToPoint(MakeSelection(FLineSize - 1, cDigitCount - 1), FEditArea); + if P.X > 0 then + begin + ScrollBy(1, 0, True); + P := SelToPoint(FSelEnd, FEditArea); + if (P.X < 0) and ((FSelEnd.Index mod FLineSize < FLineSize - 1) or (FSelEnd.Digit < cDigitCount - 1)) then + ExecuteCommand(ecRight) + end; + end else + ScrollBy(1, 0, True); + end; + ecScrollCenter: + begin + P := SelToPoint(FSelEnd, FEditArea); + I := (P.X - ClientWidth div 2) div FCharWidth; + J := (P.Y - ClientHeight div 2) div FCharHeight; + ScrollBy(I, J, True); + end; + // editing commands + ecUndo: + begin + PChI := FUndoList.PeekItem; + PChI_First := PChI; + while PChI <> nil do + begin + I := Length(PChI.Data); + J := Min(I, FSize - PChI.SelEnd.Index); + FRedoList.SetGroupData(PChI.Group, PChI.GroupReason); + case PChI.ItemReason of + crCaretPos: + FRedoList.AddChange(crCaretPos, ''); + crDeleteChar, crDeleteDigits, crDeleteString: + begin + if FBuffer <> nil then + begin + SetLength(S, J); + System.Move(FBuffer[PChI.SelEnd.Index], S[1], J); + end else + S := ''; + FRedoList.AddChange(OppositeReason(PChI.ItemReason), S, PChI.Inserted); + end; + crInsertChar, crInsertDigits, crInsertString: + FRedoList.AddChange(OppositeReason(PChI.ItemReason), PChI.Data); + end; + FSelEnd := PChI.SelEnd; + FSelStart := PChI.SelStart; + FEditArea := PChI.EditArea; + case PChI.ItemReason of + crDeleteChar, crDeleteDigits, crDeleteString: + begin + if PChI.Inserted then + ClearString(PChI.SelEnd.Index, I) + else if FBuffer <> nil then + begin + System.Move(PChI.Data[1], FBuffer[PChI.SelEnd.Index], J); + Invalidate; + end; + end; + crInsertChar, crInsertDigits, crInsertString: + InsertString(GetRealSelStart.Index, PChI.Data, I); + end; + EditAreaChanged; + SelectionChanged(False, False); + if PChI.ItemReason <> crCaretPos then + DoChange; + PChI_Next := FUndoList.PeekItem; + if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or + (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then + begin + FUndoList.PokeItem; + Break; + end; + PChI := PChI_Next; + end; + if not CaretInView then + ExecuteCommand(ecScrollCenter); + end; + ecRedo: + begin + PChI := FRedoList.PeekItem; + PChI_First := PChI; + while PChI <> nil do + begin + FUndoList.PokeItem; + I := Length(PChI.Data); + Sel1 := GetRealSelStart; + case PChI.ItemReason of + crInsertChar, crInsertDigits, crInsertString: + begin + if PChI.Inserted then + InsertString(Sel1.Index, PChI.Data, I) + else if FBuffer <> nil then + begin + System.Move(PChI.Data[1], FBuffer[Sel1.Index], Min(I, FSize - FSelEnd.Index)); + Invalidate; + end; + end; + crDeleteChar, crDeleteDigits, crDeleteString: + ClearString(Sel1.Index, I); + end; + FSelEnd := PChI.SelEnd; + FSelStart := PChI.SelStart; + FEditArea := PChI.EditArea; + EditAreaChanged; + SelectionChanged(False, False); + if PChI.ItemReason <> crCaretPos then + DoChange; + PChI_Next := FRedoList.PeekItem; + if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or + (eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then + begin + FRedoList.PokeItem; + Break; + end; + PChI := PChI_Next; + end; + if not CaretInView then + ExecuteCommand(ecScrollCenter); + end; + ecCopy: + begin + Sel1 := GetRealSelStart; + Sel2 := GetRealSelEnd; + {$IFDEF FPC} + ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) + {$ELSE} + if FEditArea = eaDigits then + ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2)) + else if L.Index <> 0 then + begin + S := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); + H := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, L.Index); + try + BA := GlobalLock(H); + try + System.Move(FBuffer[Sel1.Index], BA^, L.Index); + finally + GlobalUnlock(H); + end; + ClipBoard.Open; + try + ClipBoard.SetAsHandle(FClipboardFormat, H); + ClipBoard.AsText := string(S); + finally + ClipBoard.Close; + end; + except + GlobalFree(H); + end; + end; + {$ENDIF} + end; + ecCut: + begin + ExecuteCommand(ecCopy); + ExecuteCommand(ecClearSelection); + end; + ecPaste: + begin + if L.Index > 0 then + ExecuteCommand(ecClearSelection); + if ClipBoard.FormatCount > 0 then + begin + S := ''; + {$IFNDEF FPC} + H := 0; + // paste as binary data + if ClipBoard.HasFormat(FClipboardFormat) then + H := ClipBoard.GetAsHandle(FClipboardFormat) else + {$ENDIF} + if ClipBoard.HasFormat(CF_TEXT) then + begin + S := AnsiString(ClipBoard.AsText); + if S <> '' then + begin + M := Length(S); + if (FEditArea = eaDigits) and ExecuteCommand(ecInsertDigits, Pointer(S)) then + begin + S := ''; + if M >= cDigitCount then + begin + Inc(FSelEnd.Index, M div cDigitCount) + end else + begin + Inc(FSelEnd.Digit, M); + if FSelEnd.Digit >= cDigitCount then + begin + Inc(FSelEnd.Index); + FSelEnd.Digit := FSelEnd.Digit mod cDigitCount; + end; + end; + SelectionChanged(True); + end else + ExecuteCommand(ecInsertString, Pointer(S)); + end; + end + {$IFNDEF FPC} + else + H := ClipBoard.GetAsHandle(ClipBoard.Formats[0]); + if H <> 0 then + begin + BA := GlobalLock(H); + try + I := GlobalSize(H); + if I > 0 then + begin + SetLength(S, I); + System.Move(BA^, S[1], I); + end; + finally + GlobalUnlock(H); + end; + if S <> '' then + ExecuteCommand(ecInsertString, Pointer(S)); + end + {$ENDIF} + ; + if S <> '' then + begin + Inc(FSelEnd.Index, Length(S)); + FSelEnd.Digit := 0; + SelectionChanged(True); + end; + end; + end; + ecInsertChar: + begin + BeginUndoGroup(crInsertChar); + try + N := PByte(Data)^; + if L.Index > 0 then + ExecuteCommand(ecClearSelection); + ValidateSelection(FSelEnd, FEditArea); + if FBuffer <> nil then + I := FBuffer[FSelEnd.Index] + else + I := 0; + CanInsert := (FBuffer = nil) or (FSelEnd.Digit = 0) and + (not (elOverwrite in FStates) or (FSelEnd.Index = FSize)); + AddUndoByte(crDeleteChar, I, CanInsert); + if CanInsert then + InsertChar(FSelEnd.Index, 0) + else + Invalidate; + case FEditArea of + eaDigits: + begin + FBuffer[FSelEnd.Index] := ReplaceDigit(FBuffer[FSelEnd.Index], N, FSelEnd.Digit); + InternalMoveRight; + end; + eaText: + begin + FBuffer[FSelEnd.Index] := N; + InternalMoveRight; + end; + end; + SelectionChanged(True); + finally + EndUndoGroup; + end; + end; + ecInsertDigits: + begin + S := AnsiString(Data); + if (S <> '') and DigitsToBinStr(S) then + begin + BeginUndoGroup(crInsertDigits); + try + if L.Index > 0 then + ExecuteCommand(ecClearSelection); + ValidateSelection(FSelEnd, FEditArea); + MoreBytes := Length(S) >= cDigitCount; + if MoreBytes then + // we don't move digit positions of the remaining block + SetLength(S, Length(S) div cDigitCount * cDigitCount); + J := 0; + if (FBuffer <> nil) and (not MoreBytes or (FSelEnd.Digit > 0)) then + begin + I := FBuffer[FSelEnd.Index]; + S_FirstChar := AnsiChar(I); + S_LastChar := S_FirstChar; + // split current byte + AddUndoByte(crInsertChar, I); + ClearChar(FSelEnd.Index); + N := Length(S); + for I := FSelEnd.Digit to cDigitCount - 1 do + begin + if J < N then + begin + Inc(J); + S_FirstChar := AnsiChar(ReplaceDigit(Ord(S_FirstChar[1]), Ord(S[J]), I)); + end else + Break; + end; + K := Length(S); + if K > J then + for I := FSelEnd.Digit - 1 downto 0 do + begin + if K > J then + begin + S_LastChar := AnsiChar(ReplaceDigit(Ord(S_LastChar[1]), Ord(S[K]), I)); + Dec(K); + end else + Break; + end + else + S_LastChar := ''; + O := cDigitCount; + end else + begin + S_FirstChar := ''; + S_LastChar := ''; + O := 0; + end; + T := ''; + if MoreBytes then + begin + N := Length(S) - O; + O := J; + for I := 0 to N div cDigitCount - 1 do + begin + K := 0; + for J := 1 to cDigitCount do + begin + K := K * cBase; + M := I * 2 + J + O; + Inc(K, Ord(S[M])); + end; + T := AnsiString(Format('%s%s', [T, Char(K)])); + end; + end; + S := S_FirstChar + T + S_LastChar; + // always insert (don't overwrite) + AddUndoString(crDeleteDigits, S); + InsertString(FSelEnd.Index, S, Length(S)); + SelectionChanged(True); + finally + EndUndoGroup; + end; + end else + Result := False; + end; + ecInsertString: + begin + S := AnsiString(Data); + if S <> '' then + begin + BeginUndoGroup(crInsertString); + try + if L.Index > 0 then + ExecuteCommand(ecClearIndexSelection); + // always insert (don't overwrite) + AddUndoString(crDeleteString, S); + InsertString(FSelEnd.Index, S, Length(S)); + SelectionChanged(True); + finally + EndUndoGroup; + end; + end else + Result := False; + end; + ecDeleteLastChar: + begin + if L.Index <> 0 then ExecuteCommand(ecClearSelection) else + begin + BeginUndoGroup(crDeleteString); + try + AddUndoCaretPos; + FSelStart.Index := FSelEnd.Index - 1; + ExecuteCommand(ecClearIndexSelection) + finally + EndUndoGroup; + end; + end; + end; + ecDeleteChar: + begin + if L.Index <> 0 then ExecuteCommand(ecClearSelection) else + begin + BeginUndoGroup(crDeleteString); + try + AddUndoCaretPos; + FSelStart.Index := FSelEnd.Index + 1; + ExecuteCommand(ecClearIndexSelection) + finally + EndUndoGroup; + end; + end; + end; + ecDeleteBOL: + begin + if L.Index <> 0 then ExecuteCommand(ecClearSelection) else + begin + BeginUndoGroup(crDeleteString); + try + AddUndoCaretPos; + FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; + ExecuteCommand(ecClearIndexSelection) + finally + EndUndoGroup; + end; + end; + end; + ecDeleteEOL: + begin + if L.Index <> 0 then ExecuteCommand(ecClearSelection) else + begin + BeginUndoGroup(crDeleteString); + try + AddUndoCaretPos; + FSelStart.Index := Min((FSelEnd.Index div FLineSize + 1) * FLineSize, FSize); + ExecuteCommand(ecClearIndexSelection) + finally + EndUndoGroup; + end; + end; + end; + ecDeleteLine: + begin + if L.Index <> 0 then ExecuteCommand(ecClearSelection) else + begin + BeginUndoGroup(crDeleteString); + try + AddUndoCaretPos; + FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize; + FSelEnd.Index := Min(FSelStart.Index + FLineSize, FSize); + ExecuteCommand(ecClearIndexSelection) + finally + EndUndoGroup; + end; + end; + end; + ecSelectAll: + begin + AddUndoCaretPos; + FSelStart := MakeSelection(0, 0); + FSelEnd := MakeSelection(FSize, 0); + SelectionChanged(False); + end; + ecClearAll: + begin + ExecuteCommand(ecSelectAll); + ExecuteCommand(ecClearIndexSelection); + end; + ecClearIndexSelection: + begin + I := GetRealSelStart.Index; + AddUndoBytes(crInsertString, PBytes(@FBuffer[I]), L.Index, True); + ClearString(I, L.Index); + FSelEnd := MakeSelection(I, 0); + SelectionChanged(True); + end; + ecClearSelection: + begin + Sel1 := GetRealSelStart; + Sel2 := GetRealSelEnd; + if (Sel1.Digit > 0) {and (Sel1.Digit + Sel2.Digit = cDigitCount) }then + begin + BeginUndoGroup(crDeleteDigits); + try + // digit clear mode + AddUndoCaretPos; + FSelEnd := MakeSelection(Sel1.Index + 1, 0); + FSelStart := FSelEnd; + if Sel2.Digit = 0 then + begin + Dec(L.Index); + N := FBuffer[Sel2.Index - 1]; + end else + N := FBuffer[Sel2.Index]; + AddUndoBytes(crInsertDigits, PBytes(@FBuffer[FSelEnd.Index]), L.Index, True); + ClearString(FSelEnd.Index, L.Index); + FSelEnd := Sel1; + AddUndoByte(crDeleteChar, FBuffer[Sel1.Index], False); + for I := Sel1.Digit to cDigitCount - 1 do + begin + FBuffer[Sel1.Index] := ReplaceDigit(FBuffer[Sel1.Index], N mod cBase, I); + N := N div cBase; + end; + SelectionChanged(True); + finally + EndUndoGroup; + end; + end else + ExecuteCommand(ecClearIndexSelection); + end; + ecSearch, ecReplace: + begin + // doesn't search for single digits + PSD := Data; + if PSD <> nil then + begin + PSD.ErrorReason := eseOk; + S := AnsiString(PSD.TextToFind); + if Command = ecReplace then + begin + T := AnsiString(PSD.TextToReplace); + ReplaceAction := eraYes; + end; + if esoSelectedOnly in PSD.Options then + if esoFirstSearch in PSD.Options then + begin + PSD.SelStart := GetRealSelStart.Index; + PSD.SelEnd := GetRealSelEnd.Index; + end else + begin + PSD.SelStart := MinMax(PSD.SelStart, 0, FSize); + PSD.SelEnd := MinMax(PSD.SelEnd, 0, FSize); + end; + if esoFirstSearch in PSD.Options then + Exclude(PSD.Options, esoWereDigits); + if esoTreatAsDigits in PSD.Options then + begin + if DigitsToBinStr(S) then + begin + S := BinStrToBinary(S); + if Command = ecReplace then + begin + if DigitsToBinStr(T) then + begin + T := BinStrToBinary(T); + PSD.TextToFind := string(S); + PSD.TextToReplace := string(T); + Exclude(PSD.Options, esoTreatAsDigits); + Include(PSD.Options, esoWereDigits); + end else + PSD.ErrorReason := eseNoDigitsReplace; + end else + begin + PSD.TextToFind := string(S); + Exclude(PSD.Options, esoTreatAsDigits); + Include(PSD.Options, esoWereDigits); + end; + end else + PSD.ErrorReason := eseNoDigitsFind; + end; + if PSD.ErrorReason = eseOk then + begin + N := Length(S); + if esoBackwards in PSD.Options then + begin + O := -1; + if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then + I := FSize + else + I := GetRealSelStart.Index - 1; + if esoSelectedOnly in PSD.Options then + begin + M := PSD.SelStart; + if esoFirstSearch in PSD.Options then + I := PSD.SelEnd + end else + M := 0; + I := Min(I, FSize - N); + if I < M then + PSD.ErrorReason := eseNoMatch + end else + begin + O := 1; + if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then + I := 0 + else + I := GetRealSelEnd.Index; + if esoSelectedOnly in PSD.Options then + begin + M := PSD.SelEnd; + if esoFirstSearch in PSD.Options then + I := PSD.SelStart + end else + M := FSize; + M := Min(M, FSize - N); + if I >= M then + PSD.ErrorReason := eseNoMatch + end; + if PSD.ErrorReason = eseOk then + begin + Found := False; + MatchCase := PSD.Options * [esoMatchCase, esoWereDigits] <> []; + if MatchCase then + C1 := S[1] + else + C1 := UpCase(S[1]); + I := MinMax(I, 0, FSize - 1); + while I <> M do + begin + if MatchCase then + C2 := AnsiChar(FBuffer[I]) + else + C2 := UpCase(AnsiChar(FBuffer[I])); + if C1 = C2 then + begin + if FSize - I >= N then + begin + J := 2; + Dec(I); + while (J <= N) do + begin + if MatchCase then + begin + C2 := AnsiChar(FBuffer[I + J]); + C3 := S[J]; + end else + begin + C2 := Upcase(AnsiChar(FBuffer[I + J])); + C3 := Upcase(S[J]); + end; + if C2 = C3 then + Inc(J) + else + Break; + end; + Inc(I); + if J = N + 1 then + begin + Found := True; + FSelStart := MakeSelection(I, 0); + FSelEnd := MakeSelection(I + N, 0); + if Command = ecReplace then + begin + if (esoPrompt in PSD.Options) and Assigned(FOnReplaceText) then + begin + SelectionChanged(False, False); + if not CaretInView then + ExecuteCommand(ecScrollCenter); + FOnReplaceText(Self, string(S), string(T), ReplaceAction) + end else + ReplaceAction := eraYes; + case ReplaceAction of + eraCancel: Break; + eraYes, eraAll: + begin + if T = '' then + ExecuteCommand(ecClearIndexSelection) + else + ExecuteCommand(ecInsertString, Pointer(T)); + FSelEnd := MakeSelection(I + Length(T), 0); + AddUndoCaretPos; + if ReplaceAction = eraAll then + Include(PSD.Options, esoAll); + end; + end; + if not (esoAll in PSD.Options) then + Break; + end else + Break; + end + end; + end; + Inc(I, O); + end; + if Found then + begin + SelectionChanged(False, False); + if not CaretInView then + ExecuteCommand(ecScrollCenter); + end else + PSD.ErrorReason := eseNoMatch; + end; + end; + Exclude(PSD.Options, esoFirstSearch); + end else + Result := False; + end; + ecInsertMode: + begin + Exclude(FStates, elOverwrite); + UpdateEditorCaret(True); + end; + ecOverwriteMode: + begin + Include(FStates, elOverwrite); + UpdateEditorCaret(True); + end; + ecToggleMode: + begin + if elOverwrite in FStates then + Exclude(FStates, elOverwrite) + else + Include(FStates, elOverwrite); + UpdateEditorCaret(True); + end; + // focus change + ecGotFocus, + ecLostFocus: + begin + UpdateEditorCaret; + Invalidate; + end; + end; + if (OldSelStart.Index <> OldSelEnd.Index) or (FSelStart.Index <> FSelEnd.Index) or + (OldSelStart.Digit <> OldSelEnd.Digit) or (FSelStart.Digit <> FSelEnd.Digit) or + not (elCaretVisible in FStates) and (edInactiveCaret in FDrawStyles) and + ((FSelStart.Index <> OldSelStart.Index) or (FSelStart.Digit <> OldSelStart.Digit) or + (FSelEnd.Index <> OldSelEnd.Index) or (FSelEnd.Digit <> OldSelEnd.Digit)) then + Invalidate; + end; +end; + +procedure TKCustomHexEditor.FontChange(Sender: TObject); +begin + if not (csDestroying in ComponentState) then + begin + Font.Pitch := fpFixed; + if Font.Size >= 0 then + Font.Size := MinMax(Font.Size, cFontSizeMin, cFontSizeMax); + UpdateCharMetrics; + UpdateScrollRange; + end; +end; + +function TKCustomHexEditor.GetAreaDimensions: TKHexEditorAreaDimensions; +begin + FillChar(Result, SizeOf(Result), 0); + with Result do + begin + if edAddress in FDrawStyles then + begin + Address := Length(FAddressPrefix) + FAddressSize; + if FDrawStyles * [edDigits, edText] <> [] then + AddressOut := FAreaSpacing; + end; + if edDigits in FDrawStyles then + begin + Digits := FLineSize * cDigitCount + FLineSize div FDigitGrouping; + if FLineSize mod FDigitGrouping = 0 then + Dec(Digits); + if edAddress in FDrawStyles then + DigitsIn := FAreaSpacing; + if edText in FDrawStyles then + DigitsOut := FAreaSpacing; + end; + if edText in FDrawStyles then + begin + Text := FLineSize; + if FDrawStyles * [edAddress, edDigits] <> [] then + TextIn := FAreaSpacing; + end; + TotalHorz := Address + AddressOut + Digits + DigitsIn + DigitsOut + Text + TextIn; + if [edAddress, edDigits, edText] * FDrawStyles <> [] then + TotalVert := LineCount + else + TotalVert := 0; + end; +end; + +function TKCustomHexEditor.GetCaretVisible: Boolean; +begin + Result := elCaretVisible in FStates; +end; + +function TKCustomHexEditor.GetCharMapping: TKEditCharMapping; +begin + Result := FCharMapping; +end; + +function TKCustomHexEditor.GetClientHeightChars: Integer; +begin + Result := ClientHeight div FCharHeight; +end; + +function TKCustomHexEditor.GetClientWidthChars: Integer; +begin + Result := ClientWidth div FCharWidth; +end; + +function TKCustomHexEditor.GetCommandKey(Index: TKEditCommand): TKEditKey; +var + I: Integer; +begin + Result.Key := 0; + Result.Shift := []; + for I := 0 to Length(FKeyMapping) - 1 do + if FKeyMapping[I].Command = Index then + begin + Result := FKeyMapping[I].Key; + Exit; + end; +end; + +function TKCustomHexEditor.GetData: TDataSize; +begin + Result.Data := FBuffer; + Result.Size := FSize; +end; + +function TKCustomHexEditor.GetEmpty: Boolean; +begin + Result := FBuffer = nil; +end; + +function TKCustomHexEditor.GetFirstVisibleIndex: Integer; +begin + Result := PointToSel(Point(0, 0), False, FEditArea).Index; +end; + +function TKCustomHexEditor.GetInsertMode: Boolean; +begin + Result := not (elOverwrite in FStates); +end; + +function TKCustomHexEditor.GetKeyMapping: TKEditKeyMapping; +begin + Result := FKeyMapping; +end; + +function TKCustomHexEditor.GetLastVisibleIndex: Integer; +begin + Result := PointToSel(GetModifiedClientRect.BottomRight, False, FEditArea).Index; +end; + +function TKCustomHexEditor.GetLineCount: Integer; +begin + Result := DivUp(FSize + 1, FLineSize); +end; + +function TKCustomHexEditor.GetLines(Index: Integer): TDataSize; +var + I: Integer; +begin + I := Index * FLineSize; + if (FBuffer <> nil) and (I >= 0) and (I < FSize) then + begin + Result.Data := @FBuffer[I]; + Result.Size := Min(FLineSize, FSize - I); + end else + begin + Result.Data := nil; + Result.Size := 0; + end; +end; + +function TKCustomHexEditor.GetModified: Boolean; +begin + Result := (elModified in FStates) or FUndoList.Modified; +end; + +function TKCustomHexEditor.GetModifiedClientRect: TRect; +begin + Result := Rect(0, 0, GetClientWidthChars * FCharWidth, GetClientHeightChars * FCharHeight); +end; + +function TKCustomHexEditor.GetMaxLeftChar(Extent: Integer): Integer; +begin + if Extent <= 0 then + Extent := GetAreaDimensions.TotalHorz; + Result := Max(Extent - GetClientWidthChars, 0); +end; + +function TKCustomHexEditor.GetMaxTopLine(Extent: Integer): Integer; +begin + if Extent <= 0 then + Extent := GetAreaDimensions.TotalVert; + Result := Max(Extent - GetClientHeightChars, 0); +end; + +function TKCustomHexEditor.GetPageHorz: Integer; +begin + case FEditArea of + eaDigits: Result := ClientWidth * FDigitgrouping div (FCharWidth * (cDigitCount * FDigitGrouping + 1)); + eaText: Result := ClientWidth div FCharWidth; + else + Result := 0; + end; +end; + +function TKCustomHexEditor.GetReadOnly: Boolean; +begin + Result := elReadOnly in FStates; +end; + +function TKCustomHexEditor.GetRealSelEnd: TKHexEditorSelection; +begin + if FSelStart.Index <= FSelEnd.Index then + Result := FSelEnd + else + Result := FSelStart; +end; + +function TKCustomHexEditor.GetRealSelStart: TKHexEditorSelection; +begin + if FSelStart.Index <= FSelEnd.Index then + Result := FSelStart + else + Result := FSelEnd; +end; + +function TKCustomHexEditor.GetSelLength: TKHexEditorSelection; +begin + if FSelStart.Index <= FSelEnd.Index then + Result.Index := FSelEnd.Index - FSelStart.Index + else + Result.Index := FSelStart.Index - FSelEnd.Index; + if FSelStart.Digit <= FSelEnd.Digit then + Result.Digit := FSelEnd.Digit - FSelStart.Digit + else + Result.Digit := FSelStart.Digit - FSelEnd.Digit; +end; + +function TKCustomHexEditor.GetSelText: TKHexEditorSelText; +var + L, Sel1, Sel2: TKHexEditorSelection; +begin + L := SelLength; + with Result do + begin + if L.Index > 0 then + begin + Sel1 := GetRealSelStart; + Sel2 := GetRealSelEnd; + AsBinaryRaw := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, nil); + AsBinaryMapped := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping); + AsDigits := BinaryToDigits(FBuffer, Sel1, Sel2); + Sel1.Digit := 0; + Sel2.Digit := 0; + AsDigitsByteAligned := BinaryToDigits(FBuffer, Sel1, Sel2); + end else + begin + AsBinaryRaw := ''; + AsBinaryMapped := ''; + AsDigits := ''; + AsDigitsByteAligned := ''; + end; + end; +end; + +function TKCustomHexEditor.GetUndoLimit: Integer; +begin + Result := FUndoList.Limit; +end; + +function TKCustomHexEditor.HasFocus: Boolean; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if (Form <> nil) and Form.Visible and Form.Enabled and Form.Active then + Result := (Form.ActiveControl = Self) + else + Result := False; +end; + +procedure TKCustomHexEditor.InsertChar(At: Integer; Value: Byte); +begin + InsertString(At, AnsiChar(Value), 1); +end; + +procedure TKCustomHexEditor.InsertString(At: Integer; const Value: AnsiString; Size: Integer); +begin + if (At >= 0) and (At <= FSize) and (Length(Value) > 0) then + begin + Inc(FSize, Size); + ReallocMem(FBuffer, FSize); + if At < FSize - Size then + Move(FBuffer[At], FBuffer[At + Size], (FSize - At - Size) * SizeOf(Byte)); + Move(Value[1], FBuffer[At], Size); + UpdateScrollRange; + end; +end; + +function TKCustomHexEditor.InternalGetSelAvail: Boolean; +begin + Result := SelAvail; +end; + +procedure TKCustomHexEditor.InternalMoveLeft; +begin + if FEditArea = eaDigits then + begin + if FSelEnd.Digit > 0 then + Dec(FSelEnd.Digit) + else if FSelEnd.Index > 0 then + begin + FSelEnd.Digit := cDigitCount - 1; + Dec(FSelEnd.Index); + end + end else + Dec(FSelEnd.Index); +end; + +procedure TKCustomHexEditor.InternalMoveRight; +begin + if FEditArea = eaDigits then + begin + if (FSelEnd.Index < FSize) and (FSelEnd.Digit < cDigitCount - 1) then + Inc(FSelEnd.Digit) + else + begin + FSelEnd.Digit := 0; + Inc(FSelEnd.Index); + end + end else + Inc(FSelEnd.Index); +end; + +function TKCustomHexEditor.IsAddressPrefixStored: Boolean; +begin + Result := FAddressPrefix <> '0x'; +end; + +function TKCustomHexEditor.IsDrawStylesStored: Boolean; +begin + Result := FDrawStyles <> cDrawStylesDef; +end; + +function TKCustomHexEditor.IsOptionsStored: Boolean; +begin + Result := FOptions <> [eoGroupUndo]; +end; + +procedure TKCustomHexEditor.KeyDown(var Key: Word; Shift: TShiftState); +var + I: Integer; + HK: TKEditKey; +begin + inherited; + Exclude(FStates, elIgnoreNextChar); + if not (csDesigning in ComponentState) then + begin + for I := 0 to Length(FKeyMapping) - 1 do + begin + HK := FKeyMapping[I].Key; + if (HK.Key = Key) and (HK.Shift = Shift) then + begin + ExecuteCommand(FKeyMapping[I].Command); + Key := 0; + Include(FStates, elIgnoreNextChar); + Exit; + end; + end; + if Key = VK_ESCAPE then + Include(FStates, elIgnoreNextChar); + end; +end; + +procedure TKCustomHexEditor.KeyPress(var Key: Char); +var + I: Integer; +begin + inherited; + if not (csDesigning in ComponentState) then + begin + if not (elIgnoreNextChar in FStates) then + begin + case FEditArea of + eaDigits: I := DigitToBin(AnsiChar(Key)); + eaText: I := Ord(Key); + else + I := -1; + end; + if I >= 0 then + ExecuteCommand(ecInsertChar, @I); + end else + Exclude(FStates, elIgnoreNextChar); + end; +end; + +procedure TKCustomHexEditor.LoadFromFile(const FileName: TFileName); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmOpenRead); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TKCustomHexEditor.LoadFromStream(Stream: TStream); +var + Size: Integer; +begin + Size := Stream.Size - Stream.Position; + if Size > 0 then + begin + Clear; + FSize := Size; + GetMem(FBuffer, FSize); + Stream.Read(FBuffer^, FSize); + BufferChanged; + end; +end; + +procedure TKCustomHexEditor.MeasurePages(var Info: TKPrintMeasureInfo); +var + AD: TKHexEditorAreaDimensions; + PageLines, ActiveLines: Integer; + FitToPage, SelOnly: Boolean; + Scale: Double; + APageSetup: TKPrintPageSetup; +begin + APageSetup := PageSetup; + FitToPage := poFitToPage in APageSetup.Options; + SelOnly := APageSetup.Range = prSelectedOnly; + Scale := APageSetup.Scale / 100; + AD := GetAreaDimensions; + Info.OutlineWidth := AD.TotalHorz * FCharWidth; + if FitToPage then + Scale := APageSetup.PaintAreaWidth / Info.OutlineWidth; + PageLines := Round(APageSetup.PaintAreaHeight / Scale) div FCharHeight; + if SelOnly then + ActiveLines := DivUp(GetRealSelEnd.Index, FLineSize) - GetRealSelStart.Index div FLineSize + else + ActiveLines := LineCount; + Info.OutlineHeight := PageLines * FCharHeight; + Info.HorzPageCount := 1; // cut text off + Info.VertPageCount := DivUp(ActiveLines, PageLines); + Info.PageCount := Info.VertPageCount; +end; + +procedure TKCustomHexEditor.ModifyScrollBar(ScrollBar, ScrollCode, + Delta: Integer; UpdateNeeded: Boolean); +var + I, J, K: Integer; + HasScrollBar: Boolean; + SI: TScrollInfo; +begin + HasScrollBar := (ScrollBar = SB_HORZ) and (ScrollBars = ssHorizontal) or + (ScrollBar = SB_VERT) and (ScrollBars = ssVertical) or (ScrollBars = ssBoth); + if HasScrollBar then + begin + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_PAGE or SIF_TRACKPOS; + GetScrollInfo(Handle, ScrollBar, SI); + {$IF DEFINED(LCLGTK2)} + {.$WARNING "scrollbar arrows still not working properly on GTK2 in some cases!"} + SI.nTrackPos := Delta; + {$IFEND} + end; + if ScrollBar = SB_HORZ then + begin + I := FLeftChar; + J := GetMaxLeftChar; + end else + begin + I := FTopLine; + J := GetMaxTopLine; + end; + K := I; + if ScrollCode = cScrollDelta then + Inc(I, Delta) + else if HasScrollBar then + case ScrollCode of + SB_LINEUP: Dec(I); + SB_LINEDOWN: Inc(I); + SB_PAGEUP: Dec(I, SI.nPage); + SB_PAGEDOWN: Inc(I, SI.nPage); + SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos; + end; + I := MinMax(I, 0, J); + if K <> I then + begin + if HasScrollBar then + begin + FillChar(SI, SizeOf(TScrollInfo), 0); + SI.nPos := I; + SI.fMask := SIF_POS; + SetScrollInfo(Handle, ScrollBar, SI, True); + end; + if ScrollBar = SB_HORZ then + FLeftChar := I + else + FTopLine := I; + if UpdateNeeded then + begin + UpdateEditorCaret; + Invalidate; + end; + end; +end; + +procedure TKCustomHexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + P: TPoint; + Command: TKEditCommand; +begin + inherited; + if Enabled and (Button = mbLeft) and not (ssDouble in Shift) then + begin + SafeSetFocus; + P := Point(X, Y); + if ssShift in Shift then + Command := ecSelGotoXY + else + Command := ecGotoXY; + if ExecuteCommand(Command, @P) then + Include(FStates, elMouseCapture); + end; +end; + +procedure TKCustomHexEditor.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; + R: TRect; +begin + inherited; + if (elMouseCapture in FStates) then + begin + P := Point(X, Y); + R := GetModifiedClientRect; + if PtInRect(R, P) then + UpdateSelEnd(P, False) + else if not FScrollTimer.Enabled then + ScrollTo(P, True, False); + end; +end; + +procedure TKCustomHexEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + Exclude(FStates, elMouseCapture); +end; + +procedure TKCustomHexEditor.PaintLines(const Data: TKHexEditorPaintData); +var + HalfPosWidth, I, Index, J, K, L, M, MaxAddress, WHorz, WVert, WSep, + LeftIndent, VTextIndent: Integer; + BC1, BC2, FC1, FC2, PC1: TColor; + EditorFocused, DrawInactiveCaret, DrawNormal, DigitSep, SelCondition: Boolean; + S: AnsiString; + Fmt: string; + C: Char; + R, R1, RClip: TRect; + OldColorScheme: TKHexEditorColorScheme; + ASelStart, ASelEnd: TKHexEditorSelection; + AD: TKHexEditorAreaDimensions; +begin + { this function must be reentrant because of print function + so there is necessary to backup all changes to global properties} + OldColorScheme := FColors.ColorScheme; + with Data.Canvas do + try + R := Data.PaintRect; + AD := GetAreaDimensions; + // add possible inter-character spacing (in Lazarus not fully implemented yet) + SetTextCharacterExtra(Handle, Data.CharSpacing); + LeftIndent := R.Left - Data.LeftChar * Data.CharWidth; + VTextIndent := (Data.CharHeight - Abs(Font.Height)) div 2; + HalfPosWidth := Data.CharWidth div 2; + Fmt := ''; + MaxAddress := 0; + L := LineCount; + DrawInactiveCaret := not (Data.Printing or Data.CaretShown) and + (edInactiveCaret in FDrawStyles); + DrawNormal := not Data.Printing; + EditorFocused := HasFocus; + if FSelStart.Index <= FSelEnd.Index then + begin + ASelStart := FSelStart; + ASelEnd := FSelEnd; + end else + begin + ASelStart := FSelEnd; + ASelEnd := FSelStart; + end; + // preserve space for lines and separators + if edHorzLines in FDrawStyles then + WVert := Max(1, Data.CharHeight div 25) + else + WVert := 0; + if edVertLines in FDrawStyles then + WHorz := Max(1, Data.CharWidth div 20) + else + WHorz := 0; + if edSeparators in FDrawStyles then + WSep := Max(1, Data.CharWidth div 20) + else + WSep := 0; + // address area pre-comp + if edAddress in FDrawStyles then + begin + if FAddressMode = eamDec then + begin + C := 'd'; + J := 10; + end else + begin + C := 'x'; + J := 16; + end; + Fmt := Format('%s%%.%d%s', [FAddressPrefix, FAddressSize, C]); + MaxAddress := 1; + for I := 1 to FAddressSize do + MaxAddress := MaxAddress * J; + end; + // update color scheme + if Data.Printing then + begin + if Data.PaintColors then + FColors.ColorScheme := ecsNormal + else + FColors.ColorScheme := ecsGrayScale; + end else + begin + if Enabled or (FDisabledDrawStyle = eddNormal) then + FColors.ColorScheme := ecsNormal + else if FDisabledDrawStyle = eddGrayed then + FColors.ColorScheme := ecsGrayed + else + FColors.ColorScheme := ecsBright + end; + FColors.SingleBkGnd := edSingleBkGnd in FDrawStyles; + // get clip box for updating; + if Data.Printing then + RClip := R + else + GetClipBox(Handle, {$IFDEF FPC}@{$ENDIF}RClip); + // now paint text lines + for I := Data.TopLine to Min(L - 1, Data.BottomLine) do + begin + Brush.Style := bsSolid; + K := LeftIndent; + R.Bottom := R.Top + Data.CharHeight - WVert; + if (R.Top <= RClip.Bottom) and (R.Bottom >= RClip.Top) then + begin + if edAddress in FDrawStyles then + begin + Index := I * FLineSize; + Brush.Color := clRed; + if (DrawNormal or Data.PaintSelection) and ((ASelStart.Index <> ASelEnd.Index) or (ASelStart.Digit <> ASelEnd.Digit)) and + (Index + FLineSize - 1 >= ASelStart.Index) and (Index < ASelEnd.Index) then + begin + PC1 := FColors.LinesHighLight; + if (FEditArea = eaAddress) and (EditorFocused or Data.PaintSelection) then + begin + FC1 := FColors.SelTextFocused; + BC1 := FColors.SelBkGndFocused; + end else + begin + FC1 := FColors.SelText; + BC1 := FColors.SelBkGnd; + end; + end else + begin + PC1 := FColors.HorzLines; + FC1 := FColors.AddressText; + BC1 := FColors.AddressBkGnd; + end; + Brush.Color := BC1; + Font.Color := FC1; + R.Left := K; + Inc(K, AD.Address * Data.CharWidth); + R.Right := K; + J := I * FLineSize + FAddressOffset; + if MaxAddress <> 0 then J := J mod MaxAddress; + FillRect(R); + TextOut(R.Left, R.Top + VTextIndent, Format(Fmt, [J])); + if edHorzLines in FDrawStyles then + begin + Brush.Color := PC1; + FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); + end; + if AD.AddressOut > 0 then + begin + R.Left := K; + Inc(K, AD.AddressOut * Data.CharWidth); + R.Right := K; + Brush.Color := FColors.AddressBkGnd; + FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); + if edHorzLines in FDrawStyles then + begin + Brush.Color := FColors.HorzLines; + FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); + end; + end; + end; + if edDigits in FDrawStyles then + begin + if AD.DigitsIn > 0 then + begin + R.Left := K; + Inc(K, AD.DigitsIn * Data.CharWidth); + R.Right := K; + Brush.Color := FColors.DigitBkGnd; + FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); + if edHorzLines in FDrawStyles then + begin + Brush.Color := FColors.HorzLines; + FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); + end; + end; + Index := 0; + for J := 0 to FLineSize - 1 do + begin + Index := I * FLineSize + J; + DigitSep := (J < FLineSize - 1) and ((J + 1) mod FDigitGrouping = 0); + R.Left := K; + Inc(K, cDigitCount * Data.CharWidth); + R.Right := K; + if Index <= FSize then + begin + if Index < FSize then + S := AnsiString(Format(cFmtText, [FBuffer[Index]])) + else + S := ' '; + if (Index <> FSelStart.Index) and (Index <> FSelEnd.Index) then + begin + SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); + if (DrawNormal or Data.PaintSelection) and SelCondition then + begin + PC1 := FColors.LinesHighLight; + if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then + begin + FC1 := FColors.SelTextFocused; + BC1 := FColors.SelBkGndFocused; + end else + begin + FC1 := FColors.SelText; + BC1 := FColors.SelBkGnd; + end; + FC2 := FColors.InactiveCaretSelText; + BC2 := FColors.InactiveCaretSelBkGnd; + end else + begin + PC1 := FColors.HorzLines; + if DrawNormal or Data.PaintAll or SelCondition then + begin + if (J div FDigitGrouping) and 1 = 0 then + FC1 := FColors.DigitTextEven + else + FC1 := FColors.DigitTextOdd; + end else + FC1 := FColors.DigitBkGnd; + BC1 := FColors.DigitBkGnd; + FC2 := FColors.InactiveCaretText; + BC2 := FColors.InactiveCaretBkGnd; + end; + Brush.Color := BC1; + Font.Color := FC1; + Brush.Style := bsSolid; + FillRect(R); + Brush.Style := bsClear; + TextOut(R.Left, R.Top + VTextIndent, Char(S[1])); + TextOut(R.Left + Data.CharWidth, R.Top + VTextIndent, Char(S[2])); + if (Index = FSelEnd.Index) and DrawInactiveCaret then + begin + // draw inactive caret - place into previous drawn text + R1 := R; + Inc(R1.Left, Data.CharWidth * Min(FSelEnd.Digit, cDigitCount - 1)); + R1.Right := R1.Left + Data.CharWidth; + Font.Color := FC2; + Brush.Color := BC2; + Brush.Style := bsSolid; + FillRect(R1); + Brush.Style := bsClear; + TextOut(R1.Left, R1.Top + VTextIndent, string(S)); + end; + if edHorzLines in FDrawStyles then + begin + Brush.Color := PC1; + Brush.Style := bsSolid; + FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); + end; + end else + begin + R1 := R; + R1.Right := R1.Left; + Inc(R1.Right, Data.CharWidth); + for M := 0 to cDigitCount - 1 do + begin + SelCondition := + (ASelStart.Index = ASelEnd.Index) and ( + (M >= ASelStart.Digit) and (M < ASelEnd.Digit) or + (M >= ASelEnd.Digit) and (M < ASelStart.Digit) + ) + or + (ASelStart.Index <> ASelEnd.Index) and ( + (Index = ASelStart.Index) and (M >= ASelStart.Digit) or + (Index = ASelEnd.Index) and (M < ASelEnd.Digit) + ); + if (DrawNormal or Data.PaintSelection) and SelCondition then + begin + PC1 := FColors.LinesHighLight; + if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then + begin + FC1 := FColors.InactiveCaretSelText; + BC1 := FColors.InactiveCaretSelBkGnd; + end + else if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then + begin + FC1 := FColors.SelTextFocused; + BC1 := FColors.SelBkGndFocused; + end else + begin + FC1 := FColors.SelText; + BC1 := FColors.SelBkGnd; + end; + end else + begin + PC1 := FColors.HorzLines; + if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then + begin + FC1 := FColors.InactiveCaretText; + BC1 := FColors.InactiveCaretBkGnd; + end else + begin + if DrawNormal or Data.PaintAll or SelCondition then + begin + if (J div FDigitGrouping) and 1 = 0 then + FC1 := FColors.DigitTextEven + else + FC1 := FColors.DigitTextOdd; + end else + FC1 := FColors.DigitBkGnd; + BC1 := FColors.DigitBkGnd; + end; + end; + Brush.Color := BC1; + Font.Color := FC1; + Brush.Style := bsSolid; + FillRect(R1); + Brush.Style := bsClear; + TextOut(R1.Left, R1.Top + VTextIndent, Char(S[M + 1])); + if edHorzLines in FDrawStyles then + begin + Brush.Color := PC1; + Brush.Style := bsSolid; + FillRect(Rect(R1.Left, R1.Bottom, R1.Right, R1.Bottom + WVert)); + end; + R1.Left := R1.Right; + Inc(R1.Right, Data.CharWidth); + end; + end; + if DigitSep then + begin + if Index < FSize then + M := Data.CharWidth + else + M := HalfPosWidth; + Brush.Color := FColors.DigitBkGnd; + Brush.Style := bsSolid; + FillRect(Rect(R.Right, R.Top, R.Right + Data.CharWidth, R.Bottom)); + if edHorzLines in FDrawStyles then + begin + Brush.Color := FColors.HorzLines; + FillRect(Rect(R.Right, R.Bottom, R.Right + M, R.Bottom + WVert)); + end; + if edVertLines in FDrawStyles then + begin + M := R.Right + HalfPosWidth; + Brush.Color := FColors.VertLines; + FillRect(Rect(M, R.Top, M + WHorz, R.Bottom)); + end; + Inc(K, Data.CharWidth); + end; + end else + begin + Inc(K, Integer(DigitSep) * Data.CharWidth); + Brush.Color := FColors.DigitBkGnd; + Brush.Style := bsSolid; + FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); + end; + end; + if AD.DigitsOut > 0 then + begin + R.Left := K; + Inc(K, AD.DigitsOut * Data.CharWidth); + R.Right := K; + Brush.Style := bsSolid; + Brush.Color := FColors.DigitBkGnd; + FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom)); + if edHorzLines in FDrawStyles then + begin + if Index < FSize then + Brush.Color := FColors.HorzLines + else + Brush.Color := FColors.DigitBkGnd; + FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert)); + end; + end; + end; + if edText in FDrawStyles then + begin + if AD.TextIn > 0 then + begin + R.Left := K; + Inc(K, AD.TextIn * Data.CharWidth); + R.Right := K; + Brush.Color := FColors.TextBkGnd; + Brush.Style := bsSolid; + FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom)); + if edHorzLines in FDrawStyles then + begin + Brush.Color := FColors.HorzLines; + FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert)); + end; + end; + for J := 0 to FLineSize - 1 do + begin + Index := I * FLineSize + J; + R.Left := K; + Inc(K, Data.CharWidth); + R.Right := K; + if Index <= FSize then + begin + SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index); + if (DrawNormal or Data.PaintSelection) and SelCondition then + begin + PC1 := FColors.LinesHighLight; + if DrawInactiveCaret and (Index = FSelEnd.Index) then + begin + FC1 := FColors.InactiveCaretSelText; + BC1 := FColors.InactiveCaretSelBkGnd; + end + else if (FEditArea = eaText) and (EditorFocused or Data.PaintSelection) then + begin + FC1 := FColors.SelTextFocused; + BC1 := FColors.SelBkGndFocused; + end else + begin + FC1 := FColors.SelText; + BC1 := FColors.SelBkGnd; + end; + end else + begin + PC1 := FColors.HorzLines; + if DrawInactiveCaret and (Index = FSelEnd.Index) then + begin + FC1 := FColors.InactiveCaretText; + BC1 := FColors.InactiveCaretBkGnd; + end else + begin + if DrawNormal or Data.PaintAll or SelCondition then + FC1 := FColors.TextText + else + FC1 := FColors.TextBkgnd; + BC1 := FColors.TextBkgnd; + end; + end; + Brush.Color := BC1; + Brush.Style := bsSolid; + FillRect(R); + Brush.Style := bsClear; + if Index < FSize then + begin + Font.Color := FC1; + TextOut(R.Left, R.Top + VTextIndent, Char(FCharMapping[FBuffer[Index]])); + end; + if edHorzLines in FDrawStyles then + begin + Brush.Color := PC1; + Brush.Style := bsSolid; + FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert)); + end; + end else + begin + Brush.Color := FColors.TextBkGnd; + Brush.Style := bsSolid; + FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert)); + end; + end; + end; + end; + Inc(R.Top, Data.CharHeight); + end; + // now complete blank areas below text and optionally paint separators + K := LeftIndent; + R.Bottom := Data.PaintRect.Bottom; + Brush.Style := bsSolid; + if edAddress in FDrawStyles then + begin + R.Left := K; + Inc(K, (AD.Address + AD.AddressOut) * Data.CharWidth); + R.Right := K; if FDrawStyles * [edDigits, edText] <> [] then Dec(R.Right, WSep); + if R.Top < R.Bottom then + begin + Brush.Color := FColors.AddressBkGnd; + FillRect(R); + end; + if (edSeparators in FDrawStyles) and (FDrawStyles * [edDigits, edText] <> []) then + begin + Brush.Color := FColors.Separators; + FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); + end; + end; + if edDigits in FDrawStyles then + begin + R.Left := K; if edAddress in FDrawStyles then Inc(R.Left, WSep); + Inc(K, (AD.Digits + AD.DigitsIn + AD.DigitsOut) * Data.CharWidth); + R.Right := K; if edText in FDrawStyles then Dec(R.Right, WSep); + if R.Top < R.Bottom then + begin + Brush.Color := FColors.DigitBkGnd; + FillRect(R); + end; + if (edSeparators in FDrawStyles) and (edText in FDrawStyles) then + begin + Brush.Color := FColors.Separators; + FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom)); + end; + end; + if edText in FDrawStyles then + begin + R.Left := K; if FDrawStyles * [edAddress, edDigits] <> [] then Inc(R.Left, WSep); + Inc(K, (AD.TextIn + AD.Text) * Data.CharWidth); + R.Right := K; + if R.Top < R.Bottom then + begin + Brush.Color := FColors.TextBkGnd; + FillRect(R); + end; + end; + if K < ClientWidth then + begin + Brush.Color := FColors.BkGnd; + FillRect(Rect(K, 0, ClientWidth, ClientHeight)); + end; + finally + FColors.ColorScheme := OldColorScheme; + end; +end; + +procedure TKCustomHexEditor.PaintPage; +var + ActiveLines, AreaWidth, AreaHeight, FirstLine, PageLines: Integer; + SelOnly: Boolean; + TmpRect, TmpRect1: TRect; + APageSetup: TKPrintPageSetup; + Data: TKHexEditorPaintData; +begin + APageSetup := PageSetup; + SelOnly := APageSetup.Range = prSelectedOnly; + AreaWidth := Round(APageSetup.PaintAreaWidth / APageSetup.CurrentScale); + AreaHeight := Round(APageSetup.PaintAreaHeight / APageSetup.CurrentScale); + PageLines := AreaHeight div FCharHeight; + if SelOnly then + begin + FirstLine := GetRealSelStart.Index div FLineSize; + ActiveLines := DivUp(GetRealSelEnd.Index, FLineSize) - FirstLine; + end else + begin + FirstLine := 0; + ActiveLines := LineCount; + end; + TmpRect := Rect(0, 0, APageSetup.OutlineWidth, APageSetup.OutlineHeight); + TmpRect1 := Rect(0, 0, AreaWidth, AreaHeight); + IntersectRect(TmpRect, TmpRect, TmpRect1); + TmpRect1 := TmpRect; + TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1); + SelectClipRect(APageSetup.Canvas.Handle, TmpRect1); + Data.Canvas := APageSetup.Canvas; + Data.Canvas.Font := Font; + Data.Canvas.Font.Height := Abs(Font.Height); + Data.PaintRect := TmpRect; + Data.TopLine := (APageSetup.CurrentPage - 1) * PageLines; + Data.BottomLine := Min(Data.TopLine + PageLines, ActiveLines) - 1; + Inc(Data.TopLine, FirstLine); + Inc(Data.BottomLine, FirstLine); + Data.LeftChar := 0; + Data.CharWidth := FCharWidth; + Data.CharHeight := FCharHeight; + Data.CharSpacing := FTotalCharSpacing; + Data.Printing := True; + Data.PaintSelection := poPaintSelection in APageSetup.Options; + Data.PaintAll := not SelOnly; + Data.PaintColors := poUseColor in APageSetup.Options; + PaintLines(Data); +end; + +procedure TKCustomHexEditor.PaintToCanvas(ACanvas: TCanvas); +var + Data: TKHexEditorPaintData; +begin + ACanvas.Font := Font; + with Data do + begin + Canvas := ACanvas; + PaintRect := ClientRect; + LeftChar := FLeftChar; + TopLine := FTopLine; + CharWidth := FCharWidth; + CharHeight := FCharHeight; + BottomLine := TopLine + ClientHeight div FCharHeight; + CharSpacing := FTotalCharSpacing; + Printing := False; + PaintSelection := False; + CaretShown := elCaretVisible in FStates; + end; +{$IFDEF FPC} + if Data.CaretShown then + HideEditorCaret; + try +{$ENDIF} + PaintLines(Data); +{$IFDEF FPC} + finally + if Data.CaretShown then + ShowEditorCaret; + end; +{$ENDIF} +end; + +procedure TKCustomHexEditor.PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar, ATopLine: Integer); +var + Data: TKHexEditorPaintData; + Region: HRGN; +begin + ACanvas.Font := Font; + with Data do + begin + Canvas := ACanvas; + PaintRect := ARect; + LeftChar := ALeftChar; + TopLine := ATopLine; + CharWidth := FCharWidth; + CharHeight := FCharHeight; + BottomLine := TopLine + (ARect.Bottom - ARect.Top) div FCharHeight; + CharSpacing := FTotalCharSpacing; + Printing := False; + PaintSelection := False; + end; + Region := CreateRectRgnIndirect(ARect); + try + SelectClipRgn(ACanvas.Handle, Region); + try + PaintLines(Data); + finally + SelectClipRgn(ACanvas.Handle, 0); + end; + finally + DeleteObject(Region); + end; +end; + +function TKCustomHexEditor.PointToSel(P: TPoint; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; +var + Digit, HalfPosWidth, I, X, X1, XMax: Integer; + DigitSep: Boolean; + AD: TKHexEditorAreaDimensions; + Sel: TKHexEditorSelection; +begin + Result := MakeSelection(cInvalidIndex, 0); + P.X := P.X + FLeftChar * FCharWidth; + P.Y := P.Y div FCharHeight + FTopLine; + AD := GetAreaDimensions; + HalfPosWidth := FCharWidth div 2; + X := 0; + if OutOfArea then + P.Y := MinMax(P.Y, 0, LineCount - 1) + else + Area := eaNone; + if P.Y < LineCount then + begin + if edAddress in FDrawStyles then + begin + XMax := X + (AD.Address + AD.AddressOut) * FCharWidth; + if not OutOfArea or (Area = eaAddress) then + if (P.X >= X) and (P.X < XMax) then + begin + Result := MakeSelection(P.Y * FLineSize, 0); + Area := eaAddress; + end + else if Area = eaAddress then // OutOfArea = True + begin + Result.Index := P.Y * FLineSize; + if P.X >= XMax then + Inc(Result.Index, FLineSize); + end; + X := XMax; + end; + if (P.X >= X) or OutOfArea then + begin + if edDigits in FDrawStyles then + begin + XMax := X + (AD.Digits + AD.DigitsIn + AD.DigitsOut) * FCharWidth; + if not OutOfArea or (Area = eaDigits) then + if (P.X >= X) and (P.X < XMax) then + begin + Inc(X, AD.DigitsIn * FCharWidth); + for I := 0 to FLineSize - 1 do + begin + DigitSep := (I < FLineSize - 1) and ((I + 1) mod FDigitGrouping = 0); + X1 := X; + Inc(X, cDigitCount * FCharWidth); + if DigitSep then + Inc(X, HalfPosWidth) + else if I = FLineSize - 1 then + Inc(X, AD.DigitsOut * FCharWidth); + if P.X < X then + begin + Digit := (Max(P.X - X1, 0) + HalfPosWidth) div FCharWidth; + Sel := MakeSelection(P.Y * FLineSize + I, Digit); + if (Digit >= cDigitCount) and (Sel.Index < FSize) then // don't split the FSize character box + begin + Inc(Sel.Index); + Sel.Digit := 0; + end; + if (Sel.Index <= FSize) or OutOfArea then + begin + Result := Sel; + Area := eaDigits; + end; + Break; + end; + if DigitSep then + Inc(X, HalfPosWidth); + end; + end + else if Area = eaDigits then // OutOfArea = True + begin + Result.Index := P.Y * FLineSize; + if P.X >= XMax then + Inc(Result.Index, FLineSize); + end; + X := XMax; + end; + if ((P.X >= X) or OutOfArea) and (edText in FDrawStyles) then + begin + XMax := X + (AD.Text + AD.TextIn) * FCharWidth; + if not OutOfArea or (Area = eaText) then + if (P.X >= X) and (P.X < XMax) then + begin + Inc(X, AD.TextIn * FCharWidth); + Sel := MakeSelection(P.Y * FLineSize, 0); + I := Max(P.X - X, 0) div FCharWidth; + if Sel.Index + I = FSize then + Sel.Index := FSize // don't split the FSize character box + else + Inc(Sel.Index, (Max(P.X - X, 0) + HalfPosWidth) div FCharWidth); + if (Sel.Index <= FSize) or OutOfArea then + begin + Result := Sel; + Area := eaText; + end; + end + else if Area = eaText then // OutOfArea = True + begin + Result.Index := P.Y * FLineSize; + if P.X >= XMax then + Inc(Result.Index, FLineSize); + end; + end; + end; + end; + ValidateSelection(Result, Area); +end; + +procedure TKCustomHexEditor.SafeSetFocus; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if (Form <> nil) and Form.Visible and Form.Enabled and not (csDestroying in Form.ComponentState) + and Visible and Enabled then + Form.ActiveControl := Self; +end; + +procedure TKCustomHexEditor.SaveToFile(const FileName: TFileName); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TKCustomHexEditor.SaveToStream(Stream: TStream); +begin + if FBuffer <> nil then + Stream.Write(FBuffer^, FSize); +end; + +procedure TKCustomHexEditor.ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean); +begin + if HChars <> 0 then + ModifyScrollBar(SB_HORZ, cScrollDelta, HChars, UpdateNeeded); + if VChars <> 0 then + ModifyScrollBar(SB_VERT, cScrollDelta, VChars, UpdateNeeded); +end; + +procedure TKCustomHexEditor.ScrollTo(Point: TPoint; Timed, AlwaysScroll: Boolean); +var + ScrollHorz: Boolean; + R: TRect; +begin + // disable horizontal overscroll when scrolling e.g. with mouse + ScrollHorz := AlwaysScroll or (FSelEnd.Index mod FLineSize <> 0) and + (FSelEnd.Index < FSize) or (FSelEnd.Digit > 0); + R := GetModifiedClientRect; + if ScrollHorz then + begin + if Point.X < R.Left then + FScrollDeltaX := DivDown(Point.X, FCharWidth) + else if Point.X >= R.Right then + FScrollDeltaX := (Point.X - R.Right) div FCharWidth + 1 + else + FScrollDeltaX := 0; + end else + FScrollDeltaX := 0; + if Point.Y < R.Top then + FScrollDeltaY := DivDown(Point.Y, FCharHeight) + else if Point.Y >= R.Bottom then + FScrollDeltaY := (Point.Y - R.Bottom) div FCharHeight + 1 + else + FScrollDeltaY := 0; + if (FScrollDeltaX <> 0) or (FScrollDeltaY <> 0) then + if Timed then + begin + ScrollBy(FScrollDeltaX, FScrollDeltaY, False); + FScrollTimer.Enabled := True; + end else + ScrollBy(FScrollDeltaX, FScrollDeltaY, True); + UpdateSelEnd(Point, True); +end; + +procedure TKCustomHexEditor.ScrollTimerHandler(Sender: TObject); +var + P: TPoint; +begin + GetCursorPos(P); + P := ScreenToClient(P); + if (elMouseCapture in FStates) and not (Dragging or + PtInRect(GetModifiedClientRect, P)) then + ScrollTo(P, True, False) + else + FScrollTimer.Enabled := False; +end; + +function TKCustomHexEditor.SelAvail: Boolean; +begin + Result := SelLength.Index > 0; +end; + +procedure TKCustomHexEditor.SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True); +begin + ValidateSelection(FSelEnd, FEditArea); + if StartEqualEnd then + FSelStart := FSelEnd + else + ValidateSelection(FSelStart, FEditArea); + if HasParent then + begin + if ScrollToView and (FEditArea <> eaNone) then + ScrollTo(SelToPoint(FSelEnd, FEditArea), False, True); + UpdateEditorCaret; + Invalidate; + InvalidatePageSetup; + end; +end; + +function TKCustomHexEditor.SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; +begin + Result := (Area <> eaNone) and ( + (Value.Index >= 0) and (Value.Index < FSize) or + (Value.Index = FSize) and (Value.Digit = 0)) +end; + +function TKCustomHexEditor.SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TPoint; +var + AD: TKHexEditorAreaDimensions; +begin + Result := Point(0, 0); + AD := GetAreaDimensions; + ValidateSelection(Value, Area); + if (Area = eaDigits) and (edDigits in FDrawStyles) then + begin + Result.X := ((Value.Index mod FLineSize) div FDigitGrouping * (cDigitCount * FDigitGrouping + 1) + + (Value.Index mod FLineSize) mod FDigitGrouping * cDigitCount + Value.Digit + AD.DigitsIn) + end else if (Area = eaText) and (edText in FDrawStyles) then + Result.X := (Value.Index mod FLineSize + AD.DigitsIn + AD.Digits + AD.DigitsOut + AD.TextIn) + else if Area = eaAddress then + begin + if edDigits in FDrawStyles then + Result.X := AD.DigitsIn + else if edText in FDrawStyles then + Result.X := AD.TextIn; + end; + Result.X := (Result.X + AD.Address + AD.AddressOut - FLeftChar) * FCharWidth; + Result.Y := (Value.Index div FLineSize - FTopLine) * FCharHeight; +end; + +procedure TKCustomHexEditor.SetAddressCursor(Value: TCursor); +begin + if Value <> FAddressCursor then + begin + FAddressCursor := Value; + UpdateMouseCursor; + end; +end; + +procedure TKCustomHexEditor.SetAddressMode(Value: TKHexEditorAddressMode); +begin + if Value <> FAddressMode then + begin + FAddressMode := Value; + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetAddressOffset(Value: Integer); +begin + if Value <> FAddressOffset then + begin + FAddressOffset := Value; + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetAddressPrefix(const Value: string); +begin + if Value <> FAddressPrefix then + begin + FAddressPrefix := Value; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetAddressSize(Value: Integer); +begin + Value := MinMax(Value, cAddressSizeMin, cAddressSizeMax); + if Value <> FAddressSize then + begin + FAddressSize := Value; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetAreaSpacing(Value: Integer); +begin + Value := MinMax(Value, cAreaSpacingMin, cAreaSpacingMax); + if Value <> FAreaSpacing then + begin + FAreaSpacing := Value; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetCharMapping(const Value: TKEditCharMapping); +begin + if not CompareMem(@Value, @FCharMapping, SizeOf(TKEditCharMapping)) and + (edText in FDrawStyles) then + Invalidate; +end; + +procedure TKCustomHexEditor.SetCharSpacing(Value: Integer); +begin + Value := MinMax(Value, cCharSpacingMin, cCharSpacingMax); + if Value <> FCharSpacing then + begin + FCharSpacing := Value; + UpdateCharMetrics; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetColors(Value: TKHexEditorColors); +begin + FColors.Assign(Value); +end; + +procedure TKCustomHexEditor.SetCommandKey(Index: TKEditCommand; Value: TKEditKey); +var + I: Integer; +begin + for I := 0 to Length(FKeyMapping) - 1 do + if FKeyMapping[I].Command = Index then + begin + FKeyMapping[I].Key := Value; + Exit; + end; +end; + +procedure TKCustomHexEditor.SetData(Value: TDataSize); +begin + if (Value.Data <> FBuffer) or (Value.Size <> FSize) then + begin + Clear; + if Value.Data <> nil then + begin + FSize := Value.Size; + GetMem(FBuffer, FSize); + System.Move(Value.Data^, FBuffer^, FSize); + BufferChanged; + end; + end; +end; + +procedure TKCustomHexEditor.SetDigitGrouping(Value: Integer); +begin + Value := MinMax(Value, cDigitGroupingMin, Min(FLineSize, cDigitGroupingMax)); + if Value <> FDigitGrouping then + begin + FDigitGrouping := Value; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetDisabledDrawStyle(Value: TKHexEditorDisabledDrawStyle); +begin + if Value <> FDisabledDrawStyle then + begin + FDisabledDrawStyle := Value; + if not Enabled then + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetDrawStyles(const Value: TKHexEditorDrawStyles); +begin + if Value <> FDrawStyles then + begin + FDrawStyles := Value; + EditAreaChanged; // must be called first + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetEditArea(Value: TKHexEditorArea); +begin + if Value <> FEditArea then + begin + FEditArea := Value; + EditAreaChanged; + if Value <> FEditArea then + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetKeyMapping(const Value: TKEditKeyMapping); +begin + SetLength(FKeyMapping, Length(Value)); + Move(Value, FKeyMapping, Length(Value) * SizeOf(TKEditCommandAssignment)); +end; + +procedure TKCustomHexEditor.SetLineHeightPercent(Value: Integer); +begin + Value := MinMax(Value, cLineHeightPercentMin, cLineHeightPercentMax); + if Value <> FLineHeightPercent then + begin + FLineHeightPercent := Value; + UpdateCharMetrics; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetLeftChar(Value: Integer); +begin + Value := MinMax(Value, 0, GetMaxLeftChar); + if Value <> FLeftChar then + ScrollBy(Value - FLeftChar, 0, True); +end; + +procedure TKCustomHexEditor.SetLines(Index: Integer; const Value: TDataSize); +var + I, Size: Integer; +begin + I := Index * FLineSize; + if (Value.Data <> nil) and (Value.Size > 0) and (I >= 0) and (I <= FSize) then + begin + Size := Min(FLineSize, Value.Size); + if I + Size > FSize then + begin + FSize := Size; + ReallocMem(FBuffer, FSize); + end; + System.Move(Value.Data^, FBuffer[I], Size); + BufferChanged; + end; +end; + +procedure TKCustomHexEditor.SetLineSize(Value: Integer); +begin + Value := MinMax(Value, cLineSizeMin, cLineSizeMax); + if Value <> FLineSize then + begin + FLineSize := Value; + UpdateScrollRange; + end; +end; + +procedure TKCustomHexEditor.SetModified(Value: Boolean); +begin + if Value <> GetModified then + begin + if Value then + Include(FStates, elModified) + else + begin + Exclude(FStates, elModified); + if eoUndoAfterSave in FOptions then + FUndoList.Modified := False + else + begin + FUndoList.Clear; + FRedoList.Clear; + end; + end; + end; +end; + +function TKCustomHexEditor.SetMouseCursor(X, Y: Integer): Boolean; +var + ACursor: TCursor; + P: TPoint; + Area: TKHexEditorArea; +begin + P := Point(X, Y); + PointToSel(P, False, Area); + if PtInRect(ClientRect, P) then + begin + case Area of + eaAddress: ACursor := FAddressCursor; + eaDigits: ACursor := crIBeam; + eaText: ACursor := crIBeam; + else + ACursor := crDefault; + end; + end else + ACursor := crDefault; +{$IFDEF FPC} + FCursor := ACursor; + SetTempCursor(ACursor); +{$ELSE} + Windows.SetCursor(Screen.Cursors[ACursor]); +{$ENDIF} + Result := True; +end; + +procedure TKCustomHexEditor.SetOptions(const Value: TKEditOptions); +{$IFDEF USE_WINAPI} +var + UpdateDropFiles: Boolean; +{$ENDIF} +begin + if Value <> FOptions then + begin + {$IFDEF USE_WINAPI} + UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions); + FOptions := Value; + // (un)register HWND as drop target + if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then + DragAcceptFiles(Handle, (eoDropFiles in fOptions)); + {$ELSE} + FOptions := Value; + {$ENDIF} + end; +end; + +procedure TKCustomHexEditor.SetReadOnly(Value: Boolean); +begin + if Value <> GetReadOnly then + begin + if Value then + Include(FStates, elReadOnly) + else + Exclude(FStates, elReadOnly); + end; +end; + +procedure TKCustomHexEditor.SetScrollBars(Value: TScrollStyle); +begin + if Value <> FScrollBars then + begin + FScrollBars := Value; + {$IFDEF FPC} + UpdateSize; + {$ELSE} + RecreateWnd; + {$ENDIF} + end; +end; + +procedure TKCustomHexEditor.SetScrollSpeed(Value: Cardinal); +begin + Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax); + if Value <> FScrollSpeed then + begin + FScrollSpeed := Value; + FScrollTimer.Enabled := False; + FScrollTimer.Interval := FScrollSpeed; + end; +end; + +procedure TKCustomHexEditor.SetSelEnd(Value: TKHexEditorSelection); +begin + if (Value.Index <> FSelEnd.Index) or (Value.Digit <> FSelEnd.Digit) then + begin + FSelEnd := Value; + SelectionChanged(False, False); + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetSelLength(Value: TKHexEditorSelection); +var + X: TKHexEditorSelection; +begin + X := GetSelLength; + if (Value.Index <> X.Index) or (Value.Digit <> X.Digit) then + begin + FSelEnd.Index := FSelStart.Index + Value.Index; + FSelEnd.Digit := FSelStart.Digit + Value.Digit; + if FSelEnd.Digit >= cDigitCount then + Inc(FSelEnd.Index); + SelectionChanged(False, False); + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetSelStart(Value: TKHexEditorSelection); +begin + if (Value.Index <> FSelStart.Index) or (Value.Digit <> FSelStart.Digit) then + begin + FSelStart := Value; + SelectionChanged(False, False); + Invalidate; + end; +end; + +procedure TKCustomHexEditor.SetTopLine(Value: Integer); +begin + Value := MinMax(Value, 0, GetMaxTopLine); + if Value <> FTopLine then + ScrollBy(0, Value - FTopLine, True); +end; + +procedure TKCustomHexEditor.SetUndoLimit(Value: Integer); +begin + Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax); + if Value <> FUndoList.Limit then + begin + FUndoList.Limit := Value; + FRedoList.Limit := Value; + end; +end; + +procedure TKCustomHexEditor.HideEditorCaret; +var + P: TPoint; +begin + P := SelToPoint(FSelEnd, FEditArea); + HideCaret(Handle); + {$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); +end; + +procedure TKCustomHexEditor.ShowEditorCaret; +var + P: TPoint; +begin + P := SelToPoint(FSelEnd, FEditArea); + {$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1); + ShowCaret(Handle); +end; + +procedure TKCustomHexEditor.UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason); +begin + if (Sender = FUndoList) and (ItemReason <> crCaretPos) then + DoChange; +end; + +procedure TKCustomHexEditor.UpdateEditorCaret(Recreate: Boolean = False); +var + CW, CH: Integer; +begin + Include(FStates, elCaretUpdate); + try + if Enabled and Focused and (FEditArea in [eaDigits, eaText]) and not (csDesigning in ComponentState) then + begin + if not (elCaretVisible in FStates) or Recreate then + begin + if elOverwrite in FStates then + CW := FCharWidth + else + CW := Max(2, (Abs(Font.Height) * 2) div 25); + if edHorzLines in FDrawStyles then + CH := FCharHeight - Max(1, FCharHeight div 25) + else + CH := FCharHeight; + {$IFDEF FPC} + CreateCaret(Handle, 0, CW, CH - 2); + {$ELSE} + if CreateCaret(Handle, 0, CW, CH - 2) then + {$ENDIF} + Include(FStates, elCaretVisible); + Invalidate; + end; + if elCaretVisible in FStates then + ShowEditorCaret; + end else + begin + Exclude(FStates, elCaretVisible); + HideEditorCaret; + {$IFDEF FPC} + DestroyCaret(Handle); + {$ELSE} + DestroyCaret; + {$ENDIF} + end; + finally + Exclude(FStates, elCaretUpdate); + end; +end; + +procedure TKCustomHexEditor.UpdateCharMetrics; +var + DC: HDC; + TM: TTextMetric; +begin + DC := GetDC(0); + try + SelectObject(DC, Font.Handle); + GetTextMetrics(DC, TM); + FTotalCharSpacing := FCharSpacing * 2; + // ensure even char spacing because of PointToSel + if TM.tmAveCharWidth and 1 <> 0 then + Inc(FTotalCharSpacing); + FCharWidth := TM.tmAveCharWidth + FTotalCharSpacing; + FCharHeight := TM.tmHeight * FLineHeightPercent div 100; + finally + ReleaseDC(0, DC); + end; +end; + +procedure TKCustomHexEditor.UpdateMouseCursor; +var + P: TPoint; +begin + P := ScreenToClient(Mouse.CursorPos); + SetMouseCursor(P.X, P.Y); +end; + +procedure TKCustomHexEditor.UpdateScrollRange; +var + I: Integer; + AD: TKHexEditorAreaDimensions; + SI: TScrollInfo; +begin + if HandleAllocated then + begin + AD := GetAreaDimensions; + // update horizontal scroll position + I := FLeftChar - GetMaxLeftChar(AD.TotalHorz); + if I > 0 then + Dec(FLeftChar, I); + FLeftChar := Max(FLeftChar, 0); + // update vertical scroll position + I := FTopLine - GetMaxTopLine(AD.TotalVert); + if I > 0 then + Dec(FTopLine, I); + FTopLine := Max(FTopLine, 0); + if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then + begin + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF}; + SI.nMin := 0; + {$IFDEF UNIX} + SI.ntrackPos := SB_POLICY_CONTINUOUS; + {$ENDIF} + if FScrollBars in [ssBoth, ssHorizontal] then + begin + SI.nMax := AD.TotalHorz{$IFNDEF FPC}- 1{$ENDIF}; + SI.nPage := GetClientWidthChars; + SI.nPos := FLeftChar; + SetScrollInfo(Handle, SB_HORZ, SI, True); + ShowScrollBar(Handle, SB_HORZ, Integer(SI.nPage) < AD.TotalHorz); + end else + ShowScrollBar(Handle, SB_HORZ, False); + if FScrollBars in [ssBoth, ssVertical] then + begin + SI.nMax := AD.TotalVert{$IFNDEF FPC}- 1{$ENDIF}; + SI.nPage := GetClientHeightChars; + SI.nPos := FTopLine; + SetScrollInfo(Handle, SB_VERT, SI, True); + ShowScrollBar(Handle, SB_VERT, Integer(SI.nPage) < AD.TotalVert); + end else + ShowScrollBar(Handle, SB_VERT, False); + end; + UpdateEditorCaret(True); + Invalidate; + InvalidatePageSetup; + end; +end; + +procedure TKCustomHexEditor.UpdateSelEnd(Point: TPoint; ClipToClient: Boolean); +var + R: TRect; + Sel: TKHexEditorSelection; +begin + if ClipToClient then + begin + R := GetModifiedClientRect; + Dec(R.Right, FCharWidth); + Dec(R.Bottom, FCharHeight); + if CanScroll(ecScrollLeft) and (Point.X < R.Left) then + Point.X := R.Left + else if CanScroll(ecScrollRight) and (Point.X > R.Right) then + Point.X := R.Right; + if CanScroll(ecScrollUp) and (Point.Y < R.Top) then + Point.Y := R.Top + else if CanScroll(ecScrollDown) and (Point.Y > R.Bottom) then + Point.Y := R.Bottom; + end; + Sel := PointToSel(Point, True, FEditArea); + if (Sel.Index <> cInvalidIndex) and + ((Sel.Index <> FSelEnd.Index) or (Sel.Digit <> FSelEnd.Digit)) then + begin + FSelEnd := Sel; + UpdateEditorCaret; + Invalidate; + InvalidatePageSetup; + end; +end; + +procedure TKCustomHexEditor.UpdateSize; +begin + UpdateScrollRange; +end; + +procedure TKCustomHexEditor.ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); +begin + if Area <> eaNone then + begin + Value.Index := MinMax(Value.Index, 0, FSize); + if Value.Index = FSize then + Value.Digit := 0 + else + Value.Digit := MinMax(Value.Digit, 0, cDigitCount - 1); + end else + Value := MakeSelection(cInvalidIndex, 0); +end; + +{$IFNDEF FPC} +procedure TKCustomHexEditor.WMDropFiles(var Msg: TLMessage); +var + I, FileCount: Integer; + PathName: array[0..260] of Char; + Point: TPoint; + FilesList: TStringList; +begin + try + if Assigned(FOnDropFiles) then + begin + FilesList := TStringList.Create; + try + FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0); + DragQueryPoint(THandle(Msg.wParam), Point); + for i := 0 to FileCount - 1 do + begin + DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName)); + FilesList.Add(PathName); + end; + FOnDropFiles(Self, Point.X, Point.Y, FilesList); + finally + FilesList.Free; + end; + end; + finally + Msg.Result := 0; + DragFinish(THandle(Msg.wParam)); + end; +end; +{$ENDIF} + +procedure TKCustomHexEditor.WMEraseBkgnd(var Msg: TLMessage); +begin + Msg.Result := 1; +end; + +procedure TKCustomHexEditor.WMGetDlgCode(var Msg: TLMNoParams); +begin + Msg.Result := DLGC_WANTARROWS; +end; + +procedure TKCustomHexEditor.WMHScroll(var Msg: TLMHScroll); +begin + SafeSetFocus; + ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos, True); +end; + +procedure TKCustomHexEditor.WMKillFocus(var Msg: TLMKillFocus); +begin + inherited; + ExecuteCommand(ecLostFocus); +end; + +procedure TKCustomHexEditor.WMSetFocus(var Msg: TLMSetFocus); +begin + inherited; + ExecuteCommand(ecGotFocus); +end; + +procedure TKCustomHexEditor.WMVScroll(var Msg: TLMVScroll); +begin + SafeSetFocus; + ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos, True); +end; + +function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec; +begin + case Index of + ciAddressText: begin Result.Def := cAddressTextDef; Result.Name := sAddressText; end; + ciAddressBkGnd: begin Result.Def := cAddressBkgndDef; Result.Name := sAddressBkGnd; end; + ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := sBkGnd; end; + ciDigitTextEven: begin Result.Def := cDigitTextEvenDef; Result.Name := sDigitTextEven; end; + ciDigitTextOdd: begin Result.Def := cDigitTextOddDef; Result.Name := sDigitTextOdd; end; + ciDigitBkGnd: begin Result.Def := cDigitBkGndDef; Result.Name := sDigitBkgnd; end; + ciHorzLines: begin Result.Def := cHorzLinesDef; Result.Name := sHorzLines; end; + ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := sInactiveCaretBkGnd; end; + ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := sInactiveCaretSelBkGnd; end; + ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := sInactiveCaretSelText; end; + ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := sInactiveCaretText; end; + ciLinesHighLight: begin Result.Def := cLinesHighLightDef; Result.Name := sLinesHighLight; end; + ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := sSelBkGnd; end; + ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := sSelBkGndFocused; end; + ciSelText: begin Result.Def := cSelTextDef; Result.Name := sSelText; end; + ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := sSelTextFocused; end; + ciSeparators: begin Result.Def := cSeparatorsDef; Result.Name := sSeparators; end; + ciTextText: begin Result.Def := cTextTextDef; Result.Name := sTextText; end; + ciTextBkGnd: begin Result.Def := cTextBkgndDef; Result.Name := sTextBkGnd; end; + ciVertLines: begin Result.Def := cVertLinesDef; Result.Name := sVertLines; end; + else + Result.Def := clNone; + Result.Name := ''; + end; +end; + +end. diff --git a/components/kcontrols/source/khexeditordesign.lrs b/components/kcontrols/source/khexeditordesign.lrs new file mode 100755 index 000000000..69123036f --- /dev/null +++ b/components/kcontrols/source/khexeditordesign.lrs @@ -0,0 +1,262 @@ +LazarusResources.Add('tkhexeditor','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 + +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 + +#0#0#4#12'IDATx'#156'b'#252#255#255'?'#3'y`?'#19#144'`'#7'b^ '#22#1'bq('#27#4 + +'>'#1#241#11' ~'#3#16'@,$'#24#200#12'$X'#160#24#198#6#25'('#5#196'*@'#172#250 + +#231#213#127#241#239#167#254#243#253'y'#199#254#155'M'#254#207'6n'#251#255 + +#199#1#2#8'n'#1'###V'#175#0#197#25'XY'#153#25'xx8'#25'xy'#185#24#184#184'8' + +#24#216#217'Y'#193'b""'#252#12#26#26'r'#12'&Z'#26#12#218'3'#213#25#184'~'#9 + +'2'#176#201's3|'#150#253#196#160#19#199#185#14#168#157#21' '#128'P|@lp'#253 + +#251#252#155#129#129#137#145#129#137#27#162'}'#157#199't'#134#215'7?2'#200 + +#240'q1'#252#229'gc'#224#239'V'#6#138'>'#3'*b'#248#5#16'@'#24'A'#196#200#216 + +#136'da='#3'7w+'#131#148#20''''#131#158#158#16#131#137#137'0'#131#217#3'f'#6 + +#149#223#252#12'o'#253#217#24#140#252'M'#25'NN^'#205#240#247#232'G'#6'i'#14 + +#21#6'fA6'#6#233#185#22#12'O'#153#159#128#180#191#3#226'o'#0#1#132'a'#1#200 + +'Pd'#240#245'k5'#156#189#196#178#151#129#235#154' '#3's'#160' '#131#142#182#6 + +#195#183'G'#31#25#174'u\c0`'#6#26'.'#204#198' V'#175#199#192#174#202#203#240 + +#227#218'O'#144#242#151' '#11#0#2#136#160#15'$%'#187#192'.'#15#10#146'g8p~' + +#31#131'>G'#12'D'#238#215'3'#134#147'yg'#24#20'>'#139'1p'#139#243'0'#240#7 + +#139'2\'#149'z'#193'`'#197' '#199#240#253#251'/'#144#146'7@'#252#3' '#128#8 + +#250#224#249#243'28{wF'#15'0'#249'03'#252'}'#251#147#225#221#220'/'#12#12'G>' + +'1'#136'3'#9'3p;J0'#136#214#152'0'#136's2'#131#213#253#253#251#15'D'#1#227 + +#192#241#31'@'#0#17#244#129#130'B/'#131#189#189'8C|'#188'2\'#252#231#141#143 + +#12#223'N'#191'e'#16'd'#226'c`'#228'`'#6')d'#248'u'#251#30#195#133'o'#31#24 + +',,L'#25#152#153'AY'#4#148'G'#246#255#2#8' '#130'>x'#240#160#24#206#158#3#165 + +#255'~'#254#195#240#227#199#15#134'{'#127#159'2'#8'}'#227'e`'#187#194#195#240 + +'~.'#11#131'A'#162#10'X'#158#147#19#148#255#190#138#2#137'?'#0#1'D'#148#15#28 + +#28'@>P'#129#139#179#136#176'3'#200'&I1'#188#186#201#196#176'o'#241#30#6#167 + +#171#12#192#144#7#2'fF'#6'!'#14'U`~'#225#4#241#20#129#248';@'#0#145#228#131 + +#217'P'#154'M'#129#135#129'UN'#154#193#189#200#146#225#206#191''''#12#251#150 + +#158#1'["'#207#206#196#240'q'#229#3#6#142'0'#30#144'2P'#14#127#2#16'@'#4'} #' + +#211#205'`n.'#10'LEr('#234#152#249#191#130#233#192'Fo'#134#13#12'_'#24#142'/' + +#189#204#192'z'#158#133'A'#242#215'?'#6'n&'#9#134'?'#25'L'#162','#162#255'8' + +#1#2#136#17#150'{AE'#5#161#156#28#195#238#201#16#196#230#200#160#202','#203 + +' ;'#209#156'A ^'#9','#254#253#195'W'#134'Ei'#211#24'x>'#177#2'c'#150#141'A' + +#239#159#2#131#176#15#235#20#225'<'#150#185#0#1#132'j'#1#194#233'`'#159#128 + +'| '#208#206' '#15',_tt'#4#25'T>>`'#14#150#230'b'#224#231'ge'#168#174#246'c'#184'u'#235#10 + +#131#154#218'kG'#160'I'#15#1#2#8#167#5#148#128's'#231'N3'#24#25'}'#1#165#235 + +#15#0#1#132#221#2'd'#128','#170'('#9'LB'#192't'#15#202'H'#223#129#197#193#243 + +#183#16'qn'#14#136#248'G`'#188#8#243#1'KC'#160#158#247#155'@1'#253#27' '#128 + +#240#251#0'XT'#195#249#172','#224#18#148#225#231'o'#136#24#136#15#178#232#223 + +'?Tu'#8'6'#152#1#16'@LD'#251#251#207'_`'#225#251#7'b'#0#8#131#248'0'#135#160 + +'9'#232#224#129#3'pm'#0#1'DB'#141#134#230';"'#1'@'#0#17#31'D'#200'l|rhA'#4#16 + +'@X'#131#232#224#193#131'`'#140#194#135'y'#27#22'D'#12#144#160'@W'#135#14#0#2 + +#136#145#252'V'#5'q'#0' '#128#136#143'd2'#1'@'#128#1#0#188' dE'#131#162#228 + +'T'#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tkprintpreview','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 + +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 + +#0#0#6#175'IDATx'#156'b'#252#255#255'?'#3'###'#3#26'P'#7'bk fF'#151#128#1'VV' + +'fF'#1#1'^'#150#162#162#208#253#21#21#145' '#3#196#129#152#23'*'#253#9#136'_' + +#0#241#27#128#0'b'#193#162'7'#207#221#221#189'/<<'#156#153#149#149#21','#0'r' + +#196#127' '#253#239#223'?'#134'_'#191#127'3|'#250#242#157#225#213#219#247#12 + +#127'~'#255'`8v'#236#240#221#7#15'^'#244')(HH'#252'y'#245'_'#252#251#169#255 + +'|'#127#222#177#255'f'#147#255#179#141#219#254#255'q'#128#0'bD'#243#129#140 + +#189#189#253#189#237';v'#178#190#255#240#137#225'/'#208'@'#16#128'H3'#2'-' + +#249#199#240#251#207'_'#134#239#223#127'2'#188#253#240#129#129#149#133#153'A' + +'B'#144#157#225#234#233'M'#31#149'{'#228#217'Y~'#242'p'#176#201's3'#176#169 + +#179#191#150#236#254#145#6#212't'#5' '#128#208'}`'#228#229#229#205#250#225 + +#211'g'#134#159'@'#151#194#12#7'9'#128#133#153#9#136'Y'#24#216#128#134'r'#252 + +'a`'#224#17#20'f`'#228'fb'#16#23#17'a8'#155#193#193#255#244#198#27#6#25'>V' + +#134#191#188#140#127'EK'#255#173#1#234#2#25#240#11' '#128#152#208',`ffa'#6 + +#187#150#133#153#25#138#129#134#178#178'0'#176#179#177'2pq'#178'1'#252'['#254 + +#130#225'_'#251'c'#6#161#223#28#12'b'#194#252#12#23'f'#29'f'#248#127#236#27 + +#131'4'#187'8'#3#179' '#27#131#232'$'#150#27',b'#140#15#129#134#188#3#226'o' + +#0#1#132#25#7#192' cf'#2#6#7#208#240#210#226'B'#6#7#7'{'#6'IIQ'#6'aa.'#134#27 + +'9'''#24'4nK3'#200#6'j'#2'-'#252#193#240#231'%'#3#195#181#246#227#12#6#204'*' + +#12#204#194'l'#12'"5*'#12#187#238#175#149#214#230#146'y'#163#161'!'#247#18'd' + +#1'@'#0#161#251#0'd>'#3#19#19#19#208#18'&'#134#212#212'4'#6'C#c'#6'Y9y'#6#25 + +#25'y'#134#3'WN0'#240'0rB'#212#253'bc8'#153#177#147'A'#225#179#24#3#183'('#15 + +#3#127#176','#3'O'#176'"P}'#176'@v'#246#212#170#204#204'~P'#204#253#0#8' ,' + +#22#252#135'X'#0#12's'#14'NN'#134#175#223#190'1'#176#178's2|'#249#247#159#225 + +#247#255#191#192't'#203#204#240#247#237'O'#134'ws'#31'00'#28#249#202' '#206 + +'$'#204#192#237'('#206' Z'#163#202#240#233#243#7#134#151#239#191'3(i'#152')m' + +#218't'#220#132#129#193#241#31'@'#0'aZ'#192#0#178#128#17'l'#201#219#247#31#25 + +#254#176'p0'#156'|'#244#140'AZT'#26#174#230#231#141#143#12#31#150'>c'#16'd' + +#226'c`'#228'`'#6'ib'#248'u'#251#3'0'#142#184#24#132#5#249#25#196'D'#133#24 + +#132#132'x'#129'i|?3@'#0'a'#245#1'('#213#252#250#253#135#129#137#149#131'a' + +#251#149#187#12':**'#12#191#160'I'#22#4#254'~'#254#195#240#227#199#15#134#187 + +#127#159'2'#188#248#246#138#225#199#149#143#12#239#231#2#243#213#245#239#192 + +'T%'#196#160#166','#195#160#163#163#200#7'T'#202#9#16'@'#24#145#12#14'"F&' + +#134'g/_3'#220'|'#249#129#129'_L'#148#225#237#175#223#12#146#127'~'#194#213 + +#176#136#176'3'#200'&'#169'2'#188#186#249#151'a'#223#226#131#12'NW'#25#24#228 + +#192'i'#144#145'A E'#129'AIQ'#138#193#216'X'#21#148#179#5#0#2#8'k$3'#2#131 + +#232#237#187#143#12'w'#223'|`'#248#250#235#23#195#251#31#191#24#190#253#250#1 + +'W'#195#166#192#195#192'*'#199#206#224'>'#211#135'A"Z'#129'a'#223#159'3'#12 + +#143#174#222'c'#248'~'#238#29#195#231#213'O'#25'$'#152#133#129#137'BL'#8#168 + +#148#15' '#128#176#250#0#20#253#159#191'~'#5#27#254#229#203#15#134'w_'#190'1' + +#188#255#134#170#148#153#159#149#225#253#247#223#12'Q'#147#210#24#150'3'#204 + +'d8'#190#244'2'#3#235'y'#22#6#201'_'#255#24#184#25'D'#24#4#180#249#193'A'#4 + +#16'@'#216#131#8#24#193#255#254#254'c'#224#5'f'#176#23#159'>'#0#195'['#140 + +#225#211#15'`'#156#0#173#190#241#247#1#131#234#145#191#12#255'|'#4#24#158'*' + +#253'f'#248#241#247'/'#131'Vn'#0#195#197#215#235#24#238'}}'#207#240#130#249 + +#23#131#198#254#175#12#28'_'#185'D'#24'B'#24#254#2#4#16'N'#31#240#243#241'0' + +#200#11#240'0<'#127#249#150#225'70'#14'>|'#254#198#224#148#23#204' '#160'%' + +#199#240#133#135#135#225#157#18#11#195#179'w_'#24#222'}'#252#194#240#253#219 + +'W'#6#139':'#31#6'9q'#17#6')qi'#134#157#187#214'3'#156'?w'#230#132#3#131#198 + +'G'#128#0#194#154#138'@'#5#144#154#146'<'#195#231#215#175#24'd9'#217#25'>' + +#127#252#204#240#237#251#31#6#209'pC'#6'&3i'#134#239#154#252#12#175#127'~'#5 + +#166#251#31#12'O'#158#191'c'#248#255#237#31#195#181#171#183#24#4#248'E'#24 + +#128#217#133#225'9P'#236#194#133#219#175#129#198'}'#4#8' ,>``x'#252#236'%' + +#195#174'C'''#25#148#149#20#24#190#253#248#201#240#20'T'#6'n.N'#244#16'F'#196'#'#20#0#4#16#204#130#249'v'#158#193#186 + +#22#150'V'#12#252#188'<'#12#183#238'=f8}'#233':'#131#139#189'%'#131#149#177 + +#30'$'#236#128#254#255#11'L'#146#204#204'8'#171'i0'#0#213#130#127#254#128'+' + +#171#191' '#2' '#128#160#22'0r'#139'KJ'#131'S'#207#165'k'#183#24#238'>|'#194 + +#224'lk'#198'`'#172#171#201#240#243#215'o'#20#3'@U&.'#0#170#179#223#188#251 + +#192#176'w'#207#30#144#166's 1'#128#0#130'Z'#240#191'y'#255#182'5'#214','#192 + +'Hx'#3'L'#154'O'#239'^e'#16#229#250#199'p'#253#226'Y'#188#174'E'#7#191#129'.' + +#223#182'e'#243#223'S''O'#148#0#185'O@b'#0#1#132'\'#233#187#2#233#6' '#253#11 + +'('#6#162#149#25#240'4[p'#0#144#247#142#2#241'M'#176#179#129'f'#3#4#24#0#252 + +'1e'#249#212#25#172'k'#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tkprintpreviewdialog','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 + +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 + +#0#0#5#198'IDATx'#156'b'#252#255#255'?'#3'y`?'#19#144'`'#7'b^ '#22#1'bq('#27 + +#4'>'#1#241#11' ~'#3#16'@,'#251#246#29#248#191'k'#215'e'#130#198'111'#194'1#' + +'##'#3'33'#19#3';;'#11#3'//'#7#131#136#8#15#131#176'07'#3#215#127#22#6#166 + +''''#255#24'Dx'#4#25'$D?Fr'#219#255'?'#14#16'@, '#195#195#211#146#240#26#14 + +'4'#143#129#9'd('#19#136'f'#0'['#0#18'S'#191'u'#144#225#169#158'#'#131#216 + +#179'+'#12'w3_00'#127#254#201#192'&'#207#205#240'W'#253';'#3'w'#247#255#31'@' + +#173#172#0#1#196#2'2'#224#228#205'/'#184']'#206#8'R'#197#200#192#205#193#196 + +#192#3#196#28'l'#140#12#236'?'#255'2X'#254#186#206'p'#244#212'U'#6'ku9'#134 + +#213#133#187#25#4'/'#241'2'#200#240'I2'#252#229'cax'#225#246#159#225#243'E' + +#254#245#250#250#31#229#1#2#8'l'#193#229#7'_qZ'#192#6'4'#156#159#155#153'AZ' + +#152#133#129#159#139#149'Ax'#227'S'#6#193'G?'#24#30#165#170'2XgJ3'#156'\t'#11 + +#232'B'#6#6'i'#14'q'#6'fA6'#6#134'.]'#134#143#31'.3'#176#255#249#11#210#254 + +#13' '#128#192#22#240'>'#220#138#211#2'..6'#6#17'q'#1#6'9q'#9#134'giG'#24#248 + +'nK2'#8#7'j2H'#8'}c'#248#246#225'7'#195#181#246#19#12#6#204#170#12#204#194'l' + +#12#130'U'#210#12#247'Y'#238'3'#188'}'#251#133'A@'#0#28#223#223#0#2#8'lAGG.' + +#134#193#215#175'_gX'#180'h'#17'0'#172#217#25'8'#217#254'0'#8#243#243'2,'#187 + +'r'#140#193#132'#'#6','#255#255#23#23#195#201#188#189#12#10#159#197#25#184 + +#197'y'#24#248#131#229#25'D"'#245#193#201#233#248#241'E'#12'rr`'#31#252#0#8 + +' '#22#152#129#15#30#220#129#27#254#237#219'7'#134#137#19#167'2'#180'ut'#2'S' + +#13#19#3#11#11'3'#3#27'+3'#195#239#255#147#24#152#129#240#239#219#159#12#239 + +#230#2#131#230#200''''#6'q&a'#6'nGq'#6#209#26'e'#160#190#247'@s'#30'3'#252 + +#252#249#135#225#223'?P'#242'w'#252#7#16'@,'#12'X'#192#157';w'#24'\'#221#220 + +#25'>'#127#253#206#192#2'L:'#28#236#172#192#136'f'#135#203#255#188#241#145 + +#225#219#233'?'#12#130'L|'#12#140#28#204'@'#239'00'#252#186#253#141#129'Y' + +#157#157#129#21#232#16'P'#242#5'%g`^a'#6#8' &l'#22#128#242#30'()'#178#178#176 + +'0'#236#219#187#131#225#241#227#187#12#159'>>'#131#203#255#253#252#135#225 + +#199#143#31#12'w'#255'>ex'#241#237#21#195#143'+'#31#25#222#207'}'#196#240#239 + +#218'w'#6#30#30'Np'#190'`c'#3#187#157#19' '#128#176#250#0'j'#13#208#2'f'#6'Y' + +'Yy'#6#14#14'.`ze'#133#203#176#136#176'3'#200'&'#169'1'#188#186#249#159'a' + +#223#226#253#12'NW'#25#24#228'@'#18#204#140#12'<'#9#162#12#210#210#130'@=l' + +#160'('#16#0#8' '#156#22#128'|'#193#2#244#129#128#160#8#195#163'O?'#24#4#196 + +#197#225'rl'#10'<'#12#172'rl'#12#238'E~'#12'w'#254'=f'#216#183#244#12#216#18 + +'yv&'#6'f~'#22#6#9#23'^'#134#127#236'`'#7#241#1#4#16#214' '#130#135#245#175 + +'_'#12#23#30'2HJ'#10#131'-'#0#8' '#188'A'#196#195#205#197' '#2'L'#25'L@'#131'8X' + +#216#24#184#152'A'#185#154#139#225#215'/F'#134#175#31#190'1p|'#255#202' /+' + +#197#240#245#235#15#134'/_'#190#3#197#127#3#217#223#193'E'#197#175'_'#127'@' + +#198'|'#1#8' '#156#22#220#184#243#144#225#220#149'['#12#14#22#134#12#188#159 + +#222'3||'#0#12#215#207'_'#25#254#3#13#250#249#238#19#3#203#235#23#12#158#246 + +'V'#192'L'#200#198#240#7'X'#176#129#240#191#127#255#24'~'#255#6#250#248#251 + +'o'#134#191'@_'#2's'#242'/'#128#0#194#176#0#148#129#166#205#152#205' ,.'#197 + +'`'#172#171#206'p'#251#222'#'#6#3'5y'#6#158#127#191#25'n]'#187#201'p'#237#226 + +#21#6#150'Oo'#24#2#156'-'#25#196#132#249#193#25#242#31#158'Z'#17' '#128'P' + +#226#128#137#137#153#161#180#188#154'A'#203#216#142#193#216'@'#151#225#212 + +#133'k'#12'"'#2#220#12#186#234'J@'#23#253#5#7#155#188#188'<'#216'Pd'#0'r=##+' + +#3'6'#0#16'@p'#11#238#221'{'#2#166#223#190#253#192#160#207#203#207#176'i'#251 + +'^'#6#3']-'#6#11#19#3#20#13#31'>}F'#243#241'O'#134#237#219#182'2'#196'D'#199 + +#192#205'@'#6#0#1#196'X^>'#9#197#127#239#223#191'f8xx+'#216#149#194#192'\' + +#140#230'X'#12#0#10#29'MM'#19'`'#10#18'G'#17'ws'#211'eprr`'#4#8' '#176#246 + +#189'{'#247#147#219#180#192#11'@'#22#0#4#16'#'#249#205#22#226#0'@'#128#1#0'R' + ,#186#239#253'E'#255#199#222#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tkprintsetupdialog','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#4'gAMA'#0#0#177#142'|'#251'Q'#147#0#0#0' cHRM'#0#0'z%'#0#0#128#131#0#0 + +#249#255#0#0#128#232#0#0'u0'#0#0#234'`'#0#0':'#151#0#0#23'o'#151#169#153#212 + +#0#0#5#227'IDATx'#156'b'#252#255#255'?'#3'y`?'#19#144'`'#7'b^ '#22#1'bq('#27 + +#4'>'#1#241#11' ~'#3#16'@,'#251#246#29#248#191'k'#215'e'#130#198'111'#194'1#' + +'##'#3'33'#19#3';;'#11#3'//'#7#131#136#8#15#131#176'07'#3#215#127#22#6#166 + +''''#255#24'Dx'#4#25'$D?Fr'#219#255'?'#14#16'@, '#195#195#211#146#240#26#14 + +'4'#143#129#9'd('#19#136'f'#0'['#0#18'S'#191'u'#144#225#169#158'#'#131#216 + +#179'+'#12'w3_00'#127#254#201#192'&'#207#205#240'W'#253';'#3'w'#247#255#31'@' + +#173#172#0#1#196#2'2'#224#228#205'/'#184']'#206#8'R'#197#200#192#205#193#196 + +#192#3#196#28'l'#140#12#236'?'#255'2X'#254#186#206'p'#244#212'U'#6'ku9'#134 + +#213#133#187#25#4'/'#241'2'#200#240'I2'#252#229'cax'#225#246#159#225#243'E' + +#254#245#250#250#31#229#1#2#8'l'#193#229#7'_qZ'#192#6'4'#156#159#155#153'AZ' + +#152#133#129#159#139#149'Ax'#227'S'#6#193'G?'#24#30#165#170'2XgJ3'#156'\t'#11 + +#232'B'#6#6'i'#14'q'#6'fA6'#6#134'.]'#134#143#31'.3'#176#255#249#11#210#254 + +#13' '#128#192#22#240'>'#220#138#211#2'..6'#6#17'q'#1#6'9q'#9#134'giG'#24#248 + +'nK2'#8#7'j2H'#8'}c'#248#246#225'7'#195#181#246#19#12#6#204#170#12#204#194'l' + +#12#130'U'#210#12#247'Y'#238'3'#188'}'#251#133'A@'#0#28#223#223#0#2#8'lAGG.V' + +#195'?||'#207#240#239#223'_'#6#22#22'f'#6'66V'#134#244'+]'#12'&'#28'1`'#185 + +#255#191#248#25'N'#230#237'`P'#248','#206#192'-'#206#195#192#31','#207' '#18 + +#169#15'NN'#199#143'/b'#144#147#3#251#224#7'@'#0#177#192#12'{'#240#224#14#134 + +#5'?'#127#255'dPTP'#134#164#26'&f'#134#223#255#255'20'#3#225#223#183'?'#25 + +#222#205#189#203#192'p'#228#19#131'8'#147'0'#3#183#163'8'#131'h'#141'2'#195 + +#183'o'#239#129#230'1'#156#225#190#198#240'n'#31'0>.~'#7'G' + +#23'@'#0#161#248#0'T'#178#254#250#253#155#225#243#151#143#12'/^'#191'f'#16 + +#145#16'ex'#246#226'9'#3#23''''#27'0'#243#240'3'#216'%'#218'2'#240'iK1|'#226 + +'fg'#248','#247#150#225#246#149#135#12#26#26#230#12#191#24#255'2x'#244#6'1'#8 + +#11#137'1'#188'{'#247#14#232#243#219#12#138#138'`'#183#127#4#8' '#140'8'#248 + +#245#235#7#195#253#7'w'#25#222#0#195#127#215#238'}@K'#129'^'#230#230#0#230'L' + +#30#6#17'e>'#134#207#255#238'1'#252'y'#255#151#225#219#211'_'#12'?'#128#233 + +#253#205#149#205#12#31'8'#213#24'~'#255#250#5't'#8'?'#195#251#247#160'`'#254 + +#200' ))'#12#182#0' '#128'0,'#248#3',CXYY'#25#244#244't'#24'n'#221#190#203 + +#192#2'L'#207#172',l'#192#224'a'#1#198#209#127#6'&'#150#223#12#255#129#153#8 + +#232'Q'#6#21'eu'#6#1'M'#15#134#239'/_'#1#227#227'9'#208'q'#191#25#190'~'#253 + +#14'.*~'#253#250#3#142'V'#128#0'B'#177#0'd'#240#206'];'#128'.'#251#9#230#203 + +#203'H0'#128#162#10'\<3Ah'#6#6'Hjb'#4#6#231#219#215'/'#25#166'L'#157#10#204 + +'Xl'#12#22'f'#22#192#220#251#15'h'#241'_'#134#239#223#127'3'#252#253#11#202 + +'7'#142#191#0#2#8#197#2'I'#9'I'#134'g'#207'_0|'#251#250#133'AS['#147#225#210 + +#165'k'#232#30'D'#1#250#250#218#12#215#174'\'#3#6#159'0'#131#188#188'<'#208 + +#213#191'0'#212#0#4#16#138#5'L'#192#242'FCC'#131'a'#214#172#185#12#206#174 + +#206#12#188#252#2'x-'#224#227#229'fX'#184'p9CFj2'#176#172#194'Z(0'#0#4#16#220 + +#130'{'#247#158#128'ie'#5'5'#134#142#230'f'#134#163''''#142#130'k'#173#223 + +#191#255#128'#'#240'/'#176'T'#5#149'9'#140'@G'#128#202#27'6`p'#254#3#6'Wk}=' + +#131#162#146'2'#195#213'k'#152#133'%'#8#0#4#16#216#130#138#138#201#24#18'r' + +#178'Z'#12#220'\'#236#12#191#129'9'#249#215#239'_'#12#255#128#145#255#31#236 + +'K&p\'#177#178#178#0'K'#207'_'#12#251#15#222#5'c\'#0' '#128#192'1'#182'w'#239 + ,'~r'#155#22'x'#129#147#147#3'#@'#0'1'#146#223'l!'#14#0#4#24#0'/h'#237#236'7[' + +#12#214#0#0#0#0'IEND'#174'B`'#130 +]); diff --git a/components/kcontrols/source/khexeditordesign.pas b/components/kcontrols/source/khexeditordesign.pas new file mode 100755 index 000000000..518bdf39a --- /dev/null +++ b/components/kcontrols/source/khexeditordesign.pas @@ -0,0 +1,36 @@ +unit khexeditordesign; + +{$include kcontrols.inc} + +interface + +procedure Register; + +implementation + +{$IFNDEF FPC} + {$R *.dcr} +{$ENDIF} + +uses + Classes, KControls, KDialogs, KHexEditor +{$IFDEF FPC} + , LResources +{$ENDIF} + ; + +procedure Register; +begin + RegisterComponents('TK', [ + TKHexEditor, + TKPrintPreview, + TKPrintSetupDialog, + TKPrintPreviewDialog + ]); +end; + +{$IFDEF FPC} +initialization + {$i khexeditordesign.lrs} +{$ENDIF} +end. diff --git a/components/kcontrols/source/khexeditorlaz.lpk b/components/kcontrols/source/khexeditorlaz.lpk new file mode 100755 index 000000000..03a760817 --- /dev/null +++ b/components/kcontrols/source/khexeditorlaz.lpk @@ -0,0 +1,114 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/kcontrols/source/khexeditorlaz.pas b/components/kcontrols/source/khexeditorlaz.pas new file mode 100644 index 000000000..57ad1b886 --- /dev/null +++ b/components/kcontrols/source/khexeditorlaz.pas @@ -0,0 +1,22 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit KHexEditorLaz; + +interface + +uses + KControls, khexeditordesign, KDialogs, KFunctions, KGraphics, KHexEditor, + KPrintPreview, KPrintSetup, KWideWinProcs, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('khexeditordesign', @khexeditordesign.Register); +end; + +initialization + RegisterPackage('KHexEditorLaz', @Register); +end. diff --git a/components/kcontrols/source/kicon.pas b/components/kcontrols/source/kicon.pas new file mode 100755 index 000000000..e156ac994 --- /dev/null +++ b/components/kcontrols/source/kicon.pas @@ -0,0 +1,2607 @@ +{ @abstract(This unit provides an advanced Windows icon management + i.e. replacement for the Graphics.TIcon component) + @author(Tomas Krysl (tomkrysl@tkweb.eu)) + @created(9 Jan 2005) + @lastmod(20 Jun 2010) + + Copyright © 2005 Tomas Krysl (tomkrysl@@tkweb.eu)

+ + The purpose of the TKIcon component is to replace and expand the standard + TIcon component provided by VCL. The TKIcon component is not based on Windows + icon functions, but manages the icon structures by itself. +
    + Major features are: +
  • 32-bit icons/cursors with alpha channel supported
    • +
  • correct rendering in all 32-bit Windows platforms
    • +
  • optional rendering of all icon/ cursors subimages
    • +
  • icons/cursors can be stretched when drawn
    • +
  • multiple rendering styles
    • +
  • loading from file/stream, HICON, module resources, file associations
    • +
  • saving to file/stream
    • +
  • icon image manipulation (inserting/deleting/cropping/enlarging)
    • +
  • full TPicture integration (only TPicture.Icon can't be used)
    • +
+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KIcon; + +{$include kcontrols.inc} +{$IFNDEF TKICON_REGISTER} + {$WEAKPACKAGEUNIT ON} +{$ENDIF} + +interface + +{$IFDEF USE_WINAPI} + +uses + Windows, SysUtils, Classes, Graphics, KGraphics +{$IFDEF USE_PNG_SUPPORT} + {$IFDEF FPC} + , fpImage, GraphType, IntfGraphics + {$ELSE} + , PngImage + {$ENDIF} +{$ENDIF}; + +resourcestring + { @exclude } + SVIcons = 'Icons'; + { @exclude } + SVCursors = 'Cursors'; + { @exclude } + SIconAllocationError = 'Error while allocating icon data'; + { @exclude } + SIconBitmapError = 'Invalid icon bitmap handles'; + { @exclude } + SIconFormatError = 'Invalid icon format'; + { @exclude } + SIconResourceError = 'Invalid icon resource'; + { @exclude } + SIconIndexError = 'Invalid icon resource index'; + { @exclude } + SIconInvalidModule = 'Invalid module or no icon resources'; + { @exclude } + SIconResizingError = 'Error while resizing icon'; + { @exclude } + SIconAssocResolveError = 'Error while resolving associated icon'; + +type +{$IFDEF USE_PNG_SUPPORT} + { @exclude } + TKIconPngObject = TKPngImage; +{$ELSE} + { @exclude } + TKIconPngObject = TMemoryStream; //used to store compressed PNG stream +{$ENDIF} + + { @abstract(Icon file header) +
    + Members: +
  • idReserved - always 0
    • +
  • idType - 1=icon, 2=cursor
    • +
  • idCount - total number of icon images in file
    • +
+ } + TKIconHeader = packed record + idReserved: Word; + idType: Word; + idCount: Word; + end; + + { Pointer to the icon file header structure } + PKIconHeader = ^TKIconHeader; + + { @abstract(Helper structure identifying attributes that are different for + icons and cursors) +
    + Members: +
  • wPlanes - for icons: amount of image planes - I think that this is always 1
    • +
  • wBitCount - for icons: image color resolution
    • +
  • wX - for cursors: hot spot horizontal coordinate
    • +
  • wY - for cursors: hot spot vertical coordinate
    • +
+ } + TKIconCursorDirInfo = packed record + case Integer of + 0: ( + wPlanes: Word; + wBitCount: Word; + ); + 1: ( + wX: Word; + wY: Word; + ); + end; + + { @abstract(Icon/cursor directory entry. This structure decribes each + icon/cursor image. These structures describing all images immediately follow + the @link(TKIconHeader) structure in the icon file. After these the bitmap data + for all images are stored (TBitmapInfoHeader, palette data, bitmap bits - XOR, AND).) +
    + Members: +
  • Width - image width
    • +
  • Height - image height
    • +
  • ColorCount - number of entries in palette table
    • +
  • Reserved - not used
    • +
  • Info - different for icons/cursors
    • +
  • dwBytesInRes - total number bytes in the image including + pallette data, XOR bits, AND bits and bitmap info header
    • +
  • dwImageOffset - position of image as offset from the beginning of file
    • +
+ } + TKIconCursorDirEntry = packed record + Width: Byte; + Height: Byte; + ColorCount: Byte; + Reserved: Byte; + Info: TKIconCursorDirInfo; + dwBytesInRes: Longint; + dwImageOffset: Longint; + end; + + { Pointer to the icon/cursor directory entry } + PKIconCursorDirEntry = ^TKIconCursorDirEntry; + + { Helper structure to typecast cursor hot spot coordinates } + TKCursorHotSpot = packed record + xHotSpot: Word; + yHotSpot: Word; + end; + + { Pointer to the cursor hot spot structure } + PKCursorHotSpot = ^TKCursorHotSpot; + + { Helper structure for cursor specific data in resource file } + TKCursorDir = packed record + Width: Word; + Height: Word; + end; + + { Helper structure for icon specific data in resource file } + TKIconResdir = packed record + Width: Byte; + Height: Byte; + ColorCount: Byte; + Reserved: Byte; + end; + + { Helper structure merging icon and cursor specific data } + TKIconCursorInfo = packed record + case Integer of + 0: (Icon: TKIconResdir); + 1: (Cursor: TKCursorDir); + end; + + { @abstract(Icon/cursor directory entry as found in resource files) +
    + Members: +
  • Info - structure that merges icon/cursor specific data
    • +
  • wPlanes - not used = 0
    • +
  • wBitCount - not used = 0
    • +
  • dwBytesInRes - total number of bytes in the image including + pallette data, XOR bits, AND bits and bitmap info header
    • +
  • wEntryName - icon/cursor entry name. This number identifies the + particular icon image in a resource file (images are stored under ICONENTRY + key)
    • +
+ } + TKIconCursorDirEntryInRes = packed record + Info: TKIconCursorInfo; + wPlanes: Word; + wBitCount: Word; + dwBytesInRes: Longint; + wEntryName: Word; + end; + + { Pointer to the icon/cursor resource file directory entry } + PKIconCursorDirEntryInRes = ^TKIconCursorDirEntryInRes; + + { Helper structure to access resource data } + TKIconCursorInRes = packed record + IH: TKIconHeader; + Entries: array [0..MaxInt div SizeOf(TKIconCursorDirEntryInRes) - 2] of TKIconCursorDirEntryInRes; + end; + + { Pointer to the helper structure } + PKIconCursorInRes = ^TKIconCursorInRes; + + { Controls how the image should be aligned when they are beeing resized } + TKIconAlignStyle = ( + { image remains aligned to the top-left corner } + asNone, + { image will be centered within the new boundary rectangle } + asCenter + ); + + { Specifies the width and height of an icon or cursor image } + TKIconDimension = record + Width, + Height: Integer; + end; + + { @abstract(Specifies the GDI handles for one icon/cursor image) +
    + Members: +
  • hXOR - handle to the color bitmap - icon image
    • +
  • hAND - handle to the monochrome bitmap - icon image mask
    • +
+ } + TKIconHandles = record + hXOR, + hAND: HBITMAP; + end; + + { @abstract(Represents the internal data structure describing each icon/cursor image) +
    + Members: +
  • Width - image width
    • +
  • Height - image height
    • +
  • Bpp - image color resolution
    • +
  • BytesInRes - total image data size
    • +
  • HotSpot - hot spot for a cursor
    • +
  • iXOR - pointer to the color bitmap info header + palette
    • +
  • iXORSize - size of iXOR data
    • +
  • pXOR - pointer to the color bitmap bits
    • +
  • pXORSize - size of pXOR data
    • +
  • hXOR - handle to the color bitmap - is always a DIB section
    • +
  • pAND - pointer to the monochrome (mask) bitmap bits
    • +
  • pANDSize - size of pAND data
    • +
  • hAND - handle to the monochrome bitmap - is always a DIB section
    • +
  • PNG - holds the PNG image
    • +
+ } + TKIconData = record + Width: Integer; + Height: Integer; + Bpp: Integer; + BytesInRes: Integer; + Offset: Integer; + HotSpot: TPoint; + iXOR: PBitmapInfo; + iXORSize: Integer; + pXOR: Pointer; + pXORSize: Integer; + hXOR: HBITMAP; + pAND: Pointer; + pANDSize: Integer; + hAND: HBITMAP; + IsPNG: Boolean; + PNG: TKIconPngObject; + end; + + { Pointer to the internal image description structure } + PKIconData = ^TKIconData; + + { Specifies how the icon image(s) should be rendered. This feature can be used + along with the MaskFromColor method to implement a ‘color picker’ for a new mask construction. } + TKIconDrawStyle = ( + { paint normally } + idsNormal, + { paint without applying the mask - color bitmap only } + idsNoMask, + { paint only the mask - monochrome bitmap only } + idsMaskOnly, + { paint only the alpha channel as grayscale image - only for 32 bit icon bitmaps else paint as with idsNoMask style } + idsAlphaChannel + ); + + { KIcon main class. } + TKIcon = class(TGraphic) + private + FAlignStyle: TKIconAlignStyle; + FBpp: Integer; + FCreating: Boolean; + FCurrentIndex: Integer; + FCursor: Boolean; + FDisplayAll: Boolean; + FDisplayHorz: Boolean; + FIconCount: Integer; + FIconData: array of TKIconData; + FIconDrawStyle: TKIconDrawStyle; + FInHandleBpp: Integer; + FInHandleFullAlpha: Boolean; + FMaxHeight: Integer; + FMaxWidth: Integer; + FOptimalIcon: Boolean; + FOverSizeWeight: Single; + FRequestedSize: TKIconDimension; + FSpacing: Integer; + FStretchEnabled: Boolean; + function GetDimensions(Index: Integer): TKIconDimension; + function GetHandles(Index: Integer): TKIconHandles; + function GetHeights(Index: Integer): Integer; + function GetHotSpot(Index: Integer): TPoint; + function GetIconData(Index: Integer): TKIconData; + function GetWidths(Index: Integer): Integer; + procedure SetCurrentIndex(Value: Integer); + procedure SetDimensions(Index: Integer; Value: TKIconDimension); + procedure SetDisplayAll(Value: Boolean); + procedure SetDisplayHorz(Value: Boolean); + procedure SetHandles(Index: Integer; Value: TKIconHandles); + procedure SetHeights(Index: Integer; Value: Integer); + procedure SetHotSpot(Index: Integer; Value: TPoint); + procedure SetInHandleBpp(Value: Integer); + procedure SetIconDrawStyle(Value: TKIconDrawStyle); + procedure SetOptimalIcon(Value: Boolean); + procedure SetOverSizeWeight(Value: Single); + procedure SetRequestedSize(Value: TKIconDimension); + procedure SetSpacing(Value: Integer); + procedure SetStretchEnabled(Value: Boolean); + procedure SetWidths(Index: Integer; Value: Integer); + protected + { Overriden method - see Delphi help. Calls @link(Update) method. } + procedure Changed(Sender: TObject); override; + { Overriden method - see Delphi help. } + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; + { Overriden method - see Delphi help. } + function GetEmpty: Boolean; override; + { Overriden method - see Delphi help. } + function GetHeight: Integer; override; + { Overriden method - see Delphi help. } + function GetTransparent: Boolean; override; + { Overriden method - see Delphi help. } + function GetWidth: Integer; override; + { Copies the bitmaps stored in Handles to the icon image identified by Index. + If OrigBpp is True, the color resolution for the color bitmap remains unchanged, + otherwise the value of InHandleBpp will be used. } + procedure LoadHandles(Index: Integer; const Handles: TKIconHandles; OrigBpp: Boolean); + { Overriden method - see Delphi help. } + procedure SetHeight(Value: Integer); override; + { Overriden method - see Delphi help. } + procedure SetTransparent(Value: Boolean); override; + { Overriden method - see Delphi help. } + procedure SetWidth(Value: Integer); override; + { Updates @link(MaxWidth), @link(MaxHeight) and @link(CurrentIndex) + properties accordingly. } + procedure Update; dynamic; + { Resizes an icon image identified by Index to new dimensions stored in Value. + The AlignStyle property controls the image alignment within the new rectangle. } + procedure UpdateDim(Index: Integer; Value: TKIconDimension); + public + { Overriden method - see Delphi help. } + constructor Create; override; + { Overriden method - see Delphi help. } + destructor Destroy; override; + { Adds a new image to the end of the internal image list. You should always + specify valid color and mask bitmap handles else an exception will occur. } + procedure Add(const Handles: TKIconHandles); + { Overriden method - see Delphi help. } + procedure Assign(Source: TPersistent); override; + { Clears all images so that the instance contains no icon/cursor. } + procedure Clear; {$IFDEF FPC}override{$ELSE}dynamic{$ENDIF}; + { Copies the icon image into an alpha bitmap identified by Bitmap. + Icon image is copied to the alpha bitmap. It icon has alpha channel + it is copied as well. + Bitmap size will always be matched to the icon image. } + procedure CopyToAlphaBitmap(Index: Integer; Bitmap: TKAlphaBitmap); + { Copies the icon image into a bitmap identified by Bitmap. Both color + and mask image is copied to preserve true transparency. You can use this + to pass to Glyph properties (e.g. TSpeedButton). Bitmap properties will + always be matched to the icon image. For 32bpp icon images, + alpha channel is copied as well. } + procedure CopyToBitmap(Index: Integer; Bitmap: TBitmap); + {$IFDEF USE_PNG_SUPPORT} + { Copies the icon image into a png image identified by Png. + It is saved always in truecolor format with alpha channel (32bpp). + Png size will always be matched to the icon image. } + procedure CopyToPng(Index: Integer; Png: TKPngImage); + {$ENDIF} + { Creates an icon handle for use with Win32 API icon functions. The image + identified by Index will be used for this handle. If DisplayAll is False + and Index is out of range, CurrentIndex will be used instead. } + function CreateHandle(Index: Integer): HICON; + { Deletes an image identified by Index from the internal image list. } + procedure Delete(Index: Integer); + { Inserts an image at the position identified by Index into the internal + image list. The existing images will be preserved and shifted accordingly. } + procedure Insert(Index: Integer; const Handles: TKIconHandles); + {$IFNDEF FPC} + { Overriden method - see Delphi help. Does nothing for icons/cursors. } + procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; + APalette: HPALETTE); override; + { Loads the icon from the module associated with the file identified by FileName + (DefaultIcon registry key). If no association can be found for the file, + an exception will be raised and the function will try to load FileName + as if it was a module itself. } + {$ENDIF} + procedure LoadFromAssocFile(const FileName: string); + { Loads the icon from the module associated with the file extension identified + by Extension (DefaultIcon registry key). The Extension parameter should + contain the leading period ('.'). If no association can be found for that + extension, an exception will be triggered. } + procedure LoadFromAssocExtension(const Extension: string); + { Loads the icon from Win32 API icon handle. Please keep in mind that icon bitmaps + can't be loaded as DIBs because they are already converted to DDBs when + accessible through HICON. So it is impossible to load the icon in it's + native format (e.g. as stored in an *.ico file) from HICON. This function + has been introduced only to complete the loading schemes of this class + and you should rather use another LoadFrom... methods. The behavior of this + function can be controlled via the InHandleBpp and InHandleFullAlpha properties. + It is not recommended to use this function in new projects. } + procedure LoadFromHandle(Handle: HICON); + { Loads the icon from resources of a module identified by ModuleName. + A valid icon resource must be specified by ID, otherwise + an exception occurs. This function uses the LoadLibrary API function, so + it is recommended to use the LoadFromResourceX functions to load multiple + icons from the same module. ID is of type Word so it can’t exceed 65535. } + procedure LoadFromModule(const ModuleName: string; ID: Word); overload; + { Does the same thing, but with resource ID specified as string. Let's suppose + ID = 123. Here you can pass it as a string '#123'. } + procedure LoadFromModule(const ModuleName, ResName: string); overload; + { This function does the same as @link(LoadFromModule), but the icon resource + is specified by index here. The index stands for the n-th icon stored + in the module resources. So, LoadFromModule('dummy.exe', 'MAINICON') would + produce the same results as LoadFromModuleByIndex('dummy.exe', 0), + provided 'MAINICON' is the first icon resource in 'dummy.exe'. } + procedure LoadFromModuleByIndex(const ModuleName: string; Index: Integer); + { Loads the icon from resources of a module instance identified by Instance. + Further behavior corresponds to @link(LoadFromModule) with resource ID + specified as integer. } + procedure LoadFromResource(Instance: HINST; ID: Word); overload; + { Loads the icon from resources of a module instance identified by Instance. + Further behavior corresponds to @link(LoadFromModule) with resource ID + specified as string. } + procedure LoadFromResource(Instance: HINST; const ResName: string); overload; + { Loads the icon from resources of a module instance identified by Instance. + Further behavior corresponds to @link(LoadFromModuleByIndex). } + procedure LoadFromResourceByIndex(Instance: HINST; Index: Integer); + { Loads the icon from the stream. Parses the *.ico file structure. + An overriden method. } + procedure LoadFromStream(Stream: TStream); override; + { Makes it possible to create a new mask bitmap for the image identified by Index. + The new monochrome mask bitmap will be created from the color bitmap. + Pixels of the color bitmap that match Color will be masked by the new mask, + other pixels will be unmasked. If the Color parameter contains alpha channel, + you should set HasAlpha to True to perform comparison with the alpha channel. + Otherwise, only the red, green and blue channels will be compared. } + procedure MaskFromColor(Index: Integer; Color: TColor; HasAlpha: Boolean = False); + {$IFNDEF FPC} + { Overriden method - see Delphi help. Does nothing for icons/cursors. } + procedure SaveToClipboardFormat(var Format: Word; var Data: THandle; + var APalette: HPALETTE); override; + {$ENDIF} + { Saves the icon to the stream. Assembles the *.ico file structure. An overriden method. } + procedure SaveToStream(Stream: TStream); override; + { Controls the icon image resizing which is performed by the UpdateDim method. } + property AlignStyle: TKIconAlignStyle read FAlignStyle write FAlignStyle; + { Specifies the index of the currently displayed icon image. + If no image is loaded (no icon), the value of CurrentIndex is -1. } + property CurrentIndex: Integer read FCurrentIndex write SetCurrentIndex; + { Indicates whether the instance of this class represents a cursor (True) or an icon (False). } + property Cursor: Boolean read FCursor write FCursor; + { Specifies whether all icon images (True) or a single subimage should be + drawn (False). When True, all available icon images will be rendered. } + property DisplayAll: Boolean read FDisplayAll write SetDisplayAll; + { Specifies how the images should be drawn when @link(DisplayAll) is True. + If True, the images will be drawn horizontally aligned. If False, + the images will be drawn vertically aligned. } + property DisplayHorz: Boolean read FDisplayHorz write SetDisplayHorz; + { Makes it possible to read/modify the size of an icon image. } + property Dimensions[Index: Integer]: TKIconDimension read GetDimensions write SetDimensions; + { Makes it possible to read/modify icon image bitmaps (color and mask bitmap). + Bitmaps that you pass will be copied and remain unchanged. When reading + original bitmap handles are returned and thus must not be modified or released. } + property Handles[Index: Integer]: TKIconHandles read GetHandles write SetHandles; + { Makes it possible to read/modify the height of an icon image. } + property Heights[Index: Integer]: Integer read GetHeights write SetHeights; + { For a cursor, this property contains the hot spots for all cursor images. } + property HotSpot[Index: Integer]: TPoint read GetHotSpot write SetHotSpot; + { Returns the number of images found in this instance. } + property IconCount: Integer read FIconCount; + { Makes it possible to read the internal data structure of each icon image. + A copy of the structure is returned but the pointers or handles are original + (no copies are created) and thus must not be modified or released. } + property IconData[Index: Integer]: TKIconData read GetIconData; + { Affects the icon image rendering. } + property IconDrawStyle: TKIconDrawStyle read FIconDrawStyle write SetIconDrawStyle; + { Specifies the color resolution a DIB should have after converted from a DDB + that has been passed to the LoadHandles method. } + property InHandleBpp: Integer read FInHandleBpp write SetInHandleBpp; + { Determines whether a DIB with 32 bits per pixel should have full visibility + (alpha channel of each pixel set to 0xFF) after converted from a DDB + that has been passed to the LoadHandles method. The alpha channel values will + be only set to 0xFF when the current alpha channel of every pixel is zero. } + property InHandleFullAlpha: Boolean read FInHandleFullAlpha write FInHandleFullAlpha; + { Returns the height of the image that has the maximum height of all icon images. + When @link(DisplayAll) is True and @link(DisplayHorz) is False, returns the + total height of all images and spaces between them (specified by @link(Spacing)). } + property MaxHeight: Integer read FMaxHeight; + { Returns the width of the image that has the maximum width of all icon images. + When both @link(DisplayAll) and @link(DisplayHorz) is True, returns the + total width of all images and spaces between them (specified by @link(Spacing)). } + property MaxWidth: Integer read FMaxWidth; + { This property applies only when DisplayAll is False. It determines whether + the icon image corresponding to the RequestedSize property and the current + display mode color resolution (True) or the subimage specified by CurrentIndex + (False) should be displayed. } + property OptimalIcon: Boolean read FOptimalIcon write SetOptimalIcon; + { Controls the decision threshold for the optimal image when OptimalIcon is True. + The bigger the value is, the less is the probability a subimage greater than + RequestedSize will be selected. This value is big enough by default so that + almost always a smaller image will be selected if none with the exact size is found. } + property OverSizeWeight: Single read FOverSizeWeight write SetOverSizeWeight; + { Specifies the preferred image size when OptimalIcon is True. + When OverSizeWeight is small, a greater subimage may be often selected. } + property RequestedSize: TKIconDimension read FRequestedSize write SetRequestedSize; + { Specifies the spacing between icon images when @link(DisplayAll) is True. } + property Spacing: Integer read FSpacing write SetSpacing; + { Specifies whether icon images can be stretched when drawn. This property + was introduced perhaps only for backward compatibility with Graphics.TIcon. } + property StretchEnabled: Boolean read FStretchEnabled write SetStretchEnabled; + { Makes it possible to read/modify the width of an icon image. } + property Widths[Index: Integer]: Integer read GetWidths write SetWidths; + end; + + { This class is necessary because of the TPicture streaming. } + TIcon = class(TKIcon); + +{ Creates a bitmap from an icon object stored in application resources. } +function CreateBitmapFromResIcon(const ResName: string; ResType: PChar = RT_ICON): TBitmap; + +{ Creates an alpha bitmap from an icon object stored in application resources. } +function CreateAlphaBitmapFromResIcon(const ResName: string; ResType: PChar): TKAlphaBitmap; + +{ Returns the str1ucture containing hXOR and hAND bitmaps. } +function MakeHandles(hXOR, hAND: HBITMAP): TKIconHandles; + +{ Returns the total number of resources of a type specified by ResType + in a module identified by Instance. } +function GetModuleResourceCount(Instance: HINST; ResType: PChar): Integer; + +{ Returns the total number of HW-independent icon resources + in a module identified by Instance. } +function GetModuleIconCount(Instance: HINST): Integer; overload; + +{ Returns the total number of HW-independent icon resources + in a module identified by ModuleName. } +function GetModuleIconCount(const ModuleName: string): Integer; overload; + +{ Integrates KIcon into TPicture. } +procedure RegisterKIcon; + +{ Removes KIcon from TPicture. } +procedure UnregisterKIcon; + +{$ENDIF} + +implementation + +{$IFDEF USE_WINAPI} + +uses + Math, Registry, KFunctions; + +type + TKMaskBitmapInfo = packed record + Header: TBitmapInfoHeader; + Black, + White: TRGBQuad; + end; + +procedure FreeSubimage(PID: PKIconData); +begin + FreeMem(PID.iXOR); + if PID.hXOR <> 0 then DeleteObject(PID.hXOR); + if PID.hAND <> 0 then DeleteObject(PID.hAND); + PID.PNG.Free; + FillChar(PID^, SizeOf(TKIconData), 0); +end; + +function CalcByteWidth(Width, Bpp: Integer): Integer; +begin + Result := DivUp(Width * Bpp, SizeOf(LongWord) shl 3) * SizeOf(LongWord); +end; + +function CalcBitmapSize(Width, Height, Bpp: Integer): Integer; +begin + Result := CalcByteWidth(Width, Bpp) * Height; +end; + +procedure CalcByteWidths(Width, Bpp: Integer; out XORWidth, ANDWidth: Integer); +begin + XORWidth := CalcByteWidth(Width, Bpp); + ANDWidth := CalcByteWidth(Width, 1); +end; + +procedure CalcBitmapSizes(Width, Height, Bpp: Integer; out XORSize, ANDSize: Integer); +begin + XORSize := CalcBitmapSize(Width, Height, Bpp); + ANDSize := CalcBitmapSize(Width, Height, 1); +end; + +function GetPaletteSize(Bpp: Integer): Integer; +begin + if Bpp <= 8 then + Result := 1 shl Bpp + else + Result := 0; +end; + +procedure QueryBitmapBits(DC: HDC; hBmp: HBITMAP; var Bits: Pointer; var Size: Integer); +var + BInfo: Windows.TBitmap; + BI: TBitmapInfo; +begin + GetObject(hBmp, SizeOf(Windows.TBitmap), @BInfo); + Size := CalcBitmapSize(BInfo.bmWidth, BInfo.bmHeight, BInfo.bmBitsPixel); + GetMem(Bits, Size); + FillChar(BI, SizeOf(TBitmapInfo), 0); + with BI.bmiHeader do + begin + biSize := SizeOf(TBitmapInfoHeader); + biWidth := BInfo.bmWidth; + biHeight := BInfo.bmHeight; + biPlanes := 1; + biBitCount := BInfo.bmBitsPixel; + biCompression := BI_RGB; + end; + GetDIBits(DC, hBmp, 0, BInfo.bmHeight, Bits, BI, DIB_RGB_COLORS); +end; + +procedure CreateColorInfo(Width, Height, Bpp: Integer; var BI: PBitmapInfo; var InfoSize: Integer); +begin + InfoSize := SizeOf(TBitmapInfoHeader) + GetPaletteSize(Bpp) * SizeOf(TRGBQuad); + GetMem(BI, InfoSize); + FillChar(BI^, InfoSize, 0); + with BI.bmiHeader do + begin + biSize := SizeOf(TBitmapInfoHeader); + biWidth := Width; + biHeight := Height; + biPlanes := 1; + biBitCount := Bpp; + end; +end; + +procedure CreateMaskInfo(Width, Height: Integer; var BIMask: TKMaskBitmapInfo); +begin + FillChar(BIMask, SizeOf(TKMaskBitmapInfo), 0); + with BIMask.Header do + begin + biSize := SizeOf(TBitmapInfoHeader); + biWidth := Width; + biHeight := Height; + biPlanes := 1; + biBitCount := 1; + end; + Cardinal(BIMask.Black) := clBlack; + Cardinal(BIMask.White) := clWhite; +end; + +function CreateMonochromeBitmap(Width, Height: Integer): HBITMAP; +begin + Result := GDICheck(CreateBitmap(Width, Height, 1, 1, nil)); +end; + +procedure MaskOrBitBlt(ACanvas: TCanvas; X, Y, Width, Height: Integer; + DC_XOR, DC_AND: HDC; BM_XOR, BM_AND: HBITMAP; + XORBits: PKColorRecs; XORSize: Integer; + ANDBits: PBytes; ANDSize: Integer; + Bpp: Integer; Style: TKIconDrawStyle); +var + I, J, K, LAnd: Integer; + Alpha, ByteMask: Byte; + FreeBits: Boolean; + Q: PBytes; + Ps, Pd: PKColorRecs; + BMSrc, BMDest: TKAlphaBitmap; + R: TRect; +begin + if Style <> idsMaskOnly then + begin + BMSrc := TKAlphaBitmap.Create; + try + BMDest := TKAlphaBitmap.Create; + try + R := Rect(X, Y, X + Width, Y + Height); + BMSrc.SetSize(Width, Height); + if Bpp = 32 then + begin // perform alphablend + if XORBits = nil then + begin + QueryBitmapBits(DC_XOR, BM_XOR, Pointer(XORBits), XORSize); + FreeBits := True; + end else + FreeBits := False; + try + if Style = idsAlphaChannel then + begin + for I := 0 to Height - 1 do + begin + Ps := BMSrc.ScanLine[I]; + K := I * Width; + for J := 0 to Width - 1 do + begin + Alpha := 255 - XORBits[K + J].A; + Ps[J].R := Alpha; + Ps[J].G := Alpha; + Ps[J].B := Alpha; + end; + end; + end else + begin + BMSrc.DrawFrom(ACanvas, R); + for I := 0 to Height - 1 do + begin + Ps := @XORBits[I * Width]; + Pd := BMSrc.ScanLine[I]; + BlendLine(Ps, Pd, Width); + end + end + finally + if FreeBits then FreeMem(XORBits); + end; + end else + BitBlt(BMSrc.Canvas.Handle, 0, 0, Width, Height, DC_XOR, 0, 0, SRCCOPY); + if Style = idsNormal then + begin + BMDest.SetSize(Width, Height); + BMDest.DrawFrom(ACanvas, R); + if ANDBits = nil then + begin + QueryBitmapBits(DC_XOR, BM_AND, Pointer(ANDBits), ANDSize); + FreeBits := True; + end else + FreeBits := False; + if ANDBits <> nil then + begin + try + LAnd := CalcByteWidth(Width, 1); + Q := ANDBits; + for I := 0 to Height - 1 do + begin + Ps := BMSrc.ScanLine[I]; + Pd := BMDest.ScanLine[I]; + ByteMask := $80; + for J := 0 to Width - 1 do + begin + if Q[J shr 3] and ByteMask <> 0 then + Ps[J] := Pd[J]; + asm + ror ByteMask, 1 + end; + end; + Inc(Cardinal(Q), LAnd); + end; + finally + if FreeBits then FreeMem(ANDBits); + end; + end; + end; + BMSrc.DrawTo(ACanvas, R); + finally + BMDest.Free; + end; + finally + BMSrc.Free; + end; + end else + begin + if DC_AND = 0 then + begin + DC_AND := CreateCompatibleDC(ACanvas.Handle); + try + SelectObject(DC_AND, BM_AND); + BitBlt(ACanvas.Handle, X, Y, Width, Height, DC_AND, 0, 0, SrcCopy); + finally + DeleteDC(DC_AND); + end; + end else + BitBlt(ACanvas.Handle, X, Y, Width, Height, DC_AND, 0, 0, SrcCopy); + end; +end; + +procedure FillAlphaIfNone(Pixels: PKColorRecs; Size: Integer; Alpha: Byte); +var + I: Integer; +begin + Size := Size shr 2; + for I := 0 to Size - 1 do + if Pixels[I].A <> 0 then + Exit; // bitmap has a nonempty alpha channel, don't fill + for I := 0 to Size - 1 do + Pixels[I].A := Alpha; +end; + +function CreateBitmapFromResIcon(const ResName: string; ResType: PChar): TBitmap; +var + Icon: TKIcon; + Stream: TResourceStream; +begin + Result := TBitmap.Create; + Icon := TKIcon.Create; + try + Stream := TResourceStream.Create(HInstance, ResName, ResType); + try + Icon.LoadFromStream(Stream); + Icon.CopyToBitmap(Icon.CurrentIndex, Result); + finally + Stream.Free; + end; + finally + Icon.Free; + end; +end; + +function CreateAlphaBitmapFromResIcon(const ResName: string; ResType: PChar): TKAlphaBitmap; +var + Icon: TKIcon; + Stream: TResourceStream; +begin + Result := TKAlphaBitmap.Create; + Icon := TKIcon.Create; + try + Stream := TResourceStream.Create(HInstance, ResName, ResType); + try + Icon.LoadFromStream(Stream); + Icon.CopyToAlphaBitmap(Icon.CurrentIndex, Result); + finally + Stream.Free; + end; + finally + Icon.Free; + end; +end; + +procedure InternalCopyToAlphaBitmap(ABitmap: TKAlphaBitmap; + BM_XOR: HBITMAP; AndBits: PBytes; Bpp: Integer); +var + I, J, LAnd: Integer; + ByteMask: Byte; + Q: PBytes; + Ps: PKColorRecs; + DC: HDC; +begin + if (ABitmap <> nil) and (AndBits <> nil) and (BM_XOR <> 0) then + begin + DC := CreateCompatibleDC(0); + try + SelectObject(DC, BM_XOR); + BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, DC, 0, 0, SRCCOPY); + LAnd := CalcByteWidth(ABitmap.Width, 1); + Q := ANDBits; + for I := 0 to ABitmap.Height - 1 do + begin + Ps := ABitmap.ScanLine[I]; + ByteMask := $80; + for J := 0 to ABitmap.Width - 1 do + begin + if Q[J shr 3] and ByteMask <> 0 then + Ps[J].A := 0 + else if Bpp < 32 then + Ps[J].A := 255; + asm + ror ByteMask, 1 + end; + end; + Inc(Cardinal(Q), LAnd); + end; + finally + DeleteDC(DC); + end; + end; +end; + +function MakeHandles(hXOR, hAND: HBITMAP): TKIconHandles; +begin + Result.hXOR := hXOR; + Result.hAND := hAND; +end; + +function GetModuleResourceCount(Instance: HINST; ResType: PChar): Integer; + + function EnumIcons(hModule: HINST; lpType, lpName: PChar; dwParam: DWORD): BOOL; stdcall; + begin + Inc(PInteger(dwParam)^); + Result := True; + end; + +begin + Result := 0; + EnumResourceNames(Instance, ResType, @EnumIcons, DWORD(@Result)); +end; + +function GetModuleIconCount(Instance: HINST): Integer; +begin + Result := GetModuleResourceCount(Instance, RT_GROUP_ICON); +end; + +function GetModuleIconCount(const ModuleName: string): Integer; +var + Module: HINST; +begin + Result := 0; + Module := LoadLibraryEx(PChar(ModuleName), 0, LOAD_LIBRARY_AS_DATAFILE); + if Module <> 0 then + begin + try + Result := GetModuleIconCount(Module); + finally + FreeLibrary(Module); + end; + end; +end; + +{ TKIcon } + +constructor TKIcon.Create; +begin + inherited Create; + FCreating := True; + try + Transparent := True; // we are not in Graphics.pas... + finally + FCreating := False; + end; + FAlignStyle := asCenter; + FCursor := False; + FDisplayAll := False; + FIconDrawStyle := idsNormal; + FInHandleBpp := 0; + FInHandleFullAlpha := True; + FIconData := nil; + FOptimalIcon := True; + FOverSizeWeight := 1000.0; // virtually always selects a lower resolution image + FRequestedSize.Width := 32; + FRequestedSize.Height := 32; + FSpacing := 2; + FStretchEnabled := True; + Clear; +end; + +destructor TKIcon.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TKIcon.Add(const Handles: TKIconHandles); +begin + Inc(FIconCount); + SetLength(FIconData, FIconCount); + FillChar(FIconData[FIconCount - 1], SizeOf(TKIconData), 0); + LoadHandles(FIconCount - 1, Handles, True); +end; + +procedure TKIcon.Assign(Source: TPersistent); +var + MS: TMemoryStream; +begin + if (Source = nil) or (Source is TKIcon) then + begin + Clear; + if Source <> nil then + begin + FAlignStyle := TKIcon(Source).AlignStyle; + FCursor := TKIcon(Source).Cursor; + FDisplayAll := TKIcon(Source).DisplayAll; + FIconDrawStyle := TKIcon(Source).IconDrawStyle; + FInHandleBpp := TKIcon(Source).InHandleBpp; + FInHandleFullAlpha := TKIcon(Source).InHandleFullAlpha; + FOptimalIcon := TKIcon(Source).OptimalIcon; + FOverSizeWeight := TKIcon(Source).OverSizeWeight; + FRequestedSize := TKIcon(Source).RequestedSize; + FSpacing := TKIcon(Source).Spacing; + FStretchEnabled := TKIcon(Source).StretchEnabled; + if not TKIcon(Source).Empty then + begin + MS := TMemoryStream.Create; + try + TKIcon(Source).SaveToStream(MS); + MS.Position := 0; + LoadFromStream(MS); + FCurrentIndex := TKIcon(Source).CurrentIndex; + finally + MS.Free; + end; + end else + Changed(Self); + end else + Changed(Self); + Exit; + end; + inherited Assign(Source); +end; + +procedure TKIcon.Changed(Sender: TObject); +begin + Update; + inherited; +end; + +procedure TKIcon.Clear; +var + I: Integer; +begin + if FIconData <> nil then + begin + for I := 0 to FIconCount - 1 do + FreeSubimage(@FIconData[I]); + FIconData := nil; + end; + FIconCount := 0; + Update; +end; + +procedure TKIcon.CopyToAlphaBitmap(Index: Integer; Bitmap: TKAlphaBitmap); +var + ID: TKIconData; +{$IFDEF USE_PNG_SUPPORT} + I, J: Integer; + C: TKColorRec; + {$IFDEF FPC} + IM: TLazIntfImage; + FC: TFPColor; + {$ENDIF} +{$ENDIF} +begin + if (Index >= 0) and (Index < FIconCount) and (Bitmap <> nil) then + begin + ID := FIconData[Index]; + Bitmap.SetSize(ID.Width, ID.Height); + Bitmap.DirectCopy := True; + try + if ID.IsPng then + begin + {$IFDEF USE_PNG_SUPPORT} + {$IFDEF FPC} + IM := ID.PNG.CreateIntfImage; + try + for I := 0 to ID.Width - 1 do + for J := 0 to ID.Height - 1 do + begin + FC := IM.Colors[I, J]; + C.A := FC.alpha; C.B := FC.blue; C.R := FC.red; C.G := FC.green; + Bitmap.Pixel[I, J] := C; + end; + finally + IM.Free; + end; + {$ELSE} + for I := 0 to ID.Width - 1 do + for J := 0 to ID.Height - 1 do + begin + C.Value := ID.PNG.Pixels[I, J]; + C.A := ID.PNG.AlphaScanline[J][I]; + Bitmap.Pixel[I, J] := C; + end; + {$ENDIF} + {$ENDIF} + end else + InternalCopyToAlphaBitmap(Bitmap, ID.hXOR, ID.pAND, ID.Bpp); + finally + Bitmap.DirectCopy := False; + end; + end; +end; + +procedure TKIcon.CopyToBitmap(Index: Integer; Bitmap: TBitmap); +var + DC: HDC; + ID: TKIconData; + Mask: TBitmap; +begin + if (Index >= 0) and (Index < FIconCount) and (Bitmap <> nil) then + begin + ID := FIconData[Index]; + {$IFDEF FPC} + Bitmap.PixelFormat := PixelFormatFromBpp(ID.Bpp); + {$ELSE} + Bitmap.PixelFormat := pf32bit; + {$ENDIF} + Bitmap.Width := ID.Width; // SetSize not supported prior Delphi 2006 + Bitmap.Height := ID.Height; + if ID.IsPng then + {$IFDEF USE_PNG_SUPPORT} + Bitmap.Canvas.Draw(0, 0, ID.PNG) + {$ENDIF} + else + begin + Mask := TBitmap.Create; + try + Mask.MonoChrome := True; + Mask.Width := ID.Width; + Mask.Height := ID.Height; + DC := CreateCompatibleDC(0); + try + SelectObject(DC, ID.hXOR); + BitBlt(Bitmap.Canvas.Handle, 0, 0, ID.Width, ID.Height, DC, 0, 0, SRCCOPY); + SelectObject(DC, ID.hAND); + BitBlt(Mask.Canvas.Handle, 0, 0, ID.Width, ID.Height, DC, 0, 0, SRCCOPY); + Bitmap.MaskHandle := Mask.ReleaseHandle; + finally + DeleteDC(DC); + end; + finally + Mask.Free; + end; + end; + end; +end; + +{$IFDEF USE_PNG_SUPPORT} +procedure TKIcon.CopyToPng(Index: Integer; Png: TKPngImage); +var + ID: TKIconData; +{$IFNDEF FPC} + I, J: Integer; + C: TKColorRec; + Bitmap: TKAlphaBitmap; +{$ENDIF} +begin + if (Index >= 0) and (Index < FIconCount) and (Png <> nil) then + begin + ID := FIconData[Index]; + if ID.IsPNG then + Png.Assign(ID.PNG) + else + begin + {$IFDEF FPC} + Png.LoadFromBitmapHandles(ID.hXOR, ID.hAND); + {$ELSE} + Bitmap := TKAlphaBitmap.Create; + try + Bitmap.SetSize(ID.Width, ID.Height); + Bitmap.DirectCopy := True; + InternalCopyToAlphaBitmap(Bitmap, ID.hXOR, ID.pAND, ID.Bpp); + Png.CreateBlank(COLOR_RGBALPHA, 8, ID.Width, ID.Height); + for I := 0 to ID.Width - 1 do + for J := 0 to ID.Height - 1 do + begin + C := Bitmap.Pixel[I, J]; + Png.Pixels[I, J] := C.Value; + Png.AlphaScanline[J][I] := C.A; + end; + finally + Bitmap.Free; + end; + {$ENDIF} + end; + end; +end; +{$ENDIF} + +function TKIcon.CreateHandle(Index: Integer): HICON; +var + ABpp, ANDSize, XORSize: Integer; + PID: PKIconData; + PBI: PBitmapInfo; + DC: HDC; + hBmp: HBITMAP; + ANDBits, XORBits: Pointer; +begin + Result := 0; + if FIconData <> nil then + begin + DC := GetDC(0); + try + ABpp := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL); + if ABpp <> FBpp then + Update; + if FDisplayAll then + begin + if (Index < 0) or (Index >= FIconCount) then + Index := 0; + end + else if (Index < 0) or (Index >= FIconCount) then + Index := FCurrentIndex; + PID := @FIconData[Index]; + CalcBitmapSizes(PID.Width, PID.Height, FBpp, XORSize, ANDSize); + GetMem(XORBits, XORSize); + try + GetMem(ANDBits, XORSize); + try + PBI := PID.iXOR; + hBmp := GDICheck(CreateDIBitmap(DC, PBI.bmiHeader, CBM_INIT, PID.pXOR, PBI^, DIB_RGB_COLORS)); + try + GetBitmapBits(hBmp, XORSize, XORBits); // obsolete, but the only that works fine... + GetBitmapBits(PID.hAND, ANDSize, ANDbits); + Result := CreateIcon(HInstance, PID.Width, PID.Height, 1, FBpp, ANDBits, XORBits); + finally + if hBmp <> 0 then DeleteObject(hBmp); + end; + finally + FreeMem(ANDBits); + end; + finally + FreeMem(XORBits); + end; + finally + ReleaseDC(0, DC); + end; + end +end; + +procedure TKIcon.Delete(Index: Integer); +var + I: Integer; +begin + if (Index >= 0) and (Index < FIconCount) then + begin + FreeSubimage(@FIconData[Index]); + for I := Index + 1 to FIconCount - 1 do + FIconData[I - 1] := FIconData[I]; + Dec(FIconCount); + SetLength(FIconData, FIconCount); + Changed(Self); + end; +end; + +procedure TKIcon.Draw(ACanvas: TCanvas; const Rect: TRect); + + procedure Display(const P, WH: TPoint; Index: Integer); + var + ID: TKIconData; + Stretch: Boolean; + DC, DC_XOR, DC_AND: HDC; + BM_XOR, BM_AND: HBITMAP; + Obj, Obj_XOR, Obj_AND: HGDIObj; + begin + if (Index >= 0) and (Index < FIconCount) then + begin + ID := FIconData[Index]; + if ID.IsPNG then + begin + {$IFDEF USE_PNG_SUPPORT} + ACanvas.StretchDraw(Classes.Rect(P.X, P.Y, P.X + WH.X, P.Y + WH.Y), ID.PNG); + {$ENDIF} + end else + begin + Stretch := FStretchEnabled and ((WH.X <> ID.Width) or (WH.Y <> ID.Height)); + DC := GDICheck(CreateCompatibleDC(0)); + try + Obj := SelectObject(DC, ID.hXOR); + if Stretch then + begin + DC_XOR := GDICheck(CreateCompatibleDC(DC)); + try + BM_XOR := GDICheck(CreateCompatibleBitmap(DC, WH.X, WH.Y)); + try + DC_AND := GDICheck(CreateCompatibleDC(DC)); + try + BM_AND := GDICheck(CreateMonochromeBitmap(WH.X, WH.Y)); + try + Obj_XOR := SelectObject(DC_XOR, BM_XOR); + Obj_AND := SelectObject(DC_AND, BM_AND); + //SetStretchBltMode(DC_XOR, HALFTONE); //does not distribute alpha channel etc. + StretchBlt(DC_XOR, 0, 0, WH.X, WH.Y, DC, 0, 0, ID.Width, ID.Height, SRCCOPY); + SelectObject(DC, ID.hAND); + StretchBlt(DC_AND, 0, 0, WH.X, WH.Y, DC, 0, 0, ID.Width, ID.Height, SRCCOPY); + MaskOrBitBlt(ACanvas, P.X, P.Y, WH.X, WH.Y, DC_XOR, DC_AND, BM_XOR, BM_AND, + nil, 0, nil, 0, ID.Bpp, FIconDrawStyle); + SelectObject(DC_XOR, Obj_XOR); + SelectObject(DC_AND, Obj_AND); + finally + DeleteObject(BM_AND); + end; + finally + DeleteDC(DC_AND); + end; + finally + DeleteObject(BM_XOR); + end; + finally + DeleteDC(DC_XOR); + end; + end else + MaskOrBitBlt(ACanvas, P.X, P.Y, ID.Width, ID.Height, DC, 0, ID.hXOR, ID.hAND, + ID.pXOR, ID.pXORSize, ID.pAND, ID.pANDSize, ID.Bpp, FIconDrawStyle); + SelectObject(DC, Obj); + finally + DeleteDC(DC); + end; + end; + end; + end; + +var + ABpp, AWidth, AHeight, I: Integer; + P, WH, WH_S: TPoint; +begin + with ACanvas do if FIconData <> nil then + begin + P := Rect.TopLeft; + WH := Point(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top); + if not FStretchEnabled then + begin + Inc(P.X, (WH.X - Width) div 2); + Inc(P.Y, (WH.Y - Height) div 2); + end; + if FDisplayAll then + begin + AWidth := Width; + AHeight := Height; + WH_S := WH; + for I := 0 to FIconCount - 1 do + begin + WH_S.X := FIconData[I].Width * WH.X div AWidth; + WH_S.Y := FIconData[I].Height * WH.Y div AHeight; + Display(P, WH_S, I); + if FDisplayHorz then + Inc(P.X, (FIconData[I].Width + FSpacing) * WH.X div AWidth) + else + Inc(P.Y, (FIconData[I].Height + FSpacing) * WH.Y div AHeight) + end; + end else + begin + ABpp := GetDeviceCaps(Handle, PLANES) * GetDeviceCaps(Handle, BITSPIXEL); + if ABpp <> FBpp then + Update; + Display(P, WH, FCurrentIndex); + end; + end; +end; + +function TKIcon.GetDimensions(Index: Integer): TKIconDimension; +begin + Result.Width := 0; Result.Height := 0; + if (Index >= 0) and (Index < FIconCount) then + begin + Result.Width := FIconData[Index].Width; + Result.Height := FIconData[Index].Height; + end; +end; + +function TKIcon.GetEmpty: Boolean; +begin + Result := FIconData = nil; +end; + +function TKIcon.GetHandles(Index: Integer): TKIconHandles; +begin + if (Index >= 0) and (Index < FIconCount) then + begin + Result.hXOR := FIconData[Index].hXOR; + Result.hAND := FIconData[Index].hAND; + end else + begin + Result.hXOR := 0; + Result.hAND := 0; + end; +end; + +function TKIcon.GetHeight: Integer; +begin + if FDisplayAll and (FIconCount > 0) then + Result := FMaxHeight + else + Result := Heights[FCurrentIndex]; +end; + +function TKIcon.GetTransparent: Boolean; +begin + Result := True; +end; + +function TKIcon.GetHeights(Index: Integer): Integer; +begin + Result := 0; + if (Index >= 0) and (Index < FIconCount) then + Result := FIconData[Index].Height; +end; + +function TKIcon.GetHotSpot(Index: Integer): TPoint; +begin + Result.X := 0; Result.Y := 0; + if (Index >= 0) and (Index < FIconCount) then + Result := FIconData[Index].HotSpot; +end; + +function TKIcon.GetIconData(Index: Integer): TKIconData; +begin + FillChar(Result, SizeOf(TKIconData), #0); + if (Index >= 0) and (Index < FIconCount) then + Result := FIconData[Index]; +end; + +function TKIcon.GetWidth: Integer; +begin + if FDisplayAll and (FIconCount > 0) then + Result := FMaxWidth + else + Result := Widths[FCurrentIndex]; +end; + +function TKIcon.GetWidths(Index: Integer): Integer; +begin + Result := 0; + if (Index >= 0) and (Index < FIconCount) then + Result := FIconData[Index].Width; +end; + +procedure TKIcon.Insert(Index: Integer; const Handles: TKIconHandles); +var + I: Integer; +begin + if Index >= 0 then + if Index < FIconCount then + begin + Inc(FIconCount); + SetLength(FIconData, FIconCount); + for I := FIconCount - 2 downto Index do + FIconData[I + 1] := FIconData[I]; + FillChar(FIconData[Index], SizeOf(TKIconData), 0); + LoadHandles(Index, Handles, True); + end else + Add(Handles); +end; + +{$IFNDEF FPC} +procedure TKIcon.LoadFromClipboardFormat(AFormat: Word; AData: THandle; + APalette: HPALETTE); +begin + // does nothing +end; +{$ENDIF} + +procedure TKIcon.LoadFromHandle(Handle: HICON); +var + Handles: TKIconHandles; + Info: TIconInfo; +begin + if (Handle <> 0) and GetIconInfo(Handle, Info) then + try + Clear; + SetLength(FIconData, 1); + FillChar(FIconData[0], SizeOf(TKIconData), 0); + FIconCount := 1; + Handles.hXOR := Info.hbmColor; + Handles.hAND := Info.hbmMask; + LoadHandles(0, Handles, False); + finally + DeleteObject(Info.hbmColor); + DeleteObject(Info.hbmMask); + end; +end; + +procedure TKIcon.LoadFromAssocFile(const FileName: string); +begin + try + LoadFromAssocExtension(ExtractFileExt(FileName)); + except + LoadFromModuleByIndex(FileName, 0); + end; +end; + +procedure TKIcon.LoadFromAssocExtension(const Extension: string); +const + IconKey = 'DefaultIcon'; +var + Code, DashPos, I: Integer; + Module, S, T: string; + Reg: TRegistry; +begin + if Extension = '' then Error(SIconAssocResolveError); + Reg := TRegistry.Create(KEY_READ); + try + Reg.RootKey := HKEY_CLASSES_ROOT; + if not Reg.KeyExists(Extension) then Error(SIconAssocResolveError); + Reg.OpenKeyReadOnly(Extension); + try + S := Reg.ReadString(''); + finally + Reg.CloseKey; + end; + if S = '' then Error(SIconAssocResolveError); + S := Format('%s\%s', [S, IconKey]); + if not Reg.KeyExists(S) then Error(SIconAssocResolveError); + Reg.OpenKeyReadOnly(S); + try + S := Reg.ReadString(''); + if S = '' then Error(SIconAssocResolveError); + finally + Reg.CloseKey; + end; + finally + Reg.Free; + end; + DashPos := Pos(',', S); + if DashPos > 1 then + Module := Copy(S, 1, DashPos - 1) + else + Module := S; + while CharInSetEx(Module[1], [#9, #32, '''', '"']) do System.Delete(Module, 1, 1); + while CharInSetEx(Module[Length(Module)], [#9, #32, '''', '"']) do System.Delete(Module, Length(Module), 1); + if Module[1] = '%' then + begin + System.Delete(Module, 1, 1); + I := Pos('%', Module); + if I >= 1 then + begin + T := GetEnvironmentVariable(Copy(Module, 1, I - 1)); + if T <> '' then + begin + System.Delete(Module, 1, I); + Module := T + Module; + end; + end; + end; + if not FileExists(Module) then Error(SIconAssocResolveError); + T := LowerCase(ExtractFileExt(Module)); + if T = '.ico' then + LoadFromFile(Module) + else + begin + if DashPos > 0 then + begin + T := Copy(S, DashPos + 1, Length(S)); + while CharInSetEx(T[1], [#9, #32]) do System.Delete(T, 1, 1); + Val(T, I, Code); + end else + begin + I := 0; + Code := 0; + end; + if (Code = 0) and (I >= 0) then + LoadFromModuleByIndex(Module, I) + else + begin + if Code = 0 then + T[1] := '#'; + LoadFromModule(Module, T); + end; + end; +end; + +procedure TKIcon.LoadFromModule(const ModuleName: string; ID: Word); +begin + LoadFromModule(ModuleName, Format('#%d', [ID])); +end; + +procedure TKIcon.LoadFromModule(const ModuleName, ResName: string); +var + Module: HINST; +begin + Module := LoadLibraryEx(PChar(ModuleName), 0, LOAD_LIBRARY_AS_DATAFILE); + if Module = 0 then Error(SIconInvalidModule); + try + LoadFromResource(Module, ResName); + finally + FreeLibrary(Module); + end; +end; + +procedure TKIcon.LoadFromModuleByIndex(const ModuleName: string; Index: Integer); +var + Module: HINST; +begin + Module := LoadLibraryEx(PChar(ModuleName), 0, LOAD_LIBRARY_AS_DATAFILE); + if Module = 0 then Error(SIconInvalidModule); + try + LoadFromResourceByIndex(Module, Index); + finally + FreeLibrary(Module); + end; +end; + +procedure TKIcon.LoadFromResource(Instance: HINST; ID: Word); +begin + LoadFromResource(Instance, Format('#%d', [ID])); +end; + +procedure TKIcon.LoadFromResource(Instance: HINST; const ResName: string); +const + ResGroup: array[Boolean] of PChar = (RT_GROUP_ICON, RT_GROUP_CURSOR); + ResItem: array[Boolean] of PChar = (RT_ICON, RT_CURSOR); +var + I, L, IconName, ANDSize, PalSize, XORInfoSize, XORSize: Integer; + Masked: Boolean; + PIC: PKIconCursorInRes; + PBIn: PBitmapInfo; + PID: PKIcondata; + BIMask: TKMaskBitmapInfo; + hGroup, hItem: HRSRC; + hMemGroup, hMem: HGLOBAL; + DC: HDC; + HSign: TKImageHeaderString; +{$IFDEF USE_PNG_SUPPORT} + Stream: TMemoryStream; +{$ENDIF} + + function GetResSize(Instance: HINST; Entry : PKIconCursorDirEntryInRes) : integer; + var + Rsrc: HRSRC; + C: Cardinal; + begin + Result := Entry.dwBytesInRes; + Rsrc := FindResource(Instance, Pointer(Entry.wEntryName), RT_ICON); + if Rsrc <> 0 then + begin + C := SizeofResource(Instance,Rsrc); + if C <> 0 then // maybe if C > Result ?? + Result := C; + end; + end; + +begin + hGroup := FindResource(Instance, PChar(ResName), ResGroup[FCursor]); + if hGroup = 0 then Error(SIconResourceError); + hMemGroup := LoadResource(Instance, hGroup); + if hMemGroup = 0 then Error(SIconResourceError); + PIC := LockResource(hMemGroup); + if (PIC.IH.idType = 1) and FCursor or (PIC.IH.idType = 2) and not FCursor then + Error(SIconResourceError); + DC := GetDC(0); + try + Clear; + FIconCount := PIC.IH.idCount; + SetLength(FIconData, FIconCount); + FillChar(FIconData[0], SizeOf(TKIconData) * FIconCount, 0); + for I := 0 to PIC.IH.idCount - 1 do + begin + IconName := PIC.Entries[I].wEntryName; + hItem := FindResource(Instance, PChar(IconName), ResItem[FCursor]); + if hItem = 0 then Error(SIconResourceError); + hMem := LoadResource(Instance, hItem); + if hMem = 0 then Error(SIconResourceError); + PBIn := LockResource(hMem); + try + PID := @FIconData[I]; + try + if FCursor then + begin + PID.Width := PIC.Entries[I].Info.Cursor.Width; + PID.Height := PIC.Entries[I].Info.Cursor.Height; + PID.HotSpot.X := PKCursorHotSpot(PBIn).xHotSpot; + PID.HotSpot.Y := PKCursorHotSpot(PBIn).yHotSpot; + Inc(Integer(PBIn), SizeOf(TKCursorHotSpot)); + end else + begin + PID.Width := PIC.Entries[I].Info.Icon.Width; + PID.Height := PIC.Entries[I].Info.Icon.Height; + end; + if PID.Width = 0 then PID.Width := 256; + if PID.Height = 0 then PID.Height := 256; +// PID.BytesInRes := PIC.Entries[I].dwBytesInRes; // gigo + PID.BytesInRes := GetResSize(Instance,@PIC.Entries[I]); + PID.Bpp := PIC.Entries[I].wBitCount; + L := Min(8, PID.BytesInRes); + Byte(HSign[0]) := L; + Move(PBIn^, HSign[1], L); + if (HSign = PNGHeader) or (HSign = MNGHeader) then + begin + PID.IsPNG := True; + PID.PNG := TKIconPngObject.Create; + {$IFDEF USE_PNG_SUPPORT} + Stream := TMemoryStream.Create; + try + Stream.Write(PBIn^, PID.BytesInRes); + Stream.Seek(0, soFromBeginning); + PID.PNG.LoadFromStream(Stream); + finally + Stream.Free; + end; + {$ELSE} + PID.PNG.Write(PBIn^, PID.BytesInRes); + {$ENDIF} + end else + begin + //PID.Bpp := PIC.Entries[I].wBitCount; // this is wrong in some icons + PID.Bpp := PBIn.bmiHeader.biBitCount; + PID.Width := PBIn.bmiHeader.biWidth; // gigo + PID.Height := PBIn.bmiHeader.biHeight shr 1; // gigo + CalcBitmapSizes(PID.Width, PID.Height, PID.Bpp, XORSize, ANDSize); + PalSize := GetPaletteSize(PID.Bpp); + XORInfoSize := SizeOf(TBitmapInfoHeader) + PalSize * SizeOf(TRGBQuad); + Masked := PID.BytesInRes = XORInfoSize + XORSize + ANDSize; + if not Masked then Error(SIconFormatError); + GetMem(PID.iXOR, XORInfoSize); + PID.iXORSize := XORInfoSize; + Move(PBIn^, PID.iXOR^, XORInfoSize); + PID.iXOR.bmiHeader.biHeight := PID.iXOR.bmiHeader.biHeight div 2; + PID.hXOR := GDICheck(CreateDIBSection(DC, PID.iXOR^, + DIB_RGB_COLORS, PID.pXOR, 0, 0)); + if PID.pXOR <> nil then + begin + Move(Pointer(Cardinal(PBIn) + Cardinal(XORInfoSize))^, PID.pXOR^, XORSize); + PID.pXORSize := XORSize; + end else + Error(SIconAllocationError); + CreateMaskInfo(PID.Width, PID.Height, BIMask); + PID.hAND := GDICheck(CreateDIBSection(DC, PBitmapInfo(@BIMask)^, + DIB_RGB_COLORS, PID.pAND, 0, 0)); + if PID.pAND <> nil then + begin + Move(Pointer(Cardinal(PBIn) + Cardinal(XORInfoSize + XORSize))^, PID.pAND^, ANDSize); + PID.pANDSize := ANDSize; + end else + Error(SIconAllocationError); + end; + except + FreeSubimage(PID); + raise; + end; + finally + UnlockResource(hMem); // this is not necessary, but... + FreeResource(hMem); + end; + end; + finally + ReleaseDC(0, DC); + UnlockResource(hMemGroup); // this is not necessary, but... + FreeResource(hMemGroup); + end; + Changed(Self); +end; + +type + PCallBack = ^TCallBack; + TCallBack = record + I, + Index: Integer; + S: string; + end; + + function EnumIcons(hModule: HINST; lpType: DWORD; lpName: PChar; dwParam: DWORD): BOOL; stdcall; + var + CB: PCallBack; + begin + CB := PCallBack(dwParam); + if CB.I = CB.Index then + begin + if HiWord(Cardinal(lpName)) = 0 then + CB.S := Format('#%d', [Cardinal(lpName)]) + else + CB.S := lpName; + Result := False; + end else + Result := True; + Inc(CB.I); + end; + +procedure TKIcon.LoadFromResourceByIndex(Instance: HINST; Index: Integer); +var + CB: TCallBack; +begin + CB.I := 0; + CB.Index := Index; + CB.S := ''; + EnumResourceNames(Instance, RT_GROUP_ICON, @EnumIcons, DWORD(@CB)); + if CB.S <> '' then + LoadFromResource(Instance, CB.S) + else if CB.I = 0 then + Error(SIconInvalidModule) + else + Error(SIconIndexError); +end; + +procedure TKIcon.LoadFromStream(Stream: TStream); +var + I, ANDSize, PalSize, XORInfoSize, XORSize: Integer; + Masked: Boolean; + PID: PKIconData; + IH: TKIconHeader; + II: TKIconCursorDirEntry; + BI: TBitmapInfoHeader; + BIMask: TKMaskBitmapInfo; + DC: HDC; + HSign: TKImageHeaderString; +{$IFDEF USE_PNG_SUPPORT} + MS: TMemoryStream; +{$ENDIF} +begin + if Stream <> nil then + begin + DC := GetDC(0); + try + Clear; + Stream.Read(IH, SizeOf(TKIconHeader)); + FCursor := IH.idType = 2; + FIconCount := IH.idCount; + SetLength(FIconData, FIconCount); + FillChar(FIconData[0], SizeOf(TKIconData) * FIconCount, 0); + for I := 0 to FIconCount - 1 do + begin + PID := @FIconData[I]; + Stream.Read(II, SizeOf(TKIconCursorDirEntry)); + // for PNG read icon size here, otherwise this is overwritten when XOR bitmap is read + PID.Width := II.Width; + if PID.Width = 0 then PID.Width := 256; + PID.Height := II.Height; + if PID.Height = 0 then PID.Height := 256; + if FCursor then + begin + PID.HotSpot.X := II.Info.wX; + PID.HotSpot.Y := II.Info.wY; + end; + PID.BytesInRes := II.dwBytesInRes; + PID.Offset := II.dwImageOffset; + PID.Bpp := II.Info.wBitCount; // for PNG icons bpp is stored here + end; + for I := 0 to FIconCount - 1 do + begin + PID := @FIconData[I]; + try + Byte(HSign[0]) := Stream.Read(HSign[1], 8); + Stream.Seek(-8, soFromCurrent); + if (HSign = PNGHeader) or (HSign = MNGHeader) then + begin + PID.IsPNG := True; + PID.PNG := TKIconPngObject.Create; + {$IFDEF USE_PNG_SUPPORT} + MS := TMemoryStream.Create; + try + MS.CopyFrom(Stream, PID.BytesInRes); // secure icon integrity + MS.Seek(0, soFromBeginning); + PID.PNG.LoadFromStream(MS); + finally + MS.Free; + end; + {$ELSE} + PID.PNG.CopyFrom(Stream, PID.BytesInRes); + {$ENDIF} + end else + begin + Stream.Read(BI, SizeOf(TBitmapInfoHeader)); + PID.Bpp := BI.biBitCount; + PID.Width := BI.biWidth; + PID.Height := BI.biHeight shr 1; + PalSize := GetPaletteSize(PID.Bpp); + CalcBitmapSizes(PID.Width, PID.Height, PID.Bpp, XORSize, ANDSize); + XORInfoSize := SizeOf(TBitmapInfoHeader) + PalSize * SizeOf(TRGBQuad); + Masked := PID.BytesInRes = XORInfoSize + XORSize + ANDSize; + if not Masked then Error(SIconFormatError); + BI.biHeight := BI.biHeight div 2; + GetMem(PID.iXOR, XORInfoSize); + PID.iXORSize := XORInfoSize; + PID.iXOR.bmiHeader := BI; + PID.iXOR.bmiHeader.biSizeImage := 0; + Stream.Read(PID.iXOR.bmiColors, PalSize * SizeOf(TRGBQuad)); + PID.hXOR := GDICheck(CreateDIBSection(DC, PID.iXOR^, + DIB_RGB_COLORS, PID.pXOR, 0, 0)); + if PID.pXOR <> nil then + begin + Stream.Read(PID.pXOR^, XORSize); + PID.pXORSize := XORSize; + end else + Error(SIconAllocationError); + CreateMaskInfo(PID.Width, PID.Height, BIMask); + PID.hAND := GDICheck(CreateDIBSection(DC, PBitmapInfo(@BIMask)^, + DIB_RGB_COLORS, PID.pAND, 0, 0)); + if PID.pAND <> nil then + begin + Stream.Read(PID.pAND^, ANDSize); + PID.pANDSize := ANDSize; + end else + Error(SIconAllocationError); + end; + except + FreeSubimage(PID); + raise; + end; + end; + finally + ReleaseDC(0, DC); + end; + Changed(Self); + end; +end; + +procedure TKIcon.LoadHandles(Index: Integer; const Handles: TKIconHandles; OrigBpp: Boolean); +var + ANDSize, PalSize, XORSize, XORInfoSize: Integer; + PID: PKIconData; + BInfo: Windows.TBitmap; + BIMask: TKMaskBitmapInfo; + P: Pointer; + DC: HDC; + hBmp: HBITMAP; +begin + if (Index >= 0) and (Index < FIconCount) then + begin + PID := @FIconData[Index]; + if (Handles.hAND = 0) or + (Handles.hXOR = PID.hXOR) or (Handles.hAND = PID.hXOR) or + (Handles.hXOR = PID.hAND) or (Handles.hAND = PID.hAND) then + Error(SIconBitmapError); + FreeSubimage(PID); + DC := GetDC(0); + try + try + if Handles.hXOR <> 0 then + begin + GetObject(Handles.hXOR, SizeOf(Windows.TBitmap), @BInfo); + PID.Height := BInfo.bmHeight; + if OrigBpp or (FInHandleBpp = 0) then + PID.Bpp := BInfo.bmPlanes * BInfo.bmBitsPixel + else + PID.Bpp := FInHandleBpp; + end else + begin // must be a monochrome icon - not fully tested + GetObject(Handles.hAND, SizeOf(Windows.TBitmap), @BInfo); + PID.Height := BInfo.bmHeight div 2; + PID.Bpp := 1; + end; + PID.Width := BInfo.bmWidth; + CalcBitmapSizes(PID.Width, PID.Height, PID.Bpp, XORSize, ANDSize); + PalSize := GetPaletteSize(PID.Bpp); + XORInfoSize := SizeOf(TBitmapInfoHeader) + PalSize * SizeOf(TRGBQuad); + GetMem(PID.iXOR, XORInfoSize); + PID.iXORSize := XORInfoSize; + FillChar(PID.iXOR^, XORInfoSize, 0); + PID.BytesInRes := XORInfoSize; + PID.iXOR.bmiHeader.biSize := SizeOf(TBitmapInfoHeader); + PID.iXOR.bmiHeader.biWidth := PID.Width; + PID.iXOR.bmiHeader.biHeight := PID.Height; + PID.iXOR.bmiHeader.biPlanes := 1; + PID.iXOR.bmiHeader.biBitCount := PID.Bpp; + PID.iXOR.bmiHeader.biCompression := BI_RGB; + if Handles.hXOR <> 0 then hBmp := Handles.hXOR else hBmp := Handles.hAND; + GetDIBits(DC, hBmp, 0, PID.Height, nil, PID.iXOR^, DIB_RGB_COLORS); + PID.hXOR := GDICheck(CreateDIBSection(DC, PID.iXOR^, + DIB_RGB_COLORS, PID.pXOR, 0, 0)); + if PID.pXOR <> nil then + begin + GetDIBits(DC, hBmp, 0, PID.Height, PID.pXOR, + PID.iXOR^, DIB_RGB_COLORS); + PID.pXORSize := XORSize; + if (PID.Bpp = 32) and FInHandleFullAlpha then + FillAlphaIfNone(PKColorRecs(PID.pXOR), XORSize, $FF); + Inc(PID.BytesInRes, XORSize); + end else + Error(SIconAllocationError); + CreateMaskInfo(PID.Width, PID.Height, BIMask); + PID.hAND := GDICheck(CreateDIBSection(DC, PBitmapInfo(@BIMask)^, + DIB_RGB_COLORS, PID.pAND, 0, 0)); + if PID.pAND <> nil then + begin + if Handles.hXOR <> 0 then + begin + GetDIBits(DC, Handles.hAND, 0, PID.Height, PID.pAND, + PBitmapInfo(@BIMask)^, DIB_RGB_COLORS); + end else + begin + GetMem(P, ANDSize * 2); + try + BIMask.Header.biHeight := 2 * PID.Height; + GetDIBits(DC, Handles.hAND, 0, PID.Height * 2, P, + PBitmapInfo(@BIMask)^, DIB_RGB_COLORS); + Move(P^, PID.pAND^, ANDSize); + finally + FreeMem(P); + end; + end; + PID.pANDSize := ANDSize; + Inc(PID.BytesInRes, ANDSize); + end else + Error(SIconAllocationError); + except + FreeSubimage(PID); + raise; + end; + finally + ReleaseDC(0, DC); + end; + Changed(Self); + end; +end; + +procedure TKIcon.MaskFromColor(Index: Integer; Color: TColor; HasAlpha: Boolean = False); +var + PID: PKIconData; + DC: HDC; + OldObj: HGDIObj; + BM: TKAlphaBitmap; + ByteMask: Byte; + I, J, L, LAnd: Integer; + ColorMask: Cardinal; + P: PKColorRecs; + Q: PBytes; +begin + if (Index >= 0) and (Index < FIconCount) then + begin + Color := SwitchRGBToBGR(Color); + PID := @FIconData[Index]; + DC := 0; + BM := TKAlphaBitmap.Create; + try + BM.SetSize(PID.Width, PID.Height); + DC := GDICheck(CreateCompatibleDC(0)); + OldObj := SelectObject(DC, PID.hXOR); + BitBlt(BM.Canvas.Handle, 0, 0, PID.Width, PID.Height, DC, 0, 0, SRCCOPY); + FillChar(PID.pAND^, PID.pANDSize, $FF); + LAnd := CalcByteWidth(PID.Width, 1); + Q := PID.pAND; + Inc(Cardinal(Q), PID.pANDSize - LAnd); + if HasAlpha then ColorMask := $FFFFFFFF else ColorMask := $00FFFFFF; + for I := 0 to PID.Height - 1 do + begin + ByteMask := $7F; + P := BM.ScanLine[I]; + for J := 0 to PID.Width - 1 do + begin + L := J shr 3; + if P[J].Value and ColorMask <> Cardinal(Color) then + Q[L] := Q[L] and ByteMask; + asm + ror ByteMask, 1 + end; + end; + Dec(Cardinal(Q), LAnd); + end; + SelectObject(DC, OldObj); + finally + if DC <> 0 then DeleteDC(DC); + BM.Free; + end; + Changed(Self); + end; +end; + +procedure TKIcon.SaveToStream(Stream: TStream); +var + I, Offset, RSize: Integer; + IH: TKIconHeader; + PID: PKIconData; + II: TKIconCursorDirEntry; +{$IFDEF USE_PNG_SUPPORT} + J, Delta: Integer; + MS: TMemoryStream; +{$ENDIF} +begin + if (Stream <> nil) and (FIconData <> nil) then + begin + Offset := SizeOf(TKIconHeader) + FIconCount * SizeOf(TKIconCursorDirEntry); + IH.idReserved := 0; + if FCursor then IH.idType := 2 else IH.idType := 1; + IH.idCount := 0; + for I := 0 to FIconCount - 1 do + if (FIconData[I].iXOR <> nil) or FIconData[I].IsPNG then + Inc(IH.idCount); + Stream.Write(IH, SizeOf(TKIconHeader)); + for I := 0 to FIconCount - 1 do + begin + FillChar(II, SizeOf(TKIconCursorDirEntry), 0); // gigo + PID := @FIconData[I]; + if PID.IsPNG then + begin + II.Width := PID.Width; + II.Height := PID.Height; + II.ColorCount := GetPaletteSize(PID.Bpp); + II.Info.wPlanes := 1; + II.Info.wBitCount := PID.Bpp; + II.dwBytesInRes := PID.BytesInRes; + II.dwImageOffset := Offset; + Stream.Write(II, SizeOf(TKIconCursorDirEntry)); + Inc(Offset, PID.BytesInRes); + end + else if PID.iXOR <> nil then + begin + II.Width := PID.Width; + II.Height := PID.Height; + II.ColorCount := GetPaletteSize(PID.Bpp); + if FCursor then + begin + II.Info.wX := PID.HotSpot.X; + II.Info.wY := PID.HotSpot.Y; + end else + begin + II.Info.wPlanes := 1; + II.Info.wBitCount := PID.Bpp; + end; + RSize := PID.iXORSize + PID.pXORSize + PID.pANDSize; + II.dwBytesInRes := RSize; + II.dwImageOffset := Offset; + Stream.Write(II, SizeOf(TKIconCursorDirEntry)); + Inc(Offset, RSize); + end; + end; + for I := 0 to FIconCount - 1 do + begin + PID := @FIconData[I]; + if PID.IsPNG then + begin + {$IFDEF USE_PNG_SUPPORT} + MS := TMemoryStream.Create; + try + PID.PNG.SaveToStream(MS); + MS.Seek(0, soFromBeginning); + //// gigo + if Ms.Size <> PID.BytesInRes then + begin + Delta := PID.BytesInRes - MS.Size; + PID.BytesInRes := MS.Size; + Stream.Seek(SizeOf(TKIconHeader) + I * SizeOf(TKIconCursorDirEntry), soFromBeginning); + Stream.Read(II, SizeOf(TKIconCursorDirEntry)); + II.dwBytesInRes := PID.BytesInRes; + Stream.Seek(-1 * SizeOf(TKIconCursorDirEntry), soFromCurrent); + Stream.Write(II, SizeOf(TKIconCursorDirEntry)); + for J := I + 1 to FIconCount - 1 do + begin + Stream.Read(II, SizeOf(TKIconCursorDirEntry)); + II.dwImageOffset := II.dwImageOffset - Delta; + Stream.Seek(-1 * SizeOf(TKIconCursorDirEntry), soFromCurrent); + Stream.Write(II, SizeOf(TKIconCursorDirEntry)); + end; + Stream.Seek(0,soFromEnd); + end; + //// end gigo + Stream.CopyFrom(MS, PID.BytesInRes); // secure icon integrity + finally + MS.Free; + end; + {$ELSE} + PID.PNG.Seek(0, soFromBeginning); + Stream.CopyFrom(PID.PNG, PID.BytesInRes); + {$ENDIF} + end else if PID.iXOR <> nil then + begin + PID.iXOR.bmiHeader.biHeight := PID.iXOR.bmiHeader.biHeight * 2; + Stream.Write(PID.iXOR^, PID.iXORSize); + PID.iXOR.bmiHeader.biHeight := PID.iXOR.bmiHeader.biHeight div 2; + Stream.Write(PID.pXOR^, PID.pXORSize); + Stream.Write(PID.pAND^, PID.pANDSize); + end; + end; + end; +end; + +{$IFNDEF FPC} +procedure TKIcon.SaveToClipboardFormat(var Format: Word; var Data: THandle; + var APalette: HPALETTE); +begin + // does nothing +end; +{$ENDIF} + +procedure TKIcon.SetCurrentIndex(Value: Integer); +begin + if (Value >= 0) and (Value < FIconCount) and (Value <> FCurrentIndex) then + begin + FCurrentIndex := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetDisplayAll(Value: Boolean); +begin + if Value <> FDisplayAll then + begin + FDisplayAll := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetDisplayHorz(Value: Boolean); +begin + if Value <> FDisplayHorz then + begin + FDisplayHorz := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetDimensions(Index: Integer; Value: TKIconDimension); +begin + if (Index >= 0) and (Index < FIconCount) and + (Value.Width > 0) and (Value.Height > 0) and + (Value.Width <> Widths[Index]) and (Value.Width <> Heights[Index]) then + begin + UpdateDim(Index, Value); + Changed(Self); + end; +end; + +procedure TKIcon.SetHandles(Index: Integer; Value: TKIconHandles); +begin + LoadHandles(Index, Value, True); +end; + +procedure TKIcon.SetHeight(Value: Integer); +begin + if not FDisplayAll then + Heights[FCurrentIndex] := Value; +end; + +procedure TKIcon.SetHeights(Index: Integer; Value: Integer); +var + D: TKIconDimension; +begin + D.Width := Widths[Index]; + D.Height := Value; + Dimensions[Index] := D; +end; + +procedure TKIcon.SetHotSpot(Index: Integer; Value: TPoint); +var + PID: PKIconData; +begin + if (Index >= 0) and (Index < FIconCount) then + begin + PID := @FIconData[Index]; + if (PID.HotSpot.X <> Value.X) or (PID.HotSpot.Y <> Value.Y) then + begin + PID.HotSpot := Value; + Changed(Self); + end; + end; +end; + +procedure TKIcon.SetIconDrawStyle(Value: TKIconDrawStyle); +begin + if Value <> FIconDrawStyle then + begin + FIconDrawStyle := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetInHandleBpp(Value: Integer); +begin + if Value in [0, 1, 4, 8, 32] then + FInHandleBpp := Value; +end; + +procedure TKIcon.SetOptimalIcon(Value: Boolean); +begin + if Value <> FOptimalIcon then + begin + FOptimalIcon := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetOverSizeWeight(Value: Single); +begin + if Value <> FOverSizeWeight then + begin + FOverSizeWeight := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetRequestedSize(Value: TKIconDimension); +begin + if (Value.Width > 0) and (Value.Height > 0) then + begin + FRequestedSize := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetSpacing(Value: Integer); +begin + if Value <> FSpacing then + begin + FSpacing := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetStretchEnabled(Value: Boolean); +begin + if Value <> FStretchEnabled then + begin + FStretchEnabled := Value; + Changed(Self); + end; +end; + +procedure TKIcon.SetTransparent(Value: Boolean); +begin + if FCreating then + inherited + else + // Ignore assignments to this property. + // Icons are always transparent. +end; + +procedure TKIcon.SetWidth(Value: Integer); +begin + if not FDisplayAll then + Widths[FCurrentIndex] := Value; +end; + +procedure TKIcon.SetWidths(Index: Integer; Value: Integer); +var + D: TKIconDimension; +begin + D.Width := Value; + D.Height := Heights[Index]; + Dimensions[Index] := D; +end; + +procedure TKIcon.Update; +var + dW, dH, BestBpp, I, MaxWeight, Weight: Integer; + DC: HDC; + PID: PKIconData; +begin + FBpp := 0; + FMaxWidth := 0; + FMaxHeight := 0; + if FIconData <> nil then + begin + DC := GetDC(0); + try + FBpp := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL); + MaxWeight := MaxInt; + for I := 0 to FIconCount - 1 do + begin + PID := @FIconData[I]; + if FDisplayAll and FDisplayHorz then + begin + Inc(FMaxWidth, PID.Width); + if I <> 0 then Inc(FMaxWidth, FSpacing); + end else + if PID.Width > FMaxWidth then FMaxWidth := PID.Width; + if FDisplayAll and not FDisplayHorz then + begin + Inc(FMaxHeight, PID.Height); + if I <> 0 then Inc(FMaxHeight, FSpacing); + end else + if PID.Height > FMaxHeight then FMaxHeight := PID.Height; + end; + if FOptimalIcon and (FIconCount >= 2) then + begin + FCurrentIndex := 0; + BestBpp := FIconData[0].Bpp; + for I := 0 to FIconCount - 1 do + begin + PID := @FIconData[I]; + if (PID.Bpp <= FBpp) and (PID.Bpp >= BestBpp) then + begin + BestBpp := PID.Bpp; + dW := FRequestedSize.Width - PID.Width; + dH := FRequestedSize.Height - PID.Height; + if dW < 0 then DW := Round(-DW * FOverSizeWeight); + if dH < 0 then dH := Round(-DH * FOverSizeWeight); + Weight := dW + dH; + if Weight <= MaxWeight then + begin + MaxWeight := Weight; + FCurrentIndex := I; + end; + end; + end; + end + else if (FCurrentIndex < 0) or (FCurrentIndex >= FIconCount) then + FCurrentIndex := 0; + finally + ReleaseDC(0, DC); + end; + end else + FCurrentIndex := -1; +end; + +procedure TKIcon.UpdateDim(Index: Integer; Value: TKIconDimension); + + procedure BitMove(const Src, Dest; BitSize, BitOffset: Integer); + asm + // eax: Src + // ecx: BitSize + // edx: Dest + // stack: BitOffset + // push registers that must be preserved + push esi + push edi + push ebx + // set registers for register adressing + mov esi, eax + mov edi, edx + // test for scroll direction + mov edx, BitOffset + cmp edx, 0 + js @left + // perform move + mov ebx, edx + shr ebx, 3 + add edi, ebx + and edx, $07 + jnz @bitwise_right + // bytewise move + mov edx, ecx + shr ecx, 3 + rep movsb + and dl, $07 + jz @exit + mov cl, dl + mov al, [esi] + rol eax, cl + mov al, [edi] + ror eax, cl + mov [edi], al + jmp @exit + @bitwise_right: + // bitwise move + mov ebx, ecx + mov cl, dl + xor ch, ch + mov dl, $7F + ror dl, cl + mov dh, dl + not dh + @R00: + mov ah, [esi] + ror ah, cl + and ah, dh + mov al, [edi] + and al, dl + or al, ah + mov [edi], al + dec ebx + jz @exit + inc ch + and ch, $07 + jnz @R01 + inc esi + @R01: + ror dl, 1 + ror dh, 1 + test dh, $80 + jz @R00 + inc edi + jmp @R00 + @left: + // perform scroll + neg edx + mov ebx, edx + shr ebx, 3 + add esi, ebx + and edx, $07 + jnz @bitwise_left + // bytewise move + mov edx, ecx + shr ecx, 3 + rep movsb + and dl, $07 + jz @exit + mov cl, dl + mov al, [esi] + rol eax, cl + mov al, [edi] + ror eax, cl + mov [edi], al + jmp @exit + @bitwise_left: + // bitwise move + mov ebx, ecx + mov cl, dl + mov ch, cl + mov dl, $7F + mov dh, dl + not dh + @L00: + mov ah, [esi] + rol ah, cl + and ah, dh + mov al, [edi] + and al, dl + or al, ah + mov [edi], al + dec ebx + jz @exit + inc ch + and ch, $07 + jnz @L01 + inc esi + @L01: + ror dl, 1 + ror dh, 1 + test dh, $80 + jz @L00 + inc edi + jmp @L00 + @exit: + // pop the preserved registers + pop ebx + pop edi + pop esi + end; + +var + BitOffset, J, Size, XOR1, XOR2, AND1, AND2, + X, Y, HOffset, VOffset: Integer; + PID: PKIconData; + PBI: PBitmapInfoHeader; + BIMask: TKMaskBitmapInfo; + P: PByteArray; + hBmp: HBITMAP; + DC: HDC; +begin + PID := @FIconData[Index]; + if PID.iXOR <> nil then + begin + PBI := PBitmapInfoHeader(PID.iXOR); + P := nil; + DC := GetDC(0); + try + try + CalcByteWidths(PID.Width, PID.Bpp, XOR1, AND1); + CalcByteWidths(Value.Width, PID.Bpp, XOR2, AND2); + PBI.biWidth := Value.Width; + PBI.biHeight := Value.Height; + PBI.biSizeImage := XOR2 * Value.Height; + if FAlignStyle = asCenter then + begin + HOffset := (Value.Width - PID.Width) div 2; + VOffset := (Value.Height - PID.Height) div 2; + end else + begin + HOffset := 0; + VOffset := 0; + end; + Y := Min(PID.Height, Value.Height); + BitOffset := HOffset * PID.Bpp; + hBmp := GDICheck(CreateDIBSection(DC, PBitmapInfo(PBI)^, DIB_RGB_COLORS, Pointer(P), 0, 0)); + if P = nil then Error(SIconAllocationError); + X := Min(PID.Width, Value.Width) * PID.Bpp; + Size := XOR2 * Value.Height; + FillChar(P^, Size, #0); + for J := 1 to Y do + begin + if VOffset >= 0 then + BitMove(PByteArray(PID.pXOR)[(PID.Height - J) * XOR1], + P[(Value.Height - J - VOffset) * XOR2], X, BitOffset) + else + BitMove(PByteArray(PID.pXOR)[(PID.Height - J + VOffset) * XOR1], + P[(Value.Height - J) * XOR2], X, BitOffset); + end; + DeleteObject(PID.hXOR); + PID.pXOR := P; + PID.pXORSize := Size; + PID.hXOR := hBmp; + CreateMaskInfo(PID.Width, PID.Height, BIMask); + hBmp := GDICheck(CreateDIBSection(DC, PBitmapInfo(@BIMask)^, DIB_RGB_COLORS, Pointer(P), 0, 0)); + if P = nil then Error(SIconAllocationError); + X := Min(PID.Width, Value.Width); + Size := AND2 * Value.Height; + FillChar(P^, Size, #$FF); + for J := 1 to Y do + begin + if VOffset >= 0 then + BitMove(PByteArray(PID.pAND)[(PID.Height - J) * AND1], + P[(Value.Height - J - VOffset) * AND2], X, HOffset) + else + BitMove(PByteArray(PID.pAND)[(PID.Height - J + VOffset) * AND1], + P[(Value.Height - J) * AND2], X, HOffset); + end; + DeleteObject(PID.hAND); + PID.pAND := P; + PID.pANDSize := Size; + PID.hAND := hBmp; + PID.Width := Value.Width; + PID.Height := Value.Height; + except + FreeSubimage(PID); + Error(SIconResizingError); + end; + finally + ReleaseDC(0, DC); + end; + end; +end; + +procedure RegisterKIcon; +begin + TPicture.UnregisterGraphicClass(Graphics.TIcon); + TPicture.RegisterFileFormat('ico', SVIcons, KIcon.TIcon); + TPicture.RegisterFileFormat('cur', SVCursors, KIcon.TIcon); +end; + +procedure UnregisterKIcon; +begin + TPicture.UnregisterGraphicClass(KIcon.TIcon); + TPicture.RegisterFileFormat('ico', SVIcons, Graphics.TIcon); +end; + +{$IFDEF TKICON_REGISTER} +initialization + RegisterKIcon; +finalization + //not necessary, but... + UnregisterKIcon; +{$ENDIF} + +{$ENDIF} +end. diff --git a/components/kcontrols/source/kprintpreview.dfm b/components/kcontrols/source/kprintpreview.dfm new file mode 100755 index 000000000..a6222c843 --- /dev/null +++ b/components/kcontrols/source/kprintpreview.dfm @@ -0,0 +1,1475 @@ +object KPrintPreviewForm: TKPrintPreviewForm + Left = 324 + Top = 212 + Caption = 'Print Preview' + ClientHeight = 614 + ClientWidth = 812 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Icon.Data = { + 0000010001001010000001001800680300001600000028000000100000002000 + 00000100180000000000000000000000000000000000000000000000000092B1 + B7373D3C3A424352626552606252606252606252606252606252606252606252 + 606252626590AEB4000000000000393F3F95887B8F8378B9B0A8F1F0EEF1F0EE + F1F0EEF1F0EEF1F0EEF1F0EEF1F0EEF1F0EEEAE8E6585A5AA3C5CC0000003F49 + 49867B70D2CCC6B7ADA3C1BCB6E3E3E3E0E0E0DFDFDFFEFEFEFFFFFFFFFFFFFF + FFFFFFFFFFA5A3A187A4AA000000A5C8CE3C4444A59C93E1DDD9B6ACA2BAB4AF + A69E97A2978CA1968BA9A29BD1D0CEF1F1F1FEFEFEA8A7A587A3A90000000000 + 0087A3A98B8580BAB0A6D4CEC79A8D7EAA9E89C8C0B0CCC3B3BCAE95978B7CE2 + DEDBFDFDFDA9A8A787A3A900000000000087A3A9AAA9A8E0DCD8A29586A9986C + C6BA91D0C7A9D1C9AAC5B990AA986CA4998CF7F6F5AAA9A887A3A90000000000 + 0087A3A9ABAAA9D6D1CCA0906EAD9C60B9AC78BFB485BBB082BAAE79AB9A5EA9 + 9874D9D4D0ABAAA987A3A900000000000087A3A9ACABA9D1CBC4A18D5AB7A45C + B8A866B8A869B9A969BBA963B6A154A7925DD4CEC8ABA9A887A3A90000000000 + 0087A3A9ACABAADAD5D0AB9A6EC7B778CABB80CBBD85C9BA7FC4B371B4A157A8 + 9462DBD5D1A7A5A387A3A900000000000087A3A9ADACABEBE9E6B4A892C5B990 + D7CDA8D9D0AAD8CFAAD8CEA8C2B58CBAAF9AE4E0DC9C989487A3A90000000000 + 0087A3A9ADACABF1EFEDCFCBC8B9AC91D3C8A7F2EEE1F2EEE0D2C6A4BAAD93C9 + C4BFD5CEC781797187A3A900000000000087A3A9ADADACEDEBE9B9B7B5C3C1BE + B8B1A8A59B86A89D87CCC5BBDFD9D4E5E1DDE4E0DC58585599B9BF0000000000 + 0087A3A9AEADACEAE7E4979694B6B4B1ACAAA7A8A6A4A2A09EDAD5CFE8E5E2E6 + E3E06A6D6C8AA7AD00000000000000000087A4AAADACABE6E3DFE6E3DFE6E3DF + E6E3DFE4E1DDDED9D4D3CCC4EBE9E76A6C6D8CAAAF0000000000000000000000 + 00A3C5CC626565EFEEECF0EEECF0EEEBEEEBE9E7E3DFD4CDC6BDB3A86A6C6D8B + A9AF00000000000000000000000000000000000090AEB4536366536164536164 + 536164526063505E614C5A5C8CAAAF0000000000000000000000000000000003 + 0000000100000001000000010000800100008001000080010000800100008001 + 00008001000080010000800100008003000080070000800F0000C01F0000} + KeyPreview = True + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object ToBMain: TToolBar + Left = 0 + Top = 0 + Width = 812 + Height = 30 + AutoSize = True + ButtonHeight = 30 + ButtonWidth = 31 + Caption = 'TBMain' + DisabledImages = ILMainDis + Images = ILMain + TabOrder = 1 + Wrapable = False + object TBPageFirst: TToolButton + Left = 0 + Top = 0 + Action = ACPageFirst + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPagePrevious: TToolButton + Left = 31 + Top = 0 + Action = ACPagePrevious + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPageNext: TToolButton + Left = 62 + Top = 0 + Action = ACPageNext + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPageLast: TToolButton + Left = 93 + Top = 0 + Action = ACPageLast + Grouped = True + ParentShowHint = False + ShowHint = True + end + object ToolButton3: TToolButton + Left = 124 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object PNPage: TPanel + Left = 132 + Top = 0 + Width = 71 + Height = 30 + BevelOuter = bvNone + ParentBackground = False + TabOrder = 0 + object EDPage: TEdit + Left = 7 + Top = 4 + Width = 43 + Height = 21 + TabOrder = 0 + Text = '1' + OnExit = EDPageExit + end + object UDPage: TUpDown + Left = 50 + Top = 4 + Width = 15 + Height = 21 + Associate = EDPage + Min = 1 + Position = 1 + TabOrder = 1 + OnClick = UDPageClick + end + end + object ToolButton6: TToolButton + Left = 203 + Top = 0 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 3 + Style = tbsSeparator + end + object PNScale: TPanel + Left = 211 + Top = 0 + Width = 112 + Height = 30 + BevelOuter = bvNone + ParentBackground = False + ParentColor = True + TabOrder = 1 + object CoBScale: TComboBox + Left = 9 + Top = 4 + Width = 95 + Height = 21 + AutoComplete = False + DropDownCount = 16 + TabOrder = 0 + OnExit = CoBScaleExit + OnSelect = CoBScaleExit + Items.Strings = ( + '25 %' + '50 %' + '75 %' + '100 %' + '125 %' + '150 %' + '200 %' + '500 %' + 'whole page' + 'page width ' + ' ') + end + end + object ToolButton1: TToolButton + Left = 323 + Top = 0 + Width = 8 + Caption = 'ToolButton1' + ImageIndex = 4 + Style = tbsSeparator + end + object TBPrint: TToolButton + Left = 331 + Top = 0 + Action = ACPrint + ParentShowHint = False + ShowHint = True + end + object ToolButton4: TToolButton + Left = 362 + Top = 0 + Width = 8 + Caption = 'ToolButton4' + ImageIndex = 5 + Style = tbsSeparator + end + object TBClose: TToolButton + Left = 370 + Top = 0 + Action = ACClose + ParentShowHint = False + ShowHint = True + end + end + object Preview: TKPrintPreview + Left = 0 + Top = 30 + Width = 812 + Height = 584 + Align = alClient + Page = 0 + TabStop = True + TabOrder = 0 + OnChanged = PreviewChanged + end + object ILMain: TImageList + Height = 24 + Width = 24 + Left = 16 + Top = 52 + Bitmap = { + 494C010106000900040018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000600000003000000001002000000000000048 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000A1C3C9008EACB10081979A007E9395007E9396007E9396007E93 + 96007E9496007E9496007E9496007E9496007E93960082999D0094B3B900A5C8 + CE00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A8CCD300A8CBD200000000000000 + 0000000000000000000099B1B300FFF0C400FFE6BC00FFE6BC00FFE6BD00FFE7 + BE00FFE8BF00FFEAC300FFEAC300FFEBC500FFEFCA00FFE3C100A5C7CE000000 + 00000000000000000000A8CBD200A8CCD3000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000009ABBC10092B1B70088A1A6008691 + 9300848F91008F9B9F009D9A9100FFD4A400FFD0A300FFD1A400FFD1A700FFD4 + A900FFD5AE00FFD8B100FFD9B300FFDAB600FFDFBC00F6D6B800848B8B00848F + 920088929400889FA40093B2B8009ABBC1000000000000000000000000000000 + 00000000000000000000ACC3C700ACC3C7000000000000000000000000000000 + 000000000000000000000000000000000000ACC3C700ACC3C700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A6C9D0008DA7AD00B3B7B800D3D3 + D300D7D7D700BBBEC0006D625700EFBF9100EABC9100EABD9400EABE9600EAC1 + 9A00EAC39F00EAC5A200EAC6A500EAC8AA00EDCEB000D5B99F006A686600D5D6 + D700D2D2D200B7BABB008AA2A700A8CBD2000000000000000000000000000000 + 000000000000ACC3C7004646C1004646C100ACC3C70000000000000000000000 + 0000000000000000000000000000ACC3C7004646C1004646C100ACC3C7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000008C9EA100D4D4D400D4D4 + D400D5D5D500BEC0C200554B4300BA947200B6937300B6937500B6957700B697 + 7B00B6987C00B6987E00B79A8000B79A8500BA9F8900A38B770058575600D8D4 + D700D2D0D100D0D0D0008C9EA100000000000000000000000000000000000000 + 0000ACC3C7004646C1007575DB007474DB004646C100ACC3C700000000000000 + 00000000000000000000ACC3C7004646C1007474DB007575DB004646C100ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B2C3C700CBCBCB00D8D8 + D800D6D6D600CDCDCE0096919000B7A9A300B6A8A200B6A8A200B6A8A200B5A8 + A100B5A8A200B5A8A200B5A7A100B5A7A200B5A8A200AC9F9A009E989A009CC1 + B100AEC6BC00CBC7C900B2C3C700000000000000000000000000000000000000 + 00004646C1007575DB009898FF008E8EFF006A6ADB004646C100ACC3C7000000 + 000000000000ACC3C7004646C1006A6ADB008E8EFF009898FF007575DB004646 + C100000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AABCC000CDCDCD00E1E0 + E000EBEAEB00E3E8E600EAF0EE00E4ECEB00E4ECEB00E4ECEB00E4ECEA00E4EC + EA00E4ECEA00E4ECEA00E4EBEA00E4EBEA00E3EBE900E4ECEA00EFF0EF00CEE0 + D900C8D4CF00CBC9CA00AABCC000000000000000000000000000000000000000 + 00004646C1007474DB008E8EFF007A7AFF008080FF006767DB004646C100ACC3 + C700ACC3C7004646C1006767DB008080FF007A7AFF008E8EFF007474DB004646 + C100000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ABBDC000D6D2D400E7EE + EB006DBF9D0030A475003AA97B003AA97A003AA87A003AA87A003AA77A003AA8 + 79003AA879003AA779003BA77A003BA77A003BA77A003BA77A0030A272007DC4 + A600EDEFEE00D1CECF00ABBDC000000000000000000000000000000000000000 + 0000000000004646C1006A6ADB008080FF007575FF007B7BFF006161DB004646 + C1004646C1006161DB007B7BFF007575FF008080FF006A6ADB004646C1000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ADC1C500E5DEE100C0E2 + D3002BB27F0047C89C0040C0920041C0920041C0920041C0920041C0920041C0 + 930041C0930041C0930041C0930041C0930041C0930040BF920047C99C002CAE + 7D00C5E2D400E2DBDE00ADC1C400000000000000000000000000000000000000 + 000000000000000000004646C1006767DB007B7BFF007070FF006E6EFF007272 + FF007272FF006E6EFF007070FF007B7BFF006767DB004646C100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AFC3C600EFE8EB00C0E5 + D7002BB483002AB281001BAB76001DAD79001DAD79001DAD79001DAD79001DAD + 79001DAD79001DAD79001DAD79001DAD79001DAD79001BAB76002AB281002CAF + 7F00C9E6DA00EEE7EB00B0C3C700000000000000000000000000000000000000 + 00000000000000000000000000004646C1006161DB006E6EFF006262FF005F5F + FF005F5FFF006262FF006E6EFF006161DB004646C10000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B1C5C900F9F2F500BCE7 + D70033C2910038CB9C0024C6920026C8950026C8950026C8950026C8950026C8 + 950026C8950026C8950026C8950026C8950026C8950023C5920039CD9F0038BF + 9000C7E7D900FCF4F700B3C7CA00000000000000000000000000000000000000 + 0000000000000000000000000000000000004646C1007272FF005F5FFF005858 + FF005858FF005F5FFF007272FF004646C1000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B3C8CC00FBF4F600B1E6 + D4003ACB9D0074F4CF006EF1CC006EF2CC006EF1CC006EF1CC006EF2CC006EF2 + CC006EF2CC006EF1CC006EF1CC006EF1CC006EF2CC006FF1CC0076F4D0003CC8 + 9900C5E7DA00FFF6FA00B7CACE00000000000000000000000000000000000000 + 0000000000000000000000000000ACC3C7004646C100B5B5FF00ABABFF00A8A8 + FF00A8A8FF00ABABFF00B5B5FF004646C100ACC3C70000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B3C8CC00FBF4F600ADE7 + D4003BCFA1006AEFC80050D7AD0050D5AC0050D6AC0050D6AC0050D5AC0050D5 + AC0050D5AC0050D6AC0050D6AD0050D6AC0051D5AC004DD7AD0061ECC3003CCB + 9C00C4EADC00FFF6FA00B7CBCE00000000000000000000000000000000000000 + 00000000000000000000ACC3C7004646C1007C7CDB00BFBFFF00B9B9FF00B8B8 + FF00B8B8FF00B9B9FF00BFBFFF007C7CDB004646C100ACC3C700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B1C8CC00F6EDF000BBEC + DC0031D2A10047D5A600A9B58A00B8B58C00B5B68C00B5B68C00B5B68C00B5B6 + 8C00B5B68C00B5B68C00B5B68D00B5B68C00B8B58C00A8B78C0032CA99001AC2 + 8D00C9EFE100FBF1F400B3C9CD00000000000000000000000000000000000000 + 000000000000ACC3C7004646C1008383DB00CFCFFF00CBCBFF00CBCBFF00CCCC + FF00CCCCFF00CBCBFF00CBCBFF00CFCFFF008383DB004646C100ACC3C7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ABCED500BFC7CC009DCD + BE003AC199005ABB9A00EBC7A000FFCDA500FACCA400FACCA400FACCA400FACC + A400FACCA400FACCA400FACCA400FACCA400FECDA500EFC9A1005FBA990036BB + 9300A4CBC000C2C9CD00ACCDD400000000000000000000000000000000000000 + 0000ACC3C7004646C1008787DB00DCDCFF00D9D9FF00DBDBFF008585DB004646 + C1004646C1008585DB00DBDBFF00D9D9FF00DCDCFF008787DB004646C100ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000ACCC + D200ACCDD400A9CED300E6D2AE00FCD9B400F8D9B400F9D9B400F8D9B300F9D9 + B400F9D9B400F8D9B300F9D9B300F9D9B400FBDAB400EDD3B200ABCBD100ACCD + D400ABCED4000000000000000000000000000000000000000000000000000000 + 00004646C1008C8CDB00E9E9FF00E6E6FF00E7E7FF008A8ADB004646C1000000 + 0000000000004646C1008A8ADB00E7E7FF00E6E6FF00E9E9FF008C8CDB004646 + C100000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCFD400F6D4B100F9DAB700FADAB600F9D9B600FADAB700F9DB + B700F9DBB700F9DAB700F9DAB700FADAB700FBDAB600F1D5B300ACCED4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00004646C1008F8FDB00F3F3FF00F2F2FF008E8EDB004646C100000000000000 + 000000000000000000004646C1008E8EDB00F2F2FF00F3F3FF008F8FDB004646 + C100000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCFD300F0D1B000FADDBB00FADCBA00FADCBA00FADDBA00F9DC + BA00FADDBA00FADCBB00F9DBBA00FADCBA00FADDBA00F3D4B300B0CFD3000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000004646C1009191DB009191DB004646C10000000000000000000000 + 00000000000000000000000000004646C1009191DB009191DB004646C1000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCFD300EED0B000FADFBF00FADEBE00FADDBD00FADDBD00FADE + BE00FADEBE00FADDBD00FADEBD00FADEBE00FADEBF00F0D2B300B0CFD3000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004646C1004646C1000000000000000000000000000000 + 0000000000000000000000000000000000004646C1004646C100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCED300EECEB100FBE1C300FADFC100FADFC100FBDFC100FBDF + C100FADFC200FBDFC100FADFC100FADFC100FBE0C200EFD1B200AFCFD3000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCED300EECFB100FDE5C800FBE3C700FCE3C600FBE3C600FBE3 + C700FBE3C700FBE3C700FCE3C600FCE3C600FCE4C800EECFB200AFCED3000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFCED300EAC9AA00F0CCAC00F0CBAC00F0CBAB00F0CCAB00F0CB + AC00F0CBAC00F0CBAC00F0CBAB00F0CBAB00F0CCAC00EAC9AB00AFCED3000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000ACC3C700ACC3C700ACC3C700ACC3C7000000000000000000000000000000 + 00000000000000000000000000000000000000000000ACC3C700ACC3C7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000ACC3C700ACC3C700ACC3C7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ACC3C700ACC3C700ACC3C7000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ACC3C700ACC3C700000000000000000000000000000000000000 + 000000000000000000000000000000000000ACC3C700ACC3C700ACC3C700ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 00006BAE94006BAE94006BAE94006BAE94000000000000000000000000000000 + 0000000000000000000000000000ACC3C700ACC3C7006BAE94006BAE9400ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000ACC3C700ACC3C7006BAE94006BAE94006BAE9400ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 0000ACC3C7006BAE94006BAE94006BAE9400ACC3C700ACC3C700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000ACC3C7006BAE94006BAE9400ACC3C700ACC3C70000000000000000000000 + 0000000000000000000000000000000000006BAE94006BAE94006BAE94006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400BFF2E500BFF2E5006BAE94000000000000000000000000000000 + 000000000000ACC3C700ACC3C7006BAE94006BAE94008ACAB40090CAB6006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000ACC3C700ACC3C7006BAE94006BAE940084C8B200AAEEDD008ECAB5006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE94008ECAB500AAEEDD0084C8B2006BAE94006BAE9400ACC3C700ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE940090CAB6008ACAB4006BAE94006BAE9400ACC3C700ACC3C7000000 + 0000000000000000000000000000000000006BAE9400BFF2E500BFF2E5006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400AAEEDD00AAEEDD006BAE9400000000000000000000000000ACC3 + C700ACC3C7006BAE94006BAE940081C8B00091E9D30093EAD400A8EEDC006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000ACC3C700ACC3 + C7006BAE94006BAE940081C8B0008FE9D20084E7CE008BE8D100A4EDDB006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A4EDDB008BE8D10084E7CE008FE9D20081C8B0006BAE94006BAE + 9400ACC3C700ACC3C70000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A8EEDC0093EAD40091E9D30081C8B0006BAE94006BAE9400ACC3 + C700ACC3C7000000000000000000000000006BAE9400AAEEDD00AAEEDD006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A0ECD900A0ECD9006BAE940000000000ACC3C700ACC3C7006BAE + 94006BAE940081C8B0008EE9D20080E6CC0076E4C8007EE6CB0097EAD5006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000ACC3C700ACC3C7006BAE94006BAE + 940081C8B0008EE9D20080E6CC0075E4C8006FE3C50079E5C90095EAD4006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940095EAD40079E5C9006FE3C50075E4C80080E6CC008EE9D20081C8 + B0006BAE94006BAE9400ACC3C700ACC3C7000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE940097EAD5007EE6CB0076E4C80080E6CC008EE9D20081C8B0006BAE + 94006BAE9400ACC3C700ACC3C700000000006BAE9400A0ECD900A0ECD9006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A0ECD900A0ECD9006BAE9400ACC3C7006BAE94006BAE940081C8 + B0008EE9D20080E6CC0075E4C8006EE2C50069E1C30076E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000ACC3C700ACC3C7006BAE94006BAE940081C8B0008EE9 + D20080E6CC0075E4C8006EE2C50069E1C30068E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80068E1C20069E1C3006EE2C50075E4C80080E6 + CC008EE9D20081C8B0006BAE94006BAE9400ACC3C700ACC3C700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30076E4C80069E1C3006EE2C50075E4C80080E6CC008EE9 + D20081C8B0006BAE94006BAE9400ACC3C7006BAE9400A0ECD900A0ECD9006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A0ECD900A0ECD9006BAE94006BAE940081C8B0008EE9D20080E6 + CC0075E4C8006EE2C50069E1C30068E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 000000000000ACC3C7006BAE94006BAE940081C8B0008EE9D20080E6CC0075E4 + C8006EE2C50069E1C30068E1C20067E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20067E1C20068E1C20069E1C3006EE2 + C50075E4C80080E6CC008EE9D20081C8B0006BAE94006BAE9400ACC3C7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20068E1C20069E1C3006EE2C50075E4 + C80080E6CC008EE9D20081C8B0006BAE94006BAE9400A0ECD900A0ECD9006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A0ECD900A0ECD9006BAE940093EAD30080E6CC0075E4C8006EE2 + C50069E1C30068E1C20067E1C20067E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000ACC3C7006BAE940087C9B20093EAD30080E6CC0075E4C8006EE2C50069E1 + C30068E1C20067E1C20067E1C20067E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20067E1C20067E1C20067E1C20068E1 + C20069E1C3006EE2C50075E4C80080E6CC0093EAD30087C9B2006BAE9400ACC3 + C700000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20067E1C20067E1C20068E1C20069E1 + C3006EE2C50075E4C80080E6CC0093EAD3006BAE9400A0ECD900A0ECD9006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A0ECD900A0ECD9006BAE94007CE5CB006FE3C50069E1C30068E1 + C20067E1C20067E1C20067E1C20067E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE94008CCAB50096EAD5007CE5CB006FE3C50069E1C30068E1C20067E1 + C20067E1C20067E1C20067E1C20067E1C20067E1C20075E4C80091E9D3006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20067E1C20067E1C20067E1C20067E1 + C20067E1C20068E1C20069E1C3006FE3C5007CE5CB0096EAD5008CCAB5006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE940091E9D30075E4C80067E1C20067E1C20067E1C20067E1C20067E1 + C20068E1C20069E1C3006FE3C5007CE5CB006BAE9400A0ECD900A0ECD9006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400D6F1EA00D6F1EA006BAE9400C6EBE200C0E9DF00BEE8DE00BDE8 + DD00BDE8DD00BDE8DD00BDE8DD00BDE8DD00BDE8DD00C3EAE000CFEEE6006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE94009CCBBA00D1EFE800C6EBE200C0E9DF00BEE8DE00BDE8DD00BDE8 + DD00BDE8DD00BDE8DD00BDE8DD00BDE8DD00BDE8DD00C3EAE000CFEEE6006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400CFEEE600C3EAE000BDE8DD00BDE8DD00BDE8DD00BDE8DD00BDE8 + DD00BDE8DD00BDE8DD00BEE8DE00C0E9DF00C6EBE200D1EFE8009CCBBA006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400CFEEE600C3EAE000BDE8DD00BDE8DD00BDE8DD00BDE8DD00BDE8 + DD00BDE8DD00BEE8DE00C0E9DF00C6EBE2006BAE9400D6F1EA00D6F1EA006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400DCF2ED00DCF2ED006BAE9400D8F1EA00D1EEE700CDEDE500CBEC + E300C9EBE200C8EBE200C8EBE200C8EBE200C8EBE200CDEDE500D7F1EA006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000006BAE94009CCBBA00D8F1EA00D1EEE700CDEDE500CBECE300C9EB + E200C8EBE200C8EBE200C8EBE200C8EBE200C8EBE200CDEDE500D7F1EA006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400D7F1EA00CDEDE500C8EBE200C8EBE200C8EBE200C8EBE200C8EB + E200C9EBE200CBECE300CDEDE500D1EEE700D8F1EA009CCBBA006BAE94000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400D7F1EA00CDEDE500C8EBE200C8EBE200C8EBE200C8EBE200C9EB + E200CBECE300CDEDE500D1EEE700D8F1EA006BAE9400DCF2ED00DCF2ED006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400E3F5F000E3F5F0006BAE94006BAE94009CCBBA00DEF3ED00DAF2 + EB00D7F1E900D5F0E800D4EFE700D3EFE700D3EFE700D7F1E900DFF3EE006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 000000000000000000006BAE94006BAE94009CCBBA00DEF3ED00DAF2EB00D7F1 + E900D5F0E800D4EFE700D3EFE700D3EFE700D3EFE700D7F1E900DFF3EE006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400DFF3EE00D7F1E900D3EFE700D3EFE700D3EFE700D4EFE700D5F0 + E800D7F1E900DAF2EB00DEF3ED009CCBBA006BAE94006BAE9400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400DFF3EE00D7F1E900D3EFE700D3EFE700D4EFE700D5F0E800D7F1 + E900DAF2EB00DEF3ED009CCBBA006BAE94006BAE9400E3F5F000E3F5F0006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400EAF7F400EAF7F4006BAE9400000000006BAE94006BAE94009FCC + BC00E6F5F200E3F4F000E1F3EF00E0F3EE00DFF2ED00E1F3EF00E7F6F2006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000006BAE94006BAE94009FCCBC00E6F5 + F200E3F4F000E1F3EF00E0F3EE00DFF2ED00DEF2ED00E1F3EF00E7F6F2006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400E7F6F200E1F3EF00DEF2ED00DFF2ED00E0F3EE00E1F3EF00E3F4 + F000E6F5F2009FCCBC006BAE94006BAE94000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400E7F6F200E1F3EF00DFF2ED00E0F3EE00E1F3EF00E3F4F000E6F5 + F2009FCCBC006BAE94006BAE9400000000006BAE9400EAF7F400EAF7F4006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400F1F9F700F1F9F7006BAE94000000000000000000000000006BAE + 94006BAE9400A2CDBD00EEF8F600ECF7F500EAF7F400ECF7F500EFF9F7006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000006BAE94006BAE + 9400A2CDBD00EEF8F600ECF7F500EAF7F400E9F6F400EBF7F400EFF9F7006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400EFF9F700EBF7F400E9F6F400EAF7F400ECF7F500EEF8F600A2CD + BD006BAE94006BAE940000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400EFF9F700ECF7F500EAF7F400ECF7F500EEF8F600A2CDBD006BAE + 94006BAE94000000000000000000000000006BAE9400F1F9F700F1F9F7006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400F7FCFB00F7FCFB006BAE94000000000000000000000000000000 + 0000000000006BAE94006BAE9400A4CEBE00F5FBFA00F5FBFA00F7FCFB006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE94006BAE9400A4CEBE00F5FBFA00F4FBF900F4FBFA00F7FCFB006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400F7FCFB00F4FBFA00F4FBF900F5FBFA00A4CEBE006BAE94006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400F7FCFB00F5FBFA00F5FBFA00A4CEBE006BAE94006BAE94000000 + 0000000000000000000000000000000000006BAE9400F7FCFB00F7FCFB006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400FCFEFE00FCFEFE006BAE94000000000000000000000000000000 + 00000000000000000000000000006BAE94006BAE9400A7CFC000A7CFC0006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000006BAE94006BAE9400A7CFBF00FCFEFD00A7CFC0006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A7CFC000FCFEFD00A7CFBF006BAE94006BAE9400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00006BAE9400A7CFC000A7CFC0006BAE94006BAE940000000000000000000000 + 0000000000000000000000000000000000006BAE9400FCFEFE00FCFEFE006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 00006BAE94006BAE94006BAE94006BAE94000000000000000000000000000000 + 000000000000000000000000000000000000000000006BAE94006BAE94000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000006BAE94006BAE94006BAE94000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000006BAE94006BAE94006BAE94000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000006BAE94006BAE9400000000000000000000000000000000000000 + 0000000000000000000000000000000000006BAE94006BAE94006BAE94006BAE + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000060000000300000000100010000000000400200000000000000000000 + 000000000000000000000000FFFFFF00FFFFFFFFFFFF000000000000F8000FFF + FFFF0000000000003C001CFFFFFF000000000000000000FCFF3F000000000000 + 000000F87E1F000000000000800001F03C0F000000000000800001F0180F0000 + 00000000800001F0000F000000000000800001F8001F000000000000800001FC + 003F000000000000800001FE007F000000000000800001FF00FF000000000000 + 800001FE007F000000000000800001FC003F000000000000800001F8001F0000 + 00000000800001F0000F000000000000E00007F0180F000000000000F8001FF0 + 3C0F000000000000F8001FF87E1F000000000000F8001FFCFF3F000000000000 + F8001FFFFFFF000000000000F8001FFFFFFF000000000000F8001FFFFFFF0000 + 00000000FFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0FF9FFFFF1FF8FFFFF9FF0F + F0FE0FFFFC0FF03FFFF07F0FF0F80FFFF00FF00FFFF01F0FF0E00FFFC00FF003 + FFF0070FF0800FFF000FF000FFF0010FF0000FFC000FF0003FF0000FF0000FF8 + 000FF0001FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F + F0000FF0000FF0000FF0000FF0000FF8000FF0001FF0000FF0000FFC000FF000 + 3FF0000FF0800FFF000FF000FFF0010FF0E00FFFC00FF003FFF0070FF0F80FFF + F00FF00FFFF01F0FF0FE0FFFFC0FF03FFFF07F0FF0FF9FFFFF1FF8FFFFF9FF0F + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000 + 000000000000} + end + object ALMain: TActionList + Images = ILMain + Left = 56 + Top = 54 + object ACPageFirst: TAction + Hint = 'First page' + ImageIndex = 0 + OnExecute = ACPageFirstExecute + OnUpdate = ACPageFirstUpdate + end + object ACPagePrevious: TAction + Caption = 'Previous page' + Hint = 'Previous page' + ImageIndex = 1 + OnExecute = ACPagePreviousExecute + OnUpdate = ACPageFirstUpdate + end + object ACPageNext: TAction + Caption = 'Next page' + Hint = 'Next page' + ImageIndex = 2 + OnExecute = ACPageNextExecute + OnUpdate = ACPageNextUpdate + end + object ACPageLast: TAction + Caption = 'Last page' + Hint = 'Last page' + ImageIndex = 3 + OnExecute = ACPageLastExecute + OnUpdate = ACPageNextUpdate + end + object ACPrint: TAction + Caption = 'Print' + Hint = 'Print' + ImageIndex = 4 + OnExecute = ACPrintExecute + OnUpdate = ACPrintUpdate + end + object ACClose: TAction + Caption = 'Close' + Hint = 'Close preview' + ImageIndex = 5 + OnExecute = ACCloseExecute + OnUpdate = ACCloseUpdate + end + end + object ILMainDis: TImageList + Height = 24 + Width = 24 + Left = 96 + Top = 52 + Bitmap = { + 494C010106000900040018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000600000003000000001002000000000000048 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000A1C3C9008EACB2007F979C007B9397007C9398007C9398007C93 + 98007C9398007C9498007C9498007C9498007C93980081999E0094B3B900A5C8 + CE00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A8CCD300A8CBD200000000000000 + 0000000000000000000096B1B600E1E1E100DDDDDD00DDDDDD00DEDEDE00DEDE + DE00DFDFDF00E1E1E100E1E1E100E2E2E200E4E4E400E0E0E000A5C7CE000000 + 00000000000000000000A8CBD200A8CCD3000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000009ABBC10092B1B70088A1A6008691 + 9300848F9100919B9D00939A9B00D1D1D100D1D1D100D1D1D100D3D3D300D4D4 + D400D6D6D600D8D8D800D9D9D900DADADA00DDDDDD00D6D7D700838B8D00848F + 910088929400889FA40093B2B8009ABBC1000000000000000000000000000000 + 00000000000000000000AFC0C400AFC0C4000000000000000000000000000000 + 000000000000000000000000000000000000AFC0C400AFC0C400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A6C9D0008DA7AD00B3B7B800D3D3 + D300D7D7D700BDBDBD0062626200C0C0C000BDBDBD00BFBFBF00C0C0C000C2C2 + C200C4C4C400C6C6C600C7C7C700CACACA00CECECE00BABABA0068686800D6D6 + D600D2D2D200B7BABB008AA2A700A8CBD2000000000000000000000000000000 + 000000000000AFC0C4008383830083838300AFC0C40000000000000000000000 + 0000000000000000000000000000AFC0C4008383830083838300AFC0C4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000008C9EA100D4D4D400D4D4 + D400D5D5D500C0C0C0004C4C4C00969696009494940095959500969696009898 + 9800999999009A9A9A009B9B9B009E9E9E00A1A1A1008D8D8D0057575700D6D6 + D600D1D1D100D0D0D0008C9EA100000000000000000000000000000000000000 + 0000AFC0C40083838300A8A8A800A7A7A70083838300AFC0C400000000000000 + 00000000000000000000AFC0C40083838300A7A7A700A8A8A80083838300AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B2C3C700CBCBCB00D8D8 + D800D6D6D600CDCDCD0093939300ADADAD00ACACAC00ACACAC00ACACAC00ABAB + AB00ABABAB00ABABAB00ABABAB00ABABAB00ABABAB00A3A3A3009B9B9B00AEAE + AE00BABABA00C9C9C900B2C3C700000000000000000000000000000000000000 + 000083838300A8A8A800CBCBCB00C6C6C600A2A2A20083838300AFC0C4000000 + 000000000000AFC0C40083838300A2A2A200C6C6C600CBCBCB00A8A8A8008383 + 8300000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AABCC000CDCDCD00E0E0 + E000EAEAEA00E5E5E500EDEDED00E8E8E800E8E8E800E8E8E800E8E8E800E8E8 + E800E8E8E800E8E8E800E7E7E700E7E7E700E7E7E700E8E8E800EFEFEF00D7D7 + D700CECECE00CACACA00AABCC000000000000000000000000000000000000000 + 000083838300A7A7A700C6C6C600BCBCBC00BFBFBF00A1A1A10083838300AFC0 + C400AFC0C40083838300A1A1A100BFBFBF00BCBCBC00C6C6C600A7A7A7008383 + 8300000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ABBDC000D4D4D400EAEA + EA00969696006A6A6A0071717100717171007171710071717100707070007171 + 710071717100707070007171710071717100717171007171710069696900A0A0 + A000EEEEEE00CFCFCF00ABBDC000000000000000000000000000000000000000 + 00000000000083838300A2A2A200BFBFBF00BABABA00BDBDBD009E9E9E008383 + 8300838383009E9E9E00BDBDBD00BABABA00BFBFBF00A2A2A200838383000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ADC1C500E1E1E100D1D1 + D1006E6E6E008787870080808000808080008080800080808000808080008080 + 800080808000808080008080800080808000808080007F7F7F00888888006D6D + 6D00D3D3D300DEDEDE00ADC1C400000000000000000000000000000000000000 + 0000000000000000000083838300A1A1A100BDBDBD00B7B7B700B6B6B600B8B8 + B800B8B8B800B6B6B600B7B7B700BDBDBD00A1A1A10083838300000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AFC3C600EBEBEB00D2D2 + D2006F6F6F006E6E6E0063636300656565006565650065656500656565006565 + 65006565650065656500656565006565650065656500636363006E6E6E006D6D + 6D00D7D7D700EAEAEA00B0C3C700000000000000000000000000000000000000 + 0000000000000000000000000000838383009E9E9E00B6B6B600B0B0B000AFAF + AF00AFAFAF00B0B0B000B6B6B6009E9E9E008383830000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B1C5C900F5F5F500D1D1 + D1007A7A7A008181810075757500777777007777770077777700777777007777 + 7700777777007777770077777700777777007777770074747400838383007B7B + 7B00D7D7D700F8F8F800B3C7CA00000000000000000000000000000000000000 + 00000000000000000000000000000000000083838300B8B8B800AFAFAF00ABAB + AB00ABABAB00AFAFAF00B8B8B800838383000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B3C8CC00F7F7F700CBCB + CB0082828200B4B4B400AFAFAF00B0B0B000AFAFAF00AFAFAF00B0B0B000B0B0 + B000B0B0B000AFAFAF00AFAFAF00AFAFAF00B0B0B000B0B0B000B5B5B5008282 + 8200D6D6D600FAFAFA00B7CACE00000000000000000000000000000000000000 + 0000000000000000000000000000AFC0C40083838300DADADA00D5D5D500D3D3 + D300D3D3D300D5D5D500DADADA0083838300AFC0C40000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B3C8CC00F7F7F700CACA + CA0085858500ACACAC0093939300929292009393930093939300929292009292 + 9200929292009393930093939300939393009393930092929200A6A6A6008383 + 8300D7D7D700FAFAFA00B7CBCE00000000000000000000000000000000000000 + 00000000000000000000AFC0C40083838300ABABAB00DFDFDF00DCDCDC00DBDB + DB00DBDBDB00DCDCDC00DFDFDF00ABABAB0083838300AFC0C400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B1C8CC00F1F1F100D3D3 + D300818181008E8E8E009F9F9F00A2A2A200A1A1A100A1A1A100A1A1A100A1A1 + A100A1A1A100A1A1A100A1A1A100A1A1A100A2A2A200A1A1A1007E7E7E006E6E + 6E00DCDCDC00F6F6F600B3C9CD00000000000000000000000000000000000000 + 000000000000AFC0C40083838300AFAFAF00E7E7E700E5E5E500E5E5E500E5E5 + E500E5E5E500E5E5E500E5E5E500E7E7E700AFAFAF0083838300AFC0C4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ABCED500BCCACD00B4B5 + B6007C7E7E00898C8C00C5C5C500D2D2D200CFCFCF00CFCFCF00CFCFCF00CFCF + CF00CFCFCF00CFCFCF00CFCFCF00CFCFCF00D1D1D100C8C8C8008C8E8E007779 + 7900B6B9B900BECBCE00ACCDD400000000000000000000000000000000000000 + 0000AFC0C40083838300B1B1B100EDEDED00ECECEC00EDEDED00B0B0B0008383 + 830083838300B0B0B000EDEDED00ECECEC00EDEDED00B1B1B10083838300AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000ACCC + D200ABCDD400AACCD300C8CACB00D8D8D800D6D6D600D6D6D600D5D5D500D6D6 + D600D6D6D600D5D5D500D6D6D600D6D6D600D7D7D700CED0D000ACCBD100ABCD + D400ABCED4000000000000000000000000000000000000000000000000000000 + 000083838300B3B3B300F4F4F400F2F2F200F3F3F300B2B2B200838383000000 + 00000000000083838300B2B2B200F3F3F300F2F2F200F4F4F400B3B3B3008383 + 8300000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500D1D4D400D8D8D800D8D8D800D7D7D700D8D8D800D8D8 + D800D8D8D800D8D8D800D8D8D800D8D8D800D8D8D800D0D3D300ACCED5000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000083838300B5B5B500F9F9F900F8F8F800B4B4B40083838300000000000000 + 0000000000000000000083838300B4B4B400F8F8F800F9F9F900B5B5B5008383 + 8300000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500CFD1D100DADADA00DADADA00DADADA00DADADA00D9D9 + D900DADADA00DADADA00D9D9D900DADADA00DADADA00D1D4D400AECFD6000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000083838300B6B6B600B6B6B6008383830000000000000000000000 + 000000000000000000000000000083838300B6B6B600B6B6B600838383000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500CED0D000DCDCDC00DCDCDC00DBDBDB00DBDBDB00DCDC + DC00DCDCDC00DBDBDB00DBDBDB00DCDCDC00DCDCDC00D0D3D300ADCFD6000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000083838300838383000000000000000000000000000000 + 0000000000000000000000000000000000008383830083838300000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500CED0D000DFDFDF00DDDDDD00DDDDDD00DEDEDE00DEDE + DE00DEDEDE00DEDEDE00DDDDDD00DDDDDD00DEDEDE00D0D2D200ADCFD5000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500CED0D000E2E2E200E1E1E100E1E1E100E0E0E000E1E1 + E100E1E1E100E1E1E100E1E1E100E1E1E100E2E2E200CFD1D100ADCFD5000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ADCFD500C8CACB00CDCECE00CDCECE00CCCDCD00CCCDCD00CDCE + CE00CDCECE00CDCECE00CCCDCD00CCCDCD00CDCECE00C8CBCC00ADCFD5000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000AFC0C400AFC0C400AFC0C400AFC0C4000000000000000000000000000000 + 00000000000000000000000000000000000000000000AFC0C400AFC0C4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000AFC0C400AFC0C400AFC0C4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFC0C400AFC0C400AFC0C4000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000AFC0C400AFC0C400000000000000000000000000000000000000 + 000000000000000000000000000000000000AFC0C400AFC0C400AFC0C400AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C008C8C8C008C8C8C008C8C8C000000000000000000000000000000 + 0000000000000000000000000000AFC0C400AFC0C4008C8C8C008C8C8C00AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000AFC0C400AFC0C4008C8C8C008C8C8C008C8C8C00AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 0000AFC0C4008C8C8C008C8C8C008C8C8C00AFC0C400AFC0C400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000AFC0C4008C8C8C008C8C8C00AFC0C400AFC0C40000000000000000000000 + 0000000000000000000000000000000000008C8C8C008C8C8C008C8C8C008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00D8D8D800D8D8D8008C8C8C000000000000000000000000000000 + 000000000000AFC0C400AFC0C4008C8C8C008C8C8C00AAAAAA00ADADAD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000AFC0C400AFC0C4008C8C8C008C8C8C00A6A6A600CCCCCC00ACACAC008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00ACACAC00CCCCCC00A6A6A6008C8C8C008C8C8C00AFC0C400AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00ADADAD00AAAAAA008C8C8C008C8C8C00AFC0C400AFC0C4000000 + 0000000000000000000000000000000000008C8C8C00D8D8D800D8D8D8008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00CCCCCC00CCCCCC008C8C8C00000000000000000000000000AFC0 + C400AFC0C4008C8C8C008C8C8C00A4A4A400BDBDBD00BEBEBE00CBCBCB008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000AFC0C400AFC0 + C4008C8C8C008C8C8C00A4A4A400BCBCBC00B5B5B500B9B9B900C8C8C8008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C8C8C800B9B9B900B5B5B500BCBCBC00A4A4A4008C8C8C008C8C + 8C00AFC0C400AFC0C40000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00CBCBCB00BEBEBE00BDBDBD00A4A4A4008C8C8C008C8C8C00AFC0 + C400AFC0C4000000000000000000000000008C8C8C00CCCCCC00CCCCCC008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C6C6C600C6C6C6008C8C8C0000000000AFC0C400AFC0C4008C8C + 8C008C8C8C00A4A4A400BBBBBB00B3B3B300ADADAD00B2B2B200C0C0C0008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000AFC0C400AFC0C4008C8C8C008C8C + 8C00A4A4A400BBBBBB00B3B3B300ACACAC00A9A9A900AFAFAF00BFBFBF008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BFBFBF00AFAFAF00A9A9A900ACACAC00B3B3B300BBBBBB00A4A4 + A4008C8C8C008C8C8C00AFC0C400AFC0C4000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C0C0C000B2B2B200ADADAD00B3B3B300BBBBBB00A4A4A4008C8C + 8C008C8C8C00AFC0C400AFC0C400000000008C8C8C00C6C6C600C6C6C6008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C6C6C600C6C6C6008C8C8C00AFC0C4008C8C8C008C8C8C00A4A4 + A400BBBBBB00B3B3B300ACACAC00A8A8A800A5A5A500ADADAD00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000AFC0C400AFC0C4008C8C8C008C8C8C00A4A4A400BBBB + BB00B3B3B300ACACAC00A8A8A800A5A5A500A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A5A5A500A8A8A800ACACAC00B3B3 + B300BBBBBB00A4A4A4008C8C8C008C8C8C00AFC0C400AFC0C400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ADADAD00A5A5A500A8A8A800ACACAC00B3B3B300BBBB + BB00A4A4A4008C8C8C008C8C8C00AFC0C4008C8C8C00C6C6C600C6C6C6008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C6C6C600C6C6C6008C8C8C008C8C8C00A4A4A400BBBBBB00B3B3 + B300ACACAC00A8A8A800A5A5A500A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 000000000000AFC0C4008C8C8C008C8C8C00A4A4A400BBBBBB00B3B3B300ACAC + AC00A8A8A800A5A5A500A4A4A400A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A4A4A400A5A5A500A8A8 + A800ACACAC00B3B3B300BBBBBB00A4A4A4008C8C8C008C8C8C00AFC0C4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A5A5A500A8A8A800ACAC + AC00B3B3B300BBBBBB00A4A4A4008C8C8C008C8C8C00C6C6C600C6C6C6008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C6C6C600C6C6C6008C8C8C00BEBEBE00B3B3B300ACACAC00A8A8 + A800A5A5A500A4A4A400A4A4A400A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000AFC0C4008C8C8C00A8A8A800BEBEBE00B3B3B300ACACAC00A8A8A800A5A5 + A500A4A4A400A4A4A400A4A4A400A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A4A4A400A4A4A400A4A4 + A400A5A5A500A8A8A800ACACAC00B3B3B300BEBEBE00A8A8A8008C8C8C00AFC0 + C400000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A4A4A400A4A4A400A5A5 + A500A8A8A800ACACAC00B3B3B300BEBEBE008C8C8C00C6C6C600C6C6C6008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00C6C6C600C6C6C6008C8C8C00B0B0B000A9A9A900A5A5A500A4A4 + A400A4A4A400A4A4A400A4A4A400A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00ABABAB00C0C0C000B0B0B000A9A9A900A5A5A500A4A4A400A4A4 + A400A4A4A400A4A4A400A4A4A400A4A4A400A4A4A400ACACAC00BDBDBD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A4A4A400A4A4A400A4A4 + A400A4A4A400A4A4A400A5A5A500A9A9A900B0B0B000C0C0C000ABABAB008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BDBDBD00ACACAC00A4A4A400A4A4A400A4A4A400A4A4A400A4A4 + A400A4A4A400A5A5A500A9A9A900B0B0B0008C8C8C00C6C6C600C6C6C6008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E3E3E300E3E3E3008C8C8C00D8D8D800D4D4D400D3D3D300D2D2 + D200D2D2D200D2D2D200D2D2D200D2D2D200D2D2D200D6D6D600DEDEDE008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00B3B3B300E0E0E000D8D8D800D4D4D400D3D3D300D2D2D200D2D2 + D200D2D2D200D2D2D200D2D2D200D2D2D200D2D2D200D6D6D600DEDEDE008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00DEDEDE00D6D6D600D2D2D200D2D2D200D2D2D200D2D2D200D2D2 + D200D2D2D200D2D2D200D3D3D300D4D4D400D8D8D800E0E0E000B3B3B3008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00DEDEDE00D6D6D600D2D2D200D2D2D200D2D2D200D2D2D200D2D2 + D200D2D2D200D3D3D300D4D4D400D8D8D8008C8C8C00E3E3E300E3E3E3008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E7E7E700E7E7E7008C8C8C00E4E4E400DFDFDF00DDDDDD00DBDB + DB00DADADA00D9D9D900D9D9D900D9D9D900D9D9D900DDDDDD00E4E4E4008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000008C8C8C00B3B3B300E4E4E400DFDFDF00DDDDDD00DBDBDB00DADA + DA00D9D9D900D9D9D900D9D9D900D9D9D900D9D9D900DDDDDD00E4E4E4008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E4E4E400DDDDDD00D9D9D900D9D9D900D9D9D900D9D9D900D9D9 + D900DADADA00DBDBDB00DDDDDD00DFDFDF00E4E4E400B3B3B3008C8C8C000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E4E4E400DDDDDD00D9D9D900D9D9D900D9D9D900D9D9D900DADA + DA00DBDBDB00DDDDDD00DFDFDF00E4E4E4008C8C8C00E7E7E700E7E7E7008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00ECECEC00ECECEC008C8C8C008C8C8C00B3B3B300E8E8E800E6E6 + E600E4E4E400E2E2E200E1E1E100E1E1E100E1E1E100E4E4E400E9E9E9008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008C8C8C008C8C8C00B3B3B300E8E8E800E6E6E600E4E4 + E400E2E2E200E1E1E100E1E1E100E1E1E100E1E1E100E4E4E400E9E9E9008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E9E9E900E4E4E400E1E1E100E1E1E100E1E1E100E1E1E100E2E2 + E200E4E4E400E6E6E600E8E8E800B3B3B3008C8C8C008C8C8C00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00E9E9E900E4E4E400E1E1E100E1E1E100E1E1E100E2E2E200E4E4 + E400E6E6E600E8E8E800B3B3B3008C8C8C008C8C8C00ECECEC00ECECEC008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F0F0F000F0F0F0008C8C8C00000000008C8C8C008C8C8C00B5B5 + B500EDEDED00EBEBEB00EAEAEA00E9E9E900E8E8E800EAEAEA00EEEEEE008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C8C8C008C8C8C00B5B5B500EDED + ED00EBEBEB00EAEAEA00E9E9E900E8E8E800E8E8E800EAEAEA00EEEEEE008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00EEEEEE00EAEAEA00E8E8E800E8E8E800E9E9E900EAEAEA00EBEB + EB00EDEDED00B5B5B5008C8C8C008C8C8C000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00EEEEEE00EAEAEA00E8E8E800E9E9E900EAEAEA00EBEBEB00EDED + ED00B5B5B5008C8C8C008C8C8C00000000008C8C8C00F0F0F000F0F0F0008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F5F5F500F5F5F5008C8C8C000000000000000000000000008C8C + 8C008C8C8C00B7B7B700F3F3F300F1F1F100F0F0F000F1F1F100F4F4F4008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000008C8C8C008C8C + 8C00B7B7B700F3F3F300F1F1F100F0F0F000EFEFEF00F1F1F100F4F4F4008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F4F4F400F1F1F100EFEFEF00F0F0F000F1F1F100F3F3F300B7B7 + B7008C8C8C008C8C8C0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F4F4F400F1F1F100F0F0F000F1F1F100F3F3F300B7B7B7008C8C + 8C008C8C8C000000000000000000000000008C8C8C00F5F5F500F5F5F5008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F9F9F900F9F9F9008C8C8C000000000000000000000000000000 + 0000000000008C8C8C008C8C8C00B9B9B900F8F8F800F8F8F800F9F9F9008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C008C8C8C00B9B9B900F8F8F800F7F7F700F7F7F700F9F9F9008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F9F9F900F7F7F700F7F7F700F8F8F800B9B9B9008C8C8C008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00F9F9F900F8F8F800F8F8F800B9B9B9008C8C8C008C8C8C000000 + 0000000000000000000000000000000000008C8C8C00F9F9F900F9F9F9008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00FDFDFD00FDFDFD008C8C8C000000000000000000000000000000 + 00000000000000000000000000008C8C8C008C8C8C00BBBBBB00BBBBBB008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008C8C8C008C8C8C00BBBBBB00FDFDFD00BBBBBB008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BBBBBB00FDFDFD00BBBBBB008C8C8C008C8C8C00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C00BBBBBB00BBBBBB008C8C8C008C8C8C0000000000000000000000 + 0000000000000000000000000000000000008C8C8C00FDFDFD00FDFDFD008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 00008C8C8C008C8C8C008C8C8C008C8C8C000000000000000000000000000000 + 000000000000000000000000000000000000000000008C8C8C008C8C8C000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C8C8C008C8C8C008C8C8C000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008C8C8C008C8C8C008C8C8C000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008C8C8C008C8C8C00000000000000000000000000000000000000 + 0000000000000000000000000000000000008C8C8C008C8C8C008C8C8C008C8C + 8C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000060000000300000000100010000000000400200000000000000000000 + 000000000000000000000000FFFFFF00FFFFFFFFFFFF000000000000F8000FFF + FFFF0000000000003C001CFFFFFF000000000000000000FCFF3F000000000000 + 000000F87E1F000000000000800001F03C0F000000000000800001F0180F0000 + 00000000800001F0000F000000000000800001F8001F000000000000800001FC + 003F000000000000800001FE007F000000000000800001FF00FF000000000000 + 800001FE007F000000000000800001FC003F000000000000800001F8001F0000 + 00000000800001F0000F000000000000E00007F0180F000000000000F8001FF0 + 3C0F000000000000F8001FF87E1F000000000000F8001FFCFF3F000000000000 + F8001FFFFFFF000000000000F8001FFFFFFF000000000000F8001FFFFFFF0000 + 00000000FFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0FF9FFFFF1FF8FFFFF9FF0F + F0FE0FFFFC0FF03FFFF07F0FF0F80FFFF00FF00FFFF01F0FF0E00FFFC00FF003 + FFF0070FF0800FFF000FF000FFF0010FF0000FFC000FF0003FF0000FF0000FF8 + 000FF0001FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F + F0000FF0000FF0000FF0000FF0000FF8000FF0001FF0000FF0000FFC000FF000 + 3FF0000FF0800FFF000FF000FFF0010FF0E00FFFC00FF003FFF0070FF0F80FFF + F00FF00FFFF01F0FF0FE0FFFFC0FF03FFFF07F0FF0FF9FFFFF1FF8FFFFF9FF0F + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000 + 000000000000} + end +end diff --git a/components/kcontrols/source/kprintpreview.lfm b/components/kcontrols/source/kprintpreview.lfm new file mode 100755 index 000000000..b47e15c0d --- /dev/null +++ b/components/kcontrols/source/kprintpreview.lfm @@ -0,0 +1,1150 @@ +object KPrintPreviewForm: TKPrintPreviewForm + Left = 1112 + Height = 660 + Top = 476 + Width = 800 + ActiveControl = Preview + Caption = 'Print Preview' + ClientHeight = 660 + ClientWidth = 800 + Font.Height = -11 + Font.Name = 'Tahoma' + Icon.Data = { + 7E04000000000100010010100000010020006804000016000000280000001000 + 0000200000000100200000000000000400006400000064000000000000000000 + 000000000025161310C60F0C0AB80C0C0C8F1514149815141498151414981514 + 1498151414981514149815141498151414980C0C0C8F00000029000000000000 + 000015120FC295887BFF8F8378FFB9B0A8FFF1F0EEFFF1F0EEFFF1F0EEFFF1F0 + EEFFF1F0EEFFF1F0EEFFF1F0EEFFF1F0EEFFEAE8E6FF51504FEA0000000C0000 + 00000C0A08AE867B70FFD2CCC6FFB7ADA3FFC1BCB6FFE3E3E3FFE0E0E0FFDFDF + DFFFFEFEFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA5A3A1FF000000350000 + 00000000000913110FBBA59C93FFE1DDD9FFB6ACA2FFBAB4AFFFA69E97FFA297 + 8CFFA1968BFFA9A29BFFD1D0CEFFF1F1F1FFFEFEFEFFA8A7A5FF000000360000 + 000000000000000000368B8580FFBAB0A6FFD4CEC7FF9A8D7EFFAA9E89FFC8C0 + B0FFCCC3B3FFBCAE95FF978B7CFFE2DEDBFFFDFDFDFFA9A8A7FF000000360000 + 00000000000000000036AAA9A8FFE0DCD8FFA29586FFA9986CFFC6BA91FFD0C7 + A9FFD1C9AAFFC5B990FFAA986CFFA4998CFFF7F6F5FFAAA9A8FF000000360000 + 00000000000000000036ABAAA9FFD6D1CCFFA0906EFFAD9C60FFB9AC78FFBFB4 + 85FFBBB082FFBAAE79FFAB9A5EFFA99874FFD9D4D0FFABAAA9FF000000360000 + 00000000000000000036ACABA9FFD1CBC4FFA18D5AFFB7A45CFFB8A866FFB8A8 + 69FFB9A969FFBBA963FFB6A154FFA7925DFFD4CEC8FFABA9A8FF000000360000 + 00000000000000000036ACABAAFFDAD5D0FFAB9A6EFFC7B778FFCABB80FFCBBD + 85FFC9BA7FFFC4B371FFB4A157FFA89462FFDBD5D1FFA7A5A3FF000000360000 + 00000000000000000036ADACABFFEBE9E6FFB4A892FFC5B990FFD7CDA8FFD9D0 + AAFFD8CFAAFFD8CEA8FFC2B58CFFBAAF9AFFE4E0DCFF9C9894FF000000360000 + 00000000000000000036ADACABFFF1EFEDFFCFCBC8FFB9AC91FFD3C8A7FFF2EE + E1FFF2EEE0FFD2C6A4FFBAAD93FFC9C4BFFFD5CEC7FF817971FF000000360000 + 00000000000000000036ADADACFFEDEBE9FFB9B7B5FFC3C1BEFFB8B1A8FFA59B + 86FFA89D87FFCCC5BBFFDFD9D4FFE5E1DDFFE4E0DCFF514E4BEC0000001B0000 + 00000000000000000036AEADACFFEAE7E4FF979694FFB6B4B1FFACAAA7FFA8A6 + A4FFA2A09EFFDAD5CFFFE8E5E2FFE6E3E0FF656564EC00000031000000000000 + 00000000000000000035ADACABFFE6E3DFFFE6E3DFFFE6E3DFFFE6E3DFFFE4E1 + DDFFDED9D4FFD3CCC4FFEBE9E7FF646464EB0000002E00000000000000000000 + 0000000000000000000C5B5B5BEAEFEEECFFF0EEECFFF0EEEBFFEEEBE9FFE7E3 + DFFFD4CDC6FFBDB3A8FF646464EB0000002F0000000000000000000000000000 + 00000000000000000000000000290E0E0E8F1717179817171798171717981615 + 1598131211980C0B0A980000002E000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000 + } + KeyPreview = True + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnShow = FormShow + Position = poScreenCenter + LCLVersion = '0.9.29' + object ToBMain: TToolBar + Left = 0 + Top = 0 + Width = 800 + AutoSize = True + ButtonHeight = 30 + ButtonWidth = 31 + Caption = 'TBMain' + DisabledImages = ILMainDis + Images = ILMain + TabOrder = 0 + Wrapable = False + object TBPageFirst: TToolButton + Left = 1 + Top = 2 + Action = ACPageFirst + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPagePrevious: TToolButton + Left = 32 + Top = 2 + Action = ACPagePrevious + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPageNext: TToolButton + Left = 63 + Top = 2 + Action = ACPageNext + Grouped = True + ParentShowHint = False + ShowHint = True + end + object TBPageLast: TToolButton + Left = 94 + Top = 2 + Action = ACPageLast + Grouped = True + ParentShowHint = False + ShowHint = True + end + object ToolButton3: TToolButton + Left = 125 + Top = 2 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object ToolButton6: TToolButton + Left = 198 + Top = 2 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 3 + Style = tbsSeparator + end + object TBPrint: TToolButton + Left = 333 + Top = 2 + Action = ACPrint + ParentShowHint = False + ShowHint = True + end + object ToolButton4: TToolButton + Left = 364 + Top = 2 + Width = 8 + Caption = 'ToolButton4' + ImageIndex = 5 + Style = tbsSeparator + end + object TBClose: TToolButton + Left = 372 + Top = 2 + Action = ACClose + ParentShowHint = False + ShowHint = True + end + object PNPage: TPanel + Left = 133 + Height = 30 + Top = 2 + Width = 65 + BevelOuter = bvNone + ClientHeight = 30 + ClientWidth = 65 + TabOrder = 0 + object EDPage: TEdit + Left = 4 + Height = 21 + Top = 4 + Width = 42 + OnExit = EDPageExit + TabOrder = 0 + Text = '1' + end + object UDPage: TUpDown + Left = 46 + Height = 21 + Top = 4 + Width = 15 + Associate = EDPage + Min = 1 + Position = 1 + TabOrder = 1 + Wrap = False + OnClick = UDPageClick + end + end + object PNScale: TPanel + Left = 206 + Height = 30 + Top = 2 + Width = 120 + BevelOuter = bvNone + ClientHeight = 30 + ClientWidth = 120 + TabOrder = 1 + object CoBScale: TComboBox + Left = 2 + Height = 21 + Top = 4 + Width = 115 + DropDownCount = 16 + ItemHeight = 13 + Items.Strings = ( + '25 %' + '50 %' + '75 %' + '100 %' + '125 %' + '150 %' + '200 %' + '500 %' + 'Whole Page' + 'Page Width' + ) + OnExit = CoBScaleExit + OnSelect = CoBScaleExit + TabOrder = 0 + end + end + object ToolButton1: TToolButton + Left = 326 + Top = 2 + Width = 7 + Caption = 'ToolButton1' + Style = tbsSeparator + end + end + object Preview: TKPrintPreview + Left = 0 + Height = 628 + Top = 32 + Width = 800 + Align = alClient + Page = 0 + TabStop = True + TabOrder = 1 + OnChanged = PreviewChanged + end + object ILMain: TImageList + Height = 24 + Width = 24 + left = 16 + top = 54 + Bitmap = { + 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFFCFEFEFFFCFEFEFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B8006BAE94FF6BAE94FFA7CFC0FFA7CFC0FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFF7FCFBFFF7FCFBFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B8006BAE94FF6BAE94FFA4CEBEFFF5FBFAFFF5FBFAFFF7FCFBFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFF1F9F7FFF1F9F7FF6BAE94FFADB7B800ADB7B800ADB7B8006BAE94FF6BAE + 94FFA2CDBDFFEEF8F6FFECF7F5FFEAF7F4FFECF7F5FFEFF9F7FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFEAF7F4FFEAF7F4FF6BAE94FFADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5 + F2FFE3F4F0FFE1F3EFFFE0F3EEFFDFF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFE3F5F0FFE3F5F0FF6BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1 + E9FFD5F0E8FFD4EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFDCF2EDFFDCF2EDFF6BAE94FFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EB + E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFD6F1EAFFD6F1EAFF6BAE94FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8 + DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA0ECD9FFA0ECD9FF6BAE94FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1 + C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA0ECD9FFA0ECD9FF6BAE94FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1 + C3FF68E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA0ECD9FFA0ECD9FF6BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4 + C8FF6EE2C5FF69E1C3FF68E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9 + D2FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF76E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA0ECD9FFA0ECD9FF6BAE94FFADB7B800ADB7B880ADB7B8806BAE94FF6BAE + 94FF81C8B0FF8EE9D2FF80E6CCFF76E4C8FF7EE6CBFF97EAD5FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFAAEEDDFFAAEEDDFF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B880ADB7 + B8806BAE94FF6BAE94FF81C8B0FF91E9D3FF93EAD4FFA8EEDCFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFBFF2E5FFBFF2E5FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B880ADB7B8806BAE94FF6BAE94FF8ACAB4FF90CAB6FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF6BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FFADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B880ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FFADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B8006BAE94FF6BAE94FFA7CFBFFFFCFEFDFFA7CFC0FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE + 94FF6BAE94FFA4CEBEFFF5FBFAFFF4FBF9FFF4FBFAFFF7FCFBFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FFA2CD + BDFFEEF8F6FFECF7F5FFEAF7F4FFE9F6F4FFEBF7F4FFEFF9F7FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF9FCCBCFFE6F5F2FFE3F4 + F0FFE1F3EFFFE0F3EEFFDFF2EDFFDEF2EDFFE1F3EFFFE7F6F2FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8006BAE94FF6BAE94FF9CCBBAFFDEF3EDFFDAF2EBFFD7F1E9FFD5F0 + E8FFD4EFE7FFD3EFE7FFD3EFE7FFD3EFE7FFD7F1E9FFDFF3EEFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8006BAE94FF9CCBBAFFD8F1EAFFD1EEE7FFCDEDE5FFCBECE3FFC9EBE2FFC8EB + E2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFCDEDE5FFD7F1EAFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF9CCBBAFFD1EFE8FFC6EBE2FFC0E9DFFFBEE8DEFFBDE8DDFFBDE8DDFFBDE8 + DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFC3EAE0FFCFEEE6FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF8CCAB5FF96EAD5FF7CE5CBFF6FE3C5FF69E1C3FF68E1C2FF67E1C2FF67E1 + C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8806BAE94FF87C9B2FF93EAD3FF80E6CCFF75E4C8FF6EE2C5FF69E1C3FF68E1 + C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6CCFF75E4C8FF6EE2 + C5FF69E1C3FF68E1C2FF67E1C2FF67E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8B0FF8EE9D2FF80E6 + CCFF75E4C8FF6EE2C5FF69E1C3FF68E1C2FF75E4C8FF91E9D3FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF81C8 + B0FF8EE9D2FF80E6CCFF75E4C8FF6FE3C5FF79E5C9FF95EAD4FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B8806BAE + 94FF6BAE94FF81C8B0FF8FE9D2FF84E7CEFF8BE8D1FFA4EDDBFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B880ADB7B8806BAE94FF6BAE94FF84C8B2FFAAEEDDFF8ECAB5FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B880ADB7B8806BAE94FF6BAE94FF6BAE94FFADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8006BAE94FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA7CFC0FFFCFEFDFFA7CFBFFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFF7FCFBFFF4FBFAFFF4FBF9FFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFEFF9F7FFEBF7F4FFE9F6F4FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE + 94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFE7F6F2FFE1F3EFFFDEF2EDFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5 + F2FF9FCCBCFF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1 + E9FFDAF2EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EB + E2FFCBECE3FFCDEDE5FFD1EEE7FFD8F1EAFF9CCBBAFF6BAE94FFADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 + DDFFBDE8DDFFBEE8DEFFC0E9DFFFC6EBE2FFD1EFE8FF9CCBBAFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1 + C2FF68E1C2FF69E1C3FF6FE3C5FF7CE5CBFF96EAD5FF8CCAB5FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1 + C3FF6EE2C5FF75E4C8FF80E6CCFF93EAD3FF87C9B2FF6BAE94FFADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4 + C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9 + D2FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF95EAD4FF79E5C9FF6FE3C5FF75E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE + 94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA4EDDBFF8BE8D1FF84E7CEFF8FE9D2FF81C8B0FF6BAE94FF6BAE94FFADB7 + B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF8ECAB5FFAAEEDDFF84C8B2FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8806BAE94FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B880ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8006BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA7CFC0FFA7CFC0FF6BAE94FF6BAE94FFADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FFFCFEFEFFFCFEFEFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFF7FCFBFFF5FBFAFFF5FBFAFFA4CEBEFF6BAE94FF6BAE94FFADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FFF7FCFBFFF7FCFBFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFEFF9F7FFECF7F5FFEAF7F4FFECF7F5FFEEF8F6FFA2CDBDFF6BAE94FF6BAE + 94FFADB7B800ADB7B800ADB7B8006BAE94FFF1F9F7FFF1F9F7FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFE7F6F2FFE1F3EFFFDFF2EDFFE0F3EEFFE1F3EFFFE3F4F0FFE6F5F2FF9FCC + BCFF6BAE94FF6BAE94FFADB7B8006BAE94FFEAF7F4FFEAF7F4FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFDFF3EEFFD7F1E9FFD3EFE7FFD3EFE7FFD4EFE7FFD5F0E8FFD7F1E9FFDAF2 + EBFFDEF3EDFF9CCBBAFF6BAE94FF6BAE94FFE3F5F0FFE3F5F0FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFD7F1EAFFCDEDE5FFC8EBE2FFC8EBE2FFC8EBE2FFC8EBE2FFC9EBE2FFCBEC + E3FFCDEDE5FFD1EEE7FFD8F1EAFF6BAE94FFDCF2EDFFDCF2EDFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFCFEEE6FFC3EAE0FFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8DDFFBDE8 + DDFFBEE8DEFFC0E9DFFFC6EBE2FF6BAE94FFD6F1EAFFD6F1EAFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF67E1C2FF68E1 + C2FF69E1C3FF6FE3C5FF7CE5CBFF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF67E1C2FF67E1C2FF68E1C2FF69E1C3FF6EE2 + C5FF75E4C8FF80E6CCFF93EAD3FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF75E4C8FF67E1C2FF68E1C2FF69E1C3FF6EE2C5FF75E4C8FF80E6 + CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF91E9D3FF76E4C8FF69E1C3FF6EE2C5FF75E4C8FF80E6CCFF8EE9D2FF81C8 + B0FF6BAE94FF6BAE94FFADB7B8806BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF97EAD5FF7EE6CBFF76E4C8FF80E6CCFF8EE9D2FF81C8B0FF6BAE94FF6BAE + 94FFADB7B880ADB7B880ADB7B8006BAE94FFA0ECD9FFA0ECD9FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FFA8EEDCFF93EAD4FF91E9D3FF81C8B0FF6BAE94FF6BAE94FFADB7B880ADB7 + B880ADB7B800ADB7B800ADB7B8006BAE94FFAAEEDDFFAAEEDDFF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006BAE + 94FF90CAB6FF8ACAB4FF6BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FFBFF2E5FFBFF2E5FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8806BAE94FF6BAE94FFADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8006BAE94FF6BAE94FF6BAE94FF6BAE94FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B880ADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00EFC7A500EFC7A500EFC7A500EFC7A500EFC7 + A500EFC7A510EFC8A6EBF1CCABFBF1CBABFBF1CBAAFBF1CCAAFBF1CBABFBF1CB + ABFBF1CBABFBF1CBAAFBF1CBAAFBF1CCABFBEFC8A7EBEFC7A610EFC7A600EFC7 + A600EFC7A600EFC7A600EFC7A600F4C9A400F4CAA400F0C8A500EEC7A500EEC7 + A500EDC5A310F2CFAEEFFDE5C8FFFBE3C7FFFCE3C6FFFBE3C6FFFBE3C7FFFBE3 + C7FFFBE3C7FFFCE3C6FFFCE3C6FFFCE4C8FFF3CFB0EFEFC7A510F0C9A800EFC9 + A800F1CAA700F6CBA700F5CBA700C6B9AE00C4B8AF00E8C5A700F5CAA500F0C9 + A600EFC7A410F2CEAEEFFBE1C3FFFADFC1FFFADFC1FFFBDFC1FFFBDFC1FFFADF + C2FFFBDFC1FFFADFC1FFFADFC1FFFBE0C2FFF4D1B0EFF0CBA910F1CCAA00F7CE + A900E9C9AC00C7BCB300C9BDB200AFB1B300AFB1B300BCBCBB00C8BBB000F3CB + A600F1CAA610F3D0ADEFFADFBFFFFADEBEFFFADDBDFFFADDBDFFFADEBEFFFADE + BEFFFADDBDFFFADEBDFFFADEBEFFFADEBFFFF5D2B1EFF4CEAC10F5CFAC00C8BC + B200BEBDBD00B3B5B700B3B5B700B2B2B200B2B2B200BCBCBC00AFB2B500C8BB + AE00F2CBA810F5D1ADEFFADDBBFFFADCBAFFFADCBAFFFADDBAFFF9DCBAFFFADD + BAFFFADCBBFFF9DBBAFFFADCBAFFFADDBAFFF8D4B1EFF8D2AE10C9BCB100AFB1 + B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AAAF + B200EBC8AE0FFBD4AEEFF9DAB7FFFADAB6FFF9D9B6FFFADAB7FFF9DBB7FFF9DB + B7FFF9DAB7FFF9DAB7FFFADAB7FFFBDAB6FFF6D5B1EFC8BDAE0DACAFB200B4B4 + B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBCBB00B4B3B41BB5B0 + B3108CBAA010EAD2ABEDFCD9B4FFF8D9B4FFF9D9B4FFF8D9B3FFF9D9B4FFF9D9 + B4FFF8D9B3FFF9D9B3FFF9D9B4FFFBDAB4FFF1D3B0F0ADB1AE23B4B1B310B4B3 + B30DBDBEBD00B6B6B600B6B6B600B3B3B300B2B2B207CCC2C59D9CCDBDF333C0 + 95F155BA96EFEBC7A0FEFFCDA5FFFACCA4FFFACCA4FFFACCA4FFFACCA4FFFACC + A4FFFACCA4FFFACCA4FFFACCA4FFFECDA5FFEFC9A1FE5BB996F22FBA8FF1A3CB + BEEBCEC5C8A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF6EDF0FEBBECDCFF31D2 + A1FF47D5A6FFA9B58AFFB8B58CFFB5B68CFFB5B68CFFB5B68CFFB5B68CFFB5B6 + 8CFFB5B68CFFB5B68DFFB5B68CFFB8B58CFFA8B78CFF32CA99FF1AC28DFFC9EF + E1FFFBF1F4FFC0C0C065C3C3C300C1C1C100BFBEBE67FBF4F6FFADE7D4FF3BCF + A1FF6AEFC8FF50D7ADFF50D5ACFF50D6ACFF50D6ACFF50D5ACFF50D5ACFF50D5 + ACFF50D6ACFF50D6ADFF50D6ACFF51D5ACFF4DD7ADFF61ECC3FF3CCB9CFFC4EA + DCFFFFF6FAFFC5C5C571C8C8C800C1C1C100BEBEBE6DFBF4F6FFB1E6D4FF3ACB + 9DFF74F4CFFF6EF1CCFF6EF2CCFF6EF1CCFF6EF1CCFF6EF2CCFF6EF2CCFF6EF2 + CCFF6EF1CCFF6EF1CCFF6EF1CCFF6EF2CCFF6FF1CCFF76F4D0FF3CC899FFC5E7 + DAFFFFF6FAFFC4C4C476C7C7C700BCBCBC00B9B9B970F9F2F5FFBCE7D7FF33C2 + 91FF38CB9CFF24C692FF26C895FF26C895FF26C895FF26C895FF26C895FF26C8 + 95FF26C895FF26C895FF26C895FF26C895FF23C592FF39CD9FFF38BF90FFC7E7 + D9FFFCF4F7FFBDBDBD76C0C0C000B6B6B600B3B3B371EFE8EBFFC0E5D7FF2BB4 + 83FF2AB281FF1BAB76FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1DAD + 79FF1DAD79FF1DAD79FF1DAD79FF1DAD79FF1BAB76FF2AB281FF2CAF7FFFC9E6 + DAFFEEE7EBFFB5B5B575B8B8B800B3B3B300B0B0B074E5DEE1FFC0E2D3FF2BB2 + 7FFF47C89CFF40C092FF41C092FF41C092FF41C092FF41C092FF41C093FF41C0 + 93FF41C093FF41C093FF41C093FF41C093FF40BF92FF47C99CFF2CAE7DFFC5E2 + D4FFE2DBDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD6D2D4FFE7EEEBFF6DBF + 9DFF30A475FF3AA97BFF3AA97AFF3AA87AFF3AA87AFF3AA77AFF3AA879FF3AA8 + 79FF3AA779FF3BA77AFF3BA77AFF3BA77AFF3BA77AFF30A272FF7DC4A6FFEDEF + EEFFD1CECFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE1E0E0FFEBEA + EBFFE3E8E6FFEAF0EEFFE4ECEBFFE4ECEBFFE4ECEBFFE4ECEAFFE4ECEAFFE4EC + EAFFE4ECEAFFE4EBEAFFE4EBEAFFE3EBE9FFE4ECEAFFEFF0EFFFCEE0D9FFC8D4 + CFFFCBC9CAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 + D6FFCDCDCEFF969190FFB7A9A3FFB6A8A2FFB6A8A2FFB6A8A2FFB5A8A1FFB5A8 + A2FFB5A8A2FFB5A7A1FFB5A7A2FFB5A8A2FFAC9F9AFF9E989AFF9CC1B1FFAEC6 + BCFFCBC7C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 + D5FFBEC0C2FF554B43FFBA9472FFB69373FFB69375FFB69577FFB6977BFFB698 + 7CFFB6987EFFB79A80FFB79A85FFBA9F89FFA38B77FF585756FFD8D4D7FFD2D0 + D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 + D7FFBBBEC0FF6D6257FFEFBF91FFEABC91FFEABD94FFEABE96FFEAC19AFFEAC3 + 9FFFEAC5A2FFEAC6A5FFEAC8AAFFEDCEB0FFD5B99FFF6A6866FFD5D6D7FFD2D2 + D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 + 75B684878AB99A8E82D1FFD4A4FFFFD0A3FFFFD1A4FFFFD1A7FFFFD4A9FFFFD5 + AEFFFFD8B1FFFFD9B3FFFFDAB6FFFFDFBCFFF7D6B8FB787674C2747575B47979 + 79B4434343570000002400000019000000040000000500000000000000000000 + 000010121200675D5243FFF0C4FFFFE6BCFFFFE6BCFFFFE6BDFFFFE7BEFFFFE8 + BFFFFFEAC3FFFFEAC3FFFFEBC5FFFFEFCAFFFFE3C1FE2725230C000000000000 + 0000000000000000000500000004000000000000000000000000000000000000 + 00000000000F0503022C2B2620542B241E5A2B241E592B241E592B241E592B25 + 1E592B251F592B251F592B251F592B26205A27221D4F00000022000000090000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8004646C1FF4646C1FFADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B8004646C1FF9191DBFF9191DBFF4646C1FFADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 + C1FF8F8FDBFFF3F3FFFFF2F2FFFF8E8EDBFF4646C1FFADB7B800ADB7B800ADB7 + B800ADB7B8004646C1FF8E8EDBFFF2F2FFFFF3F3FFFF8F8FDBFF4646C1FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 + C1FF8C8CDBFFE9E9FFFFE6E6FFFFE7E7FFFF8A8ADBFF4646C1FFADB7B800ADB7 + B8004646C1FF8A8ADBFFE7E7FFFFE6E6FFFFE9E9FFFF8C8CDBFF4646C1FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8804646C1FF8787DBFFDCDCFFFFD9D9FFFFDBDBFFFF8585DBFF4646C1FF4646 + C1FF8585DBFFDBDBFFFFD9D9FFFFDCDCFFFF8787DBFF4646C1FFADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8804646C1FF8383DBFFCFCFFFFFCBCBFFFFCBCBFFFFCCCCFFFFCCCC + FFFFCBCBFFFFCBCBFFFFCFCFFFFF8383DBFF4646C1FFADB7B880ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B8804646C1FF7C7CDBFFBFBFFFFFB9B9FFFFB8B8FFFFB8B8 + FFFFB9B9FFFFBFBFFFFF7C7CDBFF4646C1FFADB7B880ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B8804646C1FFB5B5FFFFABABFFFFA8A8FFFFA8A8 + FFFFABABFFFFB5B5FFFF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B800ADB7B8004646C1FF7272FFFF5F5FFFFF5858FFFF5858 + FFFF5F5FFFFF7272FFFF4646C1FFADB7B800ADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B8004646C1FF6161DBFF6E6EFFFF6262FFFF5F5FFFFF5F5F + FFFF6262FFFF6E6EFFFF6161DBFF4646C1FFADB7B800ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8004646C1FF6767DBFF7B7BFFFF7070FFFF6E6EFFFF7272FFFF7272 + FFFF6E6EFFFF7070FFFF7B7BFFFF6767DBFF4646C1FFADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8004646C1FF6A6ADBFF8080FFFF7575FFFF7B7BFFFF6161DBFF4646C1FF4646 + C1FF6161DBFF7B7BFFFF7575FFFF8080FFFF6A6ADBFF4646C1FFADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 + C1FF7474DBFF8E8EFFFF7A7AFFFF8080FFFF6767DBFF4646C1FFADB7B880ADB7 + B8804646C1FF6767DBFF8080FFFF7A7AFFFF8E8EFFFF7474DBFF4646C1FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004646 + C1FF7575DBFF9898FFFF8E8EFFFF6A6ADBFF4646C1FFADB7B880ADB7B800ADB7 + B800ADB7B8804646C1FF6A6ADBFF8E8EFFFF9898FFFF7575DBFF4646C1FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B8804646C1FF7575DBFF7474DBFF4646C1FFADB7B880ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B8804646C1FF7474DBFF7575DBFF4646C1FFADB7B880FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B8804646C1FF4646C1FFADB7B880ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00ADB7 + B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800ADB7B800ADB7B800ADB7 + B800ADB7B800ADB7B800ADB7B800ADB7B880ADB7B880ADB7B800ADB7B800FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object ALMain: TActionList + Images = ILMain + left = 56 + top = 54 + object ACPageFirst: TAction + Hint = 'First page' + ImageIndex = 0 + OnExecute = ACPageFirstExecute + OnUpdate = ACPageFirstUpdate + end + object ACPagePrevious: TAction + Caption = 'Previous page' + Hint = 'Previous page' + ImageIndex = 1 + OnExecute = ACPagePreviousExecute + OnUpdate = ACPageFirstUpdate + end + object ACPageNext: TAction + Caption = 'Next page' + Hint = 'Next page' + ImageIndex = 2 + OnExecute = ACPageNextExecute + OnUpdate = ACPageNextUpdate + end + object ACPageLast: TAction + Caption = 'Last page' + Hint = 'Last page' + ImageIndex = 3 + OnExecute = ACPageLastExecute + OnUpdate = ACPageNextUpdate + end + object ACPrint: TAction + Caption = 'Print' + Hint = 'Print' + ImageIndex = 4 + OnExecute = ACPrintExecute + OnUpdate = ACPrintUpdate + end + object ACClose: TAction + Caption = 'Close' + Hint = 'Close preview' + ImageIndex = 5 + OnExecute = ACCloseExecute + OnUpdate = ACCloseUpdate + end + end + object ILMainDis: TImageList + Height = 24 + Width = 24 + left = 96 + top = 54 + Bitmap = { + 4C69060000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFFDFDFDFFFDFDFDFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFBBBBBBFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF9F9F9FFF9F9F9FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B2008C8C8CFF8C8C8CFFB9B9B9FFF8F8F8FFF8F8F8FFF9F9F9FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF5F5F5FFF5F5F5FF8C8C8CFFB2B2B200B2B2B200B2B2B2008C8C8CFF8C8C + 8CFFB7B7B7FFF3F3F3FFF1F1F1FFF0F0F0FFF1F1F1FFF4F4F4FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF0F0F0FFF0F0F0FF8C8C8CFFB2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDED + EDFFEBEBEBFFEAEAEAFFE9E9E9FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFECECECFFECECECFF8C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4 + E4FFE2E2E2FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE7E7E7FFE7E7E7FF8C8C8CFFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADA + DAFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE3E3E3FFE3E3E3FF8C8C8CFFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2 + D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4 + A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC6C6C6FFC6C6C6FF8C8C8CFFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5 + A5FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC6C6C6FFC6C6C6FF8C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACAC + ACFFA8A8A8FFA5A5A5FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBB + BBFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFADADADFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC6C6C6FFC6C6C6FF8C8C8CFFB2B2B200B2B2B280B2B2B2808C8C8CFF8C8C + 8CFFA4A4A4FFBBBBBBFFB3B3B3FFADADADFFB2B2B2FFC0C0C0FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFCCCCCCFFCCCCCCFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B280B2B2 + B2808C8C8CFF8C8C8CFFA4A4A4FFBDBDBDFFBEBEBEFFCBCBCBFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFD8D8D8FFD8D8D8FF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFAAAAAAFFADADADFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFF8C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFB2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B280B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B2008C8C8CFF8C8C8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C + 8CFF8C8C8CFFB9B9B9FFF8F8F8FFF7F7F7FFF7F7F7FFF9F9F9FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB7B7 + B7FFF3F3F3FFF1F1F1FFF0F0F0FFEFEFEFFFF1F1F1FFF4F4F4FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFFB5B5B5FFEDEDEDFFEBEB + EBFFEAEAEAFFE9E9E9FFE8E8E8FFE8E8E8FFEAEAEAFFEEEEEEFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B2008C8C8CFF8C8C8CFFB3B3B3FFE8E8E8FFE6E6E6FFE4E4E4FFE2E2 + E2FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE4E4E4FFE9E9E9FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2008C8C8CFFB3B3B3FFE4E4E4FFDFDFDFFFDDDDDDFFDBDBDBFFDADADAFFD9D9 + D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDDDDDDFFE4E4E4FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFB3B3B3FFE0E0E0FFD8D8D8FFD4D4D4FFD3D3D3FFD2D2D2FFD2D2D2FFD2D2 + D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD6D6D6FFDEDEDEFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFABABABFFC0C0C0FFB0B0B0FFA9A9A9FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4 + A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2808C8C8CFFA8A8A8FFBEBEBEFFB3B3B3FFACACACFFA8A8A8FFA5A5A5FFA4A4 + A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3B3FFACACACFFA8A8 + A8FFA5A5A5FFA4A4A4FFA4A4A4FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4A4FFBBBBBBFFB3B3 + B3FFACACACFFA8A8A8FFA5A5A5FFA4A4A4FFACACACFFBDBDBDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFFA4A4 + A4FFBBBBBBFFB3B3B3FFACACACFFA9A9A9FFAFAFAFFFBFBFBFFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B2808C8C + 8CFF8C8C8CFFA4A4A4FFBCBCBCFFB5B5B5FFB9B9B9FFC8C8C8FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B280B2B2B2808C8C8CFF8C8C8CFFA6A6A6FFCCCCCCFFACACACFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B280B2B2B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2008C8C8CFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBBBBBBFFFDFDFDFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF9F9F9FFF7F7F7FFF7F7F7FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF4F4F4FFF1F1F1FFEFEFEFFFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C + 8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDED + EDFFB5B5B5FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4 + E4FFE6E6E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFB2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADA + DAFFDBDBDBFFDDDDDDFFDFDFDFFFE4E4E4FFB3B3B3FF8C8C8CFFB2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 + D2FFD2D2D2FFD3D3D3FFD4D4D4FFD8D8D8FFE0E0E0FFB3B3B3FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 + A4FFA4A4A4FFA5A5A5FFA9A9A9FFB0B0B0FFC0C0C0FFABABABFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5 + A5FFA8A8A8FFACACACFFB3B3B3FFBEBEBEFFA8A8A8FF8C8C8CFFB2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACAC + ACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBB + BBFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBFBFBFFFAFAFAFFFA9A9A9FFACACACFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C + 8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC8C8C8FFB9B9B9FFB5B5B5FFBCBCBCFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2 + B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFACACACFFCCCCCCFFA6A6A6FF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2808C8C8CFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B280B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2008C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBBBBBBFFBBBBBBFF8C8C8CFF8C8C8CFFB2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFFFDFDFDFFFDFDFDFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF9F9F9FFF8F8F8FFF8F8F8FFB9B9B9FF8C8C8CFF8C8C8CFFB2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFFF9F9F9FFF9F9F9FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFF4F4F4FFF1F1F1FFF0F0F0FFF1F1F1FFF3F3F3FFB7B7B7FF8C8C8CFF8C8C + 8CFFB2B2B200B2B2B200B2B2B2008C8C8CFFF5F5F5FFF5F5F5FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFEEEEEEFFEAEAEAFFE8E8E8FFE9E9E9FFEAEAEAFFEBEBEBFFEDEDEDFFB5B5 + B5FF8C8C8CFF8C8C8CFFB2B2B2008C8C8CFFF0F0F0FFF0F0F0FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE9E9E9FFE4E4E4FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE6E6 + E6FFE8E8E8FFB3B3B3FF8C8C8CFF8C8C8CFFECECECFFECECECFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFE4E4E4FFDDDDDDFFD9D9D9FFD9D9D9FFD9D9D9FFD9D9D9FFDADADAFFDBDB + DBFFDDDDDDFFDFDFDFFFE4E4E4FF8C8C8CFFE7E7E7FFE7E7E7FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFDEDEDEFFD6D6D6FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2 + D2FFD3D3D3FFD4D4D4FFD8D8D8FF8C8C8CFFE3E3E3FFE3E3E3FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA4A4 + A4FFA5A5A5FFA9A9A9FFB0B0B0FF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA4A4A4FFA4A4A4FFA5A5A5FFA8A8 + A8FFACACACFFB3B3B3FFBEBEBEFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFACACACFFA4A4A4FFA4A4A4FFA5A5A5FFA8A8A8FFACACACFFB3B3 + B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFBDBDBDFFADADADFFA5A5A5FFA8A8A8FFACACACFFB3B3B3FFBBBBBBFFA4A4 + A4FF8C8C8CFF8C8C8CFFB2B2B2808C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFC0C0C0FFB2B2B2FFADADADFFB3B3B3FFBBBBBBFFA4A4A4FF8C8C8CFF8C8C + 8CFFB2B2B280B2B2B280B2B2B2008C8C8CFFC6C6C6FFC6C6C6FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFCBCBCBFFBEBEBEFFBDBDBDFFA4A4A4FF8C8C8CFF8C8C8CFFB2B2B280B2B2 + B280B2B2B200B2B2B200B2B2B2008C8C8CFFCCCCCCFFCCCCCCFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C8C + 8CFFADADADFFAAAAAAFF8C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFFD8D8D8FFD8D8D8FF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B2808C8C8CFF8C8C8CFFB2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B2008C8C8CFF8C8C8CFF8C8C8CFF8C8C8CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B280B2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00CACACA00CACACA00CACACA00CACACA00CACA + CA00CACACA10CACACAEBCECECEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCECE + CEFBCECECEFBCDCDCDFBCDCDCDFBCECECEFBCBCBCBEBCACACA10CACACA00CACA + CA00CACACA00CACACA00CACACA00CCCCCC00CCCCCC00CACACA00C9C9C900C9C9 + C900C8C8C810D0D0D0EFE2E2E2FFE1E1E1FFE1E1E1FFE0E0E0FFE1E1E1FFE1E1 + E1FFE1E1E1FFE1E1E1FFE1E1E1FFE2E2E2FFD1D1D1EFCACACA10CCCCCC00CBCB + CB00CCCCCC00CECECE00CECECE00BABABA00B9B9B900C7C7C700CDCDCD00CBCB + CB00C9C9C910D0D0D0EFDFDFDFFFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDEDE + DEFFDEDEDEFFDDDDDDFFDDDDDDFFDEDEDEFFD2D2D2EFCCCCCC10CDCDCD00D0D0 + D000CACACA00BDBDBD00BDBDBD00B1B1B100B1B1B100BBBBBB00BCBCBC00CCCC + CC00CBCBCB10D0D0D0EFDCDCDCFFDCDCDCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDC + DCFFDBDBDBFFDBDBDBFFDCDCDCFFDCDCDCFFD3D3D3EFD0D0D010D0D0D000BDBD + BD00BDBDBD00B5B5B500B5B5B500B2B2B200B2B2B200BCBCBC00B2B2B200BBBB + BB00CDCDCD10D1D1D1EFDADADAFFDADADAFFDADADAFFDADADAFFD9D9D9FFDADA + DAFFDADADAFFD9D9D9FFDADADAFFDADADAFFD4D4D4EFD3D3D310BDBDBD00B1B1 + B100BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BCBCBC00B4B4B400AEAE + AE00CCCCCC0FD4D4D4EFD8D8D8FFD8D8D8FFD7D7D7FFD8D8D8FFD8D8D8FFD8D8 + D8FFD8D8D8FFD8D8D8FFD8D8D8FFD8D8D8FFD3D3D3EFBBBBBB0DAFAFAF00B4B4 + B400BEBEBE00B6B6B600B6B6B600B2B2B200B2B2B200BBBBBB00B3B3B31BB2B2 + B210A3A3A310CACACAEDD8D8D8FFD6D6D6FFD6D6D6FFD5D5D5FFD6D6D6FFD6D6 + D6FFD5D5D5FFD6D6D6FFD6D6D6FFD7D7D7FFD0D0D0F0AFAFAF23B2B2B210B3B3 + B30DBDBDBD00B6B6B600B6B6B600B3B3B300B2B2B207C7C7C79DB4B4B4F37979 + 79F1878787EFC5C5C5FED2D2D2FFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCF + CFFFCFCFCFFFCFCFCFFFCFCFCFFFD1D1D1FFC8C8C8FE8A8A8AF2747474F1B7B7 + B7EBC9C9C9A5B6B6B610B7B7B700BEBEBE00BBBBBB5AF1F1F1FED3D3D3FF8181 + 81FF8E8E8EFF9F9F9FFFA2A2A2FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1A1FFA1A1 + A1FFA1A1A1FFA1A1A1FFA1A1A1FFA2A2A2FFA1A1A1FF7E7E7EFF6E6E6EFFDCDC + DCFFF6F6F6FFC0C0C065C3C3C300C1C1C100BEBEBE67F7F7F7FFCACACAFF8585 + 85FFACACACFF939393FF929292FF939393FF939393FF929292FF929292FF9292 + 92FF939393FF939393FF939393FF939393FF929292FFA6A6A6FF838383FFD7D7 + D7FFFAFAFAFFC5C5C571C8C8C800C1C1C100BEBEBE6DF7F7F7FFCBCBCBFF8282 + 82FFB4B4B4FFAFAFAFFFB0B0B0FFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB0B0 + B0FFAFAFAFFFAFAFAFFFAFAFAFFFB0B0B0FFB0B0B0FFB5B5B5FF828282FFD6D6 + D6FFFAFAFAFFC4C4C476C7C7C700BCBCBC00B9B9B970F5F5F5FFD1D1D1FF7A7A + 7AFF818181FF757575FF777777FF777777FF777777FF777777FF777777FF7777 + 77FF777777FF777777FF777777FF777777FF747474FF838383FF7B7B7BFFD7D7 + D7FFF8F8F8FFBDBDBD76C0C0C000B6B6B600B3B3B371EBEBEBFFD2D2D2FF6F6F + 6FFF6E6E6EFF636363FF656565FF656565FF656565FF656565FF656565FF6565 + 65FF656565FF656565FF656565FF656565FF636363FF6E6E6EFF6D6D6DFFD7D7 + D7FFEAEAEAFFB5B5B575B8B8B800B3B3B300B0B0B074E1E1E1FFD1D1D1FF6E6E + 6EFF878787FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF7F7F7FFF888888FF6D6D6DFFD3D3 + D3FFDEDEDEFFB0B0B076B3B3B300ADADAD00AAAAAA7FD4D4D4FFEAEAEAFF9696 + 96FF6A6A6AFF717171FF717171FF717171FF717171FF707070FF717171FF7171 + 71FF707070FF717171FF717171FF717171FF717171FF696969FFA0A0A0FFEEEE + EEFFCFCFCFFFAAAAAA7FADADAD00B7B7B700AAAAAA80CDCDCDFFE0E0E0FFEAEA + EAFFE5E5E5FFEDEDEDFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 + E8FFE8E8E8FFE7E7E7FFE7E7E7FFE7E7E7FFE8E8E8FFEFEFEFFFD7D7D7FFCECE + CEFFCACACAFFAAAAAA80B7B7B70070707000B8B8B880CBCBCBFFD8D8D8FFD6D6 + D6FFCDCDCDFF939393FFADADADFFACACACFFACACACFFACACACFFABABABFFABAB + ABFFABABABFFABABABFFABABABFFABABABFFA3A3A3FF9B9B9BFFAEAEAEFFBABA + BAFFC9C9C9FFB8B8B88070707000000000006E6E6E82D4D4D4FFD4D4D4FFD5D5 + D5FFC0C0C0FF4C4C4CFF969696FF949494FF959595FF969696FF989898FF9999 + 99FF9A9A9AFF9B9B9BFF9E9E9EFFA1A1A1FF8D8D8DFF575757FFD6D6D6FFD1D1 + D1FFD0D0D0FF6E6E6E8200000000000000073F3F3F46B4B4B4E0D3D3D3FFD7D7 + D7FFBDBDBDFF626262FFC0C0C0FFBDBDBDFFBFBFBFFFC0C0C0FFC2C2C2FFC4C4 + C4FFC6C6C6FFC7C7C7FFCACACAFFCECECEFFBABABAFF686868FFD6D6D6FFD2D2 + D2FFB8B8B8E9444444520000000500000019000000253E3E3E51777777B37575 + 75B6878787B98E8E8ED1D1D1D1FFD1D1D1FFD1D1D1FFD3D3D3FFD4D4D4FFD6D6 + D6FFD8D8D8FFD9D9D9FFDADADAFFDDDDDDFFD7D7D7FB767676C2747474B47979 + 79B4434343570000002400000019000000040000000500000000000000000000 + 0000111111005C5C5C43E1E1E1FFDDDDDDFFDDDDDDFFDEDEDEFFDEDEDEFFDFDF + DFFFE1E1E1FFE1E1E1FFE2E2E2FFE4E4E4FFE0E0E0FE2525250C000000000000 + 0000000000000000000500000004000000000000000000000000000000000000 + 00000000000F0303032C252525542424245A2424245924242459242424592424 + 24592525255925252559252525592525255A2222224F00000022000000090000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200838383FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200838383FF838383FFB2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200838383FFB6B6B6FFB6B6B6FF838383FFB2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 + 83FFB5B5B5FFF9F9F9FFF8F8F8FFB4B4B4FF838383FFB2B2B200B2B2B200B2B2 + B200B2B2B200838383FFB4B4B4FFF8F8F8FFF9F9F9FFB5B5B5FF838383FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 + 83FFB3B3B3FFF4F4F4FFF2F2F2FFF3F3F3FFB2B2B2FF838383FFB2B2B200B2B2 + B200838383FFB2B2B2FFF3F3F3FFF2F2F2FFF4F4F4FFB3B3B3FF838383FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B280838383FFB1B1B1FFEDEDEDFFECECECFFEDEDEDFFB0B0B0FF838383FF8383 + 83FFB0B0B0FFEDEDEDFFECECECFFEDEDEDFFB1B1B1FF838383FFB2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B280838383FFAFAFAFFFE7E7E7FFE5E5E5FFE5E5E5FFE5E5E5FFE5E5 + E5FFE5E5E5FFE5E5E5FFE7E7E7FFAFAFAFFF838383FFB2B2B280B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B280838383FFABABABFFDFDFDFFFDCDCDCFFDBDBDBFFDBDB + DBFFDCDCDCFFDFDFDFFFABABABFF838383FFB2B2B280B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B280838383FFDADADAFFD5D5D5FFD3D3D3FFD3D3 + D3FFD5D5D5FFDADADAFF838383FFB2B2B280B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200B2B2B200838383FFB8B8B8FFAFAFAFFFABABABFFABAB + ABFFAFAFAFFFB8B8B8FF838383FFB2B2B200B2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B200838383FF9E9E9EFFB6B6B6FFB0B0B0FFAFAFAFFFAFAF + AFFFB0B0B0FFB6B6B6FF9E9E9EFF838383FFB2B2B200B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200838383FFA1A1A1FFBDBDBDFFB7B7B7FFB6B6B6FFB8B8B8FFB8B8 + B8FFB6B6B6FFB7B7B7FFBDBDBDFFA1A1A1FF838383FFB2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200838383FFA2A2A2FFBFBFBFFFBABABAFFBDBDBDFF9E9E9EFF838383FF8383 + 83FF9E9E9EFFBDBDBDFFBABABAFFBFBFBFFFA2A2A2FF838383FFB2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 + 83FFA7A7A7FFC6C6C6FFBCBCBCFFBFBFBFFFA1A1A1FF838383FFB2B2B280B2B2 + B280838383FFA1A1A1FFBFBFBFFFBCBCBCFFC6C6C6FFA7A7A7FF838383FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383 + 83FFA8A8A8FFCBCBCBFFC6C6C6FFA2A2A2FF838383FFB2B2B280B2B2B200B2B2 + B200B2B2B280838383FFA2A2A2FFC6C6C6FFCBCBCBFFA8A8A8FF838383FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B280838383FFA8A8A8FFA7A7A7FF838383FFB2B2B280B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B280838383FFA7A7A7FFA8A8A8FF838383FFB2B2B280FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B280838383FF838383FFB2B2B280B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B280838383FF838383FFB2B2B280B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2 + B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200B2B2B200B2B2B200B2B2 + B200B2B2B200B2B2B200B2B2B200B2B2B280B2B2B280B2B2B200B2B2B200FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end +end diff --git a/components/kcontrols/source/kprintpreview.lrs b/components/kcontrols/source/kprintpreview.lrs new file mode 100755 index 000000000..dc5ac2d11 --- /dev/null +++ b/components/kcontrols/source/kprintpreview.lrs @@ -0,0 +1,1447 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TKPrintPreviewForm','FORMDATA',[ + 'TPF0'#18'TKPrintPreviewForm'#17'KPrintPreviewForm'#4'Left'#3'X'#4#6'Height'#3 + +#148#2#3'Top'#3#220#1#5'Width'#3' '#3#13'ActiveControl'#7#7'Preview'#7'Capti' + +'on'#6#13'Print Preview'#12'ClientHeight'#3#148#2#11'ClientWidth'#3' '#3#11 + +'Font.Height'#2#245#9'Font.Name'#6#6'Tahoma'#9'Icon.Data'#10#130#4#0#0'~'#4#0 + +#0#0#0#1#0#1#0#16#16#0#0#1#0' '#0'h'#4#0#0#22#0#0#0'('#0#0#0#16#0#0#0' '#0#0 + +#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#0#0#0'%'#22#19 + +#16#198#15#12#10#184#12#12#12#143#21#20#20#152#21#20#20#152#21#20#20#152#21 + +#20#20#152#21#20#20#152#21#20#20#152#21#20#20#152#21#20#20#152#12#12#12#143#0 + +#0#0')'#0#0#0#0#0#0#0#0#21#18#15#194#149#136'{'#255#143#131'x'#255#185#176 + +#168#255#241#240#238#255#241#240#238#255#241#240#238#255#241#240#238#255#241 + +#240#238#255#241#240#238#255#241#240#238#255#241#240#238#255#234#232#230#255 + +'QPO'#234#0#0#0#12#0#0#0#0#12#10#8#174#134'{p'#255#210#204#198#255#183#173 + +#163#255#193#188#182#255#227#227#227#255#224#224#224#255#223#223#223#255#254 + +#254#254#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 + +#165#163#161#255#0#0#0'5'#0#0#0#0#0#0#0#9#19#17#15#187#165#156#147#255#225 + +#221#217#255#182#172#162#255#186#180#175#255#166#158#151#255#162#151#140#255 + +#161#150#139#255#169#162#155#255#209#208#206#255#241#241#241#255#254#254#254 + +#255#168#167#165#255#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#139#133#128#255#186 + +#176#166#255#212#206#199#255#154#141'~'#255#170#158#137#255#200#192#176#255 + +#204#195#179#255#188#174#149#255#151#139'|'#255#226#222#219#255#253#253#253 + +#255#169#168#167#255#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#170#169#168#255#224 + +#220#216#255#162#149#134#255#169#152'l'#255#198#186#145#255#208#199#169#255 + +#209#201#170#255#197#185#144#255#170#152'l'#255#164#153#140#255#247#246#245 + +#255#170#169#168#255#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#171#170#169#255#214 + +#209#204#255#160#144'n'#255#173#156'`'#255#185#172'x'#255#191#180#133#255#187 + +#176#130#255#186#174'y'#255#171#154'^'#255#169#152't'#255#217#212#208#255#171 + +#170#169#255#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#172#171#169#255#209#203#196 + +#255#161#141'Z'#255#183#164'\'#255#184#168'f'#255#184#168'i'#255#185#169'i' + +#255#187#169'c'#255#182#161'T'#255#167#146']'#255#212#206#200#255#171#169#168 + +#255#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#172#171#170#255#218#213#208#255#171 + +#154'n'#255#199#183'x'#255#202#187#128#255#203#189#133#255#201#186#127#255 + +#196#179'q'#255#180#161'W'#255#168#148'b'#255#219#213#209#255#167#165#163#255 + +#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#173#172#171#255#235#233#230#255#180#168 + +#146#255#197#185#144#255#215#205#168#255#217#208#170#255#216#207#170#255#216 + +#206#168#255#194#181#140#255#186#175#154#255#228#224#220#255#156#152#148#255 + +#0#0#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#173#172#171#255#241#239#237#255#207#203 + +#200#255#185#172#145#255#211#200#167#255#242#238#225#255#242#238#224#255#210 + +#198#164#255#186#173#147#255#201#196#191#255#213#206#199#255#129'yq'#255#0#0 + +#0'6'#0#0#0#0#0#0#0#0#0#0#0'6'#173#173#172#255#237#235#233#255#185#183#181 + +#255#195#193#190#255#184#177#168#255#165#155#134#255#168#157#135#255#204#197 + +#187#255#223#217#212#255#229#225#221#255#228#224#220#255'QNK'#236#0#0#0#27#0 + +#0#0#0#0#0#0#0#0#0#0'6'#174#173#172#255#234#231#228#255#151#150#148#255#182 + +#180#177#255#172#170#167#255#168#166#164#255#162#160#158#255#218#213#207#255 + +#232#229#226#255#230#227#224#255'eed'#236#0#0#0'1'#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0'5'#173#172#171#255#230#227#223#255#230#227#223#255#230#227#223#255#230 + +#227#223#255#228#225#221#255#222#217#212#255#211#204#196#255#235#233#231#255 + +'ddd'#235#0#0#0'.'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#12'[[['#234#239#238 + +#236#255#240#238#236#255#240#238#235#255#238#235#233#255#231#227#223#255#212 + +#205#198#255#189#179#168#255'ddd'#235#0#0#0'/'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0')'#14#14#14#143#23#23#23#152#23#23#23#152#23#23#23 + +#152#22#21#21#152#19#18#17#152#12#11#10#152#0#0#0'.'#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#10'KeyP' + +'review'#9#8'OnCreate'#7#10'FormCreate'#9'OnKeyDown'#7#11'FormKeyDown'#6'OnS' + +'how'#7#8'FormShow'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.' + +'29'#0#8'TToolBar'#7'ToBMain'#4'Left'#2#0#3'Top'#2#0#5'Width'#3' '#3#8'AutoS' + +'ize'#9#12'ButtonHeight'#2#30#11'ButtonWidth'#2#31#7'Caption'#6#6'TBMain'#14 + +'DisabledImages'#7#9'ILMainDis'#6'Images'#7#6'ILMain'#8'TabOrder'#2#0#8'Wrap' + +'able'#8#0#11'TToolButton'#11'TBPageFirst'#4'Left'#2#1#3'Top'#2#2#6'Action'#7 + +#11'ACPageFirst'#7'Grouped'#9#14'ParentShowHint'#8#8'ShowHint'#9#0#0#11'TToo' + +'lButton'#14'TBPagePrevious'#4'Left'#2' '#3'Top'#2#2#6'Action'#7#14'ACPagePr' + +'evious'#7'Grouped'#9#14'ParentShowHint'#8#8'ShowHint'#9#0#0#11'TToolButton' + +#10'TBPageNext'#4'Left'#2'?'#3'Top'#2#2#6'Action'#7#10'ACPageNext'#7'Grouped' + +#9#14'ParentShowHint'#8#8'ShowHint'#9#0#0#11'TToolButton'#10'TBPageLast'#4'L' + ,'eft'#2'^'#3'Top'#2#2#6'Action'#7#10'ACPageLast'#7'Grouped'#9#14'ParentShowH' + +'int'#8#8'ShowHint'#9#0#0#11'TToolButton'#11'ToolButton3'#4'Left'#2'}'#3'Top' + +#2#2#5'Width'#2#8#7'Caption'#6#11'ToolButton3'#10'ImageIndex'#2#2#5'Style'#7 + +#12'tbsSeparator'#0#0#11'TToolButton'#11'ToolButton6'#4'Left'#3#198#0#3'Top' + +#2#2#5'Width'#2#8#7'Caption'#6#11'ToolButton6'#10'ImageIndex'#2#3#5'Style'#7 + +#12'tbsSeparator'#0#0#11'TToolButton'#7'TBPrint'#4'Left'#3'M'#1#3'Top'#2#2#6 + +'Action'#7#7'ACPrint'#14'ParentShowHint'#8#8'ShowHint'#9#0#0#11'TToolButton' + +#11'ToolButton4'#4'Left'#3'l'#1#3'Top'#2#2#5'Width'#2#8#7'Caption'#6#11'Tool' + +'Button4'#10'ImageIndex'#2#5#5'Style'#7#12'tbsSeparator'#0#0#11'TToolButton' + +#7'TBClose'#4'Left'#3't'#1#3'Top'#2#2#6'Action'#7#7'ACClose'#14'ParentShowHi' + +'nt'#8#8'ShowHint'#9#0#0#6'TPanel'#6'PNPage'#4'Left'#3#133#0#6'Height'#2#30#3 + +'Top'#2#2#5'Width'#2'A'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2#30#11 + +'ClientWidth'#2'A'#8'TabOrder'#2#0#0#5'TEdit'#6'EDPage'#4'Left'#2#4#6'Height' + +#2#21#3'Top'#2#4#5'Width'#2'*'#6'OnExit'#7#10'EDPageExit'#8'TabOrder'#2#0#4 + +'Text'#6#1'1'#0#0#7'TUpDown'#6'UDPage'#4'Left'#2'.'#6'Height'#2#21#3'Top'#2#4 + +#5'Width'#2#15#9'Associate'#7#6'EDPage'#3'Min'#2#1#8'Position'#2#1#8'TabOrde' + +'r'#2#1#4'Wrap'#8#7'OnClick'#7#11'UDPageClick'#0#0#0#6'TPanel'#7'PNScale'#4 + +'Left'#3#206#0#6'Height'#2#30#3'Top'#2#2#5'Width'#2'x'#10'BevelOuter'#7#6'bv' + +'None'#12'ClientHeight'#2#30#11'ClientWidth'#2'x'#8'TabOrder'#2#1#0#9'TCombo' + +'Box'#8'CoBScale'#4'Left'#2#2#6'Height'#2#21#3'Top'#2#4#5'Width'#2's'#13'Dro' + +'pDownCount'#2#16#10'ItemHeight'#2#13#13'Items.Strings'#1#6#4'25 %'#6#4'50 %' + +#6#4'75 %'#6#5'100 %'#6#5'125 %'#6#5'150 %'#6#5'200 %'#6#5'500 %'#6#10'Whole' + +' Page'#6#10'Page Width'#0#6'OnExit'#7#12'CoBScaleExit'#8'OnSelect'#7#12'CoB' + +'ScaleExit'#8'TabOrder'#2#0#0#0#0#11'TToolButton'#11'ToolButton1'#4'Left'#3 + +'F'#1#3'Top'#2#2#5'Width'#2#7#7'Caption'#6#11'ToolButton1'#5'Style'#7#12'tbs' + +'Separator'#0#0#0#14'TKPrintPreview'#7'Preview'#4'Left'#2#0#6'Height'#3't'#2 + +#3'Top'#2' '#5'Width'#3' '#3#5'Align'#7#8'alClient'#4'Page'#2#0#7'TabStop'#9 + +#8'TabOrder'#2#1#9'OnChanged'#7#14'PreviewChanged'#0#0#10'TImageList'#6'ILMa' + +'in'#6'Height'#2#24#5'Width'#2#24#4'left'#2#16#3'top'#2'6'#6'Bitmap'#10#14'6' + +#0#0'Li'#6#0#0#0#24#0#0#0#24#0#0#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0'k'#174#148#255'k'#174#148#255'k'#174#148#255'k'#174#148#255 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174 + +#148#255#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#252 + +#254#254#255#252#254#254#255'k'#174#148#255#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148 + +#255'k'#174#148#255#167#207#192#255#167#207#192#255'k'#174#148#255#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'k'#174#148#255#247#252#251#255#247#252#251#255 + +'k'#174#148#255#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0'k'#174#148#255'k'#174#148#255#164#206#190#255#245#251#250#255#245 + +#251#250#255#247#252#251#255'k'#174#148#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'k'#174#148#255#241#249#247#255#241#249#247#255'k'#174#148#255#173#183 + +#184#0#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174#148#255#162#205#189 + ,#255#238#248#246#255#236#247#245#255#234#247#244#255#236#247#245#255#239#249 + +#247#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#234 + +#247#244#255#234#247#244#255'k'#174#148#255#173#183#184#0'k'#174#148#255'k' + +#174#148#255#159#204#188#255#230#245#242#255#227#244#240#255#225#243#239#255 + +#224#243#238#255#223#242#237#255#225#243#239#255#231#246#242#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#227#245#240#255#227 + +#245#240#255'k'#174#148#255'k'#174#148#255#156#203#186#255#222#243#237#255 + +#218#242#235#255#215#241#233#255#213#240#232#255#212#239#231#255#211#239#231 + +#255#211#239#231#255#215#241#233#255#223#243#238#255'k'#174#148#255#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'k'#174#148#255#220#242#237#255#220#242#237#255 + +'k'#174#148#255#216#241#234#255#209#238#231#255#205#237#229#255#203#236#227 + +#255#201#235#226#255#200#235#226#255#200#235#226#255#200#235#226#255#200#235 + +#226#255#205#237#229#255#215#241#234#255'k'#174#148#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0'k'#174#148#255#214#241#234#255#214#241#234#255'k'#174#148#255 + +#198#235#226#255#192#233#223#255#190#232#222#255#189#232#221#255#189#232#221 + +#255#189#232#221#255#189#232#221#255#189#232#221#255#189#232#221#255#195#234 + +#224#255#207#238#230#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +'k'#174#148#255#160#236#217#255#160#236#217#255'k'#174#148#255'|'#229#203#255 + +'o'#227#197#255'i'#225#195#255'h'#225#194#255'g'#225#194#255'g'#225#194#255 + +'g'#225#194#255'g'#225#194#255'g'#225#194#255'u'#228#200#255#145#233#211#255 + +'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#160#236 + +#217#255#160#236#217#255'k'#174#148#255#147#234#211#255#128#230#204#255'u' + +#228#200#255'n'#226#197#255'i'#225#195#255'h'#225#194#255'g'#225#194#255'g' + +#225#194#255'g'#225#194#255'u'#228#200#255#145#233#211#255'k'#174#148#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#160#236#217#255#160#236#217 + +#255'k'#174#148#255'k'#174#148#255#129#200#176#255#142#233#210#255#128#230 + +#204#255'u'#228#200#255'n'#226#197#255'i'#225#195#255'h'#225#194#255'g'#225 + +#194#255'u'#228#200#255#145#233#211#255'k'#174#148#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0'k'#174#148#255#160#236#217#255#160#236#217#255'k'#174#148#255 + +#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200#176#255#142#233#210 + +#255#128#230#204#255'u'#228#200#255'n'#226#197#255'i'#225#195#255'v'#228#200 + +#255#145#233#211#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174 + +#148#255#160#236#217#255#160#236#217#255'k'#174#148#255#173#183#184#0#173#183 + +#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200#176#255#142 + +#233#210#255#128#230#204#255'v'#228#200#255'~'#230#203#255#151#234#213#255'k' + +#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#170#238#221 + +#255#170#238#221#255'k'#174#148#255#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200#176 + +#255#145#233#211#255#147#234#212#255#168#238#220#255'k'#174#148#255#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'k'#174#148#255#191#242#229#255#191#242#229#255 + +'k'#174#148#255#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#138 + +#202#180#255#144#202#182#255'k'#174#148#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'k'#174#148#255'k'#174#148#255'k'#174#148#255'k'#174#148#255#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255 + +#173#183#184#128#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#128#173#183 + +#184#128#173#183#184#128#173#183#184#128#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#128#173#183#184#128#173#183#184#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#0'k'#174#148#255'k'#174#148#255'k'#174#148#255#173#183#184#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0'k'#174#148#255'k'#174#148#255#167#207#191#255#252#254#253#255 + +#167#207#192#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174#148#255#164#206#190#255 + +#245#251#250#255#244#251#249#255#244#251#250#255#247#252#251#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174 + +#148#255#162#205#189#255#238#248#246#255#236#247#245#255#234#247#244#255#233 + +#246#244#255#235#247#244#255#239#249#247#255'k'#174#148#255#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +'k'#174#148#255'k'#174#148#255#159#204#188#255#230#245#242#255#227#244#240 + +#255#225#243#239#255#224#243#238#255#223#242#237#255#222#242#237#255#225#243 + +#239#255#231#246#242#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174#148#255#156#203#186#255 + +#222#243#237#255#218#242#235#255#215#241#233#255#213#240#232#255#212#239#231 + +#255#211#239#231#255#211#239#231#255#211#239#231#255#215#241#233#255#223#243 + +#238#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0'k' + +#174#148#255#156#203#186#255#216#241#234#255#209#238#231#255#205#237#229#255 + +#203#236#227#255#201#235#226#255#200#235#226#255#200#235#226#255#200#235#226 + +#255#200#235#226#255#200#235#226#255#205#237#229#255#215#241#234#255'k'#174 + +#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + ,#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#156#203#186#255 + +#209#239#232#255#198#235#226#255#192#233#223#255#190#232#222#255#189#232#221 + +#255#189#232#221#255#189#232#221#255#189#232#221#255#189#232#221#255#189#232 + +#221#255#189#232#221#255#195#234#224#255#207#238#230#255'k'#174#148#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#140#202#181#255#150#234#213 + +#255'|'#229#203#255'o'#227#197#255'i'#225#195#255'h'#225#194#255'g'#225#194 + +#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'g'#225#194 + +#255'u'#228#200#255#145#233#211#255'k'#174#148#255#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#173#183#184#128'k'#174#148#255#135#201#178#255#147#234#211#255#128 + +#230#204#255'u'#228#200#255'n'#226#197#255'i'#225#195#255'h'#225#194#255'g' + +#225#194#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'u'#228#200#255#145 + +#233#211#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0 + +#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200#176#255#142#233#210 + +#255#128#230#204#255'u'#228#200#255'n'#226#197#255'i'#225#195#255'h'#225#194 + +#255'g'#225#194#255'g'#225#194#255'u'#228#200#255#145#233#211#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173 + +#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200#176#255 + +#142#233#210#255#128#230#204#255'u'#228#200#255'n'#226#197#255'i'#225#195#255 + +'h'#225#194#255'u'#228#200#255#145#233#211#255'k'#174#148#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#129#200 + +#176#255#142#233#210#255#128#230#204#255'u'#228#200#255'o'#227#197#255'y'#229 + +#201#255#149#234#212#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255#129 + +#200#176#255#143#233#210#255#132#231#206#255#139#232#209#255#164#237#219#255 + +'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255 + +#132#200#178#255#170#238#221#255#142#202#181#255'k'#174#148#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#128#173#183#184#128'k'#174#148#255'k'#174#148#255 + +'k'#174#148#255#173#183#184#128#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#128#173#183#184#128#173#183#184#128#173#183#184#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173 + +#183#184#0'k'#174#148#255'k'#174#148#255'k'#174#148#255#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#167#207#192#255#252#254#253 + +#255#167#207#191#255'k'#174#148#255'k'#174#148#255#173#183#184#0#173#183#184 + +#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +'k'#174#148#255#247#252#251#255#244#251#250#255#244#251#249#255#245#251#250 + +#255#164#206#190#255'k'#174#148#255'k'#174#148#255#173#183#184#0#173#183#184 + +#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#239#249#247 + +#255#235#247#244#255#233#246#244#255#234#247#244#255#236#247#245#255#238#248 + +#246#255#162#205#189#255'k'#174#148#255'k'#174#148#255#173#183#184#0#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0'k'#174#148#255#231#246#242#255#225#243#239#255#222 + +#242#237#255#223#242#237#255#224#243#238#255#225#243#239#255#227#244#240#255 + +#230#245#242#255#159#204#188#255'k'#174#148#255'k'#174#148#255#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'k'#174#148#255#223#243#238#255#215#241#233#255#211#239#231#255#211#239 + +#231#255#211#239#231#255#212#239#231#255#213#240#232#255#215#241#233#255#218 + +#242#235#255#222#243#237#255#156#203#186#255'k'#174#148#255'k'#174#148#255 + +#173#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148 + +#255#215#241#234#255#205#237#229#255#200#235#226#255#200#235#226#255#200#235 + +#226#255#200#235#226#255#200#235#226#255#201#235#226#255#203#236#227#255#205 + +#237#229#255#209#238#231#255#216#241#234#255#156#203#186#255'k'#174#148#255 + +#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#207#238 + +#230#255#195#234#224#255#189#232#221#255#189#232#221#255#189#232#221#255#189 + +#232#221#255#189#232#221#255#189#232#221#255#189#232#221#255#190#232#222#255 + +#192#233#223#255#198#235#226#255#209#239#232#255#156#203#186#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#145#233#211#255'u' + +#228#200#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'g' + +#225#194#255'g'#225#194#255'h'#225#194#255'i'#225#195#255'o'#227#197#255'|' + +#229#203#255#150#234#213#255#140#202#181#255'k'#174#148#255#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0'k'#174#148#255#145#233#211#255'u'#228#200#255'g'#225#194 + +#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'h'#225#194#255'i'#225#195 + +#255'n'#226#197#255'u'#228#200#255#128#230#204#255#147#234#211#255#135#201 + +#178#255'k'#174#148#255#173#183#184#128#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +'k'#174#148#255#145#233#211#255'u'#228#200#255'g'#225#194#255'g'#225#194#255 + +'h'#225#194#255'i'#225#195#255'n'#226#197#255'u'#228#200#255#128#230#204#255 + ,#142#233#210#255#129#200#176#255'k'#174#148#255'k'#174#148#255#173#183#184 + +#128#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#145 + +#233#211#255'u'#228#200#255'h'#225#194#255'i'#225#195#255'n'#226#197#255'u' + +#228#200#255#128#230#204#255#142#233#210#255#129#200#176#255'k'#174#148#255 + +'k'#174#148#255#173#183#184#128#173#183#184#128#173#183#184#0#173#183#184#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#149#234#212#255'y'#229 + +#201#255'o'#227#197#255'u'#228#200#255#128#230#204#255#142#233#210#255#129 + +#200#176#255'k'#174#148#255'k'#174#148#255#173#183#184#128#173#183#184#128 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0'k'#174#148#255#164#237#219#255#139#232#209#255#132#231 + +#206#255#143#233#210#255#129#200#176#255'k'#174#148#255'k'#174#148#255#173 + +#183#184#128#173#183#184#128#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +'k'#174#148#255#142#202#181#255#170#238#221#255#132#200#178#255'k'#174#148 + +#255'k'#174#148#255#173#183#184#128#173#183#184#128#173#183#184#0#173#183#184 + +#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#128'k'#174#148 + +#255'k'#174#148#255'k'#174#148#255#173#183#184#128#173#183#184#128#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#173#183#184#0#173#183#184#128#173#183#184#128#173#183 + +#184#128#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184 + +#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#173#183#184#0'k'#174#148#255'k'#174#148#255#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0 + ,#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174#148#255'k' + +#174#148#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255 + +#167#207#192#255#167#207#192#255'k'#174#148#255'k'#174#148#255#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0'k'#174#148#255#252#254#254#255#252#254#254#255'k'#174#148#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#247#252#251#255#245#251#250 + +#255#245#251#250#255#164#206#190#255'k'#174#148#255'k'#174#148#255#173#183 + +#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255 + +#247#252#251#255#247#252#251#255'k'#174#148#255#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0'k'#174#148#255#239#249#247#255#236#247#245#255#234#247#244#255#236 + +#247#245#255#238#248#246#255#162#205#189#255'k'#174#148#255'k'#174#148#255 + +#173#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255#241#249#247#255#241 + +#249#247#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255 + +#231#246#242#255#225#243#239#255#223#242#237#255#224#243#238#255#225#243#239 + +#255#227#244#240#255#230#245#242#255#159#204#188#255'k'#174#148#255'k'#174 + +#148#255#173#183#184#0'k'#174#148#255#234#247#244#255#234#247#244#255'k'#174 + +#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#223#243#238#255 + +#215#241#233#255#211#239#231#255#211#239#231#255#212#239#231#255#213#240#232 + +#255#215#241#233#255#218#242#235#255#222#243#237#255#156#203#186#255'k'#174 + +#148#255'k'#174#148#255#227#245#240#255#227#245#240#255'k'#174#148#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#215#241#234#255#205#237#229 + +#255#200#235#226#255#200#235#226#255#200#235#226#255#200#235#226#255#201#235 + +#226#255#203#236#227#255#205#237#229#255#209#238#231#255#216#241#234#255'k' + +#174#148#255#220#242#237#255#220#242#237#255'k'#174#148#255#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0'k'#174#148#255#207#238#230#255#195#234#224#255#189#232 + +#221#255#189#232#221#255#189#232#221#255#189#232#221#255#189#232#221#255#189 + +#232#221#255#190#232#222#255#192#233#223#255#198#235#226#255'k'#174#148#255 + +#214#241#234#255#214#241#234#255'k'#174#148#255#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0'k'#174#148#255#145#233#211#255'u'#228#200#255'g'#225#194#255'g' + +#225#194#255'g'#225#194#255'g'#225#194#255'g'#225#194#255'h'#225#194#255'i' + +#225#195#255'o'#227#197#255'|'#229#203#255'k'#174#148#255#160#236#217#255#160 + +#236#217#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255 + +#145#233#211#255'u'#228#200#255'g'#225#194#255'g'#225#194#255'g'#225#194#255 + +'h'#225#194#255'i'#225#195#255'n'#226#197#255'u'#228#200#255#128#230#204#255 + +#147#234#211#255'k'#174#148#255#160#236#217#255#160#236#217#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#145#233#211#255'u' + +#228#200#255'g'#225#194#255'h'#225#194#255'i'#225#195#255'n'#226#197#255'u' + +#228#200#255#128#230#204#255#142#233#210#255#129#200#176#255'k'#174#148#255 + +'k'#174#148#255#160#236#217#255#160#236#217#255'k'#174#148#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0'k'#174#148#255#145#233#211#255'v'#228#200#255'i'#225 + +#195#255'n'#226#197#255'u'#228#200#255#128#230#204#255#142#233#210#255#129 + +#200#176#255'k'#174#148#255'k'#174#148#255#173#183#184#128'k'#174#148#255#160 + +#236#217#255#160#236#217#255'k'#174#148#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'k'#174#148#255#151#234#213#255'~'#230#203#255'v'#228#200#255#128#230 + +#204#255#142#233#210#255#129#200#176#255'k'#174#148#255'k'#174#148#255#173 + +#183#184#128#173#183#184#128#173#183#184#0'k'#174#148#255#160#236#217#255#160 + +#236#217#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255 + +#168#238#220#255#147#234#212#255#145#233#211#255#129#200#176#255'k'#174#148 + +#255'k'#174#148#255#173#183#184#128#173#183#184#128#173#183#184#0#173#183#184 + +#0#173#183#184#0'k'#174#148#255#170#238#221#255#170#238#221#255'k'#174#148 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + ,#255#255#255#0#255#255#255#0#255#255#255#0'k'#174#148#255#144#202#182#255#138 + +#202#180#255'k'#174#148#255'k'#174#148#255#173#183#184#128#173#183#184#128 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'k'#174 + +#148#255#191#242#229#255#191#242#229#255'k'#174#148#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#173#183#184#128'k'#174#148#255'k'#174#148#255#173#183#184#128 + +#173#183#184#128#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0'k'#174#148#255'k'#174#148#255'k'#174 + +#148#255'k'#174#148#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173 + +#183#184#128#173#183#184#128#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#128#173#183#184#128#173#183#184#128#173#183#184#128#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#239#199#165#0#239#199 + +#165#0#239#199#165#0#239#199#165#0#239#199#165#0#239#199#165#16#239#200#166 + +#235#241#204#171#251#241#203#171#251#241#203#170#251#241#204#170#251#241#203 + +#171#251#241#203#171#251#241#203#171#251#241#203#170#251#241#203#170#251#241 + +#204#171#251#239#200#167#235#239#199#166#16#239#199#166#0#239#199#166#0#239 + +#199#166#0#239#199#166#0#239#199#166#0#244#201#164#0#244#202#164#0#240#200 + +#165#0#238#199#165#0#238#199#165#0#237#197#163#16#242#207#174#239#253#229#200 + +#255#251#227#199#255#252#227#198#255#251#227#198#255#251#227#199#255#251#227 + +#199#255#251#227#199#255#252#227#198#255#252#227#198#255#252#228#200#255#243 + +#207#176#239#239#199#165#16#240#201#168#0#239#201#168#0#241#202#167#0#246#203 + +#167#0#245#203#167#0#198#185#174#0#196#184#175#0#232#197#167#0#245#202#165#0 + +#240#201#166#0#239#199#164#16#242#206#174#239#251#225#195#255#250#223#193#255 + +#250#223#193#255#251#223#193#255#251#223#193#255#250#223#194#255#251#223#193 + +#255#250#223#193#255#250#223#193#255#251#224#194#255#244#209#176#239#240#203 + +#169#16#241#204#170#0#247#206#169#0#233#201#172#0#199#188#179#0#201#189#178#0 + +#175#177#179#0#175#177#179#0#188#188#187#0#200#187#176#0#243#203#166#0#241 + +#202#166#16#243#208#173#239#250#223#191#255#250#222#190#255#250#221#189#255 + +#250#221#189#255#250#222#190#255#250#222#190#255#250#221#189#255#250#222#189 + +#255#250#222#190#255#250#222#191#255#245#210#177#239#244#206#172#16#245#207 + +#172#0#200#188#178#0#190#189#189#0#179#181#183#0#179#181#183#0#178#178#178#0 + +#178#178#178#0#188#188#188#0#175#178#181#0#200#187#174#0#242#203#168#16#245 + +#209#173#239#250#221#187#255#250#220#186#255#250#220#186#255#250#221#186#255 + +#249#220#186#255#250#221#186#255#250#220#187#255#249#219#186#255#250#220#186 + +#255#250#221#186#255#248#212#177#239#248#210#174#16#201#188#177#0#175#177#180 + +#0#190#190#190#0#182#182#182#0#182#182#182#0#178#178#178#0#178#178#178#0#188 + +#188#188#0#180#180#180#0#170#175#178#0#235#200#174#15#251#212#174#239#249#218 + +#183#255#250#218#182#255#249#217#182#255#250#218#183#255#249#219#183#255#249 + +#219#183#255#249#218#183#255#249#218#183#255#250#218#183#255#251#218#182#255 + +#246#213#177#239#200#189#174#13#172#175#178#0#180#180#180#0#190#190#190#0#182 + +#182#182#0#182#182#182#0#178#178#178#0#178#178#178#0#187#188#187#0#180#179 + +#180#27#181#176#179#16#140#186#160#16#234#210#171#237#252#217#180#255#248#217 + +#180#255#249#217#180#255#248#217#179#255#249#217#180#255#249#217#180#255#248 + +#217#179#255#249#217#179#255#249#217#180#255#251#218#180#255#241#211#176#240 + ,#173#177#174'#'#180#177#179#16#180#179#179#13#189#190#189#0#182#182#182#0#182 + +#182#182#0#179#179#179#0#178#178#178#7#204#194#197#157#156#205#189#243'3'#192 + +#149#241'U'#186#150#239#235#199#160#254#255#205#165#255#250#204#164#255#250 + +#204#164#255#250#204#164#255#250#204#164#255#250#204#164#255#250#204#164#255 + +#250#204#164#255#250#204#164#255#254#205#165#255#239#201#161#254'['#185#150 + +#242'/'#186#143#241#163#203#190#235#206#197#200#165#182#182#182#16#183#183 + +#183#0#190#190#190#0#187#187#187'Z'#246#237#240#254#187#236#220#255'1'#210 + +#161#255'G'#213#166#255#169#181#138#255#184#181#140#255#181#182#140#255#181 + +#182#140#255#181#182#140#255#181#182#140#255#181#182#140#255#181#182#140#255 + +#181#182#141#255#181#182#140#255#184#181#140#255#168#183#140#255'2'#202#153 + +#255#26#194#141#255#201#239#225#255#251#241#244#255#192#192#192'e'#195#195 + +#195#0#193#193#193#0#191#190#190'g'#251#244#246#255#173#231#212#255';'#207 + +#161#255'j'#239#200#255'P'#215#173#255'P'#213#172#255'P'#214#172#255'P'#214 + +#172#255'P'#213#172#255'P'#213#172#255'P'#213#172#255'P'#214#172#255'P'#214 + +#173#255'P'#214#172#255'Q'#213#172#255'M'#215#173#255'a'#236#195#255'<'#203 + +#156#255#196#234#220#255#255#246#250#255#197#197#197'q'#200#200#200#0#193#193 + +#193#0#190#190#190'm'#251#244#246#255#177#230#212#255':'#203#157#255't'#244 + +#207#255'n'#241#204#255'n'#242#204#255'n'#241#204#255'n'#241#204#255'n'#242 + +#204#255'n'#242#204#255'n'#242#204#255'n'#241#204#255'n'#241#204#255'n'#241 + +#204#255'n'#242#204#255'o'#241#204#255'v'#244#208#255'<'#200#153#255#197#231 + +#218#255#255#246#250#255#196#196#196'v'#199#199#199#0#188#188#188#0#185#185 + +#185'p'#249#242#245#255#188#231#215#255'3'#194#145#255'8'#203#156#255'$'#198 + +#146#255'&'#200#149#255'&'#200#149#255'&'#200#149#255'&'#200#149#255'&'#200 + +#149#255'&'#200#149#255'&'#200#149#255'&'#200#149#255'&'#200#149#255'&'#200 + +#149#255'#'#197#146#255'9'#205#159#255'8'#191#144#255#199#231#217#255#252#244 + +#247#255#189#189#189'v'#192#192#192#0#182#182#182#0#179#179#179'q'#239#232 + +#235#255#192#229#215#255'+'#180#131#255'*'#178#129#255#27#171'v'#255#29#173 + +'y'#255#29#173'y'#255#29#173'y'#255#29#173'y'#255#29#173'y'#255#29#173'y'#255 + +#29#173'y'#255#29#173'y'#255#29#173'y'#255#29#173'y'#255#27#171'v'#255'*'#178 + +#129#255','#175#127#255#201#230#218#255#238#231#235#255#181#181#181'u'#184 + +#184#184#0#179#179#179#0#176#176#176't'#229#222#225#255#192#226#211#255'+' + +#178#127#255'G'#200#156#255'@'#192#146#255'A'#192#146#255'A'#192#146#255'A' + +#192#146#255'A'#192#146#255'A'#192#147#255'A'#192#147#255'A'#192#147#255'A' + +#192#147#255'A'#192#147#255'A'#192#147#255'@'#191#146#255'G'#201#156#255',' + +#174'}'#255#197#226#212#255#226#219#222#255#176#176#176'v'#179#179#179#0#173 + +#173#173#0#170#170#170#127#214#210#212#255#231#238#235#255'm'#191#157#255'0' + +#164'u'#255':'#169'{'#255':'#169'z'#255':'#168'z'#255':'#168'z'#255':'#167'z' + +#255':'#168'y'#255':'#168'y'#255':'#167'y'#255';'#167'z'#255';'#167'z'#255';' + +#167'z'#255';'#167'z'#255'0'#162'r'#255'}'#196#166#255#237#239#238#255#209 + +#206#207#255#170#170#170#127#173#173#173#0#183#183#183#0#170#170#170#128#205 + +#205#205#255#225#224#224#255#235#234#235#255#227#232#230#255#234#240#238#255 + +#228#236#235#255#228#236#235#255#228#236#235#255#228#236#234#255#228#236#234 + +#255#228#236#234#255#228#236#234#255#228#235#234#255#228#235#234#255#227#235 + +#233#255#228#236#234#255#239#240#239#255#206#224#217#255#200#212#207#255#203 + +#201#202#255#170#170#170#128#183#183#183#0'ppp'#0#184#184#184#128#203#203#203 + +#255#216#216#216#255#214#214#214#255#205#205#206#255#150#145#144#255#183#169 + +#163#255#182#168#162#255#182#168#162#255#182#168#162#255#181#168#161#255#181 + +#168#162#255#181#168#162#255#181#167#161#255#181#167#162#255#181#168#162#255 + +#172#159#154#255#158#152#154#255#156#193#177#255#174#198#188#255#203#199#201 + +#255#184#184#184#128'ppp'#0#0#0#0#0'nnn'#130#212#212#212#255#212#212#212#255 + +#213#213#213#255#190#192#194#255'UKC'#255#186#148'r'#255#182#147's'#255#182 + +#147'u'#255#182#149'w'#255#182#151'{'#255#182#152'|'#255#182#152'~'#255#183 + +#154#128#255#183#154#133#255#186#159#137#255#163#139'w'#255'XWV'#255#216#212 + +#215#255#210#208#209#255#208#208#208#255'nnn'#130#0#0#0#0#0#0#0#7'???F'#180 + +#180#180#224#211#211#211#255#215#215#215#255#187#190#192#255'mbW'#255#239#191 + +#145#255#234#188#145#255#234#189#148#255#234#190#150#255#234#193#154#255#234 + +#195#159#255#234#197#162#255#234#198#165#255#234#200#170#255#237#206#176#255 + +#213#185#159#255'jhf'#255#213#214#215#255#210#210#210#255#184#184#184#233'DD' + +'DR'#0#0#0#5#0#0#0#25#0#0#0'%>>>Qwww'#179'uuu'#182#132#135#138#185#154#142 + +#130#209#255#212#164#255#255#208#163#255#255#209#164#255#255#209#167#255#255 + +#212#169#255#255#213#174#255#255#216#177#255#255#217#179#255#255#218#182#255 + +#255#223#188#255#247#214#184#251'xvt'#194'tuu'#180'yyy'#180'CCCW'#0#0#0'$'#0 + +#0#0#25#0#0#0#4#0#0#0#5#0#0#0#0#0#0#0#0#0#0#0#0#16#18#18#0'g]RC'#255#240#196 + +#255#255#230#188#255#255#230#188#255#255#230#189#255#255#231#190#255#255#232 + ,#191#255#255#234#195#255#255#234#195#255#255#235#197#255#255#239#202#255#255 + +#227#193#254'''%#'#12#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#5#0#0#0#4#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15#5#3#2',+& T+$'#30'Z+$'#30'Y+$'#30'Y+$'#30 + +'Y+%'#30'Y+%'#31'Y+%'#31'Y+%'#31'Y+& Z''"'#29'O'#0#0#0'"'#0#0#0#9#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0'FF'#193 + +#255'FF'#193#255#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'FF'#193#255'FF'#193#255 + +#173#183#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183 + +#184#0'FF'#193#255#145#145#219#255#145#145#219#255'FF'#193#255#173#183#184#0 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'FF' + +#193#255#145#145#219#255#145#145#219#255'FF'#193#255#173#183#184#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'FF'#193#255#143#143#219#255#243#243#255#255#242 + +#242#255#255#142#142#219#255'FF'#193#255#173#183#184#0#173#183#184#0#173#183 + +#184#0#173#183#184#0'FF'#193#255#142#142#219#255#242#242#255#255#243#243#255 + +#255#143#143#219#255'FF'#193#255#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'FF' + +#193#255#140#140#219#255#233#233#255#255#230#230#255#255#231#231#255#255#138 + +#138#219#255'FF'#193#255#173#183#184#0#173#183#184#0'FF'#193#255#138#138#219 + +#255#231#231#255#255#230#230#255#255#233#233#255#255#140#140#219#255'FF'#193 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#128'FF'#193#255#135 + +#135#219#255#220#220#255#255#217#217#255#255#219#219#255#255#133#133#219#255 + +'FF'#193#255'FF'#193#255#133#133#219#255#219#219#255#255#217#217#255#255#220 + +#220#255#255#135#135#219#255'FF'#193#255#173#183#184#128#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#173#183#184#0#173#183#184#128'FF'#193#255#131#131#219 + +#255#207#207#255#255#203#203#255#255#203#203#255#255#204#204#255#255#204#204 + +#255#255#203#203#255#255#203#203#255#255#207#207#255#255#131#131#219#255'FF' + +#193#255#173#183#184#128#173#183#184#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#173#183#184#0#173#183#184#0#173#183#184#128'FF'#193#255'||'#219#255#191#191 + +#255#255#185#185#255#255#184#184#255#255#184#184#255#255#185#185#255#255#191 + +#191#255#255'||'#219#255'FF'#193#255#173#183#184#128#173#183#184#0#173#183 + +#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#128'FF'#193#255#181#181#255#255#171#171#255#255#168 + +#168#255#255#168#168#255#255#171#171#255#255#181#181#255#255'FF'#193#255#173 + +#183#184#128#173#183#184#0#173#183#184#0#173#183#184#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + ,#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0'FF' + +#193#255'rr'#255#255'__'#255#255'XX'#255#255'XX'#255#255'__'#255#255'rr'#255 + +#255'FF'#193#255#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173#183#184#0 + +'FF'#193#255'aa'#219#255'nn'#255#255'bb'#255#255'__'#255#255'__'#255#255'bb' + +#255#255'nn'#255#255'aa'#219#255'FF'#193#255#173#183#184#0#173#183#184#0#173 + +#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0 + +'FF'#193#255'gg'#219#255'{{'#255#255'pp'#255#255'nn'#255#255'rr'#255#255'rr' + +#255#255'nn'#255#255'pp'#255#255'{{'#255#255'gg'#219#255'FF'#193#255#173#183 + +#184#0#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0'FF' + +#193#255'jj'#219#255#128#128#255#255'uu'#255#255'{{'#255#255'aa'#219#255'FF' + +#193#255'FF'#193#255'aa'#219#255'{{'#255#255'uu'#255#255#128#128#255#255'jj' + +#219#255'FF'#193#255#173#183#184#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'FF' + +#193#255'tt'#219#255#142#142#255#255'zz'#255#255#128#128#255#255'gg'#219#255 + +'FF'#193#255#173#183#184#128#173#183#184#128'FF'#193#255'gg'#219#255#128#128 + +#255#255'zz'#255#255#142#142#255#255'tt'#219#255'FF'#193#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0'FF'#193#255'uu'#219#255#152#152#255#255#142#142#255 + +#255'jj'#219#255'FF'#193#255#173#183#184#128#173#183#184#0#173#183#184#0#173 + +#183#184#128'FF'#193#255'jj'#219#255#142#142#255#255#152#152#255#255'uu'#219 + +#255'FF'#193#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#128'FF'#193 + +#255'uu'#219#255'tt'#219#255'FF'#193#255#173#183#184#128#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#128'FF'#193#255'tt'#219 + +#255'uu'#219#255'FF'#193#255#173#183#184#128#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#173#183#184#0#173#183#184#128'FF'#193#255'FF'#193#255#173#183#184#128 + +#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#128'FF'#193#255'FF'#193#255#173#183#184#128#173#183 + +#184#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#173#183#184#0#173#183#184#0#173 + +#183#184#128#173#183#184#128#173#183#184#0#173#183#184#0#173#183#184#0#173 + +#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183#184#0#173#183 + +#184#128#173#183#184#128#173#183#184#0#173#183#184#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#0#0#11 + +'TActionList'#6'ALMain'#6'Images'#7#6'ILMain'#4'left'#2'8'#3'top'#2'6'#0#7'T' + +'Action'#11'ACPageFirst'#4'Hint'#6#10'First page'#10'ImageIndex'#2#0#9'OnExe' + +'cute'#7#18'ACPageFirstExecute'#8'OnUpdate'#7#17'ACPageFirstUpdate'#0#0#7'TA' + +'ction'#14'ACPagePrevious'#7'Caption'#6#13'Previous page'#4'Hint'#6#13'Previ' + +'ous page'#10'ImageIndex'#2#1#9'OnExecute'#7#21'ACPagePreviousExecute'#8'OnU' + +'pdate'#7#17'ACPageFirstUpdate'#0#0#7'TAction'#10'ACPageNext'#7'Caption'#6#9 + +'Next page'#4'Hint'#6#9'Next page'#10'ImageIndex'#2#2#9'OnExecute'#7#17'ACPa' + +'geNextExecute'#8'OnUpdate'#7#16'ACPageNextUpdate'#0#0#7'TAction'#10'ACPageL' + +'ast'#7'Caption'#6#9'Last page'#4'Hint'#6#9'Last page'#10'ImageIndex'#2#3#9 + +'OnExecute'#7#17'ACPageLastExecute'#8'OnUpdate'#7#16'ACPageNextUpdate'#0#0#7 + +'TAction'#7'ACPrint'#7'Caption'#6#5'Print'#4'Hint'#6#5'Print'#10'ImageIndex' + +#2#4#9'OnExecute'#7#14'ACPrintExecute'#8'OnUpdate'#7#13'ACPrintUpdate'#0#0#7 + ,'TAction'#7'ACClose'#7'Caption'#6#5'Close'#4'Hint'#6#13'Close preview'#10'Im' + +'ageIndex'#2#5#9'OnExecute'#7#14'ACCloseExecute'#8'OnUpdate'#7#13'ACCloseUpd' + +'ate'#0#0#0#10'TImageList'#9'ILMainDis'#6'Height'#2#24#5'Width'#2#24#4'left' + +#2'`'#3'top'#2'6'#6'Bitmap'#10#14'6'#0#0'Li'#6#0#0#0#24#0#0#0#24#0#0#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#140#140 + +#140#255#140#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#140#140#140#255#140#140#140#255#178#178#178#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#253#253#253#255#253#253#253#255#140 + +#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#140#140#140#255#140#140#140#255#187#187 + +#187#255#187#187#187#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#140#140#140#255#249#249#249#255#249#249#249#255#140#140#140#255#178#178#178 + +#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#140#140#140#255 + +#140#140#140#255#185#185#185#255#248#248#248#255#248#248#248#255#249#249#249 + +#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#245 + +#245#245#255#245#245#245#255#140#140#140#255#178#178#178#0#178#178#178#0#178 + +#178#178#0#140#140#140#255#140#140#140#255#183#183#183#255#243#243#243#255 + +#241#241#241#255#240#240#240#255#241#241#241#255#244#244#244#255#140#140#140 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#240#240#240#255 + +#240#240#240#255#140#140#140#255#178#178#178#0#140#140#140#255#140#140#140 + +#255#181#181#181#255#237#237#237#255#235#235#235#255#234#234#234#255#233#233 + +#233#255#232#232#232#255#234#234#234#255#238#238#238#255#140#140#140#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#140#140#140#255#236#236#236#255#236#236 + +#236#255#140#140#140#255#140#140#140#255#179#179#179#255#232#232#232#255#230 + +#230#230#255#228#228#228#255#226#226#226#255#225#225#225#255#225#225#225#255 + +#225#225#225#255#228#228#228#255#233#233#233#255#140#140#140#255#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#231#231#231#255#231#231#231#255#140 + +#140#140#255#228#228#228#255#223#223#223#255#221#221#221#255#219#219#219#255 + +#218#218#218#255#217#217#217#255#217#217#217#255#217#217#217#255#217#217#217 + +#255#221#221#221#255#228#228#228#255#140#140#140#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#140#140#140#255#227#227#227#255#227#227#227#255#140#140#140 + +#255#216#216#216#255#212#212#212#255#211#211#211#255#210#210#210#255#210#210 + +#210#255#210#210#210#255#210#210#210#255#210#210#210#255#210#210#210#255#214 + +#214#214#255#222#222#222#255#140#140#140#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#140#140#140#255#198#198#198#255#198#198#198#255#140#140#140#255#176 + +#176#176#255#169#169#169#255#165#165#165#255#164#164#164#255#164#164#164#255 + +#164#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255#172#172#172 + ,#255#189#189#189#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140 + +#140#140#255#198#198#198#255#198#198#198#255#140#140#140#255#190#190#190#255 + +#179#179#179#255#172#172#172#255#168#168#168#255#165#165#165#255#164#164#164 + +#255#164#164#164#255#164#164#164#255#164#164#164#255#172#172#172#255#189#189 + +#189#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140 + +#255#198#198#198#255#198#198#198#255#140#140#140#255#140#140#140#255#164#164 + +#164#255#187#187#187#255#179#179#179#255#172#172#172#255#168#168#168#255#165 + +#165#165#255#164#164#164#255#164#164#164#255#172#172#172#255#189#189#189#255 + +#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#198#198 + +#198#255#198#198#198#255#140#140#140#255#178#178#178#128#140#140#140#255#140 + +#140#140#255#164#164#164#255#187#187#187#255#179#179#179#255#172#172#172#255 + +#168#168#168#255#165#165#165#255#173#173#173#255#189#189#189#255#140#140#140 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#198#198#198#255 + +#198#198#198#255#140#140#140#255#178#178#178#0#178#178#178#128#178#178#178 + +#128#140#140#140#255#140#140#140#255#164#164#164#255#187#187#187#255#179#179 + +#179#255#173#173#173#255#178#178#178#255#192#192#192#255#140#140#140#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#140#140#140#255#204#204#204#255#204#204 + +#204#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#128#178#178#178#128#140#140#140#255#140#140#140#255#164#164#164#255#189 + +#189#189#255#190#190#190#255#203#203#203#255#140#140#140#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#216#216#216#255#216#216#216#255#140 + +#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#128#178#178#178#128#140#140#140#255#140#140#140#255#170 + +#170#170#255#173#173#173#255#140#140#140#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#140#140#140#255#140#140#140#255#140#140#140#255#140#140#140#255#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#128#178#178#178#128#140#140#140#255#140#140 + +#140#255#178#178#178#128#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178 + +#128#178#178#178#128#178#178#178#128#178#178#178#128#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#128#178#178#178#128#178#178#178#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#140#140#140#255#140#140#140#255#140#140#140#255#178#178 + +#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#140#140#140#255#140#140#140#255#187#187 + +#187#255#253#253#253#255#187#187#187#255#140#140#140#255#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#140#140#140#255#140 + +#140#140#255#185#185#185#255#248#248#248#255#247#247#247#255#247#247#247#255 + +#249#249#249#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#140#140#140#255#140#140#140#255#183#183#183#255#243#243#243#255#241 + +#241#241#255#240#240#240#255#239#239#239#255#241#241#241#255#244#244#244#255 + +#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#140#140#140#255#140#140#140#255#181#181 + +#181#255#237#237#237#255#235#235#235#255#234#234#234#255#233#233#233#255#232 + +#232#232#255#232#232#232#255#234#234#234#255#238#238#238#255#140#140#140#255 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0#140#140 + +#140#255#140#140#140#255#179#179#179#255#232#232#232#255#230#230#230#255#228 + +#228#228#255#226#226#226#255#225#225#225#255#225#225#225#255#225#225#225#255 + +#225#225#225#255#228#228#228#255#233#233#233#255#140#140#140#255#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#178#178#178#0#140#140#140#255#179#179#179#255#228 + +#228#228#255#223#223#223#255#221#221#221#255#219#219#219#255#218#218#218#255 + +#217#217#217#255#217#217#217#255#217#217#217#255#217#217#217#255#217#217#217 + +#255#221#221#221#255#228#228#228#255#140#140#140#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#140#140#140#255#179#179#179#255#224#224#224#255#216#216#216 + +#255#212#212#212#255#211#211#211#255#210#210#210#255#210#210#210#255#210#210 + +#210#255#210#210#210#255#210#210#210#255#210#210#210#255#210#210#210#255#214 + +#214#214#255#222#222#222#255#140#140#140#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#140#140#140#255#171#171#171#255#192#192#192#255#176#176#176#255#169 + +#169#169#255#165#165#165#255#164#164#164#255#164#164#164#255#164#164#164#255 + +#164#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255#172#172#172 + +#255#189#189#189#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178 + +#178#178#128#140#140#140#255#168#168#168#255#190#190#190#255#179#179#179#255 + +#172#172#172#255#168#168#168#255#165#165#165#255#164#164#164#255#164#164#164 + +#255#164#164#164#255#164#164#164#255#164#164#164#255#172#172#172#255#189#189 + +#189#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0 + +#178#178#178#128#140#140#140#255#140#140#140#255#164#164#164#255#187#187#187 + +#255#179#179#179#255#172#172#172#255#168#168#168#255#165#165#165#255#164#164 + +#164#255#164#164#164#255#164#164#164#255#172#172#172#255#189#189#189#255#140 + +#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0 + +#178#178#178#128#178#178#178#128#140#140#140#255#140#140#140#255#164#164#164 + +#255#187#187#187#255#179#179#179#255#172#172#172#255#168#168#168#255#165#165 + +#165#255#164#164#164#255#172#172#172#255#189#189#189#255#140#140#140#255#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#128#178#178#178#128#140#140#140#255#140#140#140 + +#255#164#164#164#255#187#187#187#255#179#179#179#255#172#172#172#255#169#169 + +#169#255#175#175#175#255#191#191#191#255#140#140#140#255#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#128#178#178#178#128#140#140#140#255 + +#140#140#140#255#164#164#164#255#188#188#188#255#181#181#181#255#185#185#185 + +#255#200#200#200#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#128#178#178#178#128#140#140 + +#140#255#140#140#140#255#166#166#166#255#204#204#204#255#172#172#172#255#140 + +#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#128#178#178#178#128#140 + +#140#140#255#140#140#140#255#140#140#140#255#178#178#178#128#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#128#178#178#178#128 + +#178#178#178#128#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#178#178#178#0#140#140#140#255#140#140#140#255 + +#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140 + +#140#140#255#187#187#187#255#253#253#253#255#187#187#187#255#140#140#140#255 + +#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + ,#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#249#249#249#255 + +#247#247#247#255#247#247#247#255#248#248#248#255#185#185#185#255#140#140#140 + +#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#140#140#140#255#244#244#244#255#241#241#241#255#239#239 + +#239#255#240#240#240#255#241#241#241#255#243#243#243#255#183#183#183#255#140 + +#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#140#140#140#255#238#238#238#255#234#234#234#255#232#232#232#255#232#232#232 + +#255#233#233#233#255#234#234#234#255#235#235#235#255#237#237#237#255#181#181 + +#181#255#140#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#233 + +#233#233#255#228#228#228#255#225#225#225#255#225#225#225#255#225#225#225#255 + +#225#225#225#255#226#226#226#255#228#228#228#255#230#230#230#255#232#232#232 + +#255#179#179#179#255#140#140#140#255#140#140#140#255#178#178#178#0#178#178 + +#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#228#228#228#255 + +#221#221#221#255#217#217#217#255#217#217#217#255#217#217#217#255#217#217#217 + +#255#217#217#217#255#218#218#218#255#219#219#219#255#221#221#221#255#223#223 + +#223#255#228#228#228#255#179#179#179#255#140#140#140#255#178#178#178#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#140#140#140#255#222#222#222#255#214#214 + +#214#255#210#210#210#255#210#210#210#255#210#210#210#255#210#210#210#255#210 + +#210#210#255#210#210#210#255#210#210#210#255#211#211#211#255#212#212#212#255 + +#216#216#216#255#224#224#224#255#179#179#179#255#140#140#140#255#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#189#189#189#255#172#172#172#255#164 + +#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255 + +#164#164#164#255#164#164#164#255#165#165#165#255#169#169#169#255#176#176#176 + +#255#192#192#192#255#171#171#171#255#140#140#140#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#140#140#140#255#189#189#189#255#172#172#172#255#164#164#164 + +#255#164#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255#165#165 + +#165#255#168#168#168#255#172#172#172#255#179#179#179#255#190#190#190#255#168 + +#168#168#255#140#140#140#255#178#178#178#128#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#140#140#140#255#189#189#189#255#172#172#172#255#164#164#164#255#164 + +#164#164#255#164#164#164#255#165#165#165#255#168#168#168#255#172#172#172#255 + +#179#179#179#255#187#187#187#255#164#164#164#255#140#140#140#255#140#140#140 + +#255#178#178#178#128#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140 + +#140#140#255#189#189#189#255#172#172#172#255#164#164#164#255#165#165#165#255 + +#168#168#168#255#172#172#172#255#179#179#179#255#187#187#187#255#164#164#164 + +#255#140#140#140#255#140#140#140#255#178#178#178#128#178#178#178#128#178#178 + +#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#191 + +#191#191#255#175#175#175#255#169#169#169#255#172#172#172#255#179#179#179#255 + +#187#187#187#255#164#164#164#255#140#140#140#255#140#140#140#255#178#178#178 + +#128#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#200#200#200#255#185 + +#185#185#255#181#181#181#255#188#188#188#255#164#164#164#255#140#140#140#255 + +#140#140#140#255#178#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#140#140#140#255#172#172#172#255#204#204#204#255#166#166 + +#166#255#140#140#140#255#140#140#140#255#178#178#178#128#178#178#178#128#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178 + ,#178#178#128#140#140#140#255#140#140#140#255#140#140#140#255#178#178#178#128 + +#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#128#178 + +#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#140#140#140 + +#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#140 + +#140#140#255#140#140#140#255#140#140#140#255#140#140#140#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#187#187#187#255#187#187#187#255#140 + +#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#140#140#140#255#253#253 + +#253#255#253#253#253#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#140#140#140#255#249#249#249#255#248#248#248#255#248#248#248#255#185#185#185 + +#255#140#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0#178#178#178 + +#0#178#178#178#0#178#178#178#0#140#140#140#255#249#249#249#255#249#249#249 + +#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#244 + +#244#244#255#241#241#241#255#240#240#240#255#241#241#241#255#243#243#243#255 + +#183#183#183#255#140#140#140#255#140#140#140#255#178#178#178#0#178#178#178#0 + +#178#178#178#0#140#140#140#255#245#245#245#255#245#245#245#255#140#140#140 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#238#238#238#255 + +#234#234#234#255#232#232#232#255#233#233#233#255#234#234#234#255#235#235#235 + +#255#237#237#237#255#181#181#181#255#140#140#140#255#140#140#140#255#178#178 + +#178#0#140#140#140#255#240#240#240#255#240#240#240#255#140#140#140#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + ,#255#0#255#255#255#0#255#255#255#0#140#140#140#255#233#233#233#255#228#228 + +#228#255#225#225#225#255#225#225#225#255#225#225#225#255#226#226#226#255#228 + +#228#228#255#230#230#230#255#232#232#232#255#179#179#179#255#140#140#140#255 + +#140#140#140#255#236#236#236#255#236#236#236#255#140#140#140#255#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#228#228#228#255#221#221#221#255#217 + +#217#217#255#217#217#217#255#217#217#217#255#217#217#217#255#218#218#218#255 + +#219#219#219#255#221#221#221#255#223#223#223#255#228#228#228#255#140#140#140 + +#255#231#231#231#255#231#231#231#255#140#140#140#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#140#140#140#255#222#222#222#255#214#214#214#255#210#210#210 + +#255#210#210#210#255#210#210#210#255#210#210#210#255#210#210#210#255#210#210 + +#210#255#211#211#211#255#212#212#212#255#216#216#216#255#140#140#140#255#227 + +#227#227#255#227#227#227#255#140#140#140#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#140#140#140#255#189#189#189#255#172#172#172#255#164#164#164#255#164 + +#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255#164#164#164#255 + +#165#165#165#255#169#169#169#255#176#176#176#255#140#140#140#255#198#198#198 + +#255#198#198#198#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140 + +#140#140#255#189#189#189#255#172#172#172#255#164#164#164#255#164#164#164#255 + +#164#164#164#255#164#164#164#255#165#165#165#255#168#168#168#255#172#172#172 + +#255#179#179#179#255#190#190#190#255#140#140#140#255#198#198#198#255#198#198 + +#198#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140 + +#255#189#189#189#255#172#172#172#255#164#164#164#255#164#164#164#255#165#165 + +#165#255#168#168#168#255#172#172#172#255#179#179#179#255#187#187#187#255#164 + +#164#164#255#140#140#140#255#140#140#140#255#198#198#198#255#198#198#198#255 + +#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#189#189 + +#189#255#173#173#173#255#165#165#165#255#168#168#168#255#172#172#172#255#179 + +#179#179#255#187#187#187#255#164#164#164#255#140#140#140#255#140#140#140#255 + +#178#178#178#128#140#140#140#255#198#198#198#255#198#198#198#255#140#140#140 + +#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#140#140#140#255#192#192#192#255 + +#178#178#178#255#173#173#173#255#179#179#179#255#187#187#187#255#164#164#164 + +#255#140#140#140#255#140#140#140#255#178#178#178#128#178#178#178#128#178#178 + +#178#0#140#140#140#255#198#198#198#255#198#198#198#255#140#140#140#255#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#140#140#140#255#203#203#203#255#190#190 + +#190#255#189#189#189#255#164#164#164#255#140#140#140#255#140#140#140#255#178 + +#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#140 + +#140#140#255#204#204#204#255#204#204#204#255#140#140#140#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#140#140#140#255#173#173#173#255#170#170#170#255#140 + +#140#140#255#140#140#140#255#178#178#178#128#178#178#178#128#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#140#140#140#255#216 + +#216#216#255#216#216#216#255#140#140#140#255#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#178#178#178#128#140#140#140#255#140#140#140#255#178#178#178#128#178 + +#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#140#140#140#255#140#140#140#255#140#140 + +#140#255#140#140#140#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0 + +#178#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#128#178#178#178#128#178#178#178#128#178#178#178#128 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#202#202#202#0#202 + +#202#202#0#202#202#202#0#202#202#202#0#202#202#202#0#202#202#202#16#202#202 + +#202#235#206#206#206#251#206#206#206#251#205#205#205#251#205#205#205#251#206 + +#206#206#251#206#206#206#251#206#206#206#251#205#205#205#251#205#205#205#251 + +#206#206#206#251#203#203#203#235#202#202#202#16#202#202#202#0#202#202#202#0 + +#202#202#202#0#202#202#202#0#202#202#202#0#204#204#204#0#204#204#204#0#202 + +#202#202#0#201#201#201#0#201#201#201#0#200#200#200#16#208#208#208#239#226#226 + +#226#255#225#225#225#255#225#225#225#255#224#224#224#255#225#225#225#255#225 + +#225#225#255#225#225#225#255#225#225#225#255#225#225#225#255#226#226#226#255 + +#209#209#209#239#202#202#202#16#204#204#204#0#203#203#203#0#204#204#204#0#206 + +#206#206#0#206#206#206#0#186#186#186#0#185#185#185#0#199#199#199#0#205#205 + +#205#0#203#203#203#0#201#201#201#16#208#208#208#239#223#223#223#255#221#221 + +#221#255#221#221#221#255#222#222#222#255#222#222#222#255#222#222#222#255#222 + +#222#222#255#221#221#221#255#221#221#221#255#222#222#222#255#210#210#210#239 + +#204#204#204#16#205#205#205#0#208#208#208#0#202#202#202#0#189#189#189#0#189 + +#189#189#0#177#177#177#0#177#177#177#0#187#187#187#0#188#188#188#0#204#204 + +#204#0#203#203#203#16#208#208#208#239#220#220#220#255#220#220#220#255#219#219 + +#219#255#219#219#219#255#220#220#220#255#220#220#220#255#219#219#219#255#219 + +#219#219#255#220#220#220#255#220#220#220#255#211#211#211#239#208#208#208#16 + +#208#208#208#0#189#189#189#0#189#189#189#0#181#181#181#0#181#181#181#0#178 + +#178#178#0#178#178#178#0#188#188#188#0#178#178#178#0#187#187#187#0#205#205 + +#205#16#209#209#209#239#218#218#218#255#218#218#218#255#218#218#218#255#218 + +#218#218#255#217#217#217#255#218#218#218#255#218#218#218#255#217#217#217#255 + +#218#218#218#255#218#218#218#255#212#212#212#239#211#211#211#16#189#189#189#0 + +#177#177#177#0#190#190#190#0#182#182#182#0#182#182#182#0#178#178#178#0#178 + +#178#178#0#188#188#188#0#180#180#180#0#174#174#174#0#204#204#204#15#212#212 + +#212#239#216#216#216#255#216#216#216#255#215#215#215#255#216#216#216#255#216 + +#216#216#255#216#216#216#255#216#216#216#255#216#216#216#255#216#216#216#255 + +#216#216#216#255#211#211#211#239#187#187#187#13#175#175#175#0#180#180#180#0 + +#190#190#190#0#182#182#182#0#182#182#182#0#178#178#178#0#178#178#178#0#187 + +#187#187#0#179#179#179#27#178#178#178#16#163#163#163#16#202#202#202#237#216 + +#216#216#255#214#214#214#255#214#214#214#255#213#213#213#255#214#214#214#255 + +#214#214#214#255#213#213#213#255#214#214#214#255#214#214#214#255#215#215#215 + +#255#208#208#208#240#175#175#175'#'#178#178#178#16#179#179#179#13#189#189#189 + +#0#182#182#182#0#182#182#182#0#179#179#179#0#178#178#178#7#199#199#199#157 + +#180#180#180#243'yyy'#241#135#135#135#239#197#197#197#254#210#210#210#255#207 + +#207#207#255#207#207#207#255#207#207#207#255#207#207#207#255#207#207#207#255 + +#207#207#207#255#207#207#207#255#207#207#207#255#209#209#209#255#200#200#200 + +#254#138#138#138#242'ttt'#241#183#183#183#235#201#201#201#165#182#182#182#16 + +#183#183#183#0#190#190#190#0#187#187#187'Z'#241#241#241#254#211#211#211#255 + +#129#129#129#255#142#142#142#255#159#159#159#255#162#162#162#255#161#161#161 + +#255#161#161#161#255#161#161#161#255#161#161#161#255#161#161#161#255#161#161 + +#161#255#161#161#161#255#161#161#161#255#162#162#162#255#161#161#161#255'~~~' + +#255'nnn'#255#220#220#220#255#246#246#246#255#192#192#192'e'#195#195#195#0 + +#193#193#193#0#190#190#190'g'#247#247#247#255#202#202#202#255#133#133#133#255 + +#172#172#172#255#147#147#147#255#146#146#146#255#147#147#147#255#147#147#147 + +#255#146#146#146#255#146#146#146#255#146#146#146#255#147#147#147#255#147#147 + +#147#255#147#147#147#255#147#147#147#255#146#146#146#255#166#166#166#255#131 + +#131#131#255#215#215#215#255#250#250#250#255#197#197#197'q'#200#200#200#0#193 + +#193#193#0#190#190#190'm'#247#247#247#255#203#203#203#255#130#130#130#255#180 + +#180#180#255#175#175#175#255#176#176#176#255#175#175#175#255#175#175#175#255 + +#176#176#176#255#176#176#176#255#176#176#176#255#175#175#175#255#175#175#175 + +#255#175#175#175#255#176#176#176#255#176#176#176#255#181#181#181#255#130#130 + ,#130#255#214#214#214#255#250#250#250#255#196#196#196'v'#199#199#199#0#188#188 + +#188#0#185#185#185'p'#245#245#245#255#209#209#209#255'zzz'#255#129#129#129 + +#255'uuu'#255'www'#255'www'#255'www'#255'www'#255'www'#255'www'#255'www'#255 + +'www'#255'www'#255'www'#255'ttt'#255#131#131#131#255'{{{'#255#215#215#215#255 + +#248#248#248#255#189#189#189'v'#192#192#192#0#182#182#182#0#179#179#179'q' + +#235#235#235#255#210#210#210#255'ooo'#255'nnn'#255'ccc'#255'eee'#255'eee'#255 + +'eee'#255'eee'#255'eee'#255'eee'#255'eee'#255'eee'#255'eee'#255'eee'#255'ccc' + +#255'nnn'#255'mmm'#255#215#215#215#255#234#234#234#255#181#181#181'u'#184#184 + +#184#0#179#179#179#0#176#176#176't'#225#225#225#255#209#209#209#255'nnn'#255 + +#135#135#135#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#127#127#127#255#136#136#136#255'mmm' + +#255#211#211#211#255#222#222#222#255#176#176#176'v'#179#179#179#0#173#173#173 + +#0#170#170#170#127#212#212#212#255#234#234#234#255#150#150#150#255'jjj'#255 + +'qqq'#255'qqq'#255'qqq'#255'qqq'#255'ppp'#255'qqq'#255'qqq'#255'ppp'#255'qqq' + +#255'qqq'#255'qqq'#255'qqq'#255'iii'#255#160#160#160#255#238#238#238#255#207 + +#207#207#255#170#170#170#127#173#173#173#0#183#183#183#0#170#170#170#128#205 + +#205#205#255#224#224#224#255#234#234#234#255#229#229#229#255#237#237#237#255 + +#232#232#232#255#232#232#232#255#232#232#232#255#232#232#232#255#232#232#232 + +#255#232#232#232#255#232#232#232#255#231#231#231#255#231#231#231#255#231#231 + +#231#255#232#232#232#255#239#239#239#255#215#215#215#255#206#206#206#255#202 + +#202#202#255#170#170#170#128#183#183#183#0'ppp'#0#184#184#184#128#203#203#203 + +#255#216#216#216#255#214#214#214#255#205#205#205#255#147#147#147#255#173#173 + +#173#255#172#172#172#255#172#172#172#255#172#172#172#255#171#171#171#255#171 + +#171#171#255#171#171#171#255#171#171#171#255#171#171#171#255#171#171#171#255 + +#163#163#163#255#155#155#155#255#174#174#174#255#186#186#186#255#201#201#201 + +#255#184#184#184#128'ppp'#0#0#0#0#0'nnn'#130#212#212#212#255#212#212#212#255 + +#213#213#213#255#192#192#192#255'LLL'#255#150#150#150#255#148#148#148#255#149 + +#149#149#255#150#150#150#255#152#152#152#255#153#153#153#255#154#154#154#255 + +#155#155#155#255#158#158#158#255#161#161#161#255#141#141#141#255'WWW'#255#214 + +#214#214#255#209#209#209#255#208#208#208#255'nnn'#130#0#0#0#0#0#0#0#7'???F' + +#180#180#180#224#211#211#211#255#215#215#215#255#189#189#189#255'bbb'#255#192 + +#192#192#255#189#189#189#255#191#191#191#255#192#192#192#255#194#194#194#255 + +#196#196#196#255#198#198#198#255#199#199#199#255#202#202#202#255#206#206#206 + +#255#186#186#186#255'hhh'#255#214#214#214#255#210#210#210#255#184#184#184#233 + +'DDDR'#0#0#0#5#0#0#0#25#0#0#0'%>>>Qwww'#179'uuu'#182#135#135#135#185#142#142 + +#142#209#209#209#209#255#209#209#209#255#209#209#209#255#211#211#211#255#212 + +#212#212#255#214#214#214#255#216#216#216#255#217#217#217#255#218#218#218#255 + +#221#221#221#255#215#215#215#251'vvv'#194'ttt'#180'yyy'#180'CCCW'#0#0#0'$'#0 + +#0#0#25#0#0#0#4#0#0#0#5#0#0#0#0#0#0#0#0#0#0#0#0#17#17#17#0'\\\C'#225#225#225 + +#255#221#221#221#255#221#221#221#255#222#222#222#255#222#222#222#255#223#223 + +#223#255#225#225#225#255#225#225#225#255#226#226#226#255#228#228#228#255#224 + +#224#224#254'%%%'#12#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#5#0#0#0#4#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#15#3#3#3',%%%T$$$Z$$$Y$$$Y$$$Y$$$Y%%%Y%%%Y%%%' + +'Y%%%Z"""O'#0#0#0'"'#0#0#0#9#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + ,#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#178#178#178#0#178#178#178#0#131#131#131#255#131#131#131#255#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#178#178#178#0#131#131#131#255#131#131#131#255#178#178#178#0 + +#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#131#131 + +#131#255#182#182#182#255#182#182#182#255#131#131#131#255#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#131#131 + +#131#255#182#182#182#255#182#182#182#255#131#131#131#255#178#178#178#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#131#131#131#255#181#181#181#255#249#249 + +#249#255#248#248#248#255#180#180#180#255#131#131#131#255#178#178#178#0#178 + +#178#178#0#178#178#178#0#178#178#178#0#131#131#131#255#180#180#180#255#248 + +#248#248#255#249#249#249#255#181#181#181#255#131#131#131#255#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#131#131#131#255#179#179#179#255#244#244#244#255#242 + +#242#242#255#243#243#243#255#178#178#178#255#131#131#131#255#178#178#178#0 + +#178#178#178#0#131#131#131#255#178#178#178#255#243#243#243#255#242#242#242 + +#255#244#244#244#255#179#179#179#255#131#131#131#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#178#178#178#128#131#131#131#255#177#177#177#255#237#237#237 + +#255#236#236#236#255#237#237#237#255#176#176#176#255#131#131#131#255#131#131 + +#131#255#176#176#176#255#237#237#237#255#236#236#236#255#237#237#237#255#177 + +#177#177#255#131#131#131#255#178#178#178#128#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#178#178#178#0#178#178#178#128#131#131#131#255#175#175#175#255#231#231 + +#231#255#229#229#229#255#229#229#229#255#229#229#229#255#229#229#229#255#229 + +#229#229#255#229#229#229#255#231#231#231#255#175#175#175#255#131#131#131#255 + +#178#178#178#128#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178 + +#178#0#178#178#178#0#178#178#178#128#131#131#131#255#171#171#171#255#223#223 + +#223#255#220#220#220#255#219#219#219#255#219#219#219#255#220#220#220#255#223 + +#223#223#255#171#171#171#255#131#131#131#255#178#178#178#128#178#178#178#0 + +#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#128#131#131#131#255#218#218#218#255#213#213 + +#213#255#211#211#211#255#211#211#211#255#213#213#213#255#218#218#218#255#131 + +#131#131#255#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#0#131#131#131#255#184#184#184#255#175#175#175#255#171#171#171 + +#255#171#171#171#255#175#175#175#255#184#184#184#255#131#131#131#255#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#178#178#178#0#178#178#178#0#178#178#178#0#131#131#131#255#158#158 + +#158#255#182#182#182#255#176#176#176#255#175#175#175#255#175#175#175#255#176 + +#176#176#255#182#182#182#255#158#158#158#255#131#131#131#255#178#178#178#0 + +#178#178#178#0#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178 + +#178#0#178#178#178#0#131#131#131#255#161#161#161#255#189#189#189#255#183#183 + +#183#255#182#182#182#255#184#184#184#255#184#184#184#255#182#182#182#255#183 + +#183#183#255#189#189#189#255#161#161#161#255#131#131#131#255#178#178#178#0 + +#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#131#131 + +#131#255#162#162#162#255#191#191#191#255#186#186#186#255#189#189#189#255#158 + +#158#158#255#131#131#131#255#131#131#131#255#158#158#158#255#189#189#189#255 + +#186#186#186#255#191#191#191#255#162#162#162#255#131#131#131#255#178#178#178 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#131#131#131#255#167#167#167#255#198 + +#198#198#255#188#188#188#255#191#191#191#255#161#161#161#255#131#131#131#255 + +#178#178#178#128#178#178#178#128#131#131#131#255#161#161#161#255#191#191#191 + ,#255#188#188#188#255#198#198#198#255#167#167#167#255#131#131#131#255#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#131#131#131#255#168#168#168#255#203#203#203#255 + +#198#198#198#255#162#162#162#255#131#131#131#255#178#178#178#128#178#178#178 + +#0#178#178#178#0#178#178#178#128#131#131#131#255#162#162#162#255#198#198#198 + +#255#203#203#203#255#168#168#168#255#131#131#131#255#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#178#178#178#128#131#131#131#255#168#168#168#255#167#167#167 + +#255#131#131#131#255#178#178#178#128#178#178#178#0#178#178#178#0#178#178#178 + +#0#178#178#178#0#178#178#178#128#131#131#131#255#167#167#167#255#168#168#168 + +#255#131#131#131#255#178#178#178#128#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178 + +#178#178#0#178#178#178#128#131#131#131#255#131#131#131#255#178#178#178#128 + +#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178 + +#178#178#0#178#178#178#128#131#131#131#255#131#131#131#255#178#178#178#128 + +#178#178#178#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#178#178#178#0#178#178 + +#178#0#178#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0#178#178 + +#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0#178#178#178#0 + +#178#178#178#128#178#178#178#128#178#178#178#0#178#178#178#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#0#0#0 +]); diff --git a/components/kcontrols/source/kprintpreview.pas b/components/kcontrols/source/kprintpreview.pas new file mode 100755 index 000000000..b6cc0e0f9 --- /dev/null +++ b/components/kcontrols/source/kprintpreview.pas @@ -0,0 +1,228 @@ +{ @abstract(This unit contains print preview form.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(18 Sep 2009) + @lastmod(20 Jun 2010) + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KPrintPreview; + +{$include kcontrols.inc} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LResources, +{$ELSE} + Windows, Messages, ToolWin, ImgList, +{$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, ActnList, Buttons, StdCtrls, + ExtCtrls, KControls; + +type + + { TKPrintPreviewForm } + + TKPrintPreviewForm = class(TForm) + ILMain: TImageList; + ALMain: TActionList; + ACPageFirst: TAction; + ACPageLast: TAction; + ACPageNext: TAction; + ACPagePrevious: TAction; + ACClose: TAction; + ILMainDis: TImageList; + ToBMain: TToolBar; + TBPageFirst: TToolButton; + TBPagePrevious: TToolButton; + ToolButton1: TToolButton; + ToolButton3: TToolButton; + TBPageNext: TToolButton; + TBPageLast: TToolButton; + PNPage: TPanel; + EDPage: TEdit; + UDPage: TUpDown; + ToolButton6: TToolButton; + PNScale: TPanel; + CoBScale: TComboBox; + TBClose: TToolButton; + Preview: TKPrintPreview; + TBPrint: TToolButton; + ToolButton4: TToolButton; + ACPrint: TAction; + procedure CoBScaleExit(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ACPageFirstExecute(Sender: TObject); + procedure ACPageFirstUpdate(Sender: TObject); + procedure ACPagePreviousExecute(Sender: TObject); + procedure ACPageNextExecute(Sender: TObject); + procedure ACPageNextUpdate(Sender: TObject); + procedure ACPageLastExecute(Sender: TObject); + procedure ACCloseExecute(Sender: TObject); + procedure ACCloseUpdate(Sender: TObject); + procedure EDPageExit(Sender: TObject); + procedure UDPageClick(Sender: TObject; Button: TUDBtnType); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure PreviewChanged(Sender: TObject); + procedure ACPrintExecute(Sender: TObject); + procedure ACPrintUpdate(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + procedure ScaleChanged; + { Private declarations } + public + { Public declarations } + end; + +implementation + +uses + KFunctions; + +procedure TKPrintPreviewForm.FormCreate(Sender: TObject); +begin + CoBScale.ItemIndex := 9; // page width + Preview.DoubleBuffered := True; +end; + +procedure TKPrintPreviewForm.FormShow(Sender: TObject); +begin + UDPage.Min := Preview.StartPage; + UDPage.Max := Preview.EndPage; +end; + +procedure TKPrintPreviewForm.CoBScaleExit(Sender: TObject); +begin + ScaleChanged; +end; + +procedure TKPrintPreviewForm.ACPageFirstExecute(Sender: TObject); +begin + Preview.FirstPage; +end; + +procedure TKPrintPreviewForm.ACPageFirstUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Preview.Page > Preview.StartPage; +end; + +procedure TKPrintPreviewForm.ACPagePreviousExecute(Sender: TObject); +begin + Preview.PreviousPage; +end; + +procedure TKPrintPreviewForm.ACPageNextExecute(Sender: TObject); +begin + Preview.NextPage; +end; + +procedure TKPrintPreviewForm.ACPageNextUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Preview.Page < Preview.EndPage; +end; + +procedure TKPrintPreviewForm.ACPageLastExecute(Sender: TObject); +begin + Preview.LastPage; +end; + +procedure TKPrintPreviewForm.ACPrintExecute(Sender: TObject); +begin + Preview.Control.PrintOut; +end; + +procedure TKPrintPreviewForm.ACPrintUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(Preview.Control) and Preview.Control.CanPrint; +end; + +procedure TKPrintPreviewForm.ACCloseExecute(Sender: TObject); +begin + Close; +end; + +procedure TKPrintPreviewForm.ACCloseUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TKPrintPreviewForm.EDPageExit(Sender: TObject); +begin + Preview.Page := MinMax(StrToIntDef(EDPage.Text, Preview.Page), Preview.StartPage, Preview.EndPage); + EDPage.Text := IntToStr(Preview.Page); +end; + +procedure TKPrintPreviewForm.UDPageClick(Sender: TObject; Button: TUDBtnType); +begin + EDPageExit(nil); +end; + +procedure TKPrintPreviewForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + begin + Close; + Key := 0; + end; +end; + +procedure TKPrintPreviewForm.PreviewChanged(Sender: TObject); +begin + EDPage.Text := IntToStr(Preview.Page); +end; + +procedure TKPrintPreviewForm.ScaleChanged; +var + S: string; +begin + S := CoBScale.Text; + if CoBScale.Items.IndexOf(S) < 0 then + CoBScale.ItemIndex := -1; + case CoBScale.ItemIndex of + -1: + begin + while (S <> '') and not CharInSetEx(S[Length(S)], ['0'..'9']) do Delete(S, Length(S), 1); + Preview.Scale := StrToIntDef(S, 100); + end; + 0: Preview.Scale := 25; + 1: Preview.Scale := 50; + 2: Preview.Scale := 75; + 3: Preview.Scale := 100; + 4: Preview.Scale := 125; + 5: Preview.Scale := 150; + 6: Preview.Scale := 200; + 7: Preview.Scale := 500; + end; + case CoBScale.ItemIndex of + -1: + begin + Preview.ScaleMode := smScale; + CobScale.Text := Format('%d %%', [Preview.Scale]); + end; + 0..7: Preview.ScaleMode := smScale; + 8: Preview.ScaleMode := smWholePage; + 9: Preview.ScaleMode := smPageWidth; + end; +end; + +{$IFDEF FPC} +initialization + {$i kprintpreview.lrs} +{$ELSE} + {$R *.dfm} +{$ENDIF} +end. diff --git a/components/kcontrols/source/kprintsetup.dfm b/components/kcontrols/source/kprintsetup.dfm new file mode 100755 index 000000000..049fca2c0 --- /dev/null +++ b/components/kcontrols/source/kprintsetup.dfm @@ -0,0 +1,427 @@ +object KPrintSetupForm: TKPrintSetupForm + Left = 808 + Top = 247 + ActiveControl = CBFitToPage + BorderStyle = bsDialog + Caption = 'Page setup' + ClientHeight = 357 + ClientWidth = 464 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = True + Position = poScreenCenter + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object GBFileToPrint: TGroupBox + Left = 8 + Top = 8 + Width = 449 + Height = 45 + Caption = 'Title of printed document:' + TabOrder = 0 + object EDTitle: TEdit + Left = 8 + Top = 16 + Width = 432 + Height = 21 + TabOrder = 0 + Text = 'EDTitle' + end + end + object GBPrintOptions: TGroupBox + Left = 8 + Top = 109 + Width = 249 + Height = 105 + Caption = 'Print options:' + TabOrder = 1 + object Label1: TLabel + Left = 162 + Top = 23 + Width = 29 + Height = 13 + Caption = 'Scale:' + Color = clBtnFace + FocusControl = EDPrintScale + ParentColor = False + end + object CBFitToPage: TCheckBox + Left = 8 + Top = 21 + Width = 70 + Height = 17 + Caption = '&Fit to page' + TabOrder = 0 + OnClick = EDTopExit + end + object CBPageNumbers: TCheckBox + Left = 8 + Top = 40 + Width = 86 + Height = 17 + Caption = 'Pa&ge numbers' + TabOrder = 1 + OnClick = CBPageNumbersClick + end + object CBUseColor: TCheckBox + Left = 8 + Top = 59 + Width = 62 + Height = 17 + Caption = '&Use color' + TabOrder = 2 + OnClick = CBPageNumbersClick + end + object EDPrintScale: TEdit + Left = 162 + Top = 39 + Width = 48 + Height = 21 + TabOrder = 3 + OnExit = EDTopExit + end + object CBPaintSelection: TCheckBox + Left = 8 + Top = 78 + Width = 87 + Height = 17 + Caption = 'Pa&int selection' + TabOrder = 4 + OnClick = CBPageNumbersClick + end + object CBPrintTitle: TCheckBox + Left = 134 + Top = 78 + Width = 61 + Height = 17 + Caption = 'Print tit&le' + TabOrder = 5 + OnClick = CBPageNumbersClick + end + end + object BUPrint: TButton + Left = 89 + Top = 325 + Width = 74 + Height = 25 + Caption = '&Print' + TabOrder = 4 + OnClick = BUPrintClick + end + object BUCancel: TButton + Left = 383 + Top = 325 + Width = 74 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 5 + end + object GBMargins: TGroupBox + Left = 264 + Top = 109 + Width = 193 + Height = 211 + Caption = 'Margins:' + TabOrder = 3 + object LBMarginUnits: TLabel + Left = 8 + Top = 23 + Width = 62 + Height = 13 + Caption = 'Margin u&nits:' + Color = clBtnFace + FocusControl = CoBMarginUnits + ParentColor = False + end + object LBLeft: TLabel + Left = 8 + Top = 86 + Width = 23 + Height = 13 + Caption = 'Left:' + Color = clBtnFace + FocusControl = EDLeft + ParentColor = False + end + object LBRight: TLabel + Left = 102 + Top = 86 + Width = 29 + Height = 13 + Caption = 'Right:' + Color = clBtnFace + FocusControl = EDRight + ParentColor = False + end + object LBTop: TLabel + Left = 9 + Top = 131 + Width = 22 + Height = 13 + Caption = 'Top:' + Color = clBtnFace + FocusControl = EDTop + ParentColor = False + end + object LBBottom: TLabel + Left = 102 + Top = 131 + Width = 38 + Height = 13 + Caption = 'Bottom:' + Color = clBtnFace + FocusControl = EDBottom + ParentColor = False + end + object LBUnitsLeft: TLabel + Left = 58 + Top = 105 + Width = 7 + Height = 13 + Caption = 'A' + Color = clBtnFace + ParentColor = False + end + object LBUnitsTop: TLabel + Left = 58 + Top = 150 + Width = 7 + Height = 13 + Caption = 'A' + Color = clBtnFace + ParentColor = False + end + object LBUnitsRight: TLabel + Left = 152 + Top = 105 + Width = 7 + Height = 13 + Caption = 'A' + Color = clBtnFace + ParentColor = False + end + object LBUnitsBottom: TLabel + Left = 152 + Top = 150 + Width = 7 + Height = 13 + Caption = 'A' + Color = clBtnFace + ParentColor = False + end + object CoBMarginUnits: TComboBox + Left = 8 + Top = 39 + Width = 176 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 0 + OnChange = CoBMarginUnitsChange + Items.Strings = ( + 'milimeters' + 'centimeters' + 'inches' + 'hundredths of inches') + end + object CBMirrorMargins: TCheckBox + Left = 8 + Top = 181 + Width = 86 + Height = 17 + Caption = '&Mirror margins' + TabOrder = 5 + OnClick = CBPageNumbersClick + end + object EDLeft: TEdit + Left = 8 + Top = 102 + Width = 48 + Height = 21 + TabOrder = 1 + OnExit = EDTopExit + end + object EDRight: TEdit + Left = 102 + Top = 102 + Width = 48 + Height = 21 + TabOrder = 2 + OnExit = EDTopExit + end + object EDTop: TEdit + Left = 8 + Top = 147 + Width = 48 + Height = 21 + TabOrder = 3 + OnExit = EDTopExit + end + object EDBottom: TEdit + Left = 102 + Top = 147 + Width = 48 + Height = 21 + TabOrder = 4 + OnExit = EDTopExit + end + end + object GBPageSelection: TGroupBox + Left = 8 + Top = 215 + Width = 249 + Height = 105 + Caption = 'Page selection:' + TabOrder = 2 + object LBRangeTo: TLabel + Left = 163 + Top = 51 + Width = 14 + Height = 13 + Caption = 'to:' + Color = clBtnFace + ParentColor = False + end + object LBCopies: TLabel + Left = 8 + Top = 78 + Width = 87 + Height = 13 + Caption = 'Number of &copies:' + Color = clBtnFace + FocusControl = EDCopies + ParentColor = False + end + object RBAll: TRadioButton + Left = 8 + Top = 22 + Width = 61 + Height = 17 + Caption = '&All pages' + Checked = True + TabOrder = 0 + TabStop = True + OnClick = RBAllClick + end + object RBRange: TRadioButton + Left = 8 + Top = 48 + Width = 78 + Height = 17 + Caption = '&Range from:' + TabOrder = 1 + OnClick = RBAllClick + end + object RBSelectedOnly: TRadioButton + Left = 128 + Top = 22 + Width = 82 + Height = 17 + Caption = 'Selected &only' + TabOrder = 2 + OnClick = RBAllClick + end + object EDRangeFrom: TEdit + Left = 108 + Top = 46 + Width = 48 + Height = 21 + TabOrder = 3 + OnExit = EDTopExit + end + object EDRangeTo: TEdit + Left = 193 + Top = 46 + Width = 48 + Height = 21 + TabOrder = 4 + OnExit = EDTopExit + end + object EDCopies: TEdit + Left = 126 + Top = 73 + Width = 48 + Height = 21 + TabOrder = 5 + end + object CBCollate: TCheckBox + Left = 179 + Top = 75 + Width = 51 + Height = 17 + Caption = 'Collate' + TabOrder = 6 + OnClick = CBPageNumbersClick + end + end + object BUPreview: TButton + Left = 8 + Top = 325 + Width = 75 + Height = 25 + Caption = 'Previe&w...' + TabOrder = 6 + OnClick = BUPreviewClick + end + object BUOk: TButton + Left = 303 + Top = 325 + Width = 74 + Height = 25 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 7 + end + object GBPrinter: TGroupBox + Left = 8 + Top = 56 + Width = 449 + Height = 50 + Caption = 'Printer settings' + TabOrder = 8 + object LBPrinterName: TLabel + Left = 8 + Top = 20 + Width = 65 + Height = 13 + Caption = 'Printer name:' + Color = clBtnFace + FocusControl = EDCopies + ParentColor = False + end + object CoBPrinterName: TComboBox + Left = 112 + Top = 17 + Width = 206 + Height = 21 + ItemHeight = 13 + TabOrder = 0 + Text = 'CoBPrinterName' + OnChange = EDTopExit + end + object BUConfigure: TButton + Left = 328 + Top = 15 + Width = 113 + Height = 25 + Caption = 'Configure...' + TabOrder = 1 + OnClick = BUConfigureClick + end + end + object PSDMain: TPrinterSetupDialog + Left = 416 + Top = 29 + end +end diff --git a/components/kcontrols/source/kprintsetup.lfm b/components/kcontrols/source/kprintsetup.lfm new file mode 100755 index 000000000..26f0b5b3b --- /dev/null +++ b/components/kcontrols/source/kprintsetup.lfm @@ -0,0 +1,423 @@ +object KPrintSetupForm: TKPrintSetupForm + Left = 838 + Height = 357 + Top = 417 + Width = 464 + ActiveControl = EDTitle + BorderStyle = bsDialog + Caption = 'Page setup' + ClientHeight = 357 + ClientWidth = 464 + Font.Height = -11 + Font.Name = 'Tahoma' + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poScreenCenter + LCLVersion = '0.9.29' + object GBFileToPrint: TGroupBox + Left = 8 + Height = 45 + Top = 8 + Width = 449 + Caption = 'Title of printed document:' + ClientHeight = 27 + ClientWidth = 445 + TabOrder = 0 + object EDTitle: TEdit + Left = 8 + Height = 21 + Top = 2 + Width = 432 + TabOrder = 0 + Text = 'EDTitle' + end + end + object GBPrintOptions: TGroupBox + Left = 8 + Height = 105 + Top = 109 + Width = 249 + Caption = 'Print options:' + ClientHeight = 87 + ClientWidth = 245 + TabOrder = 1 + object Label1: TLabel + Left = 162 + Height = 14 + Top = 4 + Width = 30 + Caption = 'Scale:' + FocusControl = EDPrintScale + ParentColor = False + end + object CBFitToPage: TCheckBox + Left = 8 + Height = 17 + Top = 2 + Width = 70 + Caption = '&Fit to page' + OnClick = EDTopExit + TabOrder = 0 + end + object CBPageNumbers: TCheckBox + Left = 8 + Height = 17 + Top = 21 + Width = 86 + Caption = 'Pa&ge numbers' + OnClick = CBPageNumbersClick + TabOrder = 1 + end + object CBUseColor: TCheckBox + Left = 8 + Height = 17 + Top = 40 + Width = 62 + Caption = '&Use color' + OnClick = CBPageNumbersClick + TabOrder = 2 + end + object EDPrintScale: TEdit + Left = 162 + Height = 21 + Top = 20 + Width = 48 + OnExit = EDTopExit + TabOrder = 3 + end + object CBPaintSelection: TCheckBox + Left = 8 + Height = 17 + Top = 59 + Width = 87 + Caption = 'Pa&int selection' + OnClick = CBPageNumbersClick + TabOrder = 4 + end + object CBPrintTitle: TCheckBox + Left = 134 + Height = 17 + Top = 59 + Width = 61 + Caption = 'Print tit&le' + OnClick = CBPageNumbersClick + TabOrder = 5 + end + end + object BUPrint: TButton + Left = 89 + Height = 25 + Top = 325 + Width = 74 + Caption = '&Print' + OnClick = BUPrintClick + TabOrder = 4 + end + object BUCancel: TButton + Left = 383 + Height = 25 + Top = 325 + Width = 74 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 5 + end + object GBMargins: TGroupBox + Left = 264 + Height = 211 + Top = 109 + Width = 193 + Caption = 'Margins:' + ClientHeight = 193 + ClientWidth = 189 + TabOrder = 3 + object LBMarginUnits: TLabel + Left = 8 + Height = 14 + Top = 6 + Width = 63 + Caption = 'Margin u&nits:' + FocusControl = CoBMarginUnits + ParentColor = False + end + object LBLeft: TLabel + Left = 8 + Height = 14 + Top = 67 + Width = 24 + Caption = 'Left:' + FocusControl = EDLeft + ParentColor = False + end + object LBRight: TLabel + Left = 102 + Height = 14 + Top = 67 + Width = 30 + Caption = 'Right:' + FocusControl = EDRight + ParentColor = False + end + object LBTop: TLabel + Left = 9 + Height = 14 + Top = 126 + Width = 23 + Caption = 'Top:' + FocusControl = EDTop + ParentColor = False + end + object LBBottom: TLabel + Left = 102 + Height = 14 + Top = 112 + Width = 39 + Caption = 'Bottom:' + FocusControl = EDBottom + ParentColor = False + end + object LBUnitsLeft: TLabel + Left = 58 + Height = 14 + Top = 86 + Width = 8 + Caption = 'A' + ParentColor = False + end + object LBUnitsTop: TLabel + Left = 58 + Height = 14 + Top = 131 + Width = 8 + Caption = 'A' + ParentColor = False + end + object LBUnitsRight: TLabel + Left = 152 + Height = 14 + Top = 86 + Width = 8 + Caption = 'A' + ParentColor = False + end + object LBUnitsBottom: TLabel + Left = 152 + Height = 14 + Top = 131 + Width = 8 + Caption = 'A' + ParentColor = False + end + object CoBMarginUnits: TComboBox + Left = 8 + Height = 21 + Top = 22 + Width = 176 + ItemHeight = 13 + Items.Strings = ( + 'milimeters' + 'centimeters' + 'inches' + 'hundredths of inches' + ) + OnChange = CoBMarginUnitsChange + Style = csDropDownList + TabOrder = 0 + end + object CBMirrorMargins: TCheckBox + Left = 8 + Height = 17 + Top = 162 + Width = 86 + Caption = '&Mirror margins' + OnClick = CBPageNumbersClick + TabOrder = 5 + end + object EDLeft: TEdit + Left = 8 + Height = 21 + Top = 83 + Width = 48 + OnExit = EDTopExit + TabOrder = 1 + end + object EDRight: TEdit + Left = 102 + Height = 21 + Top = 83 + Width = 48 + OnExit = EDTopExit + TabOrder = 2 + end + object EDTop: TEdit + Left = 8 + Height = 21 + Top = 128 + Width = 48 + OnExit = EDTopExit + TabOrder = 3 + end + object EDBottom: TEdit + Left = 102 + Height = 21 + Top = 128 + Width = 48 + OnExit = EDTopExit + TabOrder = 4 + end + end + object GBPageSelection: TGroupBox + Left = 8 + Height = 105 + Top = 215 + Width = 249 + Caption = 'Page selection:' + ClientHeight = 87 + ClientWidth = 245 + TabOrder = 2 + object LBRangeTo: TLabel + Left = 163 + Height = 14 + Top = 32 + Width = 15 + Caption = 'to:' + ParentColor = False + end + object LBCopies: TLabel + Left = 8 + Height = 14 + Top = 59 + Width = 88 + Caption = 'Number of &copies:' + FocusControl = EDCopies + ParentColor = False + end + object RBAll: TRadioButton + Left = 8 + Height = 17 + Top = 3 + Width = 61 + Caption = '&All pages' + Checked = True + OnClick = RBAllClick + State = cbChecked + TabOrder = 0 + end + object RBRange: TRadioButton + Left = 8 + Height = 17 + Top = 29 + Width = 78 + Caption = '&Range from:' + OnClick = RBAllClick + TabOrder = 1 + TabStop = False + end + object RBSelectedOnly: TRadioButton + Left = 128 + Height = 17 + Top = 3 + Width = 82 + Caption = 'Selected &only' + OnClick = RBAllClick + TabOrder = 2 + TabStop = False + end + object EDRangeFrom: TEdit + Left = 108 + Height = 21 + Top = 27 + Width = 48 + OnExit = EDTopExit + TabOrder = 3 + end + object EDRangeTo: TEdit + Left = 193 + Height = 21 + Top = 27 + Width = 48 + OnExit = EDTopExit + TabOrder = 4 + end + object EDCopies: TEdit + Left = 126 + Height = 21 + Top = 54 + Width = 48 + TabOrder = 5 + end + object CBCollate: TCheckBox + Left = 179 + Height = 17 + Top = 56 + Width = 51 + Caption = 'Collate' + OnClick = CBPageNumbersClick + TabOrder = 6 + end + end + object BUPreview: TButton + Left = 8 + Height = 25 + Top = 325 + Width = 75 + Caption = 'Previe&w...' + OnClick = BUPreviewClick + TabOrder = 6 + end + object BUOk: TButton + Left = 303 + Height = 25 + Top = 325 + Width = 74 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 7 + end + object GBPrinter: TGroupBox + Left = 8 + Height = 50 + Top = 56 + Width = 449 + Caption = 'Printer settings' + ClientHeight = 32 + ClientWidth = 445 + TabOrder = 8 + object LBPrinterName: TLabel + Left = 8 + Height = 14 + Top = 6 + Width = 66 + Caption = 'Printer name:' + FocusControl = EDCopies + ParentColor = False + end + object CoBPrinterName: TComboBox + Left = 112 + Height = 21 + Top = 2 + Width = 206 + ItemHeight = 13 + OnChange = EDTopExit + TabOrder = 0 + Text = 'CoBPrinterName' + end + object BUConfigure: TButton + Left = 328 + Height = 25 + Top = 1 + Width = 113 + Caption = 'Configure...' + OnClick = BUConfigureClick + TabOrder = 1 + end + end + object PSDMain: TPrinterSetupDialog + left = 376 + top = 104 + end +end diff --git a/components/kcontrols/source/kprintsetup.lrs b/components/kcontrols/source/kprintsetup.lrs new file mode 100755 index 000000000..203e0c02f --- /dev/null +++ b/components/kcontrols/source/kprintsetup.lrs @@ -0,0 +1,102 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TKPrintSetupForm','FORMDATA',[ + 'TPF0'#16'TKPrintSetupForm'#15'KPrintSetupForm'#4'Left'#3'F'#3#6'Height'#3'e' + +#1#3'Top'#3#161#1#5'Width'#3#208#1#13'ActiveControl'#7#7'EDTitle'#11'BorderS' + +'tyle'#7#8'bsDialog'#7'Caption'#6#10'Page setup'#12'ClientHeight'#3'e'#1#11 + +'ClientWidth'#3#208#1#11'Font.Height'#2#245#9'Font.Name'#6#6'Tahoma'#12'OnCl' + +'oseQuery'#7#14'FormCloseQuery'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7 + +#11'FormDestroy'#6'OnShow'#7#8'FormShow'#8'Position'#7#14'poScreenCenter'#10 + +'LCLVersion'#6#6'0.9.29'#0#9'TGroupBox'#13'GBFileToPrint'#4'Left'#2#8#6'Heig' + +'ht'#2'-'#3'Top'#2#8#5'Width'#3#193#1#7'Caption'#6#26'Title of printed docum' + +'ent:'#12'ClientHeight'#2#27#11'ClientWidth'#3#189#1#8'TabOrder'#2#0#0#5'TEd' + +'it'#7'EDTitle'#4'Left'#2#8#6'Height'#2#21#3'Top'#2#2#5'Width'#3#176#1#8'Tab' + +'Order'#2#0#4'Text'#6#7'EDTitle'#0#0#0#9'TGroupBox'#14'GBPrintOptions'#4'Lef' + +'t'#2#8#6'Height'#2'i'#3'Top'#2'm'#5'Width'#3#249#0#7'Caption'#6#14'Print op' + +'tions:'#12'ClientHeight'#2'W'#11'ClientWidth'#3#245#0#8'TabOrder'#2#1#0#6'T' + +'Label'#6'Label1'#4'Left'#3#162#0#6'Height'#2#14#3'Top'#2#4#5'Width'#2#30#7 + +'Caption'#6#6'Scale:'#12'FocusControl'#7#12'EDPrintScale'#11'ParentColor'#8#0 + +#0#9'TCheckBox'#11'CBFitToPage'#4'Left'#2#8#6'Height'#2#17#3'Top'#2#2#5'Widt' + +'h'#2'F'#7'Caption'#6#12'&Fit to page'#7'OnClick'#7#9'EDTopExit'#8'TabOrder' + +#2#0#0#0#9'TCheckBox'#13'CBPageNumbers'#4'Left'#2#8#6'Height'#2#17#3'Top'#2 + +#21#5'Width'#2'V'#7'Caption'#6#13'Pa&ge numbers'#7'OnClick'#7#18'CBPageNumbe' + +'rsClick'#8'TabOrder'#2#1#0#0#9'TCheckBox'#10'CBUseColor'#4'Left'#2#8#6'Heig' + +'ht'#2#17#3'Top'#2'('#5'Width'#2'>'#7'Caption'#6#10'&Use color'#7'OnClick'#7 + +#18'CBPageNumbersClick'#8'TabOrder'#2#2#0#0#5'TEdit'#12'EDPrintScale'#4'Left' + +#3#162#0#6'Height'#2#21#3'Top'#2#20#5'Width'#2'0'#6'OnExit'#7#9'EDTopExit'#8 + +'TabOrder'#2#3#0#0#9'TCheckBox'#16'CBPaintSelection'#4'Left'#2#8#6'Height'#2 + +#17#3'Top'#2';'#5'Width'#2'W'#7'Caption'#6#16'Pa&int selection'#7'OnClick'#7 + +#18'CBPageNumbersClick'#8'TabOrder'#2#4#0#0#9'TCheckBox'#12'CBPrintTitle'#4 + +'Left'#3#134#0#6'Height'#2#17#3'Top'#2';'#5'Width'#2'='#7'Caption'#6#12'Prin' + +'t tit&le'#7'OnClick'#7#18'CBPageNumbersClick'#8'TabOrder'#2#5#0#0#0#7'TButt' + +'on'#7'BUPrint'#4'Left'#2'Y'#6'Height'#2#25#3'Top'#3'E'#1#5'Width'#2'J'#7'Ca' + +'ption'#6#6'&Print'#7'OnClick'#7#12'BUPrintClick'#8'TabOrder'#2#4#0#0#7'TBut' + +'ton'#8'BUCancel'#4'Left'#3#127#1#6'Height'#2#25#3'Top'#3'E'#1#5'Width'#2'J' + +#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#5#0#0#9 + +'TGroupBox'#9'GBMargins'#4'Left'#3#8#1#6'Height'#3#211#0#3'Top'#2'm'#5'Width' + +#3#193#0#7'Caption'#6#8'Margins:'#12'ClientHeight'#3#193#0#11'ClientWidth'#3 + +#189#0#8'TabOrder'#2#3#0#6'TLabel'#13'LBMarginUnits'#4'Left'#2#8#6'Height'#2 + +#14#3'Top'#2#6#5'Width'#2'?'#7'Caption'#6#14'Margin u&nits:'#12'FocusControl' + +#7#14'CoBMarginUnits'#11'ParentColor'#8#0#0#6'TLabel'#6'LBLeft'#4'Left'#2#8#6 + +'Height'#2#14#3'Top'#2'C'#5'Width'#2#24#7'Caption'#6#5'Left:'#12'FocusContro' + +'l'#7#6'EDLeft'#11'ParentColor'#8#0#0#6'TLabel'#7'LBRight'#4'Left'#2'f'#6'He' + +'ight'#2#14#3'Top'#2'C'#5'Width'#2#30#7'Caption'#6#6'Right:'#12'FocusControl' + +#7#7'EDRight'#11'ParentColor'#8#0#0#6'TLabel'#5'LBTop'#4'Left'#2#9#6'Height' + +#2#14#3'Top'#2'~'#5'Width'#2#23#7'Caption'#6#4'Top:'#12'FocusControl'#7#5'ED' + +'Top'#11'ParentColor'#8#0#0#6'TLabel'#8'LBBottom'#4'Left'#2'f'#6'Height'#2#14 + +#3'Top'#2'p'#5'Width'#2''''#7'Caption'#6#7'Bottom:'#12'FocusControl'#7#8'EDB' + +'ottom'#11'ParentColor'#8#0#0#6'TLabel'#11'LBUnitsLeft'#4'Left'#2':'#6'Heigh' + +'t'#2#14#3'Top'#2'V'#5'Width'#2#8#7'Caption'#6#1'A'#11'ParentColor'#8#0#0#6 + +'TLabel'#10'LBUnitsTop'#4'Left'#2':'#6'Height'#2#14#3'Top'#3#131#0#5'Width'#2 + +#8#7'Caption'#6#1'A'#11'ParentColor'#8#0#0#6'TLabel'#12'LBUnitsRight'#4'Left' + +#3#152#0#6'Height'#2#14#3'Top'#2'V'#5'Width'#2#8#7'Caption'#6#1'A'#11'Parent' + +'Color'#8#0#0#6'TLabel'#13'LBUnitsBottom'#4'Left'#3#152#0#6'Height'#2#14#3'T' + +'op'#3#131#0#5'Width'#2#8#7'Caption'#6#1'A'#11'ParentColor'#8#0#0#9'TComboBo' + +'x'#14'CoBMarginUnits'#4'Left'#2#8#6'Height'#2#21#3'Top'#2#22#5'Width'#3#176 + +#0#10'ItemHeight'#2#13#13'Items.Strings'#1#6#10'milimeters'#6#11'centimeters' + +#6#6'inches'#6#20'hundredths of inches'#0#8'OnChange'#7#20'CoBMarginUnitsCha' + +'nge'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#0#0#0#9'TCheckBox'#15'CBMi' + +'rrorMargins'#4'Left'#2#8#6'Height'#2#17#3'Top'#3#162#0#5'Width'#2'V'#7'Capt' + +'ion'#6#15'&Mirror margins'#7'OnClick'#7#18'CBPageNumbersClick'#8'TabOrder'#2 + +#5#0#0#5'TEdit'#6'EDLeft'#4'Left'#2#8#6'Height'#2#21#3'Top'#2'S'#5'Width'#2 + +'0'#6'OnExit'#7#9'EDTopExit'#8'TabOrder'#2#1#0#0#5'TEdit'#7'EDRight'#4'Left' + +#2'f'#6'Height'#2#21#3'Top'#2'S'#5'Width'#2'0'#6'OnExit'#7#9'EDTopExit'#8'Ta' + +'bOrder'#2#2#0#0#5'TEdit'#5'EDTop'#4'Left'#2#8#6'Height'#2#21#3'Top'#3#128#0 + +#5'Width'#2'0'#6'OnExit'#7#9'EDTopExit'#8'TabOrder'#2#3#0#0#5'TEdit'#8'EDBot' + +'tom'#4'Left'#2'f'#6'Height'#2#21#3'Top'#3#128#0#5'Width'#2'0'#6'OnExit'#7#9 + +'EDTopExit'#8'TabOrder'#2#4#0#0#0#9'TGroupBox'#15'GBPageSelection'#4'Left'#2 + ,#8#6'Height'#2'i'#3'Top'#3#215#0#5'Width'#3#249#0#7'Caption'#6#15'Page selec' + +'tion:'#12'ClientHeight'#2'W'#11'ClientWidth'#3#245#0#8'TabOrder'#2#2#0#6'TL' + +'abel'#9'LBRangeTo'#4'Left'#3#163#0#6'Height'#2#14#3'Top'#2' '#5'Width'#2#15 + +#7'Caption'#6#3'to:'#11'ParentColor'#8#0#0#6'TLabel'#8'LBCopies'#4'Left'#2#8 + +#6'Height'#2#14#3'Top'#2';'#5'Width'#2'X'#7'Caption'#6#18'Number of &copies:' + +#12'FocusControl'#7#8'EDCopies'#11'ParentColor'#8#0#0#12'TRadioButton'#5'RBA' + +'ll'#4'Left'#2#8#6'Height'#2#17#3'Top'#2#3#5'Width'#2'='#7'Caption'#6#10'&Al' + +'l pages'#7'Checked'#9#7'OnClick'#7#10'RBAllClick'#5'State'#7#9'cbChecked'#8 + +'TabOrder'#2#0#0#0#12'TRadioButton'#7'RBRange'#4'Left'#2#8#6'Height'#2#17#3 + +'Top'#2#29#5'Width'#2'N'#7'Caption'#6#12'&Range from:'#7'OnClick'#7#10'RBAll' + +'Click'#8'TabOrder'#2#1#7'TabStop'#8#0#0#12'TRadioButton'#14'RBSelectedOnly' + +#4'Left'#3#128#0#6'Height'#2#17#3'Top'#2#3#5'Width'#2'R'#7'Caption'#6#14'Sel' + +'ected &only'#7'OnClick'#7#10'RBAllClick'#8'TabOrder'#2#2#7'TabStop'#8#0#0#5 + +'TEdit'#11'EDRangeFrom'#4'Left'#2'l'#6'Height'#2#21#3'Top'#2#27#5'Width'#2'0' + +#6'OnExit'#7#9'EDTopExit'#8'TabOrder'#2#3#0#0#5'TEdit'#9'EDRangeTo'#4'Left'#3 + +#193#0#6'Height'#2#21#3'Top'#2#27#5'Width'#2'0'#6'OnExit'#7#9'EDTopExit'#8'T' + +'abOrder'#2#4#0#0#5'TEdit'#8'EDCopies'#4'Left'#2'~'#6'Height'#2#21#3'Top'#2 + +'6'#5'Width'#2'0'#8'TabOrder'#2#5#0#0#9'TCheckBox'#9'CBCollate'#4'Left'#3#179 + +#0#6'Height'#2#17#3'Top'#2'8'#5'Width'#2'3'#7'Caption'#6#7'Collate'#7'OnClic' + +'k'#7#18'CBPageNumbersClick'#8'TabOrder'#2#6#0#0#0#7'TButton'#9'BUPreview'#4 + +'Left'#2#8#6'Height'#2#25#3'Top'#3'E'#1#5'Width'#2'K'#7'Caption'#6#11'Previe' + +'&w...'#7'OnClick'#7#14'BUPreviewClick'#8'TabOrder'#2#6#0#0#7'TButton'#4'BUO' + +'k'#4'Left'#3'/'#1#6'Height'#2#25#3'Top'#3'E'#1#5'Width'#2'J'#7'Caption'#6#2 + +'OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#7#0#0#9'TGroupBox'#9'GBP' + +'rinter'#4'Left'#2#8#6'Height'#2'2'#3'Top'#2'8'#5'Width'#3#193#1#7'Caption'#6 + +#16'Printer settings'#12'ClientHeight'#2' '#11'ClientWidth'#3#189#1#8'TabOrd' + +'er'#2#8#0#6'TLabel'#13'LBPrinterName'#4'Left'#2#8#6'Height'#2#14#3'Top'#2#6 + +#5'Width'#2'B'#7'Caption'#6#13'Printer name:'#12'FocusControl'#7#8'EDCopies' + +#11'ParentColor'#8#0#0#9'TComboBox'#14'CoBPrinterName'#4'Left'#2'p'#6'Height' + +#2#21#3'Top'#2#2#5'Width'#3#206#0#10'ItemHeight'#2#13#8'OnChange'#7#9'EDTopE' + +'xit'#8'TabOrder'#2#0#4'Text'#6#14'CoBPrinterName'#0#0#7'TButton'#11'BUConfi' + +'gure'#4'Left'#3'H'#1#6'Height'#2#25#3'Top'#2#1#5'Width'#2'q'#7'Caption'#6#12 + +'Configure...'#7'OnClick'#7#16'BUConfigureClick'#8'TabOrder'#2#1#0#0#0#19'TP' + +'rinterSetupDialog'#7'PSDMain'#4'left'#3'x'#1#3'top'#2'h'#0#0#0 +]); diff --git a/components/kcontrols/source/kprintsetup.pas b/components/kcontrols/source/kprintsetup.pas new file mode 100755 index 000000000..6e9d8eadd --- /dev/null +++ b/components/kcontrols/source/kprintsetup.pas @@ -0,0 +1,369 @@ +{ @abstract(This unit contains page setup dialog.) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(18 Sep 2009) + @lastmod(15 Oct 2009) + + Copyright © 2009 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KPrintSetup; + +{$include kcontrols.inc} + +interface + +uses +{$IFDEF FPC} + LCLType, LCLIntf, LResources, PrintersDlgs, +{$ELSE} + Windows, Messages, Dialogs, +{$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, + StdCtrls, ExtCtrls, KControls, KPrintPreview; + +resourcestring + sPrinterSetup = 'Printer setup'; + sAllPages = 'All pages (%d)'; + sErrPrintSetup = 'Print setup error'; + sErrNoPrinterInstalled = 'No printer is installed on this computer.'; + +type + + { TKPrintSetupForm } + + TKPrintSetupForm = class(TForm) + BUConfigure: TButton; + CoBPrinterName: TComboBox; + EDTitle: TEdit; + GBFileToPrint: TGroupBox; + GBPrinter: TGroupBox; + GBPrintOptions: TGroupBox; + LBPrinterName: TLabel; + BUPrint: TButton; + BUCancel: TButton; + CBFitToPage: TCheckBox; + CBPageNumbers: TCheckBox; + CBUseColor: TCheckBox; + GBMargins: TGroupBox; + CoBMarginUnits: TComboBox; + LBMarginUnits: TLabel; + CBMirrorMargins: TCheckBox; + GBPageSelection: TGroupBox; + RBAll: TRadioButton; + RBRange: TRadioButton; + RBSelectedOnly: TRadioButton; + LBRangeTo: TLabel; + LBCopies: TLabel; + EDLeft: TEdit; + LBLeft: TLabel; + LBRight: TLabel; + EDRight: TEdit; + EDTop: TEdit; + LBTop: TLabel; + EDBottom: TEdit; + LBBottom: TLabel; + EDRangeFrom: TEdit; + EDRangeTo: TEdit; + EDCopies: TEdit; + Label1: TLabel; + EDPrintScale: TEdit; + LBUnitsLeft: TLabel; + LBUnitsTop: TLabel; + LBUnitsRight: TLabel; + LBUnitsBottom: TLabel; + BUPreview: TButton; + CBPaintSelection: TCheckBox; + BUOk: TButton; + CBPrintTitle: TCheckBox; + CBCollate: TCheckBox; + PSDMain: TPrinterSetupDialog; + procedure BUConfigureClick(Sender: TObject); + procedure CoBMarginUnitsChange(Sender: TObject); + procedure RBAllClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure BUPreviewClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure EDTopExit(Sender: TObject); + procedure CBPageNumbersClick(Sender: TObject); + procedure BUPrintClick(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { Private declarations } + FPrevSetup: TKPrintPageSetup; + FPageSetup: TKPrintPageSetup; + FPreviewForm: TKPrintPreviewForm; + FPreviewCreated: Boolean; + FSelAvail: Boolean; + FUpdateLock: Boolean; + procedure SetPageSetup(const Value: TKPrintPageSetup); + procedure SetPreviewForm(const Value: TKPrintPreviewForm); + protected + procedure PageSetupToForm; virtual; + procedure FormToPageSetup; virtual; + procedure ValidateForm; + public + { Public declarations } + property PageSetup: TKPrintPageSetup read FPageSetup write SetPageSetup; + property PreviewForm: TKPrintPreviewForm read FPreviewForm write SetPreviewForm; + property SelAvail: Boolean read FSelAvail write FSelAvail; + end; + +implementation + +uses + Printers, KFunctions; + +procedure TKPrintSetupForm.FormCreate(Sender: TObject); +begin + FPageSetup := nil; + FPrevSetup := TKPrintPageSetup.Create(nil); + FPreviewForm := nil; + FPreviewCreated := False; +{$IFDEF FPC} + PSDMain.Title := sPrinterSetup; +{$ENDIF} +end; + +procedure TKPrintSetupForm.FormDestroy(Sender: TObject); +begin + if FPreviewCreated then + begin + FPreviewForm.Free; + FPreviewCreated := False; + end; + FPrevSetup.Free; +end; + +procedure TKPrintSetupForm.FormShow(Sender: TObject); +begin + PageSetupToForm; +end; + +procedure TKPrintSetupForm.PageSetupToForm; + function FmtMargin(Value: Double): string; + const + Fmt = '%.*f'; + var + Precision: Integer; + begin + case FPageSetup.Units of + puCM: Precision := 1; + puMM: Precision := 0; + puInch: Precision := 2; + else + Precision := 0; + end; + Result := Format(Fmt, [Precision, Value]); + end; + + function FmtUnit: string; + begin + case FPageSetup.Units of + puMM: Result := 'mm'; + puInch: Result := '"'; + puHundredthInch: Result := '".100'; + else + Result := 'cm'; + end; + end; +var + S: string; +begin + if Assigned(FPageSetup) then + begin + FUpdateLock := True; + try + CBCollate.Checked := poCollate in FPageSetup.Options; + CBFitToPage.Checked := poFitToPage in FPageSetup.Options; + CBPageNumbers.Checked := poPageNumbers in FPageSetup.Options; + CBUseColor.Checked := poUseColor in FPageSetup.Options; + CBPaintSelection.Checked := poPaintSelection in FPageSetup.Options; + CBPrintTitle.Checked := poTitle in FPageSetup.Options; + CBMirrorMargins.Checked := poMirrorMargins in FPageSetup.Options; + CoBPrinterName.Items.Assign(Printer.Printers); + CoBPrinterName.ItemIndex := CoBPrinterName.Items.IndexOf(FPageSetup.PrinterName); + if CoBPrinterName.ItemIndex < 0 then CoBPrinterName.ItemIndex := Printer.PrinterIndex; + RBSelectedOnly.Enabled := FPageSetup.SelAvail; + if RBSelectedOnly.Enabled and FSelAvail then + RBSelectedOnly.Checked := True + else if FPageSetup.Range = prRange then + RBRange.Checked := True + else + RBAll.Checked := True; + RBAll.Caption := Format(sAllPages, [FPageSetup.PageCount]); + EDRangeFrom.Enabled := RBRange.Checked; + EDRangeFrom.Text := IntToStr(FPageSetup.StartPage); + EDRangeTo.Enabled := RBRange.Checked; + EDRangeTo.Text := IntToStr(FPageSetup.EndPage); + EDCopies.Text := IntToStr(FPageSetup.Copies); + EDPrintScale.Enabled := not CBFitTopage.Checked; + EDPrintScale.Text := IntToStr(FPageSetup.Scale); + EDTitle.Text := FPageSetup.Title; + CoBMarginUnits.ItemIndex := Integer(FPageSetup.Units); + S := FmtUnit; + EDBottom.Text := FmtMargin(FPageSetup.MarginBottom); LBUnitsBottom.Caption := S; + EDLeft.Text := FmtMargin(FPageSetup.MarginLeft); LBUnitsLeft.Caption := S; + EDRight.Text := FmtMargin(FPageSetup.MarginRight); LBUnitsRight.Caption := S; + EDTop.Text := FmtMargin(FPageSetup.MarginTop); LBUnitsTop.Caption := S; + finally + FUpdateLock := False; + end; + end; +end; + +procedure TKPrintSetupForm.FormToPageSetup; +var + Options: TKPrintOptions; +begin + if Assigned(FPageSetup) and not FUpdateLock then + begin + FPageSetup.LockUpdate; + try + Options := []; + if CBCollate.Checked then Include(Options, poCollate); + if CBFitToPage.Checked then Include(Options, poFitToPage); + if CBPageNumbers.Checked then Include(Options, poPageNumbers); + if CBUseColor.Checked then Include(Options, poUseColor); + if CBPaintSelection.Checked then Include(Options, poPaintSelection); + if CBPrintTitle.Checked then Include(Options, poTitle); + if CBMirrorMargins.Checked then Include(Options, poMirrorMargins); + FPageSetup.PrinterName := CoBPrinterName.Text; + FPageSetup.Options := Options; + if RBSelectedOnly.Checked then FPageSetup.Range := prSelectedOnly + else if RBRange.Checked then FPageSetup.Range := prRange + else FPageSetup.Range := prAll; + FPageSetup.StartPage := StrToIntDef(EDRangeFrom.Text, FPageSetup.StartPage); + FPageSetup.EndPage := StrToIntDef(EDRangeTo.Text, FPageSetup.EndPage); + FPageSetup.Copies := StrToIntDef(EDCopies.Text, FPageSetup.Copies); + FPageSetup.Scale := StrToIntDef(EDPrintScale.Text, FPageSetup.Scale); + FPageSetup.Title := EDTitle.Text; + FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); + FPageSetup.MarginBottom := StrToFloatDef(AdjustDecimalSeparator(EDBottom.Text), FPageSetup.MarginBottom); + FPageSetup.MarginLeft := StrToFloatDef(AdjustDecimalSeparator(EDLeft.Text), FPageSetup.MarginLeft); + FPageSetup.MarginRight := StrToFloatDef(AdjustDecimalSeparator(EDRight.Text), FPageSetup.MarginRight); + FPageSetup.MarginTop := StrToFloatDef(AdjustDecimalSeparator(EDTop.Text), FPageSetup.MarginTop); + finally + FPageSetup.UnlockUpdate; + end; + end; +end; + +procedure TKPrintSetupForm.BUPrintClick(Sender: TObject); +begin + FormToPageSetup; + FPageSetup.PrintOut; +end; + +procedure TKPrintSetupForm.BUConfigureClick(Sender: TObject); +begin + FormToPageSetup; + try + if PSDMain.Execute then + begin + FPageSetup.LockUpdate; + try + FPageSetup.PrinterName := ''; + finally + FPageSetup.UnlockUpdate; + end; + PageSetupToForm; + end; + except + MessageBox(Handle, PChar(sErrNoPrinterInstalled), PChar(sErrPrintSetup), MB_OK); + end; +end; + +procedure TKPrintSetupForm.EDTopExit(Sender: TObject); +begin + ValidateForm; +end; + +procedure TKPrintSetupForm.CoBMarginUnitsChange(Sender: TObject); +begin + if Assigned(FPageSetup) then + begin + FPageSetup.Units := TKPrintUnits(CoBMarginUnits.ItemIndex); + PageSetupToForm; + end; +end; + +procedure TKPrintSetupForm.CBPageNumbersClick(Sender: TObject); +begin + FormToPageSetup; +end; + +procedure TKPrintSetupForm.RBAllClick(Sender: TObject); +begin + FSelAvail := RBSelectedOnly.Checked; + ValidateForm; +end; + +procedure TKPrintSetupForm.SetPageSetup(const Value: TKPrintPageSetup); +begin + if Value <> FPageSetup then + begin + FPrevSetup.Assign(Value); + FPageSetup := Value; + PageSetupToForm; + end; +end; + +procedure TKPrintSetupForm.SetPreviewForm(const Value: TKPrintPreviewForm); +begin + if Value <> FPreviewForm then + begin + if FPreviewCreated then + begin + FPreviewForm.Free; + FPreviewCreated := False; + end; + FPreviewForm := Value; + end; +end; + +procedure TKPrintSetupForm.ValidateForm; +begin + FormToPageSetup; + PageSetupToForm; +end; + +procedure TKPrintSetupForm.FormCloseQuery(Sender: TObject; + var CanClose: Boolean); +begin + if FPreviewCreated then + FPreviewForm.Hide; + if ModalResult = mrOk then + FormToPageSetup + else if Assigned(FPageSetup) then + FPageSetup.Assign(FPrevSetup); +end; + +procedure TKPrintSetupForm.BUPreviewClick(Sender: TObject); +begin + ValidateForm; + if FPreviewForm = nil then + begin + FPreviewForm := TKPrintPreviewForm.Create(nil); + FPreviewCreated := True; + end; + FPreviewForm.Preview.Control := FPageSetup.Control; + FPreviewForm.Show; +end; + +{$IFDEF FPC} +initialization + {$i kprintsetup.lrs} +{$ELSE} + {$R *.dfm} +{$ENDIF} +end. diff --git a/components/kcontrols/source/kwidewinprocs.pas b/components/kcontrols/source/kwidewinprocs.pas new file mode 100755 index 000000000..67269523e --- /dev/null +++ b/components/kcontrols/source/kwidewinprocs.pas @@ -0,0 +1,96 @@ +{ @abstract(This unit contains Unicode equivalents of ANSI Win32 API functions + not supported in Win9X without Unicode Layer for Win9X) + @author(Tomas Krysl (tk@tkweb.eu)) + @created(10 Jun 2008) + @lastmod(14 Oct 2009) + + Copyright © 2008 Tomas Krysl (tk@@tkweb.eu)

+ + License:
+ This code is distributed as a freeware. You are free to use it as part + of your application for any purpose including freeware, commercial and + shareware applications. The origin of this source code must not be + misrepresented; you must not claim your authorship. You may modify this code + solely for your own purpose. Please feel free to contact the author if you + think your changes might be useful for other users. You may distribute only + the original package. The author accepts no liability for any damage + that may result from using this code. } + +unit KWideWinProcs; + +{$include kcontrols.inc} + +interface + +{$IFDEF USE_WIDEWINPROCS} + +type + { Procedural type for @link(TKWideWinProcs.CompareString). } + TCompareStringW = function(Locale, dwCmpFlags: Cardinal; lpString1: PWideChar; cchCount1: + Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall; + + { Procedural type for @link(TKWideWinProcs.LStrLenW). } + TLStrLenW = function(lpString: PWideChar): Integer; + + { Unicode equivalents of ANSI Win32 API functions not available in Win9X + without Unicode Layer for Win9X. Only those used in KControls. } + TKWideWinProcs = class(TObject) + private + FCompareStringW: TCompareStringW; + FLStrLenW: TLStrLenW; + public + { Creates the instance. } + constructor Create; + { See MSDN for help. } + function CompareString(Locale, dwCmpFlags: Cardinal; lpString1: PWideChar; + cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; + { See MSDN for help. } + function LStrLenW(lpString: PWideChar): Integer; + end; + +var + WideWinProcs: TKWideWinProcs; + +{$ENDIF} + +implementation + +{$IFDEF USE_WIDEWINPROCS} + +uses + Windows, KFunctions; + +{ TWideWinProcs } + +constructor TKWideWinProcs.Create; +begin + FCompareStringW := GetProcAddress(GetModuleHandle('kernel32.dll'), 'CompareStringW'); + FLStrLenW := GetProcAddress(GetModuleHandle('kernel32.dll'), 'lstrlenW'); +end; + +function TKWideWinProcs.CompareString(Locale, dwCmpFlags: Cardinal; + lpString1: PWideChar; cchCount1: Integer; lpString2: PWideChar; + cchCount2: Integer): Integer; +begin + if Assigned(FCompareStringW) then + Result := FCompareStringW(Locale, dwCmpFlags, lpString1, cchCount1, + lpString2, cchCount2) + else + Result := CompareStringA(Locale, dwCmpFlags, PAnsiChar(WideCharToAnsiString(lpString1)), + cchCount1, PAnsiChar(WideCharToAnsiString(lpString2)), cchCount2); +end; + +function TKWideWinProcs.LStrLenW(lpString: PWideChar): Integer; +begin + if Assigned(FLStrLenW) then + Result := FLStrLenW(lpString) + else + Result := LStrLenA(PAnsiChar(WideCharToAnsiString(lpString))); +end; + +initialization + WideWinProcs := TKWideWinProcs.Create; +finalization + WideWinProcs.Free; +{$ENDIF} +end. diff --git a/components/kcontrols/source/xpman.res b/components/kcontrols/source/xpman.res new file mode 100755 index 000000000..8c46dfcf4 Binary files /dev/null and b/components/kcontrols/source/xpman.res differ