Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. {*******************************************************************************
  2.    Class: TSortGrid
  3.    Copyright 1996,1997,1999
  4.    Author: Bill Menees
  5.            bmenees@usit.net
  6.                    www.public.usit.net/bmenees
  7.    Modified by Russell Peters, Jan 2003
  8.     - Stop comparison exceptions (Versions 6+)
  9.    Modified by Eric W. Engler, Feb 1997
  10.     - fixed a bug in autodetection of type
  11.     - OnBeginSort event was called before the autodetect of type; moved to after.
  12.     - expanded date sort to incl datetime (these are usu compatible in Delphi)
  13.     - added a time sort
  14.    Modified by Ivo Eichler <eichler@sce.cz>, Jan 1999
  15.     - now supports the national string setting in the control panel by
  16.       using ANSICompare and ANSIUppercase functions.
  17.    Modified by Chris Vleghert Jan. 19 1999.
  18.     - Fixed a memory leak in the procedure TSortedList.Reset;
  19.    Modified by Andrea Gnesutta Mar. 8 1999.  (gnes@zero.it)
  20.     - Added property LastSortDirection (ReadOnly)
  21.     - Added property SortState (ReadOnly)
  22.     - Added property LastSortedCol (ReadOnly)
  23.    Modified by Chris Vleghert Mar. 10 1999. (RCV02)
  24.     - Changed property LastSortDirection into SortDirection (R/W)
  25.     - Changed property LastSortedCol into SortColumn (R/W)
  26.     - Changed property ClickSorting into SortOnClick
  27.     - Added property SortSymbol
  28.     - Added property SortSpacingHor
  29.     - Added property SortSpacingVert
  30.     - Added property SortBitMapA
  31.     - Added property SortBitMapD
  32.     - Added property SortFooter
  33.     - Added property FooterRows
  34.     - Added property FooterColor
  35.     - Added property FooterFont
  36.     - Added property FooterBevelStyle
  37.     - Added function InsertRows
  38.     - Added function InsertCols
  39.     - Added function ClearRows
  40.     - Added function ClearFrom
  41.     - Added function RemoveRows
  42.     - Added function RemoveCols
  43.     - Added function ClearCols
  44.     - Added function FindFirst
  45.     - Added function FindNext
  46.     - Added event OnMouseEnter
  47.     - Added event OnMouseLeave
  48.    Modified by Chris Vleghert Jan. 1 2000. (RCV03)
  49.    (integrated MultiGrd http://www.pablop.demon.co.uk/marley/tmultigrid.htm into SortGrid)
  50.     - Added extended multiselect
  51.     - Added property Selected[RowNumber], do not use the Selection property anymore!
  52.     - Added property SelectedCount
  53.     - Added property SelectedItems[1 to SelectedCount];
  54.     - Added function ClearSelection
  55.    Modified by Chris Vleghert May. 11 2000. (RCV04)
  56.     - Added method ShowRows( StartRow, EndRow: LongInt )
  57.     - Added method HideRows( StartRow, EndRow: LongInt )
  58.     - Added method AutoSizeRow( aRow: LongInt )
  59.     - Added method AutoSizeRows( StartRow, EndRow: LongInt )
  60.     - Added method AutoSizeVisibleRows( StartRow, EndRow: LongInt )
  61.     - Added method AutoSizeHiddenRows( StartRow, EndRow: LongInt )
  62.     - Added method HideCols( StartCol, EndCol: LongInt )
  63.     - Added method ShowCols( StartCol, EndCol: LongInt )
  64.     - Added method Print            only D4+ and BCB4+
  65.     - Added method PrintPreview     only D4+ and BCB4+
  66.     - Added method PageCount        only D4+ and BCB4+
  67.     - Added method UpdatePreview( aCanvas: TCanvas )         only D4+ and BCB4+
  68.     - Added property PrintOptions   only D4+ and BCB4+
  69.     - Added property WordWrap
  70.    Modified by Chris Vleghert Jul. 28 2000, Bug report: Florian Schick
  71.     - FindFirst and FindNext did not do what they were supposed to be doing.
  72.  
  73.  
  74.    IMPORTANT!  Do NOT use BCB's or Delphi's "Break on Exception" option if
  75.    you run a program that uses this component from the GUI.  This VCL uses
  76.    exceptions during normal processing.
  77. ***************************************************************************}
  78. (************************************************************************
  79.  Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  80.       Eric W. Engler and Chris Vleghert.
  81.  
  82.    This file is part of TZipMaster Version 1.9.
  83.  
  84.     TZipMaster is free software: you can redistribute it and/or modify
  85.     it under the terms of the GNU Lesser General Public License as published by
  86.     the Free Software Foundation, either version 3 of the License, or
  87.     (at your option) any later version.
  88.  
  89.     TZipMaster is distributed in the hope that it will be useful,
  90.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  91.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  92.     GNU Lesser General Public License for more details.
  93.  
  94.     You should have received a copy of the GNU Lesser General Public License
  95.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  96.  
  97.     contact: problems@delphizip.org (include ZipMaster in the subject).
  98.     updates: http://www.delphizip.org
  99.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  100. ************************************************************************)
  101.  
  102.  
  103. UNIT SortGrid;
  104.  
  105. {$INCLUDE '..\..\ZipVers19.inc'}
  106.  
  107. INTERFACE
  108.  
  109. uses
  110.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  111.   StdCtrls, Grids, Printers;
  112.  
  113. type
  114.   {TSortCompare must return < 0 if Str1 is less than Str2,
  115.    0 if they are equal, and > 0 if Str1 is greater than Str2.}
  116.   TSortCompare = function (const Str1, Str2: String): Integer;
  117.  
  118.   TSortDirection = ( sdAscending, sdDescending );
  119.   TSortStyle     = ( ssAutomatic, ssAlphabetic, ssNumeric, ssDateTime, ssTime,ssCustom );
  120.   TSortSymbol    = ( sgNone, sgArrow, sgGlyph, sgCustom );
  121.   TSortState     = ( ssUnsorted, ssSorted );  // Line modified/added by gnes@zero.it
  122.   TAutoSize      = ( asAll, asVisible, asHidden );
  123.   TPrintMode     = ( pmPrint, pmPreview, pmPageCount );
  124.  
  125.   {**************************************************************}
  126.   {*** NOTE: These are the options you can set to affect sorting.}
  127.   TSortOptions = record
  128.     SortStyle:         TSortStyle;
  129.     SortDirection:     TSortDirection;
  130.     SortCaseSensitive: Boolean;
  131.     SortCompare:       TSortCompare;  //Used only if SortStyle = ssCustom.
  132.   end;
  133.  
  134.   TSortedListEntry = record
  135.     Str:    String;
  136.     RowNum: LongInt;
  137.   end;
  138.   pSortedListEntry = ^TSortedListEntry;
  139.  
  140.   TSortedList = class( TList )
  141.   public
  142.     function GetItem( const i: Integer ): pSortedListEntry;
  143.     procedure Reset;
  144.   end;
  145.  
  146.   TOldRowColEntry = record
  147.     IsRowCol:    Integer;
  148.           RowColNum:   LongInt;
  149.     RowColValue: Integer;
  150.   end;
  151.   pOldRowColEntry = ^TOldRowColEntry;
  152.  
  153.   TOldRowColValueList = class( TList )
  154.   public
  155.      procedure SetValue( const rc: LongInt; Const rcValue, IsRC: Integer );
  156.      function  GetValue( const rc: LongInt; Const IsRC: Integer ): Integer;
  157.      procedure RemRC( Const rc: LongInt; Const IsRC: Integer );
  158.      procedure MoveUp( Const rc: LongInt; Const IsRC: Integer );
  159.      procedure MoveDown( Const rc: LongInt; Const IsRC: Integer );
  160.      procedure Reset;
  161.   end;
  162.  
  163.   TCellBevelStyle = ( cbNone, cbRaised, cbLowered );
  164.   {**********************************************************}
  165.   {*** NOTE: This is one of the structures in TFormatOptions.}
  166.   TCellBevel = record
  167.     Style:           TCellBevelStyle;
  168.     UpperLeftColor:  TColor;
  169.     LowerRightColor: TColor;
  170.   end;
  171.   TVertAlignment = ( taTopJustify, taBottomJustify, taMiddle );
  172.  
  173.   {**************************************************}
  174.   {*** NOTE: These are the display options you can set
  175.              for each cell in OnGetCellFormat.}
  176.   TFormatOptions = record
  177.     Brush:         TBrush;
  178.     Font:          TFont;
  179.     AlignmentHorz: TAlignment;
  180.     AlignmentVert: TVertAlignment;
  181.     Bevel:         TCellBevel;
  182.     HideText:      Boolean;
  183.   end;
  184.  
  185.   TPrintOptions = class( TPersistent )
  186.     private
  187.       fJobTitle:        String;
  188.       fPageTitle:       String;
  189.       fPageTitleMargin: Cardinal;
  190.       fCopies:          Cardinal;
  191.       fPreviewPage:     Cardinal;
  192.       fFromRow:         Cardinal;
  193.       fToRow:           Cardinal;
  194.             fBorderStyle:     TBorderStyle;
  195.       fLeftPadding:     Cardinal;
  196.       fMarginBottom:    Cardinal;
  197.       fMarginLeft:      Cardinal;
  198.       fMarginTop:       Cardinal;
  199.       fMarginRight:     Cardinal;
  200.       fPageFooter:      String;
  201.       fDateFormat:      String;
  202.       fTimeFormat:      String;
  203.       fHeaderSize:      Cardinal;
  204.       fFooterSize:      Cardinal;
  205.       fOrientation:     TPrinterOrientation;
  206.       fLogo:            String;
  207.  
  208.       procedure SetMarginBottom( Const Value: Cardinal );
  209.       procedure SetMarginLeft( Const Value: Cardinal );
  210.       procedure SetMarginTop( Const Value: Cardinal );
  211.       procedure SetMarginRight( Const Value: Cardinal );
  212.       procedure SetPageFooter( Const Value: String );
  213.       procedure SetDateFormat( Const Value: String );
  214.       procedure SetTimeFormat( Const Value: String );
  215.       procedure SetFooterSize( Const Value: Cardinal);
  216.       procedure SetHeaderSize( Const Value: Cardinal );
  217.             procedure SetOrientation( Const Value: TPrinterOrientation );
  218.       procedure SetLogo( Const Value: String );
  219.  
  220.     public
  221.       constructor Create;
  222.  
  223.     published
  224.       property Orientation: TPrinterOrientation read fOrientation write SetOrientation;
  225.       property JobTitle: String read fJobTitle write fJobTitle;
  226.       property PageTitle: String read fPageTitle write fPageTitle;
  227.       property Logo: String read fLogo write SetLogo;
  228.       property PageTitleMargin: Cardinal read fpageTitleMargin write fpageTitleMargin;
  229.       property PageFooter: String read fPageFooter write SetPageFooter;
  230.       property HeaderSize: Cardinal read fHeaderSize write SetHeaderSize;
  231.       property FooterSize: Cardinal read fFooterSize write SetFooterSize;
  232.       property DateFormat: String read fDateFormat write SetDateFormat;
  233.       property TimeFormat: String read fTimeFormat write SetTimeFormat;
  234.       property Copies: Cardinal read fCopies write fCopies default 1;
  235.       property FromRow: Cardinal read fFromRow write fFromRow;
  236.       property ToRow: Cardinal read fToRow write fToRow;
  237.       property PreviewPage: Cardinal read fPreviewPage write fPreviewPage default 1;
  238.       property BorderStyle: TBorderstyle read fBorderStyle write fBorderStyle;
  239.       property Leftpadding: Cardinal read fLeftpadding write fLeftPadding default 2;
  240.             property MarginBottom: Cardinal read fMarginBottom write SetMarginBottom;
  241.       property MarginLeft: Cardinal read fMarginLeft write SetMarginLeft;
  242.       property MarginTop: Cardinal read fMarginTop write SetMarginTop;
  243.       property MarginRight: Cardinal read fMarginRight write SetMarginRight;
  244.   end;
  245.  
  246.   {These are the new events defined for TSortGrid.}
  247.   TFormatDrawCellEvent = procedure( Sender: TObject; Col, Row: LongInt; State: TGridDrawState;
  248.                                     var FormatOptions: TFormatOptions ) of object;
  249.   TClickSortEvent      = procedure( Sender: TObject; Col, Row: LongInt; var SortOptions: TSortOptions ) of object;
  250.   TUpdateGridEvent     = procedure( Sender: TObject; Index: LongInt ) of object;
  251.   TSizeChangedEvent    = procedure( Sender: TObject; OldColCount, OldRowCount: LongInt ) of object;
  252.   TBeginSortEvent      = procedure( Sender: TObject; Col: LongInt; var SortOptions: TSortOptions ) of object;
  253.   TEndSortEvent        = procedure( Sender: TObject; Col: LongInt ) of object;
  254.   TCellValidateEvent   = procedure( Sender: TObject; Col, Row: LongInt; var Value: String;
  255.                                     var Valid: Boolean ) of object;
  256.  
  257.   {Here's the main new class: TSortGrid}
  258.   TSortGrid = class( TStringGrid )
  259.   private
  260.     { Private declarations }
  261.     fSortedList:             TSortedList;
  262.     fAlignmentHorz:          TAlignment;
  263.           fAlignmentVert:          TVertAlignment;
  264.     fBevelStyle:             TCellBevelStyle;
  265.     fSortState:              TSortState;               // Line modified/added by gnes@zero.it
  266.     fSortDirection:          TSortDirection;
  267.     fProportionalScrollBars: Boolean;
  268.     fCaseSensitive:          Boolean;
  269.     fExtendedKeys:           Boolean;
  270.     fSorting:                Boolean;
  271.     fModified:               Boolean;
  272.     fOldModifiedValue:       Boolean;
  273.     fEntered:                Boolean;
  274.     fSortOnClick:            Boolean;
  275.     fSortFooter:             Boolean;
  276.     fOldCellText:            String;
  277.     fOldCol, fOldRow:        LongInt;
  278.     fSortSymbol:             TSortSymbol;
  279.     fSortSpacingHor:         Integer;
  280.     fSortSpacingVert:        Integer;
  281.     fSortColumn:             Integer; // Line modified/added by gnes@zero.it
  282.     fFooterRows:             Integer;
  283.     gFooterSub:              Integer;
  284.     fSortBMA:                TBitmap;
  285.     fSortBMD:                TBitmap;
  286.           fFooterColor:            TColor;
  287.     fFooterFont:             TFont;
  288.     fFooterBevelStyle:       TCellBevelStyle;
  289.  
  290.     fSelectedRows:           TList;
  291.     fAnchor:                 LongInt;
  292.     fLastMoveOn:             LongInt;
  293.     fLastTopRow:             LongInt;
  294.     fMouseIsDown:            Boolean;
  295.  
  296.     fOldRowCol:              TOldRowColValueList;
  297.     fWordWrap:               Boolean;
  298.     fPrintOptions:           TPrintOptions;
  299.     fPageCount:              Cardinal;
  300.     fPrintImage:             TBitmap;
  301.     fOldFont:                TFont;
  302.     fOldBrush:               TBrush;
  303.  
  304.     fOnGetCellFormat:        TFormatDrawCellEvent;
  305.     fOnClickSort:            TClickSortEvent;
  306.     fOnRowInsert:            TUpdateGridEvent;
  307.           fOnRowDelete:            TUpdateGridEvent;
  308.     fOnColumnInsert:         TUpdateGridEvent;
  309.     fOnColumnDelete:         TUpdateGridEvent;
  310.     fOnColumnWidthsChanged:  TNotifyEvent;
  311.     fOnRowHeightsChanged:    TNotifyEvent;
  312.     fOnSizeChanged:          TSizeChangedEvent;
  313.     fOnBeginSort:            TBeginSortEvent;
  314.     fOnEndSort:              TEndSortEvent;
  315.     fOnCellValidate:         TCellValidateEvent;
  316.     fOnMouseEnter:           TNotifyEvent;
  317.     fOnMouseLeave:           TNotifyEvent;
  318.  
  319.     GSortBM:     TBitmap;
  320.     GASE:        Boolean;
  321.     GFindString: String;
  322.     GStartRow, GEndRow, GStartCol, GEndCol: LongInt;
  323.  
  324.     procedure SetSortBMA( Value: TBitmap );
  325.     procedure SetSortBMD( Value: TBitmap );
  326.     procedure SetSortSymbol( Value: TSortSymbol );
  327.     procedure SetBevelStyle( Value: TCellBevelStyle );
  328.     procedure SetSortColumn( Value: Integer );
  329.     procedure SetSortOnClick( Value: Boolean );
  330.           procedure SetSortFooter( Value: Boolean );
  331.     procedure SetAlignmentHorz( Value: TAlignment );
  332.     procedure SetAlignmentVert( Value: TVertAlignment );
  333.     procedure SetSortDirection( Value: TSortDirection );
  334.     procedure SetSortSpacingHor( Value: Integer );
  335.     procedure SetSortSpacingVert( Value: Integer );
  336.     procedure SetProportionalScrollBars( Value: Boolean );
  337.     procedure SetFooterRows( Value: Integer );
  338.     procedure SetFooterColor( Value: TColor );
  339.     procedure SetFooterFont( Value: TFont );
  340.     procedure SetFooterBevelStyle( Value: TCellBevelStyle );
  341.     function  GetSelected( Row: LongInt ): Boolean;
  342.     procedure SetSelected( Row: LongInt; Select: Boolean );
  343.     function  GetSelectedCount: LongInt;
  344.     function  GetSelItems( Index: LongInt ): LongInt;
  345.     procedure SetWordWrap( const Value: Boolean );
  346.  
  347.     procedure SetGSortSymbol;
  348.     function  CheckRange( startcr, endcr: Integer; IsRow: Boolean): Boolean;
  349.     procedure SetResetASE( SetASE: Boolean );
  350.     procedure ToggleRow( aRow: LongInt );
  351.     procedure SelectRow( aRow: LongInt; Select: Boolean );
  352.     procedure SelectRows( aRow, bRow : LongInt; Select: Boolean );
  353.         procedure InvalidateRow( aRow : LongInt );
  354.     procedure AutoSizeRowsInt( StartRow, EndRow: LongInt; How: TAutoSize );
  355.     procedure ShowRC( StartRC, EndRC: LongInt; IsRC: Integer );
  356.     procedure HideRC( StartRC, EndRC: LongInt; IsRC: Integer );
  357.     procedure DrawToCanvas( aCanvas: TCanvas; Mode: TPrintMode; FromRow, ToRow: Integer );
  358.     procedure WMSize( var Msg: TWMSize); message WM_SIZE;
  359.     procedure CMMouseEnter( var Message ); message CM_MOUSEENTER;
  360.     procedure CMMouseLeave( var Message ); message CM_MOUSELEAVE;
  361.  
  362.   protected
  363.     { Protected declarations }
  364.     procedure ListQuickSort( const aCol: LongInt; const SortOptions: TSortOptions ); virtual;
  365.     function  DetermineSortStyle( const aCol: LongInt ): TSortStyle; virtual;
  366.     procedure InitializeFormatOptions( const aCol, aRow: LongInt; var FmtOpts: TFormatOptions );
  367.     procedure DrawCell( aCol, aRow: LongInt; aRect: TRect; aState: TGridDrawState ); override;
  368.     procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;
  369.     procedure ColWidthsChanged; override;
  370.     procedure RowHeightsChanged; override;
  371.     procedure SizeChanged( OldColCount, OldRowCount: LongInt ); override;
  372.     procedure UpdateScrollPage; virtual;
  373.     procedure KeyDown( var Key: Word; Shift: TShiftState ); override;
  374.           procedure SetEditText( aCol, aRow: LongInt; const Value: string ); override;
  375.     procedure Click; override;
  376.     procedure DoEnter; override;
  377.     procedure DoExit; override;
  378.     procedure InitValidate; virtual;
  379.     procedure KeyPress( var Key: Char ); override;
  380.     procedure DrawSortSymbol( x, y: Integer );
  381.     procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );override;
  382.     procedure MouseMove( Shift: TShiftState; X, Y: Integer );override;
  383.     procedure TopLeftChanged; override;
  384.  
  385.   public
  386.     GSortBMWidth: Integer;
  387.     GSortBMHeight: Integer;
  388.     { Public declarations }
  389.     { run time properties }
  390.  
  391.     property  Sorting: Boolean read fSorting default False;
  392.     property  Modified: Boolean read fModified write fModified default False;
  393.     property  SortState: TSortState read fSortState;                       // Line modified/added by gnes@zero.it
  394.     property  Selected[ Row: LongInt ]: Boolean read GetSelected write SetSelected;
  395.     property  SelectedCount: LongInt read GetSelectedCount;
  396.     property  SelectedItems[ Index: LongInt ]: LongInt read GetSelItems;
  397.  
  398.     constructor Create( AOwner: TComponent ); override;
  399.     destructor  Destroy; override;
  400.  
  401.     procedure MoveTo( aCol, aRow: LongInt ); virtual;
  402.     function  Clear: Boolean; virtual;
  403.     function  ClearFrom( FromRow: LongInt ): Boolean; virtual;
  404.     procedure InsertRow( aRow: LongInt ); virtual;
  405.     procedure InsertColumn( aCol: LongInt ); virtual;
  406.     procedure DeleteRow( aRow: LongInt ); reintroduce; virtual;
  407.     procedure DeleteColumn( aCol: LongInt ); reintroduce; virtual;
  408.     procedure MoveRow( FromIndex, ToIndex: LongInt ); virtual;
  409.     procedure MoveColumn( FromIndex, ToIndex: LongInt ); virtual;
  410.     procedure SwapRows( aRow1, aRow2: LongInt ); virtual;
  411.     procedure SwapColumns( aCol1, aCol2: LongInt ); virtual;
  412.     procedure AutoSizeCol( const aCol: LongInt ); virtual;
  413.     procedure AutoSizeColumns( const DoFixedCols: Boolean; const Padding: Integer ); virtual;
  414.     procedure SortByColumn( const aCol: LongInt; SortOptions: TSortOptions ); virtual;
  415.     function  IsCell( const Value: String; var aCol, aRow: LongInt ): Boolean; virtual;
  416.     procedure LoadFromFile( const FileName: String; const Delimiter: Char ); virtual;
  417.     procedure SaveToFile( const FileName: String; const Delimiter: Char ); virtual;
  418.     function  CanUndoSort: Boolean; virtual;
  419.     procedure UndoSort; virtual;
  420.         function  GetCellDrawState( const aCol, aRow: LongInt ): TGridDrawState;
  421.     function  SelectCell( aCol, aRow: LongInt ): Boolean; override;
  422.     procedure ValidateCell; virtual;
  423.     function  InsertRows( aRow, rCount: Integer ): Boolean; virtual;
  424.     function  InsertCols( aCol, cCount: Integer ): Boolean; virtual;
  425.     function  ClearRows( sRow, eRow: Integer ): Boolean; virtual;
  426.     function  RemoveRows( sRow, eRow: Integer ): Boolean; virtual;
  427.     function  RemoveCols( sCol, eCol: Integer ): Boolean; virtual;
  428.     function  ClearCols( sCol, eCol: Integer ): Boolean; virtual;
  429.     function  FindFirst( const aStr: String; var sCol, sRow: LongInt; eCol, eRow: LongInt ): Boolean; virtual;
  430.     function  FindNext( var aCol, aRow: LongInt ): Boolean; virtual;
  431.     procedure ClearSelection;
  432.     procedure ShowRows( StartRow, EndRow: LongInt ); virtual;
  433.     procedure HideRows( StartRow, EndRow: LongInt ); virtual;
  434.     procedure ShowCols( StartCol, EndCol: LongInt ); virtual;
  435.     procedure HideCols( StartCol, EndCol: LongInt ); virtual;
  436.     procedure AutoSizeRow( aRow: LongInt ); virtual;
  437.     procedure AutoSizeRows( StartRow, EndRow: LongInt ); virtual;
  438.     procedure AutoSizeVisibleRows( StartRow, EndRow: LongInt ); virtual;
  439.     procedure AutoSizeHiddenRows( StartRow, EndRow: LongInt ); virtual;
  440. //    {$IfDef VERD4+}
  441.     procedure Print;
  442.     procedure PrintPreview;
  443.         procedure UpdatePreview( aCanvas: TCanvas );
  444.     function  PageCount: Integer;
  445.     procedure SmoothResize( var Src, Dst: TBitmap );
  446. //    {$EndIf}
  447.  
  448.   published
  449.     { Published declarations }
  450.     property CaseSensitive: Boolean read fCaseSensitive write fCaseSensitive;
  451.     property AlignmentHorz: TAlignment read fAlignmentHorz write SetAlignmentHorz;
  452.     property AlignmentVert: TVertAlignment read fAlignmentVert write SetAlignmentVert;
  453.     property BevelStyle: TCellBevelStyle read fBevelStyle write SetBevelStyle default cbNone;
  454.     property ProportionalScrollBars: Boolean read fProportionalScrollBars write SetProportionalScrollBars;
  455.     property ExtendedKeys: Boolean read fExtendedKeys write fExtendedKeys;
  456.     property SortSymbol: TSortSymbol read FSortSymbol write SetSortSymbol default sgNone;
  457.     property SortSpacingHor: Integer read FSortSpacingHor write SetSortSpacingHor default 2;
  458.     property SortSpacingVert: Integer read FSortSpacingVert write SetSortSpacingVert default 0;
  459.     property SortDirection: TSortDirection read FSortDirection write SetSortDirection default sdAscending;
  460.     property SortBitMapA: TBitmap read FSortBMA write SetSortBMA nodefault;
  461.     property SortBitMapD: TBitmap read FSortBMD write SetSortBMD nodefault;
  462.     property SortColumn: Integer read FSortColumn write SetSortColumn default 1;
  463.     property SortOnClick: Boolean read FSortOnClick write SetSortOnClick default False;
  464.     property SortFooter: Boolean read FSortFooter write SetSortFooter default False;
  465.     property FooterRows: Integer read FFooterRows write SetFooterRows default 0;
  466.         property FooterColor: TColor read FFooterColor write SetFooterColor default clAqua;
  467.     property FooterFont: TFont read FFooterFont write SetFooterFont;
  468.     property FooterBevelStyle: TCellBevelStyle read fFooterBevelStyle write SetFooterBevelStyle default cbNone;
  469. //    {$IfDef VERD4+}
  470.     property PrintOptions: TPrintOptions read fPrintOptions write fPrintOptions;
  471. //    {$EndIf}
  472.     property WordWrap: Boolean read fWordWrap write SetWordWrap;
  473.  
  474.     { Published events }
  475.     property OnGetCellFormat: TFormatDrawCellEvent read fOnGetCellFormat write fOnGetCellFormat;
  476.     property OnClickSort: TClickSortEvent read fOnClickSort write fOnClickSort;
  477.     property OnRowInsert: TUpdateGridEvent read fOnRowInsert write fOnRowInsert;
  478.     property OnRowDelete: TUpdateGridEvent read fOnRowDelete write fOnRowDelete;
  479.     property OnColumnInsert: TUpdateGridEvent read fOnColumnInsert write fOnColumnInsert;
  480.     property OnColumnDelete: TUpdateGridEvent read fOnColumnDelete write fOnColumnDelete;
  481.     property OnColumnWidthsChanged: TNotifyEvent read fOnColumnWidthsChanged write fOnColumnWidthsChanged;
  482.     property OnRowHeightsChanged: TNotifyEvent read fOnRowHeightsChanged write fOnRowHeightsChanged;
  483.     property OnSizeChanged: TSizeChangedEvent read fOnSizeChanged write fOnSizeChanged;
  484.     property OnBeginSort: TBeginSortEvent read fOnBeginSort write fOnBeginSort;
  485.     property OnEndSort: TEndSortEvent read fOnEndSort write fOnEndSort;
  486.     property OnCellValidate: TCellValidateEvent read fOnCellValidate write fOnCellValidate;
  487.     property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
  488.     property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
  489.   end;
  490.  
  491. //procedure Register;
  492.  
  493. function StringCompare( const Str1, Str2: String ): Integer;
  494. function DateTimeCompare( const Str1, Str2: String ): Integer;
  495. function NumericCompare( const Str1, Str2: String ): Integer;
  496. function TimeCompare( const Str1, Str2: String ): Integer;  
  497. {$IFDEF VERDPre6}
  498. // version 5 or less
  499. function TryStrToFloat(s: string; var v: extended): boolean;
  500. function TryStrToInt(s: string; var v: integer): boolean;
  501. function TryStrToTime(s: string; var v: TDateTime): boolean;
  502. function TryStrToDateTime(s: string; var v: TDateTime): boolean;
  503. {$endif}
  504.  
  505. IMPLEMENTATION
  506.  
  507. uses SortGridPreview;
  508.  
  509. {$R SortGrid.Res}
  510. {$R DefaultSort.Res}
  511.  
  512. var
  513.    //This is here for Compare.  I can't pass it as a parameter,
  514.    //and I can't make Compare a method.  So I had to use a global. :-(
  515.    GlobalSortOptions: TSortOptions;
  516. {$IFDEF VERDPre6}
  517. // version 5 or less                    
  518. // IF YOU GET AN EXCEPTION HERE WHEN RUNNING FROM THE IDE,
  519. // THEN YOU NEED TO TURN OFF "Break on Exception"
  520. function TryStrToFloat(s: string; var v: extended): boolean;
  521. begin                
  522.   if (s = '') or not (s[1] in ['0'..'9']) then
  523.     Result := False
  524.   else
  525.   begin
  526.     Result:= true;
  527.     try
  528.       v := StrToFloat(s);
  529.     except
  530.       on EConvertError do
  531.         Result := false;
  532.     end;
  533.   end;
  534. end;
  535. function TryStrToInt(s: string; var v: integer): boolean;
  536. begin          
  537.   if (s = '') or not (s[1] in ['0'..'9','$']) then
  538.     Result := False
  539.   else
  540.   begin
  541.     Result:= true;
  542.     try
  543.       v := StrToInt(s);
  544.     except
  545.       on EConvertError do
  546.         Result := false;
  547.     end;
  548.   end;
  549. end;
  550. function TryStrToTime(s: string; var v: TDateTime): boolean;
  551. begin
  552.   if (s = '') or not (s[1] in ['0'..'9']) then
  553.     Result := False
  554.   else
  555.   begin
  556.     Result:= true;
  557.     try
  558.       v := StrToTime(s);
  559.     except
  560.       on EConvertError do
  561.         Result := false;
  562.     end;
  563.   end;
  564. end;
  565. function TryStrToDateTime(s: string; var v: TDateTime): boolean;
  566. begin            
  567.   if (s = '') or not (s[1] in ['0'..'9']) then
  568.     Result := False
  569.   else
  570.   begin
  571.     Result:= true;
  572.     try
  573.       v := StrToDateTime(s);
  574.     except
  575.       on EConvertError do
  576.         Result := false;
  577.     end;
  578.   end;
  579. end;
  580. {$endif}
  581.  
  582. {******************************************************************************}
  583. {** Miscellaneous Non-Member Functions                                       **}
  584. {******************************************************************************}
  585. procedure TokenizeGridString( const S: String; const Delimiter: Char; Tokens: TStringList );
  586. var
  587.    i, Len:   Integer;
  588.    CurToken: String;
  589. begin
  590.    Tokens.Clear;
  591.    CurToken := '';
  592.    Len:=Length( S );
  593.    for i := 1 to Len do
  594.    begin
  595.       if S[i] = Delimiter then
  596.       begin
  597.            Tokens.Add( CurToken );
  598.            CurToken := '';
  599.       end
  600.       else
  601.           CurToken := CurToken + S[i];
  602.    end;
  603.    Tokens.Add( CurToken );
  604. end;
  605.  
  606. function StringCompare( const Str1, Str2: String ): Integer;
  607. var
  608.    c: Integer;
  609. begin
  610.    c := AnsiCompareStr( str1, str2 );
  611.    if c < 0 then Result := -1
  612.    else if c > 0 then Result := 1
  613.    else Result := 0;
  614. end;
  615.  
  616. function DateTimeCompare( const Str1, Str2: String ): Integer;
  617. var
  618.    Val1, Val2: TDateTime;
  619. begin
  620.         Result := 0;
  621.    try
  622.         if not (TryStrToDateTime( Str1 , Val1 ) and TryStrToDateTime( Str2 , Val2 )) then
  623.                 exit;
  624.  {        Val1 := StrToDateTime( Str1 );
  625.           Val2 := StrToDateTime( Str2 );  }
  626.       if Val1 < Val2 then Result := -1
  627.       else if Val2 < Val1 then Result := 1
  628.       else Result := 0;
  629.    except
  630.       on EConvertError do Result := 0;
  631.    end;
  632. end;
  633.  
  634. function TimeCompare( const Str1, Str2: String ): Integer;
  635. var
  636.    Val1, Val2: TDateTime;
  637. begin
  638.         Result := 0;
  639.    try                      
  640.         if not (TryStrToTime( Str1 , Val1 ) and TryStrToTime( Str2 , Val2 )) then
  641.                 exit;
  642. {      Val1:=StrToTime( Str1 );
  643.           Val2:=StrToTime( Str2 ); }
  644.       if Val1 < Val2 then Result := -1
  645.       else if Val2 < Val1 then Result := 1
  646.       else Result := 0;
  647.    except
  648.       on EConvertError do Result := 0;
  649.    end;
  650. end;
  651.  
  652. function NumericCompare( const Str1, Str2: String ): Integer;
  653. var
  654.    Val1, Val2: Extended;
  655. begin  
  656.         Result := 0;
  657.    try                  
  658.         if not (TryStrToFloat( Str1 , Val1 ) and TryStrToFloat( Str2 , Val2 )) then
  659.                 exit;
  660. {      Val1 := StrToFloat( Str1 );
  661.           Val2 := StrToFloat( Str2 ); }
  662.       if Val1 < Val2 then Result := -1
  663.       else if Val2 < Val1 then Result := 1
  664.       else Result := 0;
  665.    except
  666.       on EConvertError do Result := 0;
  667.    end;
  668. end;
  669.  
  670. //This looks at the global variable GlobalSortOptions.
  671. //I hated to use a global, but I can't pass any additional
  672. //parameters to Compare, and I can't make Compare a
  673. //method of an object.  A global seemed the only choice.
  674. function Compare( Item1, Item2: Pointer ): Integer;
  675. var
  676.    Entry1, Entry2: pSortedListEntry;
  677. begin
  678.    Entry1 := Item1;
  679.    Entry2 := Item2;
  680.  
  681.    //Handle Case-Insensitivity.
  682.    if NOT GlobalSortOptions.SortCaseSensitive then
  683.    begin
  684.       Entry1^.Str := ANSIUppercase( Entry1^.Str );
  685.       Entry2^.Str := ANSIUppercase( Entry2^.Str );
  686.    end;
  687.  
  688.    //Determine compare type and do the comparison.
  689.    case GlobalSortOptions.SortStyle of
  690.       ssNumeric:  Result := NumericCompare( Entry1^.Str, Entry2^.Str );
  691.       ssDateTime: Result := DateTimeCompare( Entry1^.Str, Entry2^.Str );
  692.       ssTime:     Result := TimeCompare( Entry1^.Str, Entry2^.Str );
  693.       ssCustom:   Result := GlobalSortOptions.SortCompare( Entry1^.Str, Entry2^.Str );
  694.       else        Result := StringCompare( Entry1^.Str, Entry2^.Str );
  695.    end;
  696.  
  697.    //Now, make sure we don't swap the rows if the Keys are equal.
  698.    //If they're equal then we sort by row number.
  699.    if Result = 0 then
  700.    begin
  701.       if Entry1^.RowNum < Entry2^.RowNum then Result := -1
  702.       else if Entry1^.RowNum > Entry2^.RowNum then Result := 1
  703.       else Result := 0; //Sometimes an item does get compared to itself.
  704.    end
  705.    else //Reverse polarity if descending sort.
  706.       if GlobalSortOptions.SortDirection = sdDescending then
  707.          Result := -1 * Result;
  708. end;
  709.  
  710. {******************************************************************************}
  711. {** Public Members for TSortedList                                           **}
  712. {******************************************************************************}
  713. function TSortedList.GetItem( const i: Integer ): pSortedListEntry;
  714. begin
  715.    //Cast the pointer.
  716.    Result := pSortedListEntry( Items[ i ] );
  717. end;
  718.  
  719. procedure TSortedList.Reset;
  720. var
  721.    i:     Integer;
  722.    Item: pSortedListEntry;
  723. begin
  724.    //Dispose of anything in the list first.
  725.    for i := 0 to Count - 1 do
  726.    begin
  727.           if Items[i] <> nil then
  728.       begin
  729.          Item      := Items[ i ];
  730.          Item^.Str := '';
  731.          Dispose( Items[ i ] );
  732.       end;
  733.    end;
  734.    // Now clear the list.
  735.    Clear();
  736. end;
  737.  
  738. {******************************************************************************}
  739. {** Public Members for TOldRowColValue                                       **}
  740. {******************************************************************************}
  741. procedure TOldRowColValueList.SetValue( const rc: LongInt; Const rcValue, IsRC: Integer );
  742. var
  743.    Item: pOldRowColEntry;
  744. begin
  745.    New( Item );
  746.    Item^.IsRowCol    := IsRC;
  747.    Item^.RowColNum   := rc;
  748.    Item^.RowColValue := rcValue;
  749.    Add( Item );
  750. end;
  751.  
  752. function TOldRowColValueList.GetValue( const rc: LongInt; Const IsRC: Integer ): Integer;
  753. var
  754.    i:     Integer;
  755.    Item: pOldRowColEntry;
  756. begin
  757.    Result := -1;
  758.    for i := 0 to Count - 1 do  // Find the row or column
  759.    begin
  760.       Item := Items[ i ];
  761.       if (Item^.IsRowCol = IsRC) and (Item^.RowColNum = rc) then
  762.       begin
  763.          Result := Item^.RowColValue;
  764.          Exit;
  765.       end;
  766.    end;
  767. end;
  768.  
  769. procedure TOldRowColValueList.RemRC( Const rc: LongInt; Const IsRC: Integer );
  770. var
  771.    i:     Integer;
  772.    Item: pOldRowColEntry;
  773. begin
  774.    for i := Count - 1 DownTo 0 do
  775.    begin
  776.       if Items[ i ] <> nil then
  777.       begin
  778.          Item := Items[ i ];
  779.          if (Item^.IsRowCol = IsRC) and (Item^.RowColNum = rc) then
  780.          begin
  781.             Dispose( Item );
  782.             Delete( i );
  783.             Exit;
  784.          end;
  785.       end;
  786.    end;
  787. end;
  788.  
  789. procedure TOldRowColValueList.MoveUp( Const rc: LongInt; Const IsRC: Integer );
  790. var
  791.    i:     Integer;
  792.    Item: pOldRowColEntry;
  793. begin
  794.    for i := 0 to Count - 1 do if Items[ i ] <> nil then
  795.    begin
  796.           Item := Items[ i ];
  797.       if (Item^.IsRowCol = IsRC) and (Item^.RowColNum >= rc) then
  798.          Inc( Item^.RowColNum );
  799.    end;
  800.  
  801. end;
  802.  
  803. procedure TOldRowColValueList.MoveDown( Const rc: LongInt; Const IsRC: Integer );
  804. var
  805.    i:     Integer;
  806.    Item: pOldRowColEntry;
  807. begin
  808.    for i := 0 to Count - 1 do if Items[ i ] <> nil then
  809.    begin
  810.       Item := Items[ i ];
  811.       if (Item^.IsRowCol = IsRC) and (Item^.RowColNum < rc) then
  812.          Dec( Item^.RowColNum );
  813.    end;
  814. end;
  815.  
  816. procedure TOldRowColValueList.Reset;
  817. var
  818.    i:     Integer;
  819.    Item: pOldRowColEntry;
  820. begin
  821.    for i := 0 to Count - 1 do   // Dispose of anything in the list first.
  822.    begin
  823.       if Items[ i ] <> nil then
  824.       begin
  825.          Item := Items[ i ];
  826.          Dispose( Item );
  827.       end;
  828.    end;
  829.    Clear();  // Now clear the list.
  830. end;
  831.  
  832. {******************************************************************************}
  833. {** Private Members for TSortGrid                                            **}
  834. {******************************************************************************}
  835. procedure TSortGrid.SetAlignmentHorz(Value: TAlignment);
  836. begin
  837.    fAlignmentHorz:=Value;
  838.    Invalidate;
  839. end;
  840.  
  841. procedure TSortGrid.SetAlignmentVert(Value: TVertAlignment);
  842. begin
  843.    fAlignmentVert:=Value;
  844.    Invalidate;
  845. end;
  846.  
  847. procedure TSortGrid.SetBevelStyle(Value: TCellBevelStyle);
  848. begin
  849.    fBevelStyle:=Value;
  850.    Invalidate;
  851. end;
  852.  
  853. procedure TSortGrid.WMSize(var Msg: TWMSize);
  854. begin
  855.    inherited;
  856.    UpdateScrollPage;
  857. end;
  858.  
  859. procedure TSortGrid.SetProportionalScrollBars( Value: Boolean );
  860. begin
  861.    fProportionalScrollBars := Value;
  862.    UpdateScrollPage;
  863. end;
  864.  
  865. procedure TSortGrid.SetSortBMA( Value: TBitmap );
  866. begin
  867.         if Value <> fSortBMA then
  868.    begin
  869.                 fSortBMA.Assign( Value );
  870.                 SetGSortSymbol();
  871.                 InvalidateRow( 0 );
  872.    end;
  873. end;
  874.  
  875. procedure TSortGrid.SetSortBMD( Value: TBitmap );
  876. begin
  877.         if Value <> fSortBMD then
  878.    begin
  879.                 fSortBMD.Assign( Value );
  880.                 SetGSortSymbol();
  881.                 InvalidateRow( 0 );
  882.         end;
  883. end;
  884.  
  885. procedure TSortGrid.SetSortOnClick( Value: Boolean );
  886. begin
  887.         if fSortOnClick <> Value then
  888.    begin
  889.                 fSortOnClick := Value;
  890.                 InvalidateRow( 0 );
  891.         end;
  892. end;
  893.  
  894. procedure TSortGrid.SetSortDirection( Value: TSortDirection );
  895. begin
  896.         if fSortDirection <> Value then
  897.    begin
  898.                 fSortDirection := Value;
  899.                 SetGSortSymbol();
  900.                 InvalidateRow( 0 );
  901.         end;
  902. end;
  903.  
  904. procedure TSortGrid.SetSortColumn( Value: Integer );
  905. begin
  906.         if (fSortColumn <> Value) and (Value >= 0) and (Value < ColCount) then
  907.    begin
  908.                 fSortColumn := Value;
  909.                 InvalidateRow( 0 );
  910.         end;
  911. end;
  912.  
  913. procedure TSortGrid.SetSortSpacingHor( Value: Integer );
  914. begin
  915.         if fSortSpacingHor <> Value then
  916.    begin
  917.                 fSortSpacingHor := Value;
  918.                 InvalidateRow( 0 );
  919.         end;
  920. end;
  921.  
  922. procedure TSortGrid.SetSortSpacingVert( Value: Integer );
  923. begin
  924.    if fSortSpacingVert <> Value then
  925.    begin
  926.                 fSortSpacingVert := Value;
  927.                 InvalidateRow( 0 );
  928.         end;
  929. end;
  930.  
  931. procedure TSortGrid.SetSortSymbol( Value: TSortSymbol );
  932. begin
  933.         if fSortSymbol <> Value then
  934.    begin
  935.                 fSortSymbol := Value;
  936.                 SetGSortSymbol();
  937.                 InvalidateRow( 0 );
  938.    end;
  939. end;
  940.  
  941. procedure TSortGrid.CMMouseEnter( var Message );
  942. begin
  943.    if Assigned( fOnMouseEnter ) then
  944.       fOnMouseEnter( Self );
  945. end;
  946.  
  947. procedure TSortGrid.CMMouseLeave( var Message );
  948. begin
  949.    if Assigned( fOnMouseLeave ) then
  950.       fOnMouseLeave( Self );
  951. end;
  952.  
  953. procedure TSortGrid.SetSortFooter( Value: Boolean );
  954. begin
  955.    if fSortFooter <> Value then
  956.       fSortFooter := Value;
  957.    if fSortFooter then
  958.       gFooterSub := 0
  959.    else
  960.       gFooterSub := fFooterRows;
  961. end;
  962.  
  963. procedure TSortGrid.SetFooterRows( Value: Integer );
  964. var
  965.    i, FootStart: Integer;
  966. begin
  967.    if (Value >= 0) and (Value <= RowCount - FixedRows) and (fFooterRows <> Value) then
  968.    begin
  969.       if Value > fFooterRows then
  970.          FootStart := Value
  971.       else
  972.          FootStart := fFooterRows;
  973.       for i := RowCount - 1 downto RowCount - FootStart do
  974.          InvalidateRow( i );
  975.       fFooterRows := Value;
  976.    end;
  977.    if NOT fSortFooter then
  978.       gFooterSub := fFooterRows;
  979. end;
  980.  
  981. procedure TSortGrid.SetFooterColor( Value: TColor );
  982. var
  983.    i: Integer;
  984. begin
  985.    if fFooterColor <> Value then
  986.    begin
  987.       fFooterColor := Value;
  988.       for i := RowCount - 1 downto RowCount - fFooterRows do
  989.          InvalidateRow( i );
  990.    end;
  991. end;
  992.  
  993. procedure TSortGrid.SetFooterFont( Value: TFont );
  994. var
  995.    i: Integer;
  996. begin
  997.    if fFooterFont <> Value then
  998.    begin
  999.       fFooterFont.Assign( Value );
  1000.       for i := RowCount - 1 downto RowCount - fFooterRows do
  1001.          InvalidateRow( i );
  1002.    end;
  1003. end;
  1004.  
  1005. procedure TSortGrid.SetFooterBevelStyle( Value: TCellBevelStyle );
  1006. var
  1007.    i: Integer;
  1008. begin
  1009.    if fFooterBevelStyle <> Value then
  1010.    begin
  1011.       fFooterBevelStyle := Value;
  1012.       for i := RowCount - 1 downto RowCount - fFooterRows do
  1013.          InvalidateRow( i );
  1014.    end;
  1015. end;
  1016.  
  1017. function TSortGrid.GetSelected( Row: LongInt ): Boolean;
  1018. begin
  1019.    Result := fSelectedRows.IndexOf( Pointer( Row ) ) > -1 ;
  1020. end;
  1021.  
  1022. procedure TSortGrid.SetSelected( Row: LongInt; Select: Boolean );
  1023. begin
  1024.    SelectRow( Row, Select );
  1025. end;
  1026.  
  1027. function TSortGrid.GetSelectedCount: LongInt;
  1028. begin
  1029.    Result := fSelectedRows.Count;
  1030. end;
  1031.  
  1032. function TSortGrid.GetSelItems( Index: LongInt ): LongInt;
  1033. begin
  1034.    Result := LongInt( fSelectedRows.Items[ Index - 1 ] );
  1035. end;
  1036.  
  1037. procedure TSortGrid.SetWordWrap( const Value: Boolean );
  1038. begin
  1039.    if Value <> fWordWrap then
  1040.    begin
  1041.       fWordWrap := Value;
  1042.       Invalidate;
  1043.    end;
  1044. end;
  1045.  
  1046. {******************************************************************************}
  1047. {** Private Members for TPrintOptions                                        **}
  1048. {******************************************************************************}
  1049. procedure TPrintOptions.SetDateFormat( Const Value: String );
  1050. begin
  1051.    fDateFormat := Value;
  1052. end;
  1053.  
  1054. procedure TPrintOptions.SetFooterSize( Const Value: Cardinal );
  1055. begin
  1056.    fFooterSize := Value;
  1057. end;
  1058.  
  1059. procedure TPrintOptions.SetHeaderSize( Const Value: Cardinal );
  1060. begin
  1061.    fHeaderSize := Value;
  1062. end;
  1063.  
  1064. procedure TPrintOptions.SetLogo( Const Value: String );
  1065. begin
  1066.    fLogo := Value;
  1067. end;
  1068.  
  1069. procedure TPrintOptions.SetMarginBottom( Const Value: Cardinal );
  1070. begin
  1071.    fMarginBottom := Value;
  1072. end;
  1073.  
  1074. procedure TPrintOptions.SetMarginLeft( Const Value: Cardinal );
  1075. begin
  1076.    fMarginLeft := Value;
  1077. end;
  1078.  
  1079. procedure TPrintOptions.SetMarginRight( Const Value: Cardinal );
  1080. begin
  1081.    fMarginRight := Value;
  1082. end;
  1083.  
  1084. procedure TPrintOptions.SetMarginTop( Const Value: Cardinal );
  1085. begin
  1086.    fMarginTop := Value;
  1087. end;
  1088.  
  1089. procedure TPrintOptions.SetOrientation( Const Value: TPrinterOrientation );
  1090. begin
  1091.    fOrientation := Value;
  1092. end;
  1093.  
  1094. procedure TPrintOptions.SetPageFooter( Const Value: String );
  1095. begin
  1096.    fPageFooter := Value;
  1097. end;
  1098.  
  1099. procedure TPrintOptions.SetTimeFormat( Const Value: String );
  1100. begin
  1101.    fTimeFormat := Value;
  1102. end;
  1103.  
  1104. {******************************************************************************}
  1105. {** Private Members for TSortGrid                                            **}
  1106. {******************************************************************************}
  1107. procedure TSortGrid.ToggleRow( aRow: LongInt );
  1108. var
  1109.   aCol:  Longint;
  1110.   Index: Integer;
  1111. begin
  1112.   Index := fSelectedRows.IndexOf( Pointer( aRow ) );
  1113.   if Index <> -1 then
  1114.      fSelectedRows.Delete( Index )
  1115.   else
  1116.      fSelectedRows.Add( Pointer( aRow ) );
  1117.   for aCol := FixedCols to Pred( ColCount ) do
  1118.         InvalidateCell( aCol, aRow );
  1119. end;
  1120.  
  1121. procedure TSortGrid.InvalidateRow( aRow: LongInt );
  1122. var
  1123.   aCol: LongInt;
  1124. begin
  1125.   for aCol := FixedCols to Pred( ColCount ) do
  1126.     InvalidateCell( aCol, aRow );
  1127. end;
  1128.  
  1129. procedure TSortGrid.SelectRow( aRow: LongInt; Select: Boolean );
  1130. var
  1131.   ListIndex: Integer;
  1132. begin
  1133.   ListIndex := fSelectedRows.IndexOf( Pointer( aRow ) );
  1134.   if ( ListIndex = -1 ) and (Select) then
  1135.      begin
  1136.         fSelectedRows.Add( Pointer( aRow ) );
  1137.         InvalidateRow( aRow );
  1138.      end
  1139.   else if ( ListIndex <> -1 ) and (NOT Select) then
  1140.      begin
  1141.                 fSelectedRows.Delete( ListIndex );
  1142.         InvalidateRow( aRow );
  1143.      end;
  1144. end;
  1145.  
  1146. procedure TSortGrid.SelectRows( aRow, bRow: LongInt; Select: Boolean );
  1147. var
  1148.   Index, StartRow, EndRow: LongInt;
  1149. begin
  1150.   if aRow > bRow then
  1151.      begin
  1152.         StartRow := bRow;
  1153.         EndRow   := aRow;
  1154.      end
  1155.   else
  1156.      begin
  1157.         StartRow := aRow;
  1158.         EndRow  :=  bRow;
  1159.      end;
  1160.   for Index := StartRow to EndRow do
  1161.      SelectRow( Index, Select );
  1162. end;
  1163.  
  1164.  
  1165. {******************************************************************************}
  1166. {** Protected Members for TSortGrid                                          **}
  1167. {******************************************************************************}
  1168. procedure TSortGrid.ListQuickSort( const aCol: LongInt; const SortOptions: TSortOptions );
  1169. var
  1170.    i:           Integer;
  1171.    Item:       pSortedListEntry;
  1172.    BufferGrid:  TStringGrid;
  1173. begin
  1174.    //Let everyone know we're sorting.
  1175.    fSorting := True;
  1176.    try
  1177.       //Get rid of any old entries in the sorted list.
  1178.       fSortedList.Reset;
  1179.  
  1180.       //Set the sort options for the list.
  1181.       //"Compare" can only look at GlobalSortOptions.
  1182.       GlobalSortOptions := SortOptions;
  1183.       SetSortDirection( SortOptions.SortDirection ); // Line modified/added by gnes@zero.it
  1184.       fSortColumn := aCol;
  1185.  
  1186.       //Insert the Row Number and Key (Str) into
  1187.           for i := FixedRows to RowCount - 1 - gFooterSub do
  1188.       begin
  1189.           New( Item );
  1190.           Item^.RowNum := i;
  1191.           Item^.Str    := Cells[aCol, i];
  1192.           fSortedList.Add( Item );
  1193.       end;
  1194.  
  1195.       //Quick Sort the list by key string.
  1196.       //Then the row numbers will indicate where
  1197.       //each row should be placed.
  1198.       //E.g. If list item 0 contains a RowNum of 4 then
  1199.       //row 4 should be the first row (position 0).
  1200.       fSortedList.Sort( Compare );
  1201.  
  1202.       BufferGrid := nil;
  1203.       try
  1204.          //Now rearrange the rows of the grid in sorted order.
  1205.          //This is a fast but space inefficient way to do it.
  1206.          //First, create a buffer grid and size it correctly.
  1207.          BufferGrid := TStringGrid.Create( Self );
  1208.  
  1209.          BufferGrid.ColCount := ColCount;
  1210.                  BufferGrid.RowCount := RowCount;
  1211.          //Copy the rows to the buffer grid in sorted order.
  1212.          for i := 0 to fSortedList.Count - 1 do
  1213.          begin
  1214.              Item := fSortedList.GetItem( i );
  1215.              BufferGrid.Rows[i + FixedRows].Assign( Rows[Item^.RowNum] );
  1216.          end;
  1217.          //Now put the rows back into the original grid.
  1218.          for i := FixedRows to RowCount - 1 - gFooterSub do
  1219.              Rows[i].Assign( BufferGrid.Rows[i] );
  1220.       finally
  1221.          BufferGrid.Free;
  1222.       end;
  1223.  
  1224.       //Now put the selection back on the right row.
  1225.       for i := 0 to fSortedList.Count - 1 do
  1226.       begin
  1227.          Item := fSortedList.GetItem( i );
  1228.          if Item^.RowNum = Row then
  1229.          begin
  1230.             MoveTo( Col, i + FixedRows );
  1231.             Break;
  1232.          end;
  1233.           end;
  1234.    finally
  1235.       //Make sure we get this turned off.
  1236.       fSorting   := False;
  1237.       fSortState := ssSorted;   // Now the grid is sorted // Line modified/added by gnes@zero.it
  1238.    end;
  1239. end;
  1240.  
  1241. //This function tries to determine the best sort style
  1242. //for a column.  If all the entries can be converted to
  1243. //numbers, a numeric sort is returned.  If they can all
  1244. //be converted to dates, a date sort is returned.  If time,
  1245. //then a time sort is returned,
  1246. //Otherwise, an alphabetic sort is returned.
  1247. function TSortGrid.DetermineSortStyle( const aCol: LongInt ): TSortStyle;
  1248. var
  1249.    i: Integer;
  1250.    DoNumeric, DoDateTime, DoTime: Boolean;
  1251.    F: extended;
  1252.    dt:TDateTime;
  1253.    s: string;
  1254. begin
  1255.    DoNumeric  := True;
  1256.    DoDateTime := True;
  1257.    DoTime     := True;
  1258.  
  1259.    //Note: We only go through the rows once.
  1260.    //This code depends on the fact that no
  1261.    //entry can be both a date and number.
  1262.    for i := FixedRows to RowCount - 1 - gFooterSub do
  1263.    begin
  1264.       if NOT DoNumeric and NOT doDateTime and NOT doTime then
  1265.                  Break; //speed things up a little.
  1266.           s := Cells[aCol, i];
  1267.           if DoNumeric then
  1268.                   DoNumeric := TryStrToFloat(s ,f);
  1269.  
  1270.           if DoTime then
  1271.                   DoTime := TryStrToTime( s , dt );
  1272.  
  1273.           if DoDateTime then
  1274.                   DoDateTime := TryStrToDateTime( s , dt );
  1275.    end;
  1276.  
  1277.    if DoNumeric then
  1278.       Result := ssNumeric
  1279.    else if DoDateTime then
  1280.       Result := ssDateTime
  1281.    else if DoTime then
  1282.       Result := ssTime
  1283.    else
  1284.       Result := ssAlphabetic;
  1285. end;
  1286.  
  1287. procedure TSortGrid.InitializeFormatOptions( const aCol, aRow: LongInt; var FmtOpts: TFormatOptions );
  1288. begin
  1289.    // Setup good defaults for FormatOptions.
  1290.    if aRow > RowCount - 1 - fFooterRows then
  1291.    begin
  1292.       Canvas.Font         := fFooterFont;
  1293.       Canvas.Brush.Color  := fFooterColor;
  1294.       FmtOpts.Bevel.Style := fFooterBevelStyle;
  1295.    end else
  1296.       FmtOpts.Bevel.Style := fBevelStyle;
  1297.  
  1298.    FmtOpts.HideText      := False;
  1299.    FmtOpts.Font          := Canvas.Font;
  1300.    FmtOpts.Brush         := Canvas.Brush;
  1301.    FmtOpts.AlignmentHorz := AlignmentHorz;
  1302.    FmtOpts.AlignmentVert := AlignmentVert;
  1303.  
  1304.    // Set defaults for the bevel colors.
  1305.    case BevelStyle of
  1306.       cbRaised:
  1307.       begin
  1308.          FmtOpts.Bevel.UpperLeftColor  := clBtnHighlight;
  1309.          FmtOpts.Bevel.LowerRightColor := clBtnShadow;
  1310.       end;
  1311.       cbLowered:
  1312.       begin
  1313.          FmtOpts.Bevel.UpperLeftColor  := clBtnShadow;
  1314.          FmtOpts.Bevel.LowerRightColor := clBtnHighlight;
  1315.       end;
  1316.       else
  1317.          FmtOpts.Bevel.UpperLeftColor  := clWindow;
  1318.          FmtOpts.Bevel.LowerRightColor := clWindow;
  1319.    end;
  1320. end;
  1321.  
  1322. procedure TSortGrid.DrawCell( aCol, aRow: LongInt; aRect: TRect; aState: TGridDrawState );
  1323. var
  1324.    xOffset, yOffset, w: Integer;
  1325.    FmtOpts:  TFormatOptions;
  1326.    NewState: TGridDrawState;
  1327. begin
  1328.    InitializeFormatOptions( aCol, aRow, FmtOpts );
  1329.  
  1330.    NewState := aState;
  1331.    if (fSelectedRows.IndexOf( Pointer( aRow ) ) > -1) then
  1332.       Include( NewState, gdSelected )
  1333.    else
  1334.       Exclude( NewState, gdSelected );
  1335.    if not (gdFixed in NewState) and (aRow <= RowCount - 1 - fFooterRows) and (goRangeSelect in Options) then
  1336.    begin
  1337.       if (gdSelected in NewState) then
  1338.       begin
  1339.          FmtOpts.Brush.Color := clHighlight;
  1340.          FmtOpts.Font.Color  := clHighlightText;
  1341.       end else
  1342.       begin
  1343.          FmtOpts.Brush.Color := clWindow;
  1344.          FmtOpts.Font.Color  := clWindowText;
  1345.       end;
  1346.    end;
  1347.  
  1348.    // Now do the OnGetCellFormat event if necessary.
  1349.    if Assigned( fOnGetCellFormat ) then
  1350.       fOnGetCellFormat( Self, aCol, aRow, aState, FmtOpts );
  1351.  
  1352.    if DefaultDrawing then
  1353.    begin
  1354.       // Calculate horizontal offset.
  1355.       case FmtOpts.AlignmentHorz of
  1356.          taRightJustify:
  1357.             xOffset := aRect.Right - aRect.Left - Canvas.TextWidth( Cells[aCol, aRow] )- 2;
  1358.          taCenter:
  1359.             xOffset := (aRect.Right - aRect.Left - Canvas.TextWidth( Cells[aCol, aRow] )) div 2;
  1360.          else
  1361.             xOffset := 2;
  1362.       end;
  1363.  
  1364.       // Calculate vertical offset.
  1365.       case FmtOpts.AlignmentVert of
  1366.           taBottomJustify:
  1367.              yOffset := aRect.Bottom - aRect.Top - Canvas.TextHeight( Cells[aCol, aRow] )- 3;
  1368.           taMiddle:
  1369.              yOffset := (aRect.Bottom - aRect.Top - Canvas.TextHeight( Cells[aCol, aRow] )) div 2;
  1370.           else
  1371.              yOffset := 2;
  1372.       end;
  1373.  
  1374.       // Now do the text drawing.
  1375.       if NOT FmtOpts.HideText then
  1376.          Canvas.TextRect( aRect, aRect.Left + xOffset, aRect.Top + yOffset, Cells[aCol, aRow] )
  1377.       else
  1378.          Canvas.TextRect( aRect, aRect.Left + xOffset, aRect.Top + yOffset, '' );
  1379.  
  1380.       // Draw a sort marker.
  1381.       if (SortSymbol <> sgNone) and (aRow = 0) and (aCol = SortColumn) and (FixedRows > 0) then
  1382.       begin
  1383.          w := Canvas.TextWidth( Cells[aCol, aRow] );
  1384.          DrawSortSymbol( aRect.Left + xOffset + w + SortSpacingHor, aRect.Top + yOffset + SortSpacingVert );
  1385.       end;
  1386.  
  1387.       // Draw Bevel.
  1388.       if (FmtOpts.Bevel.Style <> cbNone) and (aCol >= FixedCols) and (aRow >= FixedRows) then
  1389.       begin
  1390.          //Draw from bottom-most lines out to mimic behaviour of
  1391.          //fixed cells when FixedXXXXLine is toggled.
  1392.          with ARect do
  1393.             begin
  1394.                if goFixedVertLine in Options then
  1395.                begin
  1396.                   Canvas.Pen.Color := FmtOpts.Bevel.LowerRightColor;
  1397.                   Canvas.PolyLine( [Point( Right - 1, Top ), Point( Right - 1, Bottom )] );
  1398.                end;
  1399.                if goFixedHorzLine in Options then
  1400.                begin
  1401.                   Canvas.Pen.Color := FmtOpts.Bevel.LowerRightColor;
  1402.                   Canvas.PolyLine( [Point(Left, Bottom - 1), Point(Right, Bottom - 1)] );
  1403.                end;
  1404.                if goFixedVertLine in Options then
  1405.                begin
  1406.                   Canvas.Pen.Color := FmtOpts.Bevel.UpperLeftColor;
  1407.                   Canvas.PolyLine( [Point( Left, Top ), Point( Left, Bottom )] );
  1408.                end;
  1409.                if goFixedHorzLine in Options then
  1410.                begin
  1411.                   Canvas.Pen.Color := FmtOpts.Bevel.UpperLeftColor;
  1412.                   Canvas.PolyLine( [Point( Left, Top ), Point( Right, Top )] );
  1413.             end;
  1414.          end;
  1415.       end;
  1416.       if Assigned( OnDrawCell ) then
  1417.          OnDrawCell( Self, aCol, aRow, aRect, NewState );
  1418.    end else
  1419.       inherited DrawCell( aCol, aRow, aRect, NewState );
  1420. end;
  1421.  
  1422. procedure TSortGrid.DrawSortSymbol( x, y: Integer );
  1423. var
  1424.    MyCol: TColor;
  1425. begin
  1426.         if Assigned( GSortBM ) then
  1427.    begin
  1428.       if SortSymbol = sgCustom then
  1429.          MyCol := GSortBM.Canvas.Pixels[0, 0]
  1430.       else
  1431.          MyCol := clAqua;
  1432.                 Canvas.BrushCopy( Rect(x, y, x + GSortBM.Width, y + GSortBM.Height ), GSortBM, Rect( 0, 0, GSortBM.Width, GSortBM.Height ), MyCol );
  1433.         end;
  1434. end;
  1435.  
  1436. procedure TSortGrid.SetGSortSymbol;
  1437. var
  1438.    pos: Integer;
  1439.    RcStr: String;
  1440. begin
  1441.         GSortBM.Free;                                                           // Delete the old bitmap if present.
  1442.         GSortBM := nil;
  1443.         GSortBMWidth  := 0;
  1444.    GSortBMHeight := 0;
  1445.         if SortSymbol <> sgNone then           // Do we use a bitmap?
  1446.    begin
  1447.                 GSortBM := TBitmap.Create;          // Yes, create a new bitmap.
  1448.                 if SortSymbol = sgCustom then
  1449.       begin
  1450.                         // Copy the custom Bitmap to the Sort Bitmap.
  1451.          if SortDirection = sdAscending then
  1452.               GSortBM.Assign( FSortBMA )
  1453.          else
  1454.             GSortBM.Assign( FSortBMD );
  1455.       end else                                                                  // It's an internal bitmap symbol...
  1456.       begin
  1457.          pos := 0;
  1458.          if SortSymbol <> sgArrow then
  1459.             pos := 2;
  1460.          if SortDirection <> sdAscending then
  1461.             Inc( pos );
  1462.                         RcStr := Copy( 'SORTUPSORTDNSORTAZSORTZA', pos * 6 + 1, 6 );
  1463.                         // Load it from the resource.
  1464.                         GSortBM.Handle := LoadBitmap( HInstance, pChar( RcStr ) );
  1465.      end;
  1466.      GSortBMWidth  := GSortBM.Width;
  1467.      GSortBMHeight := GSortBM.Height;
  1468.         end;
  1469. end;
  1470.  
  1471. procedure TSortGrid.MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
  1472. var
  1473.    Point:         TPoint;
  1474.    aCol, aRow:    LongInt;
  1475.    SortOptions:   TSortOptions;
  1476.    CurrentCursor: TCursor;
  1477. begin
  1478.    //Make sure we're not sizing and have a header row.
  1479.    if Focused and SortOnClick and (fGridState = gsNormal) and (FixedRows >= 1) and (Shift = []) then
  1480.    begin
  1481.       Point.x := X;
  1482.       Point.y := Y;
  1483.       MouseToCell( Point.x, Point.y, aCol, aRow );
  1484.       //Make sure they clicked a fixed row.
  1485.       if (aRow >= 0) and (aRow <= (FixedRows - 1)) then
  1486.       begin
  1487.          SortOptions.SortStyle := ssAutomatic;
  1488.          if Button = mbRight then
  1489.             SortOptions.SortDirection := sdDescending
  1490.          else
  1491.             SortOptions.SortDirection := sdAscending;
  1492.  
  1493.          { EWE: Set case sensitivity here }
  1494.          SortOptions.SortCaseSensitive := fCaseSensitive;
  1495.  
  1496.          SortOptions.SortCompare := nil;
  1497.          if Assigned( fOnClickSort ) then
  1498.             fOnClickSort( Self, aCol, aRow, SortOptions );
  1499.          CurrentCursor := Screen.Cursor;
  1500.          try
  1501.             Screen.Cursor := crHourglass;
  1502.             SortByColumn( aCol, SortOptions );
  1503.          finally
  1504.             Screen.Cursor := CurrentCursor;
  1505.          end;
  1506.       end;
  1507.    end;
  1508.    inherited MouseUp( Button, Shift, X, Y );
  1509.    fMouseIsDown := False;
  1510. end;
  1511.  
  1512. procedure TSortGrid.ColWidthsChanged;
  1513. begin
  1514.    inherited ColWidthsChanged;
  1515.    if Assigned( fOnColumnWidthsChanged ) then
  1516.       fOnColumnWidthsChanged( Self );
  1517.    UpdateScrollPage;
  1518. end;
  1519.  
  1520. procedure TSortGrid.RowHeightsChanged;
  1521. begin
  1522.    inherited RowHeightsChanged;
  1523.    if Assigned( fOnRowHeightsChanged ) then
  1524.       fOnRowHeightsChanged( Self );
  1525.    UpdateScrollPage;
  1526. end;
  1527.  
  1528. procedure TSortGrid.SizeChanged( OldColCount, OldRowCount: LongInt );
  1529. begin
  1530.    inherited SizeChanged( OldColCount, OldRowCount );
  1531.    if Assigned( fOnSizeChanged ) then
  1532.       fOnSizeChanged( Self, OldColCount, OldRowCount );
  1533.    UpdateScrollPage;
  1534. end;
  1535.  
  1536. procedure TSortGrid.UpdateScrollPage;
  1537.    function LMax( const A, B: LongInt ): LongInt;
  1538.    begin
  1539.       Result := B;
  1540.       if A > B then Result := A;
  1541.    end;
  1542. var
  1543.    SI: TScrollInfo;
  1544. begin
  1545.    {Make the scroll bar(s) proportional.}
  1546.    {To do this correctly, I should sum colwidths and rowheights,
  1547.    but I just approximate by basing the proportion on visible rows or cols
  1548.    divided by row or col count...}
  1549.    {Also, I can't really figure out Borland's scroll bar range and position
  1550.    scheme.  Thus, sometimes when you click on the end of the scroll bar, you
  1551.    still have to scroll farther with the arrows to actually get to the end
  1552.    of the grid.  If anyone knows how to fix this, PLEASE let me know...}
  1553.    if (ScrollBars = ssVertical) or (ScrollBars = ssBoth) then
  1554.    begin
  1555.       SI.cbSize := SizeOf( SI );
  1556.       SI.fMask:=SIF_PAGE or SIF_POS or SIF_RANGE;
  1557.       GetScrollInfo( Handle, SB_VERT, SI );
  1558.       SI.fMask := SIF_PAGE;
  1559.       if ProportionalScrollBars then
  1560.       begin
  1561.          SI.nPage := LMax(Round(((1.0*(VisibleRowCount+FixedRows))/RowCount)*(SI.nMax-SI.nMin+1)), 1)
  1562.       end else
  1563.          SI.nPage := 0;
  1564.          SetScrollInfo( Handle, SB_VERT, SI, True );
  1565.    end;
  1566.    if (ScrollBars = ssHorizontal) or (ScrollBars = ssBoth) then
  1567.    begin
  1568.       SI.cbSize := SizeOf( SI );
  1569.       SI.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;
  1570.       GetScrollInfo( Handle, SB_HORZ, SI );
  1571.       SI.fMask := SIF_PAGE;
  1572.       if ProportionalScrollBars then
  1573.       begin
  1574.          SI.nPage := LMax(Round(((1.0*(VisibleColCount+FixedCols))/ColCount)*(SI.nMax-SI.nMin+1)), 1)
  1575.       end else
  1576.          SI.nPage := 0;
  1577.          SetScrollInfo( Handle, SB_HORZ, SI, True );
  1578.    end;
  1579. end;
  1580.  
  1581. procedure TSortGrid.KeyDown( var Key: Word; Shift: TShiftState );
  1582. begin
  1583.    inherited KeyDown( Key, Shift );
  1584.    if ExtendedKeys and NOT EditorMode then
  1585.    begin
  1586.       if Shift = [ssCtrl] then
  1587.       begin
  1588.          case Key of
  1589.             VK_INSERT: InsertRow( Row );
  1590.             VK_DELETE: if RowCount > (FixedRows + 1) then
  1591.                           DeleteRow( Row );
  1592.          end;
  1593.       end
  1594.       else if Shift = [ssCtrl, ssShift] then
  1595.       begin
  1596.          case Key of
  1597.             VK_INSERT: InsertColumn( Col );
  1598.             VK_DELETE: if ColCount > (FixedCols + 1) then
  1599.                           DeleteColumn( Col );
  1600.          end;
  1601.       end;
  1602.    end;
  1603. end;
  1604.  
  1605. procedure TSortGrid.SetEditText( aCol, aRow: LongInt; const Value: String );
  1606. begin
  1607.    try
  1608.       if Value <> Cells[aCol, aRow] then
  1609.          Modified := True;
  1610.    finally
  1611.       inherited SetEditText( aCol, aRow, Value );
  1612.    end;
  1613. end;
  1614.  
  1615. procedure TSortGrid.Click;
  1616. begin
  1617.    try
  1618.       inherited Click;
  1619.    finally
  1620.       if fEntered then
  1621.          ValidateCell;
  1622.    end;
  1623. end;
  1624.  
  1625. procedure TSortGrid.DoEnter;
  1626. begin
  1627.    try
  1628.       inherited DoEnter;
  1629.       fEntered := True;
  1630.    finally
  1631.       InitValidate;
  1632.    end;
  1633. end;
  1634.  
  1635. procedure TSortGrid.DoExit;
  1636. begin
  1637.    try
  1638.       Click;
  1639.    finally
  1640.       inherited DoExit;
  1641.       fEntered := False;
  1642.    end;
  1643. end;
  1644.  
  1645. procedure TSortGrid.InitValidate;
  1646. begin
  1647.    fOldCol := Col;
  1648.    fOldRow := Row;
  1649.    fOldCellText := Cells[ fOldCol, fOldRow ];
  1650.    fOldModifiedValue := Modified;
  1651. end;
  1652.  
  1653. procedure TSortGrid.TopLeftChanged;
  1654. begin
  1655.    inherited TopLeftChanged;
  1656.    if fMouseIsDown then
  1657.    begin
  1658.       if TopRow > fLastTopRow then
  1659.       begin
  1660.          fLastMoveOn := TopRow + VisibleRowCount - 1;
  1661.          SelectRow( TopRow + VisibleRowCount - 1, True );
  1662.       end;
  1663.    end;
  1664.    fLastTopRow := TopRow;
  1665. end;
  1666.  
  1667. procedure TSortGrid.MouseMove( Shift: TShiftState; X, Y: Integer );
  1668. var
  1669.   aCol, aRow: LongInt;
  1670. begin
  1671.   inherited MouseMove( Shift, X, Y );
  1672.   if fMouseIsDown then
  1673.     begin
  1674.       MouseToCell( X, Y, aCol, aRow );
  1675.       if ( aRow <> fLastMoveOn ) then
  1676.         begin
  1677.           if ( aRow >= fAnchor ) and ( aRow < fLastMoveOn ) then
  1678.             begin
  1679.               SelectRows( fLastMoveOn , aRow , False );
  1680.               if aRow = fAnchor then
  1681.                 SelectRow( fAnchor , True );
  1682.             end
  1683.           else if ( aRow <= fAnchor ) and ( aRow > fLastMoveOn ) then
  1684.             begin
  1685.               SelectRows( fLastMoveOn, aRow , False );
  1686.               if aRow = fAnchor then
  1687.                 SelectRow( fAnchor, True );
  1688.             end
  1689.           else if ( aRow < fAnchor ) and ( fLastMoveOn > fAnchor ) then
  1690.             begin
  1691.               SelectRows( fLastMoveOn, fAnchor + 1, False );
  1692.               SelectRows( fAnchor, aRow, True );
  1693.             end
  1694.           else if ( aRow > fAnchor ) and ( fLastMoveOn < fAnchor ) then
  1695.             begin
  1696.               SelectRows( fLastMoveOn, fAnchor - 1, False );
  1697.               SelectRows( fAnchor, aRow, True );
  1698.             end
  1699.           else
  1700.             SelectRows( aRow, fAnchor, True );
  1701.           fLastMoveOn := aRow;
  1702.         end;
  1703.     end;
  1704. end;
  1705.  
  1706. procedure TSortGrid.MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
  1707. var
  1708.    aRow, aCol: LongInt;
  1709. begin
  1710.    inherited MouseDown( Button, Shift, X, Y );
  1711.    if (Button = mbLeft) and (goRangeSelect in Options) then
  1712.    begin
  1713.       MouseToCell( X, Y, aCol, aRow );
  1714.       if aRow < FixedRows then
  1715.          Exit;
  1716.       fMouseIsDown := True;
  1717.       fLastMoveOn  := aRow;
  1718.  
  1719.       if ssCtrl in Shift then
  1720.       begin
  1721.          if aRow > -1 then
  1722.          begin
  1723.             ToggleRow( aRow );
  1724.             fAnchor := aRow;
  1725.          end;
  1726.       end else if ssShift in Shift then
  1727.       begin
  1728.          fSelectedRows.Clear;
  1729.          SelectRows( fAnchor, aRow, True );
  1730.       end else
  1731.       begin
  1732.          if fSelectedRows.Count > 0 then
  1733.             fSelectedRows.Clear;
  1734.          if aRow > -1 then
  1735.          begin
  1736.             fSelectedRows.Add( Pointer( aRow ) );
  1737.             fAnchor := aRow;
  1738.          end;
  1739.          Refresh;
  1740.       end;
  1741.    end;
  1742. end;
  1743.  
  1744. {******************************************************************************}
  1745. {** Public Members for TPrintOptions                                         **}
  1746. {******************************************************************************}
  1747. constructor TPrintOptions.Create;
  1748. begin
  1749.    inherited Create;
  1750.    PageFooter  := 'date|time|page';
  1751.    DateFormat  := 'd-mmm-yyyy';
  1752.    TimeFormat  := 'h:nn';
  1753.    fCopies      := 1;
  1754.    fLeftPadding := 2;
  1755.    fPreviewPage := 1;
  1756. end;
  1757.  
  1758. {******************************************************************************}
  1759. {** Public Members for TSortGrid                                             **}
  1760. {******************************************************************************}
  1761. constructor TSortGrid.Create( AOwner: TComponent );
  1762. begin
  1763.    inherited Create( AOwner );
  1764.    fSortedList              := TSortedList.Create;
  1765.    fCaseSensitive           := False;  { dflt to no case sensitivity }
  1766.    fAlignmentHorz           := taLeftJustify;
  1767.    fAlignmentVert           := taTopJustify;
  1768.    fBevelStyle              := cbNone;
  1769.    fProportionalScrollBars  := True;
  1770.    fExtendedKeys            := False;
  1771.    fSorting                 := False;
  1772.    fModified                := False;
  1773.    fEntered                 := False;
  1774.    fSortState               := ssUnsorted;     // Line modified/added by gnes@zero.it
  1775.    fSortBMA                 := TBitmap.Create;
  1776.    fSortBMD                 := TBitmap.Create;
  1777.    GSortBM                  := nil;
  1778.    fSortSymbol              := sgNone;
  1779.    fSortSpacingHor          := 2;
  1780.    fSortSpacingVert         := 0;
  1781.    fSortColumn              := 1;
  1782.    fSortDirection           := sdAscending;
  1783.    fSortOnClick             := True;
  1784.    fSortFooter              := False;
  1785.    fFooterRows              := 0;
  1786.    gFooterSub               := 0;
  1787.    fFooterColor             := clAqua;
  1788.    fFooterFont              := TFont.Create;
  1789.    fFooterBevelStyle        := cbNone;
  1790.    gASE                     := False;
  1791.    fSelectedRows            := TList.Create;
  1792.    fSelectedRows.Add( Pointer( FixedRows ) );
  1793.    fAnchor                  := FixedRows;
  1794.    fMouseIsDown             := False;
  1795.    fLastTopRow              := TopRow;
  1796.    fOldRowCol               := TOldRowColValueList.Create;
  1797.    fPrintOptions            := TPrintOptions.Create;
  1798.    fPrintOptions.HeaderSize := Font.Size + 2;
  1799.    fPrintOptions.FooterSize := fFooterFont.Size - 1;
  1800.    fOldFont                 := TFont.Create;
  1801.    fOldBrush                := TBrush.Create;
  1802.    fOldFont.Assign( Canvas.Font );
  1803.    fOldBrush.Assign( Canvas.Brush );
  1804.  
  1805.    InitValidate;
  1806. end;
  1807.  
  1808. destructor TSortGrid.Destroy;
  1809. begin
  1810.    fOldBrush.Free;
  1811.    fOldFont.Free;
  1812.    fPrintOptions.Free;
  1813.    fOldRowCol.Reset;
  1814.    fOldRowCol.Free;
  1815.    fSelectedRows.Free;
  1816.    fFooterFont.Free;
  1817.    fSortBMA.Free;
  1818.    fSortBMD.Free;
  1819.    gSortBM.Free;  //    Delete the old bitmap if present.
  1820.    fSortedList.Reset;
  1821.    fSortedList.Free;
  1822.    inherited Destroy;
  1823. end;
  1824.  
  1825. procedure TSortGrid.ValidateCell;
  1826. var
  1827.    Value: String;
  1828.    Valid: Boolean;
  1829. begin
  1830.    if fOldCellText <> Cells[fOldCol, fOldRow] then
  1831.    begin
  1832.       Value := Cells[fOldCol, fOldRow];
  1833.       Valid := True;
  1834.       if Assigned( fOnCellValidate ) then
  1835.          fOnCellValidate( Self, fOldCol, fOldRow, Value, Valid );
  1836.       //Since Value is also a VAR parameter, we always
  1837.       //use it if it was changed in OnCellValidate.
  1838.       if NOT Valid then
  1839.       begin
  1840.          if Value <> Cells[fOldCol, fOldRow] then
  1841.             Cells[fOldCol, fOldRow] := Value
  1842.          else
  1843.              Cells[fOldCol, fOldRow] := fOldCellText;
  1844.          Modified := fOldModifiedValue;
  1845.       end else
  1846.          if Value <> Cells[fOldCol, fOldRow] then
  1847.             Cells[fOldCol, fOldRow] := Value;
  1848.    end;
  1849.    InitValidate;
  1850. end;
  1851.  
  1852. //AutoSizes the aCol column.
  1853. procedure TSortGrid.AutoSizeCol( const aCol: LongInt );
  1854. var
  1855.    MaxWidth, TextW, i: Integer;
  1856.    FmtOpts:            TFormatOptions;
  1857. begin
  1858.    //Resize the column to display the largest value.
  1859.    MaxWidth := 0;
  1860.    Canvas.Font := Font;
  1861.    for i := 0 to RowCount - 1 do
  1862.    begin
  1863.       InitializeFormatOptions( aCol, i, FmtOpts );
  1864.       if Assigned( fOnGetCellFormat ) then
  1865.          fOnGetCellFormat( Self, Col, i, GetCellDrawState( aCol, i ), FmtOpts );
  1866.       Canvas.Font := FmtOpts.Font;
  1867.       TextW := Canvas.TextWidth( Cells[aCol, i] );
  1868.       if TextW > MaxWidth then
  1869.          MaxWidth := TextW;
  1870.    end;
  1871.    ColWidths[aCol] := MaxWidth + Canvas.TextWidth( 'x' );
  1872. end;
  1873.  
  1874. //AutoSizes ALL the variable columns and optionally the fixed columns.
  1875. procedure TSortGrid.AutoSizeColumns( const DoFixedCols: Boolean; const Padding: Integer );
  1876. var
  1877.    i: Integer;
  1878. begin
  1879.    if DoFixedCols then
  1880.       for i := 0 to FixedCols - 1 do
  1881.       begin
  1882.          AutoSizeCol(i);
  1883.          if Padding <> 0 then
  1884.             ColWidths[i] := ColWidths[i] + Padding;
  1885.       end;
  1886.    for i := FixedCols to ColCount - 1 do
  1887.    begin
  1888.       AutoSizeCol( i );
  1889.       if Padding <> 0 then
  1890.          ColWidths[i] := ColWidths[i] + Padding;
  1891.    end;
  1892. end;
  1893.  
  1894. //Sorts the variable rows using Column aCol as a key
  1895. procedure TSortGrid.SortByColumn( const aCol: LongInt; SortOptions: TSortOptions );
  1896. begin
  1897.    //Don't sort while in edit mode.
  1898.    if NOT EditorMode then
  1899.    begin
  1900.       //If there's only one row we don't need to do anything.
  1901.       if RowCount > (FixedRows + 1) then
  1902.       begin
  1903.          //Now we do the Automatic sorting determination.
  1904.          if SortOptions.SortStyle = ssAutomatic then
  1905.             SortOptions.SortStyle := DetermineSortStyle( aCol );
  1906.  
  1907.          //Call the OnBeginSort event.
  1908.          if Assigned( fOnBeginSort ) then
  1909.             fOnBeginSort( Self, aCol, SortOptions );
  1910.  
  1911.          //Quick Sort column ACol.
  1912.          ListQuickSort( aCol, SortOptions );
  1913.  
  1914.          //Call the OnEndSort event.
  1915.          if Assigned( fOnEndSort ) then
  1916.             fOnEndSort( Self, aCol );
  1917.       end;
  1918.    end;
  1919. end;
  1920.  
  1921. procedure TSortGrid.InsertRow( aRow: LongInt );
  1922. begin
  1923.    RowCount := RowCount + 1;
  1924.    fOldRowCol.MoveUp( aRow, 1 );
  1925.    MoveRow( RowCount - 1, aRow );
  1926.    Rows[aRow].Clear;
  1927.    Row := aRow;
  1928.    fSortState := ssUnsorted; // Line modified/added by gnes@zero.it
  1929.    if Assigned( fOnRowInsert ) then
  1930.       fOnRowInsert( Self, aRow );
  1931. end;
  1932.  
  1933. function TSortGrid.InsertRows( aRow, rCount: Integer ): Boolean;
  1934. var
  1935.    i: Integer;
  1936. begin
  1937.         if CheckRange( aRow, aRow, True ) then
  1938.    begin
  1939.       for i := 0 to rCount - 1 do
  1940.       begin
  1941.                    RowCount := RowCount + 1;
  1942.          fOldRowCol.MoveUp( aRow + i, 1 );
  1943.          MoveRow( RowCount - 1, aRow );
  1944.                    Rows[aRow].Clear();
  1945.                    Row := aRow;
  1946.                    if Assigned( OnRowInsert ) then
  1947.             OnRowInsert( Self, aRow );
  1948.            end;
  1949.       Result := True;
  1950.    end else
  1951.       Result := False;
  1952. end;
  1953.  
  1954. procedure TSortGrid.InsertColumn( aCol: LongInt );
  1955. begin
  1956.    ColCount := ColCount + 1;
  1957.    fOldRowCol.MoveUp( aCol, 2 );
  1958.    MoveColumn( ColCount - 1, aCol );
  1959.    Cols[aCol].Clear;
  1960.    Col := aCol;
  1961.    if Assigned( fOnColumnInsert ) then
  1962.       fOnColumnInsert( Self, aCol );
  1963. end;
  1964.  
  1965. function TSortGrid.InsertCols( aCol, cCount: Integer ): Boolean;
  1966. var
  1967.    i: Integer;
  1968. begin
  1969.         if CheckRange( aCol, aCol, False ) then
  1970.    begin
  1971.      for i := 0 to cCount - 1 do
  1972.      begin
  1973.        ColCount := ColCount + 1;
  1974.        fOldRowCol.MoveUp( aCol + i, 2 );
  1975.                    MoveColumn( ColCount - 1, aCol );
  1976.                    Cols[aCol].Clear();
  1977.                    Col := aCol;
  1978.                    if Assigned( OnColumnInsert ) then
  1979.         OnColumnInsert( Self, aCol );
  1980.            end;
  1981.         Result := True;
  1982.    end else
  1983.       Result := False;
  1984. end;
  1985.  
  1986. function TSortGrid.CheckRange( startcr, endcr: Integer; IsRow: Boolean): Boolean;
  1987. var
  1988.    aCount: Integer;
  1989. begin
  1990.    if IsRow = True then
  1991.       aCount := RowCount
  1992.    else
  1993.       aCount := ColCount;
  1994.  
  1995.         if (startcr >= 0) and (startcr < aCount) and (endcr >= startcr) and (endcr < aCount) then
  1996.       Result := True
  1997.    else
  1998.            Result := False;
  1999. end;
  2000.  
  2001. //Clears the grid.
  2002. function TSortGrid.Clear: Boolean;
  2003. begin
  2004.    Result := ClearRows( 0, RowCount - 1 );
  2005. end;
  2006.  
  2007. function TSortGrid.ClearFrom( FromRow: LongInt ): Boolean;
  2008. begin
  2009.    Result := ClearRows( FromRow, RowCount - 1 );
  2010. end;
  2011.  
  2012. function TSortGrid.ClearRows( sRow, eRow: Integer ): Boolean;
  2013. var
  2014.    i: Integer;
  2015. begin
  2016.    if CheckRange( sRow, eRow, True ) then
  2017.    begin
  2018.       for i := sRow to eRow do
  2019.          Rows[i].Clear();
  2020.            Result := True;
  2021.       Modified       := False;
  2022.       fSortDirection := sdAscending; // Line modified/added by gnes@zero.it
  2023.       fSortState     := ssUnsorted;  // Line modified/added by gnes@zero.it
  2024.    end else
  2025.       Result := False;
  2026. end;
  2027.  
  2028. function TSortGrid.ClearCols( sCol, eCol: Integer ): Boolean;
  2029. var
  2030.    i: Integer;
  2031. begin
  2032.         if CheckRange( sCol, eCol, False ) then
  2033.    begin
  2034.       i := sCol;
  2035.       while i <= eCol do
  2036.       begin
  2037.          Cols[i].Clear();
  2038.          Inc( i, 2 );
  2039.       end;
  2040.            Result := True;
  2041.    end else
  2042.       Result := False;
  2043. end;
  2044.  
  2045. { If goAlwaysShowEditor is enabled then RemoveRow
  2046.          and MoveRow leave the caret past the last row or
  2047.          in one of the fixed rows.  So its turned off before
  2048.          the delete and then back on afterward.                          }
  2049. procedure TSortGrid.SetResetASE( SetASE: Boolean );
  2050. begin
  2051.         if SetASE then
  2052.    begin
  2053.                 if goAlwaysShowEditor in Options then
  2054.       begin
  2055.                         Options := Options - [goAlwaysShowEditor];
  2056.                         GASE := True;
  2057.                 end;
  2058.         end else
  2059.    begin
  2060.       if GASE then
  2061.       begin
  2062.               Options := Options + [goAlwaysShowEditor];
  2063.                    GASE := False;
  2064.            end;
  2065.    end;
  2066. end;
  2067.  
  2068. procedure TSortGrid.DeleteRow( aRow: LongInt );
  2069. var
  2070.    i: LongInt;
  2071. begin
  2072.    if Selected[ aRow ] then
  2073.    begin
  2074.       SelectRow( aRow, False );
  2075.       for i := 0 to SelectedCount do
  2076.          if LongInt( fSelectedRows.Items[ i ] ) > aRow then
  2077.             fSelectedRows.Items[ i ] := Pointer( LongInt( fSelectedRows.Items[ i ] ) - 1 );
  2078.    end;
  2079.  
  2080.    Rows[ aRow ].Clear;
  2081.    {If goAlwaysShowEditor is enabled then DeleteRow
  2082.     and MoveRow leave the caret past the last row or
  2083.     in one of the fixed rows.  So I turn it off before
  2084.     the delete and then back on after to get it
  2085.     working correctly.}
  2086.         SetResetASE( True );
  2087.    fOldRowCol.RemRC( aRow, 1 );  // RCV04
  2088.    fOldRowCol.MoveDown( aRow, 1 );  // RCV04
  2089.    inherited DeleteRow( aRow );
  2090.         SetResetASE( False );
  2091.    if Assigned( fOnRowDelete ) then
  2092.       fOnRowDelete( Self, aRow );
  2093.  
  2094.    if fFooterRows > RowCount - FixedRows then
  2095.       FooterRows := RowCount - FixedRows;
  2096. end;
  2097.  
  2098. function TSortGrid.RemoveRows( sRow, eRow: Integer ): Boolean;
  2099. var
  2100.    r: Integer;
  2101. begin
  2102.         if CheckRange( sRow, eRow, True ) then
  2103.    begin
  2104.       for r := eRow downto sRow do
  2105.       begin
  2106.          Rows[r].Clear();
  2107.                 SetResetASE( True );
  2108.          DeleteRow( r );
  2109.                 SetResetASE( False );
  2110.       end;
  2111.       Result := True;
  2112.    end else
  2113.       Result := False;
  2114. end;
  2115.  
  2116. procedure TSortGrid.DeleteColumn( aCol: LongInt );
  2117. begin
  2118.    Cols[ aCol ].Clear;
  2119.    //See DeleteRow for comments...
  2120.         SetResetASE( True );
  2121.    fOldRowCol.RemRC( aCol, 2 );  // RCV04
  2122.    fOldRowCol.MoveDown( aCol, 2 );  // RCV04
  2123.    inherited DeleteColumn( aCol );
  2124.         SetResetASE( False );
  2125.    if Assigned( fOnColumnDelete ) then
  2126.       fOnColumnDelete( Self, aCol );
  2127. end;
  2128.  
  2129. function TSortGrid.RemoveCols( sCol, eCol: Integer ): Boolean;
  2130. var
  2131.    c: Integer;
  2132. begin
  2133.         if CheckRange( sCol, eCol, False ) then
  2134.    begin
  2135.       for c := eCol downto sCol do
  2136.       begin
  2137.                    Cols[ c ].Clear();
  2138.                    SetResetASE( True );
  2139.                    DeleteColumn( c );
  2140.                    SetResetASE( False );
  2141.       end;
  2142.            Result := True;
  2143.    end else
  2144.       Result := False;
  2145. end;
  2146.  
  2147. procedure TSortGrid.MoveRow( FromIndex, ToIndex: LongInt );
  2148. begin
  2149.    //See DeleteRow for comments...
  2150.    SetResetASE( True );
  2151.    inherited MoveRow( FromIndex, ToIndex );
  2152.    SetResetASE( False );
  2153.    fSortState := ssUnsorted; // Line modified/added by gnes@zero.it
  2154. end;
  2155.  
  2156. procedure TSortGrid.MoveColumn( FromIndex, ToIndex: LongInt );
  2157. begin
  2158.    //See DeleteRow for comments...
  2159.    SetResetASE( True );
  2160.    inherited MoveColumn( FromIndex, ToIndex );
  2161.    SetResetASE( False );
  2162. end;
  2163.  
  2164. //The logic gets around a weird case where you swap with the last row.
  2165. procedure TSortGrid.SwapRows( aRow1, aRow2: LongInt );
  2166. begin
  2167.    if aRow1 < aRow2 then
  2168.    begin
  2169.       MoveRow( aRow2, aRow1 );
  2170.       MoveRow( aRow1 + 1, aRow2 );
  2171.    end
  2172.    else if aRow2 < aRow1 then
  2173.    begin
  2174.       MoveRow( aRow1, aRow2 );
  2175.       MoveRow( aRow2 + 1, aRow1 );
  2176.    end;
  2177. end;
  2178.  
  2179. //The logic gets around a weird case where you swap with the last column.
  2180. procedure TSortGrid.SwapColumns( aCol1, aCol2: LongInt );
  2181. begin
  2182.    if aCol1 < aCol2 then
  2183.    begin
  2184.       MoveColumn( aCol2, aCol1 );
  2185.       MoveColumn( aCol1 + 1, aCol2 );
  2186.    end
  2187.    else if aCol2 < aCol1 then
  2188.    begin
  2189.       MoveColumn( aCol1, ACol2 );
  2190.       MoveColumn( aCol2 + 1, ACol1 );
  2191.    end;
  2192. end;
  2193.  
  2194. //Moves the selected cell to (aCol, aRow) and makes it visible.
  2195. procedure TSortGrid.MoveTo( aCol, aRow: LongInt );
  2196. begin
  2197.    if aCol < FixedCols then aCol := FixedCols;
  2198.    if aRow < FixedRows then aRow := FixedRows;
  2199.    if SelectCell( aCol, aRow ) then
  2200.    begin
  2201.       Col := aCol;
  2202.       Row := aRow;
  2203.       MoveColRow( aCol, aRow, True, True );
  2204.    end;
  2205. end;
  2206.  
  2207. //Finds a string in the grid.
  2208. //It searches by column and returns the first instance it finds.
  2209. function TSortGrid.IsCell( const Value: String; var aCol, aRow: LongInt ): Boolean;
  2210. var
  2211.    i, Place: LongInt;
  2212. begin
  2213.    Result := False;
  2214.    for i := 0 to ColCount - 1 do
  2215.    begin
  2216.       Place := Cols[i].IndexOf( Value );
  2217.       if Place >= 0 then
  2218.       begin
  2219.          aRow   := Place;
  2220.          aCol   := i;
  2221.          Result := True;
  2222.          Break;
  2223.       end;
  2224.    end;
  2225. end;
  2226.  
  2227. procedure TSortGrid.LoadFromFile( const FileName: String; const Delimiter: Char );
  2228. var
  2229.    r:             LongInt;
  2230.    Lines, Fields: TStringList;
  2231. begin
  2232.    Lines  := TStringList.Create;
  2233.    Fields := TStringList.Create;
  2234.    try
  2235.       Clear;
  2236.  
  2237.       Lines.LoadFromFile( FileName );
  2238.       RowCount := Lines.Count;
  2239.       ColCount := FixedCols + 1;
  2240.       for r := 0 to Lines.Count - 1 do
  2241.       begin
  2242.          TokenizeGridString( Lines[r], Delimiter, Fields );
  2243.          if Fields.Count > ColCount then
  2244.             ColCount := Fields.Count;
  2245.          Rows[r].Assign( Fields );
  2246.       end;
  2247.    finally
  2248.       Fields.Free;
  2249.       Lines.Free;
  2250.    end;
  2251. end;
  2252.  
  2253. procedure TSortGrid.SaveToFile( const FileName: String; const Delimiter: Char );
  2254. var
  2255.    r, c:   LongInt;
  2256.    BufStr: String;
  2257.    Lines:  TStringList;
  2258. begin
  2259.    Lines := TStringList.Create;
  2260.    try
  2261.       Lines.Clear;
  2262.       for r := 0 to RowCount - 1 do
  2263.       begin
  2264.          BufStr := '';
  2265.          for c := 0 to ColCount - 1 do
  2266.          begin
  2267.             BufStr := BufStr + Cells[c, r];
  2268.             if c <> (ColCount - 1) then
  2269.                BufStr := BufStr + Delimiter;
  2270.          end;
  2271.          Lines.Add( BufStr );
  2272.       end;
  2273.       Lines.SaveToFile( FileName );
  2274.    finally
  2275.       Lines.Free;
  2276.    end;
  2277. end;
  2278.  
  2279. function TSortGrid.CanUndoSort: Boolean;
  2280. begin
  2281.    //We can only undo a sort if we still have exactly the
  2282.    //same number of rows that we did when we sorted.
  2283.    Result := (fSortedList.Count = (RowCount - FixedRows));
  2284.    if Result = False then
  2285.       fSortedList.Reset;
  2286. end;
  2287.  
  2288. procedure TSortGrid.UndoSort;
  2289. var
  2290.    BufferGrid: TStringGrid;
  2291.    Item:       pSortedListEntry;
  2292.    i:          Integer;
  2293. begin
  2294.    if CanUndoSort then
  2295.    begin
  2296.       BufferGrid := nil;
  2297.       try
  2298.          BufferGrid := TStringGrid.Create( Self );
  2299.          BufferGrid.ColCount := ColCount;
  2300.          BufferGrid.RowCount := RowCount;
  2301.          //Copy the rows to the buffer grid in the current order.
  2302.          for i := FixedRows to RowCount - 1 - gFooterSub do
  2303.              BufferGrid.Rows[i].Assign( Rows[i] );
  2304.          //Now put the rows back into the original grid in the old order.
  2305.          for i := 0 to fSortedList.Count - 1 do
  2306.          begin
  2307.              Item := fSortedList.GetItem( i );
  2308.              Rows[Item^.RowNum].Assign( BufferGrid.Rows[i + FixedRows] );
  2309.          end;
  2310.       finally
  2311.          BufferGrid.Free;
  2312.       end;
  2313.  
  2314.       //Now put the selection back on the right row.
  2315.       Item := fSortedList.GetItem( Row - FixedRows );
  2316.       MoveTo( Col, Item^.RowNum );
  2317.       //Now reset the list.
  2318.       fSortedList.Reset;
  2319.    end;
  2320.    fSortState := ssUnsorted;    // Line modified/added by gnes@zero.it
  2321. end;
  2322.  
  2323. // Finds the first (sub)string in the grid.
  2324. // It searches by row and by column starting from sRow and sCol to eCol and finally eRow.
  2325. // Comparisons are made folowing the SortCaseSensitive property.
  2326. // If found, returning the cell coordinates in sCol and sRow and return True.
  2327. function TSortGrid.FindFirst( const aStr: String; var sCol, sRow: LongInt; eCol, eRow: LongInt ): Boolean;
  2328. var
  2329.    pStr: String;
  2330.    r, c: Integer;
  2331. begin
  2332.    Result := False;
  2333.         if CheckRange( sCol, eCol, false ) and CheckRange( sRow, eRow, true ) then
  2334.    begin;
  2335.       GFindString       := aStr;
  2336.            GEndCol              := eCol;
  2337.            GEndRow              := eRow;
  2338.       for r := sRow to eRow do
  2339.       begin
  2340.          for c := sCol to eCol do
  2341.          begin
  2342.             if FCaseSensitive then
  2343.                pStr := Cells[c, r]
  2344.             else
  2345.                pStr := UpperCase( Cells[c, r] );
  2346.             if {$IfDef VER90}Pos{$Else}AnsiPos{$EndIf}( aStr, pStr ) > 0 then
  2347.             begin
  2348.                sCol := c;
  2349.                GStartCol := c;
  2350.                sRow := r;
  2351.                GStartRow := r;
  2352.                Result := True;
  2353.                Exit;
  2354.             end;
  2355.          end;
  2356.       end
  2357.    end;
  2358. end;
  2359.  
  2360. function TSortGrid.FindNext( var aCol, aRow: LongInt ): Boolean;
  2361. var
  2362.    pStr: String;
  2363.    r, c: Integer;
  2364. begin
  2365.    Result := False;
  2366.         for r := GStartRow to GEndRow do
  2367.    begin
  2368.                 for c := GStartCol + 1 to GEndCol do
  2369.       begin
  2370.          if FCaseSensitive then
  2371.             pStr := Cells[c, r]
  2372.          else
  2373.             pStr := UpperCase( Cells[c, r] );
  2374.                         if {$IfDef VER90}Pos{$Else}AnsiPos{$EndIf}( GFindString, pStr ) > 0 then
  2375.          begin
  2376.                                 aCol := c;
  2377.                                 aRow := r;
  2378.             Result := True;
  2379.             GStartCol := c;
  2380.             GStartRow := r;
  2381.             Exit;
  2382.                         end;
  2383.                 end;
  2384.       GStartCol := -1;
  2385.         end;
  2386.    GStartRow := RowCount; // Keep returning False
  2387. end;
  2388.  
  2389. function TSortGrid.GetCellDrawState( const aCol, aRow: LongInt ): TGridDrawState;
  2390.    function PointInGridRect( Col, Row: LongInt; const Rect: TGridRect ): Boolean;
  2391.    begin
  2392.      Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top) and (Row <= Rect.Bottom);
  2393.    end;
  2394. var
  2395.    DrawState: TGridDrawState;
  2396. begin
  2397.    DrawState := [];
  2398.    if (aRow < FixedRows) and (aCol < FixedCols) then Include( DrawState, gdFixed );
  2399.    if Focused and (aRow = Row) and (aCol = Col) then Include( DrawState, gdFocused );
  2400.    if PointInGridRect( aCol, aCol, Selection ) then Include( DrawState, gdSelected );
  2401.    Result := DrawState;
  2402. end;
  2403.  
  2404. function TSortGrid.SelectCell( aCol, aRow: LongInt ): Boolean;
  2405. begin
  2406.    Result := inherited SelectCell( aCol, aRow );
  2407. end;
  2408.  
  2409. procedure TSortGrid.KeyPress( var Key: Char );
  2410. begin
  2411.    //I have to do this here because KeyDown doesn't get called
  2412.    //when the enter key is pressed in the inplace editor.
  2413.    if Key = #13 then
  2414.       ValidateCell;
  2415.    inherited KeyPress( Key );
  2416. end;
  2417.  
  2418. procedure TSortGrid.ClearSelection;
  2419. begin
  2420.    fSelectedRows.Clear;
  2421.    fSelectedRows.Add( Pointer( Row ) );
  2422.    Refresh;
  2423. end;
  2424.  
  2425. // IsRC = 1...Rows IsRC = 2...Columns
  2426. procedure TSortGrid.ShowRC( StartRC, EndRC: LongInt; IsRC: Integer ); // RCV04 priv
  2427. var
  2428.    rc, v: Integer;
  2429. begin
  2430.    for rc := StartRC to EndRC do
  2431.    begin
  2432.       if ( ((IsRc = 1) and (RowHeights[ rc ] = 0)) or ((IsRC = 2) and (ColWidths[ rc ] = 0)) ) then
  2433.       begin
  2434.          v := fOldRowCol.GetValue( rc, IsRC );
  2435.          if v <> -1 then
  2436.          begin
  2437.             if IsRC = 1 then
  2438.                RowHeights[ rc ] := v
  2439.             else
  2440.                ColWidths[ rc ] := v;
  2441.             fOldRowCol.RemRC( rc, IsRC );
  2442.          end;
  2443.       end;
  2444.    end;
  2445. end;
  2446.  
  2447. procedure TSortGrid.HideRC( StartRC, EndRC: LongInt; IsRC: Integer ); // RCV04 priv
  2448. var
  2449.    rc: Integer;
  2450. begin
  2451.    for rc := StartRC to EndRC do
  2452.    begin
  2453.       if IsRC = 1 then
  2454.       begin
  2455.          fOldRowCol.SetValue( rc, RowHeights[ rc ], IsRC );
  2456.          RowHeights[ rc ] := 0;
  2457.       end else
  2458.       begin
  2459.          fOldRowCol.SetValue( rc, ColWidths[ rc ], IsRC );
  2460.          ColWidths[ rc ] := 0;
  2461.       end;
  2462.    end;
  2463. end;
  2464.  
  2465. procedure TSortGrid.ShowRows( StartRow, EndRow: LongInt ); // RCV04
  2466. begin
  2467.    ShowRC( StartRow, EndRow, 1 );
  2468. end;
  2469.  
  2470. procedure TSortGrid.HideRows( StartRow, EndRow: LongInt ); // RCV04
  2471. begin
  2472.    HideRC( StartRow, EndRow, 1 );
  2473. end;
  2474.  
  2475. procedure TSortGrid.AutoSizeRows( StartRow, EndRow: LongInt ); // RCV04
  2476. begin
  2477.    AutoSizeRowsInt( StartRow, EndRow, asAll );
  2478. end;
  2479.  
  2480. procedure TSortGrid.AutoSizeVisibleRows( StartRow, EndRow: LongInt ); // RCV04
  2481. begin
  2482.    AutoSizeRowsInt( StartRow, EndRow, asVisible );
  2483. end;
  2484.  
  2485. procedure TSortGrid.AutoSizeHiddenRows( StartRow, EndRow: LongInt ); // RCV04
  2486. begin
  2487.    AutoSizeRowsInt( StartRow, EndRow, asHidden );
  2488. end;
  2489.  
  2490. // TAutoSize: asAll, asVisible, asHidden
  2491. procedure TSortGrid.AutoSizeRowsInt( StartRow, EndRow: LongInt; How: TAutoSize ); // RCV04 priv
  2492. var
  2493.    r:    Integer;
  2494.    Auto: Boolean;
  2495. begin
  2496.    for r := StartRow to EndRow do
  2497.    begin
  2498.       Auto := False;
  2499.       if How = asAll then Auto := True;
  2500.       if (How = asVisible) and (RowHeights[ r ] <> 0) then Auto := True;
  2501.       if (How = asHidden) and (RowHeights[ r ] = 0) then Auto := True;
  2502.       if Auto = True then AutoSizeRow( r );
  2503.    end;
  2504. end;
  2505.  
  2506. procedure TSortGrid.AutoSizeRow( aRow: LongInt ); // RCV04
  2507. var
  2508.    c, maxh, h, v: Integer;
  2509.    R: TRect;  s: String;
  2510. begin
  2511.    maxh := DefaultRowHeight;
  2512.    for c := 0 to ColCount - 1 do
  2513.    begin
  2514.       s := Cells[ c, aRow ];
  2515.       R := CellRect( c, aRow );
  2516.       DrawText( Canvas.Handle, pChar( s ), -1, R, DT_CALCRECT or DT_WORDBREAK );
  2517.       h := R.Bottom - R.Top + 1;
  2518.       if h < maxh then maxh := h;
  2519.    end;
  2520.    v := fOldRowCol.GetValue( aRow, 1 );
  2521.    if v <> -1 then
  2522.    begin
  2523.       fOldRowCol.RemRC( aRow, 1 );
  2524.       fOldRowCol.SetValue( aRow, maxh, 1 );
  2525.    end else RowHeights[ aRow ] := maxh;
  2526. end;
  2527.  
  2528. procedure TSortGrid.ShowCols( StartCol, EndCol: LongInt ); // RCV04
  2529. begin
  2530.    ShowRC( StartCol, EndCol, 2 );
  2531. end;
  2532.  
  2533. procedure TSortGrid.HideCols( StartCol, EndCol: LongInt ); // RCV04
  2534. begin
  2535.    HideRC( StartCol, EndCol, 2 );
  2536. end;
  2537.  
  2538. //{$IfDef VERD4+}
  2539. procedure TSortGrid.Print; // RCV04
  2540. begin
  2541.    AutoSizeHiddenRows( 0, RowCount - 1 );
  2542.    if Printer.Printers.Count = 0 then
  2543.    begin
  2544.       MessageDlg( 'No Printer is installed', mtError, [mbOK], 0 );
  2545.       Exit;
  2546.    end;
  2547.    Printer.Title  := PrintOptions.fJobTitle;
  2548.    Printer.Copies := PrintOptions.fCopies;
  2549.    Printer.Orientation := PrintOptions.Orientation;
  2550.    PrintOptions.ToRow := RowCount - 1;
  2551.    Printer.BeginDoc;
  2552.    DrawToCanvas( Printer.Canvas, pmPrint, PrintOptions.FromRow, PrintOptions.ToRow );
  2553.    Printer.EndDoc;
  2554. end;
  2555.  
  2556. procedure TSortGrid.PrintPreview; // RCV04
  2557. var
  2558.    Preview: TSortGridPreviewForm;
  2559. begin
  2560.    fPageCount := 0;
  2561.    Preview := TSortGridPreviewForm.Create( Application );
  2562.    Preview.Grid := Self;
  2563.    fPrintImage := Preview.PrintImage;
  2564.    DrawToCanvas( fPrintImage.Canvas, pmPreview, 1, RowCount - 1 );
  2565.    Preview.PreviewImage.Picture.Bitmap.Assign( fPrintImage );
  2566.    Preview.ShowModal;
  2567.    Preview.Free;
  2568. end;
  2569.  
  2570. procedure TSortGrid.UpdatePreview( aCanvas: TCanvas ); // RCV04
  2571. begin
  2572.    fPageCount := 0;
  2573.    DrawToCanvas( aCanvas, pmPreview, 1, RowCount - 1 );
  2574. end;
  2575.  
  2576. function TSortGrid.PageCount: Integer; // RCV04
  2577. begin
  2578.    fPageCount := 0;
  2579.    DrawToCanvas( nil, pmPageCount, 1, RowCount - 1 );
  2580.    Result := fPageCount;
  2581. end;
  2582.  
  2583. procedure TSortGrid.DrawToCanvas( aCanvas: TCanvas; Mode: TPrintMode; FromRow, ToRow: LongInt ); // RCV04
  2584. var
  2585.    PageWidth, PageHeight, PageRow, PageCol, I, iRow, FromCol, ToCol, X, Y: Integer;
  2586.    DoPaint, HasLogo:  Boolean;
  2587.    Hheader, Hfooter:  Integer;
  2588.    LogoPic, LogoPics: TBitmap;
  2589.  
  2590.    function ScaleX( I: Integer ): Integer;
  2591.    begin
  2592.       if Mode = pmPreview then
  2593.          Result := I
  2594.       else
  2595.          Result := Round( I *(GetDeviceCaps( Printer.Handle, LOGPIXELSX ) / Screen.PixelsPerInch ) );
  2596.    end;
  2597.  
  2598.    function ScaleY( I:Integer ): Integer;
  2599.    begin
  2600.       if Mode = pmPreview then
  2601.          Result := I
  2602.       else
  2603.          Result := Round( I *(GetDeviceCaps( Printer.Handle, LOGPIXELSY ) / Screen.PixelsPerInch ) );
  2604.    end;
  2605.  
  2606.    procedure DrawCells( iRow: Integer );
  2607.    var
  2608.       iCol, I: Integer;
  2609.       R:       TRect;
  2610.       drs:     String;
  2611.       aState:  TGridDrawState;
  2612.       FmtOpts: TFormatOptions;
  2613.       xOffset: Cardinal;
  2614.       yOffset: Cardinal;
  2615.    begin
  2616.       if DoPaint then
  2617.       begin
  2618.          Canvas.Font.Assign( fOldFont );
  2619.          Canvas.Brush.Assign( fOldBrush );
  2620.       end;
  2621.       for iCol := FromCol to ToCol do
  2622.       begin
  2623.          if ColWidths[ iCol ] <> 0 then
  2624.          begin
  2625.             InitializeFormatOptions( iCol, iRow, FmtOpts );
  2626.             if DoPaint then
  2627.             begin
  2628.                if (iRow >= FixedRows) and (iRow <= RowCount - 1 - fFooterRows) then
  2629.                   Canvas.Brush.Color := Color;
  2630.                if (iRow < FixedRows) or ((iCol < FixedCols) and (iRow <= RowCount - 1 - fFooterRows)) then
  2631.                   Canvas.Brush.Color := FixedColor;
  2632.             end;
  2633.             // Now do the OnGetCellFormat event if necessary.
  2634.             if Assigned( fOnGetCellFormat ) then
  2635.                fOnGetCellFormat( Self, iCol, iRow, aState, FmtOpts );
  2636.  
  2637.             case FmtOpts.AlignmentHorz of
  2638.                taRightJustify:
  2639.                   xOffset := DT_RIGHT;
  2640.                taCenter:
  2641.                   xOffset := DT_CENTER;
  2642.                else
  2643.                   xOffset := DT_LEFT;
  2644.             end;
  2645.  
  2646.             case FmtOpts.AlignmentVert of
  2647.                taBottomJustify:
  2648.                   yOffset := DT_BOTTOM;
  2649.                taMiddle:
  2650.                   yOffset := DT_VCENTER;
  2651.                else
  2652.                   yOffset := DT_TOP;
  2653.             end;
  2654.             if DoPaint then
  2655.             begin
  2656.                aCanvas.Brush.Assign( FmtOpts.Brush );
  2657.                aCanvas.Font.Assign( FmtOpts.Font );
  2658.             end;
  2659.  
  2660.             // X Offset
  2661.             X := ScaleX( PrintOptions.Marginleft );
  2662.             for I := FromCol to iCol - 1 do
  2663.                Inc( X, ScaleX( ColWidths[ I ]+ 1) );
  2664.             // Text Rect
  2665.             R := Rect( X, Y, X + ScaleX( ColWidths[ iCol ] ), Y + ScaleY( RowHeights[ iRow ] ) );
  2666.             // Draw on the Canvas
  2667.             if DoPaint then
  2668.             begin
  2669.                aCanvas.Brush.Color := FmtOpts.Brush.Color;
  2670.                aCanvas.FillRect( Rect( r.Left, r.Top, r.Right + ScaleX( 2 ), r.Bottom + ScaleY( 1 ) ) );
  2671.                if PrintOptions.BorderStyle = bsSingle then
  2672.                begin
  2673.                   aCanvas.Brush.Style := bsClear;
  2674.                   aCanvas.Rectangle( r.Left, r.Top, r.Right + ScaleX( 2 ), r.Bottom + ScaleY( 1 ) );
  2675.                end;
  2676.                drs := Cells[ iCol, iRow ];
  2677.                R.Left := R.Left + ScaleX( PrintOptions.LeftPadding );
  2678.                if ( FWordWrap and (iCol < FixedCols ) and (iRow < FixedRows) ) then
  2679.                   DrawText( aCanvas.Handle, pChar( drs ), -1, R, DT_SINGLELINE or xOffset or yOffset )
  2680.                else
  2681.                   DrawText( aCanvas.Handle, pChar( drs ), -1, R, DT_WORDBREAK or xOffset );
  2682.             end;
  2683.          end;
  2684.       end;
  2685.       Inc( Y, ScaleY( RowHeights[ iRow ] ) );
  2686.    end;
  2687.  
  2688.    procedure DrawTitle; // Draw Header and Footer
  2689.    var
  2690.       S, fstr: String;
  2691.       flist:   TStringList;
  2692.       i:       Integer;
  2693.       tmpfont: TFont; // I have no idea why you can't use gettextwidth when acanvas = printer.canvas, it returns wrong value
  2694.    begin
  2695.       tmpfont := nil;
  2696.       if DoPaint then
  2697.       begin
  2698.         aCanvas.Font.Size := fPrintOptions.HeaderSize;
  2699.         tmpfont := Font;
  2700.         Canvas.Font := aCanvas.Font;
  2701.       end;
  2702.       // Title
  2703.       Y := ScaleY( PrintOptions.MarginTop );
  2704.       S := PrintOptions.PageTitle;
  2705.       HHeader := Canvas.TextHeight( S );
  2706.       if HasLogo then if LogoPic.Height > HHeader then HHeader := LogoPic.Height;
  2707.       if DoPaint then
  2708.       begin
  2709.          if HasLogo then
  2710.             aCanvas.Draw( ScaleX( PrintOptions.MarginLeft ), Y, LogoPics );
  2711.          aCanvas.TextOut( (PageWidth div 2) - (ScaleX( Canvas.TextWidth( S ) div 2 )), Y, S );
  2712.       end;
  2713.       Y := Y + ScaleY( HHeader );
  2714.       // Page nr
  2715.       S := 'Page ' + IntToStr( PageRow );
  2716.       if (ToCol < ColCount - 1) or (PageCol > 1) then
  2717.          S := S + '-' + IntToStr( PageCol );
  2718.       fstr := PrintOptions.PageFooter ;
  2719.       HFooter := Canvas.TextHeight( fstr );
  2720.       if fstr <> '' then if DoPaint then
  2721.       begin
  2722.          aCanvas.Font.Size := fPrintOptions.FooterSize ;
  2723.          Canvas.font := aCanvas.Font;
  2724.          HFooter := Canvas.TextHeight( fstr );
  2725.          fList := TStringList.Create;
  2726.          fList.Text := StringReplace( fstr, '|' , #$0D#$0A, [rfreplaceall] );
  2727.          while flist.count < 3 do
  2728.             fList.Append( '' );
  2729.          for i := 0 to 2 do
  2730.          begin
  2731.             fList[ i ] := StringReplace( fList[ i ], 'date', formatdatetime( PrintOptions.Dateformat, now ), [] );
  2732.             fList[ i ] := StringReplace( fList[ i ], 'time', formatdatetime( PrintOptions.Timeformat, now ), [] );
  2733.             fList[ i ] := StringReplace( fList[ i ], 'page', s, [] );
  2734.          end;
  2735.          // Paint left footer
  2736.          if fList[ 0 ] <> '' then
  2737.             aCanvas.TextOut( ScaleX( Integer( PrintOptions.MarginLeft ) + Canvas.TextWidth( fList[ 0 ] ) ), PageHeight - ScaleY( Integer( PrintOptions.MarginBottom )+ Canvas.TextHeight( fList[ 0 ] )), fList[ 0 ] );
  2738.          // Paint center Footer
  2739.          if fList[ 1 ] <> '' then
  2740.             aCanvas.TextOut( (PageWidth div 2)-(ScaleX( Canvas.TextWidth( fList[ 1 ] ) ) div 2), PageHeight - ScaleY( Integer( PrintOptions.MarginBottom )+ Canvas.TextHeight(fList[ 1 ] ) ), fList[ 1 ] );
  2741.          // Paint right Footer
  2742.          if fList[ 2 ] <> '' then
  2743.             aCanvas.TextOut( PageWidth - ScaleX( Integer( PrintOptions.MarginRight ) + Canvas.TextWidth( fList[ 2 ])+ 10 ), PageHeight - ScaleY( Integer( PrintOptions.MarginBottom )+ Canvas.TextHeight( fList[ 2 ])), fList[ 2 ] );
  2744.           fList.Free;
  2745.       end;
  2746.  
  2747.       if DoPaint then
  2748.       begin
  2749.          aCanvas.Font.Size := Font.Size;
  2750.          Canvas.Font := tmpfont;
  2751.       end;
  2752.       Y := Y + ScaleY( PrintOptions.PageTitleMargin );
  2753.       DrawCells( 0 );
  2754.    end;
  2755.  
  2756.  
  2757. begin
  2758.    Canvas.Font.Assign( fOldFont );
  2759.    Canvas.Brush.Assign( fOldBrush );
  2760.    // Page size
  2761.    PageWidth  := Printer.PageWidth;
  2762.    PageHeight := Printer.PageHeight;
  2763.    if Mode = pmPreview then
  2764.    begin
  2765.       PageWidth  := PageWidth div ((GetDeviceCaps( Printer.Handle, LOGPIXELSX ) div Screen.PixelsPerInch) );
  2766.       PageHeight := PageHeight div ((GetDeviceCaps( Printer.Handle, LOGPIXELSY ) div Screen.PixelsPerInch) );
  2767.       fPrintImage.Width   := PageWidth;
  2768.       fPrintImage.Height  := PageHeight;
  2769.       aCanvas.Brush.Color := Color;
  2770.       aCanvas.FillRect( Rect( 0, 0, PageWidth, PageHeight ) );
  2771.    end;
  2772.    HasLogo := False;
  2773.    if PrintOptions.Logo <> '' then if FileExists( PrintOptions.Logo ) then
  2774.    begin
  2775.       LogoPic := TBitmap.Create;
  2776.       Logopic.LoadFromFile( PrintOptions.Logo );
  2777.       Haslogo := True;
  2778.       Logopics := TBitmap.Create;
  2779.       Logopics.Width := ScaleX( Logopic.Width );
  2780.       Logopics.Height := ScaleY( Logopic.Height );
  2781.       Logopic.PixelFormat := pf24bit;
  2782.       Logopics.PixelFormat := pf24bit;
  2783.       SmoothResize( LogoPic, LogoPics );
  2784.    end;
  2785.  
  2786.    if Mode <> pmPageCount then
  2787.    begin
  2788.       aCanvas.Font := Font;
  2789.       aCanvas.Font.Color := clBlack;
  2790.    end;
  2791.    PageCol :=  0;
  2792.    FromCol := -1;
  2793.    ToCol   := -1;
  2794.    // Scan cols
  2795.    repeat
  2796.       // Scan missing cols
  2797.       if FromCol = ToCol then
  2798.          Inc( FromCol )
  2799.       else
  2800.          FromCol := ToCol + 1;
  2801.       Inc( ToCol );
  2802.       // Get Cols with width that fits page
  2803.       X := PrintOptions.MarginLeft;
  2804.       for I := FromCol to ColCount - 1 do
  2805.       begin
  2806.          Inc( X, ScaleX( ColWidths[ I ]+ 1 ) );
  2807.          if X <= (PageWidth - Integer( PrintOptions.MarginRight )) then
  2808.             ToCol := I;
  2809.       end;
  2810.       PageRow := 1;
  2811.       Inc( PageCol );
  2812.       // Mode = PageCount
  2813.       Inc( fPageCount );
  2814.       // Preview mode
  2815.       DoPaint := (((Mode = pmPreview) and (fPageCount = PrintOptions.PreviewPage)) or (Mode = pmPrint));
  2816.       // Header & Footer
  2817.       DrawTitle;
  2818.       // Contents
  2819.       iRow := FromRow;
  2820.       repeat
  2821.          if (Y + ScaleY( RowHeights[ iRow ] ) ) <= (PageHeight - ScaleY( Integer( PrintOptions.MarginBottom ) + 20 + HFooter ) ) then
  2822.          begin // Draw contents to canvas
  2823.             if RowHeights[ iRow ] <> 0 then
  2824.                DrawCells( iRow );
  2825.             Inc( iRow );
  2826.          end else // New page
  2827.          begin
  2828.             if (DoPaint = True) and (Mode = pmPreview) then
  2829.                Exit;
  2830.             if Mode = pmPrint then
  2831.                Printer.NewPage;
  2832.             Inc( fPageCount ); // Pagecount
  2833.             DoPaint := (((Mode = pmPreview) and (fPageCount = PrintOptions.PreviewPage)) or (Mode = pmPrint));
  2834.             Inc( PageRow );
  2835.             DrawTitle;
  2836.          end;
  2837.          if (iRow = ToRow + 1) and (ToCol < ColCount - 1) and (Y <= PageHeight - ScaleY( 20 )) then
  2838.          begin
  2839.             if (DoPaint = True) and (Mode = pmPreview) then
  2840.                Exit;
  2841.             if Mode = pmPrint then
  2842.                Printer.NewPage;
  2843.             DrawTitle;
  2844.          end;
  2845.       until iRow = ToRow + 1;
  2846.    until ToCol = ColCount - 1;
  2847.    if HasLogo then
  2848.    begin
  2849.       LogoPic.Free;
  2850.       LogoPics.Free;
  2851.    end;
  2852. end;
  2853.  
  2854. procedure TSortGrid.SmoothResize( var Src, Dst: TBitmap ); // RCV04
  2855. var
  2856.    x, y, xP, yP,
  2857.    yP2, xP2:        Integer;
  2858.    Read, Read2:    pByteArray;
  2859.    t, z, z2, iz2:   Integer;
  2860.    pc:             pBytearray;
  2861.    w1, w2, w3, w4:  Integer;
  2862.    Col1r, col1g, col1b, Col2r, Col2g, Col2b: Byte;
  2863. begin
  2864.   xP2 := ((src.Width- 1)shl 15)div Dst.Width;
  2865.   yP2 := ((src.Height- 1)shl 15)div Dst.Height;
  2866.   yP := 0;
  2867.   for y := 0 to Dst.Height- 1 do
  2868.   begin
  2869.     xP := 0;
  2870.     Read := src.ScanLine[ yP shr 15 ];
  2871.     if yP shr 16 < src.Height- 1 then
  2872.       Read2 := src.ScanLine [ yP shr 15 + 1 ]
  2873.     else
  2874.       Read2 := src.ScanLine [ yP shr 15 ];
  2875.     pc := Dst.scanline[ y ];
  2876.     z2 := yP and $7FFF;
  2877.     iz2 := $8000 - z2;
  2878.     for x := 0 to Dst.Width- 1 do
  2879.     begin
  2880.       t := xP shr 15;
  2881.       Col1r := Read[ t * 3 ];
  2882.       Col1g := Read[ t * 3 + 1 ];
  2883.       Col1b := Read[ t * 3 + 2 ];
  2884.       Col2r := Read2[ t * 3 ];
  2885.       Col2g := Read2[ t * 3 + 1 ];
  2886.       Col2b := Read2[ t * 3 + 2 ];
  2887.       z := xP and $7FFF;
  2888.       w2 := (z * iz2) shr 15;
  2889.       w1 := iz2 - w2;
  2890.       w4 := (z * z2) shr 15;
  2891.       w3 := z2 - w4;
  2892.       pc[ x * 3 + 2 ]:= (Col1b * w1 + Read[ (t + 1)* 3 + 2]* w2 + Col2b * w3 + Read2[ (t + 1)* 3 + 2]* w4) shr 15;
  2893.       pc[ x * 3 + 1 ] := (Col1g * w1 + Read[(t + 1)* 3 + 1]* w2 + Col2g * w3 + Read2[ (t + 1)* 3 + 1 ]* w4) shr 15;
  2894.       pc[ x * 3 ] := (Col1r * w1 + Read2[ (t + 1)* 3 ]* w2 + Col2r * w3 + Read2[ (t + 1)* 3 ]* w4) shr 15;
  2895.       Inc( xP, xP2 );
  2896.     end;
  2897.     Inc( yP, yP2 );
  2898.   end;
  2899. end;
  2900. //{$EndIf}
  2901.  
  2902. //procedure Register;
  2903. //begin
  2904. //   RegisterComponents( 'Delphi Zip', [TSortGrid] );
  2905. //end;
  2906.  
  2907. End.
  2908.  
  2909.