WebSVN – autosfx – Blame – /zmstr1900102/Demos/SortGrid/SortGrid.pas

Rev	Author	Line No.	Line
1	daniel-mar	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
		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

Subversion Repositories autosfx

autosfx/zmstr1900102/Demos/SortGrid/SortGrid.pas – Rev 1