Delphi控件源码

开发平台：

Delphi

SkinGrids.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ DynamicSkinForm }
{ Version 4.98 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit SkinGrids;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses Messages, Windows, SysUtils, Classes, Graphics, Menus, Controls, Forms,
StdCtrls, Mask, SkinData, SkinCtrls;
const
MaxCustomExtents = MaxListSize;
MaxShortInt = High(ShortInt);
type
EInvalidGridOperation = class(Exception);
{ Internal grid types }
TGetExtentsFunc = function(Index: Longint): Integer of object;
TGridAxisDrawInfo = record
EffectiveLineWidth: Integer;
FixedBoundary: Integer;
GridBoundary: Integer;
GridExtent: Integer;
LastFullVisibleCell: Longint;
FullVisBoundary: Integer;
FixedCellCount: Integer;
FirstGridCell: Integer;
GridCellCount: Integer;
GetExtent: TGetExtentsFunc;
end;
TGridDrawInfo = record
Horz, Vert: TGridAxisDrawInfo;
end;
TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
gsRowMoving, gsColMoving);
TGridMovement = gsRowMoving..gsColMoving;
{ TInplaceEdit }
{ The inplace editor is not intended to be used outside the grid }
TspSkinCustomGrid = class;
TspSkinTransparentMaskEdit = class(TCustomMaskEdit)
private
FTransparent: Boolean;
FDown: Boolean;
procedure SetTransparent(Value: Boolean);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CNCtlColorEdit(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure DoExit; override;
procedure DoEnter; override;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMove(var Message: TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLButtonDown(var Message: TWMKeyDown); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure InvalidateEdit;
public
constructor Create(AOwner: TComponent); override;
procedure Invalidate; override;
published
property Transparent: Boolean read FTransparent write SetTransparent;
end;
TspSkinInplaceEdit = class(TspSkinTransparentMaskEdit)
private
FGrid: TspSkinCustomGrid;
FClickTime: Longint;
procedure InternalMove(const Loc: TRect; Redraw: Boolean);
procedure SetGrid(Value: TspSkinCustomGrid);
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMPaste(var Message); message WM_PASTE;
procedure WMCut(var Message); message WM_CUT;
procedure WMClear(var Message); message WM_CLEAR;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure DblClick; override;
function EditCanModify: Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure BoundsChanged; virtual;
procedure UpdateContents; virtual;
procedure WndProc(var Message: TMessage); override;
property Grid: TspSkinCustomGrid read FGrid;
public
constructor Create(AOwner: TComponent); override;
procedure Deselect;
procedure Hide;
procedure Invalidate;
procedure Move(const Loc: TRect);
function PosEqual(const Rect: TRect): Boolean;
procedure SetFocus;
procedure UpdateLoc(const Loc: TRect);
function Visible: Boolean;
end;
{ TspSkinCustomGrid }
TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
goColMoving, goEditing, goTabs, goRowSelect,
goAlwaysShowEditor, goThumbTracking);
TGridOptions = set of TGridOption;
TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
TGridCoord = record
X: Longint;
Y: Longint;
end;
TGridRect = record
case Integer of
0: (Left, Top, Right, Bottom: Longint);
1: (TopLeft, BottomRight: TGridCoord);
end;
TSelectCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
var CanSelect: Boolean) of object;
TDrawCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
Rect: TRect; State: TGridDrawState) of object;
TspSkinCustomGrid = class(TspSkinControl)
private
FTransparent: Boolean;
FInCheckScrollBars: Boolean;
FGridLineColor: TColor;
FHScrollBar: TspSkinScrollBar;
FVScrollBar: TspSkinScrollBar;
ParentImage: TBitMap;
FAnchor: TGridCoord;
FBorderStyle: TBorderStyle;
FCanEditModify: Boolean;
FColCount: Longint;
FColWidths: Pointer;
FTabStops: Pointer;
FCurrent: TGridCoord;
FDefaultColWidth: Integer;
FDefaultRowHeight: Integer;
FFixedCols: Integer;
FFixedRows: Integer;
FFixedColor: TColor;
FGridLineWidth: Integer;
FOptions: TGridOptions;
FRowCount: Longint;
FRowHeights: Pointer;
FTopLeft: TGridCoord;
FSizingIndex: Longint;
FSizingPos, FSizingOfs: Integer;
FMoveIndex, FMovePos: Longint;
FHitTest: TPoint;
FInplaceEdit: TspSkinInplaceEdit;
FInplaceCol, FInplaceRow: Longint;
FColOffset: Integer;
FDefaultDrawing: Boolean;
FEditorMode: Boolean;
procedure SetGridLineColor(Value: TColor);
procedure SetHScrollBar(Value: TspSkinScrollBar);
procedure SetVScrollBar(Value: TspSkinScrollBar);
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure SetTransparent(Value: Boolean);
procedure PaintWallPaper(C: TCanvas);
function CalcCoordFromPoint(X, Y: Integer;
const DrawInfo: TGridDrawInfo): TGridCoord;
procedure CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
UseWidth, UseHeight: Integer);
function CalcMaxTopLeft(const Coord: TGridCoord;
const DrawInfo: TGridDrawInfo): TGridCoord;
procedure CancelMode;
procedure ChangeGridOrientation(RightToLeftOrientation: Boolean);
procedure ChangeSize(NewColCount, NewRowCount: Longint);
procedure ClampInView(const Coord: TGridCoord);
procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);
procedure DrawMove;
procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
procedure GridRectToScreenRect(GridRect: TGridRect;
var ScreenRect: TRect; IncludeLine: Boolean);
procedure HideEdit;
procedure Initialize;
procedure InvalidateGrid;
procedure InvalidateRect(ARect: TGridRect);
procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal;
UseRightToLeft: Boolean);
procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
procedure MoveAnchor(const NewAnchor: TGridCoord);
procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfo;
var Axis: TGridAxisDrawInfo; Scrollbar: Integer; const MousePt: TPoint);
procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
procedure MoveTopLeft(ALeft, ATop: Longint);
procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
procedure SelectionMoved(const OldSel: TGridRect);
procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfo);
procedure TopLeftMoved(const OldTopLeft: TGridCoord);
procedure UpdateScrollPos;
procedure UpdateScrollRange;
function GetColWidths(Index: Longint): Integer;
function GetRowHeights(Index: Longint): Integer;
function GetSelection: TGridRect;
function GetTabStops(Index: Longint): Boolean;
function GetVisibleColCount: Integer;
function GetVisibleRowCount: Integer;
function IsActiveControl: Boolean;
procedure ReadColWidths(Reader: TReader);
procedure ReadRowHeights(Reader: TReader);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetCol(Value: Longint);
procedure SetColCount(Value: Longint);
procedure SetColWidths(Index: Longint; Value: Integer);
procedure SetDefaultColWidth(Value: Integer);
procedure SetDefaultRowHeight(Value: Integer);
procedure SetEditorMode(Value: Boolean);
procedure SetFixedColor(Value: TColor);
procedure SetFixedCols(Value: Integer);
procedure SetFixedRows(Value: Integer);
procedure SetGridLineWidth(Value: Integer);
procedure SetLeftCol(Value: Longint);
procedure SetOptions(Value: TGridOptions);
procedure SetRow(Value: Longint);
procedure SetRowCount(Value: Longint);
procedure SetRowHeights(Index: Longint; Value: Integer);
procedure SetSelection(Value: TGridRect);
procedure SetTabStops(Index: Longint; Value: Boolean);
procedure SetTopRow(Value: Longint);
procedure UpdateEdit;
procedure UpdateText;
procedure WriteColWidths(Writer: TWriter);
procedure WriteRowHeights(Writer: TWriter);
procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE;
procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
protected
FGridState: TGridState;
FSaveCellExtents: Boolean;
DesignOptionsBoost: TGridOptions;
VirtualView: Boolean;
//
procedure GetSkinData; override;
//
procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo);
procedure CalcFixedInfo(var DrawInfo: TGridDrawInfo);
procedure CalcSizingState(X, Y: Integer; var State: TGridState;
var Index: Longint; var SizingPos, SizingOfs: Integer;
var FixedInfo: TGridDrawInfo); virtual;
function CreateEditor: TspSkinInplaceEdit; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); reintroduce; dynamic;
function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
procedure DoExit; override;
function CellRect(ACol, ARow: Longint): TRect;
function CanEditAcceptKey(Key: Char): Boolean; dynamic;
function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
function CanEditModify: Boolean; dynamic;
function CanEditShow: Boolean; virtual;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function GetEditText(ACol, ARow: Longint): string; dynamic;
procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
function GetEditMask(ACol, ARow: Longint): string; dynamic;
function GetEditLimit: Integer; dynamic;
function GetGridWidth: Integer;
function GetGridHeight: Integer;
procedure HideEditor;
procedure ShowEditor;
procedure ShowEditorChar(Ch: Char);
procedure InvalidateEditor;
procedure MoveColumn(FromIndex, ToIndex: Longint);
procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
procedure MoveRow(FromIndex, ToIndex: Longint);
procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); virtual; abstract;
procedure DefineProperties(Filer: TFiler); override;
procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
function SelectCell(ACol, ARow: Longint): Boolean; virtual;
procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
function Sizing(X, Y: Integer): Boolean;
procedure ScrollData(DX, DY: Integer);
procedure InvalidateCell(ACol, ARow: Longint);
procedure InvalidateCol(ACol: Longint);
procedure InvalidateRow(ARow: Longint);
procedure TopLeftChanged; dynamic;
procedure TimedScroll(Direction: TGridScrollDirection); dynamic;
procedure Paint; override;
procedure ColWidthsChanged; dynamic;
procedure RowHeightsChanged; dynamic;
procedure DeleteColumn(ACol: Longint); virtual;
procedure DeleteRow(ARow: Longint); virtual;
procedure UpdateDesigner;
function BeginColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
function BeginRowDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
function CheckColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
function CheckRowDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
function EndColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
function EndRowDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; dynamic;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Col: Longint read FCurrent.X write SetCol;
property Color default clWindow;
property ColCount: Longint read FColCount write SetColCount default 5;
property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
property EditorMode: Boolean read FEditorMode write SetEditorMode;
property FixedColor: TColor read FFixedColor write SetFixedColor default clBtnFace;
property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
property GridHeight: Integer read GetGridHeight;
property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
property GridWidth: Integer read GetGridWidth;
property HitTest: TPoint read FHitTest;
property InplaceEditor: TspSkinInplaceEdit read FInplaceEdit;
property LeftCol: Longint read FTopLeft.X write SetLeftCol;
property Options: TGridOptions read FOptions write SetOptions
default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect];
property ParentColor default False;
property Row: Longint read FCurrent.Y write SetRow;
property RowCount: Longint read FRowCount write SetRowCount default 5;
property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
property Selection: TGridRect read GetSelection write SetSelection;
property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
property TopRow: Longint read FTopLeft.Y write SetTopRow;
property VisibleColCount: Integer read GetVisibleColCount;
property VisibleRowCount: Integer read GetVisibleRowCount;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure WMPAINT(var Msg: TWMPAINT); message WM_PAINT;
procedure OnVScrollBarUpButtonClick(Sender: TObject);
procedure OnVScrollBarDownButtonClick(Sender: TObject);
procedure OnHScrollBarUpButtonClick(Sender: TObject);
procedure OnHScrollBarDownButtonClick(Sender: TObject);
public
// skin properties
FixedCellRect, SelectCellRect, FocusCellRect: TRect;
FixedCellLeftOffset, FixedCellRightOffset: Integer;
FixedCellTextRect: TRect;
CellLeftOffset, CellRightOffset: Integer;
CellTextRect: TRect;
LinesColor, BGColor: TColor;
BGPictureIndex: Integer;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, SelectFontColor, FocusFontColor: TColor;
FixedFontName: String;
FixedFontStyle: TFontStyles;
FixedFontHeight: Integer;
FixedFontColor: TColor;
Picture, BGPicture: TBitMap;
procedure ChangeSkinData; override;
function GetNewTextRect(CellR: TRect; AState: TGridDrawState): TRect;
procedure SetParentImage;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function MouseCoord(X, Y: Integer): TGridCoord;
published
property Transparent: Boolean read FTransparent write SetTransparent;
property TabStop default True;
property HScrollBar: TspSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TspSkinScrollBar read FVScrollBar
write SetVScrollBar;
property GridLineColor: TColor read FGridLineColor write SetGridLineColor;
end;
{ TspSkinDrawGrid }
TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
TMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
TspSkinDrawGrid = class(TspSkinCustomGrid)
private
FOnColumnMoved: TMovedEvent;
FOnDrawCell: TDrawCellEvent;
FOnGetEditMask: TGetEditEvent;
FOnGetEditText: TGetEditEvent;
FOnRowMoved: TMovedEvent;
FOnSelectCell: TSelectCellEvent;
FOnSetEditText: TSetEditEvent;
FOnTopLeftChanged: TNotifyEvent;
protected
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
function GetEditMask(ACol, ARow: Longint): string; override;
function GetEditText(ACol, ARow: Longint): string; override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
function SelectCell(ACol, ARow: Longint): Boolean; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure TopLeftChanged; override;
public
function CellRect(ACol, ARow: Longint): TRect;
procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
property Canvas;
property Col;
property ColWidths;
property EditorMode;
property GridHeight;
property GridWidth;
property LeftCol;
property Selection;
property Row;
property RowHeights;
property TabStops;
property TopRow;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property ColCount;
property Constraints;
property DefaultColWidth;
property DefaultRowHeight;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property FixedCols;
property RowCount;
property FixedRows;
property Font;
property GridLineWidth;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnClick;
property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnRowMoved: TMovedEvent read FOnRowMoved write FOnRowMoved;
property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
end;
{ TspSkinStringGrid }
TspSkinStringGrid = class;
TspSkinStringGridStrings = class(TStrings)
private
FGrid: TspSkinStringGrid;
FIndex: Integer;
procedure CalcXY(Index: Integer; var X, Y: Integer);
protected
function Get(Index: Integer): string; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure Put(Index: Integer; const S: string); override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create(AGrid: TspSkinStringGrid; AIndex: Longint);
function Add(const S: string): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: string); override;
end;
TspSkinStringGrid = class(TspSkinDrawGrid)
private
FData: Pointer;
FRows: Pointer;
FCols: Pointer;
FUpdating: Boolean;
FNeedsUpdating: Boolean;
FEditUpdate: Integer;
procedure DisableEditUpdate;
procedure EnableEditUpdate;
procedure Initialize;
procedure Update(ACol, ARow: Integer); reintroduce;
procedure SetUpdateState(Updating: Boolean);
function GetCells(ACol, ARow: Integer): string;
function GetCols(Index: Integer): TStrings;
function GetObjects(ACol, ARow: Integer): TObject;
function GetRows(Index: Integer): TStrings;
procedure SetCells(ACol, ARow: Integer; const Value: string);
procedure SetCols(Index: Integer; Value: TStrings);
procedure SetObjects(ACol, ARow: Integer; Value: TObject);
procedure SetRows(Index: Integer; Value: TStrings);
function EnsureColRow(Index: Integer; IsCol: Boolean): TspSkinStringGridStrings;
function EnsureDataRow(ARow: Integer): Pointer;
protected
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
function GetEditText(ACol, ARow: Longint): string; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
property Cols[Index: Integer]: TStrings read GetCols write SetCols;
property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
property Rows[Index: Integer]: TStrings read GetRows write SetRows;
end;
implementation
uses Math, Consts, spUtils;
type
PIntArray = ^TIntArray;
TIntArray = array[0..MaxCustomExtents] of Integer;
procedure InvalidOp(const id: string);
begin
raise EInvalidGridOperation.Create(id);
end;
function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
begin
with Result do
begin
Left := Coord2.X;
if Coord1.X < Coord2.X then Left := Coord1.X;
Right := Coord1.X;
if Coord1.X < Coord2.X then Right := Coord2.X;
Top := Coord2.Y;
if Coord1.Y < Coord2.Y then Top := Coord1.Y;
Bottom := Coord1.Y;
if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
end;
end;
function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
and (Row <= Rect.Bottom);
end;
type
TXorRects = array[0..3] of TRect;
procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
var
Intersect, Union: TRect;
function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
begin
with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
(Y <= Bottom);
end;
function Includes(const P1: TPoint; var P2: TPoint): Boolean;
begin
with P1 do
begin
Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
if Result then P2 := P1;
end;
end;
function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
begin
Build := True;
with R do
if Includes(P1, TopLeft) then
begin
if not Includes(P3, BottomRight) then BottomRight := P2;
end
else if Includes(P2, TopLeft) then BottomRight := P3
else Build := False;
end;
begin
FillChar(XorRects, SizeOf(XorRects), 0);
if not Bool(IntersectRect(Intersect, R1, R2)) then
begin
{ Don't intersect so its simple }
XorRects[0] := R1;
XorRects[1] := R2;
end
else
begin
UnionRect(Union, R1, R2);
if Build(XorRects[0],
Point(Union.Left, Union.Top),
Point(Union.Left, Intersect.Top),
Point(Union.Left, Intersect.Bottom)) then
XorRects[0].Right := Intersect.Left;
if Build(XorRects[1],
Point(Intersect.Left, Union.Top),
Point(Intersect.Right, Union.Top),
Point(Union.Right, Union.Top)) then
XorRects[1].Bottom := Intersect.Top;
if Build(XorRects[2],
Point(Union.Right, Intersect.Top),
Point(Union.Right, Intersect.Bottom),
Point(Union.Right, Union.Bottom)) then
XorRects[2].Left := Intersect.Right;
if Build(XorRects[3],
Point(Union.Left, Union.Bottom),
Point(Intersect.Left, Union.Bottom),
Point(Intersect.Right, Union.Bottom)) then
XorRects[3].Top := Intersect.Bottom;
end;
end;
procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
Default: Integer);
var
LongSize, OldSize: LongInt;
NewSize: Integer;
I: Integer;
begin
if Amount <> 0 then
begin
if not Assigned(Extents) then OldSize := 0
else OldSize := PIntArray(Extents)^[0];
if (Index < 0) or (OldSize < Index) then InvalidOp(SIndexOutOfRange);
LongSize := OldSize + Amount;
if LongSize < 0 then InvalidOp(STooManyDeleted)
else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
NewSize := Cardinal(LongSize);
if NewSize > 0 then Inc(NewSize);
ReallocMem(Extents, NewSize * SizeOf(Integer));
if Assigned(Extents) then
begin
I := Index + 1;
while I < NewSize do
begin
PIntArray(Extents)^[I] := Default;
Inc(I);
end;
PIntArray(Extents)^[0] := NewSize-1;
end;
end;
end;
procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
Default: Integer);
var
OldSize: Integer;
begin
OldSize := 0;
if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
end;
procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
var
Extent: Integer;
begin
if Assigned(Extents) then
begin
Extent := PIntArray(Extents)^[FromIndex];
if FromIndex < ToIndex then
Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
(ToIndex - FromIndex) * SizeOf(Integer))
else if FromIndex > ToIndex then
Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
(FromIndex - ToIndex) * SizeOf(Integer));
PIntArray(Extents)^[ToIndex] := Extent;
end;
end;
function CompareExtents(E1, E2: Pointer): Boolean;
var
I: Integer;
begin
Result := False;
if E1 <> nil then
begin
if E2 <> nil then
begin
for I := 0 to PIntArray(E1)^[0] do
if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
Result := True;
end
end
else Result := E2 = nil;
end;
{ Private. LongMulDiv multiplys the first two arguments and then
divides by the third. This is used so that real number
(floating point) arithmetic is not necessary. This routine saves
the possible 64-bit value in a temp before doing the divide. Does
not do error checking like divide by zero. Also assumes that the
result is in the 32-bit range (Actually 31-bit, since this algorithm
is for unsigned). }
function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
external 'kernel32.dll' name 'MulDiv';
type
TSelection = record
StartPos, EndPos: Integer;
end;
constructor TspSkinTransparentMaskEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FTransparent := False;
FDown := False;
end;
procedure TspSkinTransparentMaskEdit.SetTransparent;
begin
if FTransparent <> Value
then
begin
FTransparent := Value;
ReCreateWnd;
end;
end;
procedure TspSkinTransparentMaskEdit.InvalidateEdit;
var
R: TRect;
begin
if Parent = nil then Exit;
R := ClientRect;
R.TopLeft := Parent.ScreenToClient(ClientToScreen(R.TopLeft));
R.BottomRight := Parent.ScreenToClient(ClientToScreen(R.BottomRight));
InvalidateRect(Parent.Handle, @R, true);
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end;
procedure TspSkinTransparentMaskEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FTransparent
then
with Params do
ExStyle := ExStyle or WS_EX_TRANSPARENT
else
inherited;
end;
procedure TspSkinTransparentMaskEdit.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FTransparent
then
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(HOLLOW_BRUSH);
end
else
inherited;
end;
procedure TspSkinTransparentMaskEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FTransparent then Invalidate else inherited;
end;
procedure TspSkinTransparentMaskEdit.DoExit;
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.DoEnter;
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMSetText(var Message:TWMSetText);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMMove(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMCut(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMPaste(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMClear(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMUndo(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMLButtonDown(var Message: TWMKeyDown);
begin
inherited;
FDown := True;
if FTransparent then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMMOUSEMOVE;
begin
inherited;
if FDown then Invalidate;
end;
procedure TspSkinTransparentMaskEdit.WMLButtonUp;
begin
inherited;
FDown := False;
end;
procedure TspSkinTransparentMaskEdit.Invalidate;
begin
if FTransparent then InvalidateEdit else inherited;
end;
constructor TspSkinInplaceEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ParentCtl3D := False;
Ctl3D := False;
TabStop := False;
BorderStyle := bsNone;
end;
procedure TspSkinInplaceEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if not Transparent then inherited;
end;
procedure TspSkinInplaceEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE;
end;
procedure TspSkinInplaceEdit.SetGrid(Value: TspSkinCustomGrid);
begin
FGrid := Value;
end;
procedure TspSkinInplaceEdit.CMShowingChanged(var Message: TMessage);
begin
end;
procedure TspSkinInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
if goTabs in Grid.Options then
Message.Result := Message.Result or DLGC_WANTTAB;
end;
procedure TspSkinInplaceEdit.WMPaste(var Message);
begin
if not EditCanModify then Exit;
inherited
end;
procedure TspSkinInplaceEdit.WMClear(var Message);
begin
if not EditCanModify then Exit;
inherited;
end;
procedure TspSkinInplaceEdit.WMCut(var Message);
begin
if not EditCanModify then Exit;
inherited;
end;
procedure TspSkinInplaceEdit.DblClick;
begin
Grid.DblClick;
end;
function TspSkinInplaceEdit.EditCanModify: Boolean;
begin
Result := Grid.CanEditModify;
end;
procedure TspSkinInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
procedure SendToParent;
begin
Grid.KeyDown(Key, Shift);
Key := 0;
end;
procedure ParentEvent;
var
GridKeyDown: TKeyEvent;
begin
GridKeyDown := Grid.OnKeyDown;
if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
end;
function ForwardMovement: Boolean;
begin
Result := goAlwaysShowEditor in Grid.Options;
end;
function Ctrl: Boolean;
begin
Result := ssCtrl in Shift;
end;
function Selection: TSelection;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
end;
function RightSide: Boolean;
begin
with Selection do
Result := ((StartPos = 0) or (EndPos = StartPos)) and
(EndPos = GetTextLen);
end;
function LeftSide: Boolean;
begin
with Selection do
Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
end;
begin
case Key of
VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_ESCAPE: SendToParent;
VK_INSERT:
if Shift = [] then SendToParent
else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
VK_LEFT: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
VK_F2:
begin
ParentEvent;
if Key = VK_F2 then
begin
Deselect;
Exit;
end;
end;
VK_TAB: if not (ssAlt in Shift) then SendToParent;
end;
if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
if Key <> 0 then
begin
ParentEvent;
inherited KeyDown(Key, Shift);
end;
end;
procedure TspSkinInplaceEdit.KeyPress(var Key: Char);
var
Selection: TSelection;
begin
Grid.KeyPress(Key);
if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
begin
Key := #0;
MessageBeep(0);
end;
case Key of
#9, #27: Key := #0;
#13:
begin
SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
Deselect else
SelectAll;
Key := #0;
end;
^H, ^V, ^X, #32..#255:
if not Grid.CanEditModify then Key := #0;
end;
if Key <> #0 then inherited KeyPress(Key);
end;
procedure TspSkinInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
Grid.KeyUp(Key, Shift);
end;
procedure TspSkinInplaceEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_SETFOCUS:
begin
if (GetParentForm(Self) = nil) or GetParentForm(Self).SetFocusedControl(Grid) then Dispatch(Message);
Exit;
end;
WM_LBUTTONDOWN:
begin
if ((GetMessageTime - FClickTime) < GetDoubleClickTime) then
Message.Msg := WM_LBUTTONDBLCLK;
FClickTime := 0;
end;
end;
inherited WndProc(Message);
end;
procedure TspSkinInplaceEdit.Deselect;
begin
SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
end;
procedure TspSkinInplaceEdit.Invalidate;
var
Cur: TRect;
begin
if not Transparent
then
begin
ValidateRect(Handle, nil);
InvalidateRect(Handle, nil, True);
Windows.GetClientRect(Handle, Cur);
MapWindowPoints(Handle, Grid.Handle, Cur, 2);
ValidateRect(Grid.Handle, @Cur);
InvalidateRect(Grid.Handle, @Cur, False);
end
else
inherited;
end;
procedure TspSkinInplaceEdit.Hide;
begin
if HandleAllocated and IsWindowVisible(Handle) then
begin
Invalidate;
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
SWP_NOREDRAW);
if Focused then Windows.SetFocus(Grid.Handle);
end;
end;
function TspSkinInplaceEdit.PosEqual(const Rect: TRect): Boolean;
var
Cur: TRect;
begin
GetWindowRect(Handle, Cur);
MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
Result := EqualRect(Rect, Cur);
end;
procedure TspSkinInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
begin
if IsRectEmpty(Loc) then Hide
else
begin
CreateHandle;
Redraw := Redraw or not IsWindowVisible(Handle);
Invalidate;
with Loc do
SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
SWP_SHOWWINDOW or SWP_NOREDRAW);
BoundsChanged;
if Redraw then Invalidate;
if Grid.Focused then
Windows.SetFocus(Handle);
end;
end;
procedure TspSkinInplaceEdit.BoundsChanged;
var
R: TRect;
begin
R := Rect(2, 2, Width - 2, Height);
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;
procedure TspSkinInplaceEdit.UpdateLoc(const Loc: TRect);
begin
InternalMove(Loc, False);
end;
function TspSkinInplaceEdit.Visible: Boolean;
begin
Result := IsWindowVisible(Handle);
end;
procedure TspSkinInplaceEdit.Move(const Loc: TRect);
begin
InternalMove(Loc, True);
end;
procedure TspSkinInplaceEdit.SetFocus;
begin
if IsWindowVisible(Handle) then
Windows.SetFocus(Handle);
end;
procedure TspSkinInplaceEdit.UpdateContents;
begin
Text := '';
EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
Text := Grid.GetEditText(Grid.Col, Grid.Row);
MaxLength := Grid.GetEditLimit;
end;
{ TspSkinCustomGrid }
constructor TspSkinCustomGrid.Create(AOwner: TComponent);
const
GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
begin
inherited Create(AOwner);
FHScrollBar := nil;
FVScrollBar := nil;
FTransparent := False;
Ctl3D := False;
if NewStyleControls then
ControlStyle := GridStyle else
ControlStyle := GridStyle + [csFramed];
FCanEditModify := True;
FInCheckScrollBars := False;
FColCount := 5;
FRowCount := 5;
FFixedCols := 1;
FFixedRows := 1;
FGridLineWidth := 1;
FOptions := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect];
DesignOptionsBoost := [goColSizing, goRowSizing];
FFixedColor := clBtnFace;
FBorderStyle := bsSingle;
FDefaultColWidth := 64;
FDefaultRowHeight := 24;
FDefaultDrawing := True;
FSaveCellExtents := True;
FEditorMode := False;
Color := clWindow;
ParentColor := False;
TabStop := True;
SetBounds(Left, Top, FColCount * FDefaultColWidth,
FRowCount * FDefaultRowHeight);
Picture := nil;
BGPicture := nil;
Initialize;
FSkinDataName := 'grid';
FGridLineColor := clWindowText;
end;
destructor TspSkinCustomGrid.Destroy;
begin
FHScrollBar := nil;
FVScrollBar := nil;
FInplaceEdit.Free;
inherited Destroy;
FreeMem(FColWidths);
FreeMem(FRowHeights);
FreeMem(FTabStops);
end;
procedure TspSkinCustomGrid.OnVScrollBarUpButtonClick(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEDOWN, VScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.OnVScrollBarDownButtonClick(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEUP, VScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.OnHScrollBarUpButtonClick(Sender: TObject);
begin
FHScrollBar.Position := FHScrollBar.Position + FHScrollBar.SmallChange;
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.OnHScrollBarDownButtonClick(Sender: TObject);
begin
FHScrollBar.Position := FHScrollBar.Position - FHScrollBar.SmallChange;
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TspSkinCustomGrid.SetGridLineColor;
begin
FGridLineColor := Value;
if FIndex = -1 then RePaint;
end;
procedure TspSkinCustomGrid.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FHScrollBar)
then FHScrollBar := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
end;
procedure TspSkinCustomGrid.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil then
begin
FHScrollBar.Enabled := True;
FHScrollBar.Visible := False;
FHScrollBar.OnLastChange := OnHScrollBarChange;
FHScrollBar.OnUpButtonClick := OnHScrollBarUpButtonClick;
FHScrollBar.OnDownButtonClick := OnHScrollBarDownButtonClick;
end;
UpdateScrollRange;
end;
procedure TspSkinCustomGrid.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil then
begin
FVScrollBar.Enabled := True;
FVScrollBar.Visible := False;
FVScrollBar.OnLastChange := OnVScrollBarChange;
FVScrollBar.OnUpButtonClick := OnVScrollBarUpButtonClick;
FVScrollBar.OnDownButtonClick := OnVScrollBarDownButtonClick;
end;
UpdateScrollRange;
end;
procedure TspSkinCustomGrid.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.OnHScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;
procedure TspSkinCustomGrid.SetParentImage;
begin
if FTransparent
then
begin
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage(Self, ParentImage.Canvas);
end;
end;
procedure TspSkinCustomGrid.SetTransparent;
begin
if FTransparent <> Value
then
begin
FTransparent := Value;
Invalidate;
end;
end;
function TspSkinCustomGrid.GetNewTextRect;
var
SR1, SR2, R: TRect;
OX: Integer;
begin
if FIndex < 0
then
begin
Result := CellR;
Exit;
end
else
begin
R := CellR;
if gdFixed in AState
then
begin
SR1 := FixedCellRect;
SR2 := FixedCellTextRect;
end
else
begin
SR1 := SelectCellRect;
SR2 := CellTextRect;
end;
if not IsNullRect(SR2)
then
begin
OX := RectWidth(CellR) - RectWidth(SR1);
Inc(R.Left, SR2.Left);
Inc(R.Top, SR2.Top);
R.Right := R.Left + RectWidth(SR2) + OX;
R.Bottom := R.Top + RectHeight(SR2);
end;
Result := R;
end
end;
procedure TspSkinCustomGrid.ChangeSkinData;
var
i, Old: Integer;
begin
GetSkinData;
if CursorIndex <> -1
then
Cursor := FSD.StartCursorIndex + CursorIndex
else
Cursor := crDefault;
if FIndex > -1
then
begin
Old := DefaultRowHeight;
i := SelectCellRect.Bottom - SelectCellRect.Top;
if i <> Old
then
DefaultRowHeight := i
else
Invalidate;
end
else
Invalidate;
end;
procedure TspSkinCustomGrid.GetSkinData;
begin
BGPicture := nil;
Picture := nil;
FIndex := -1;
inherited;
if FIndex > -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinGridControl
then
with TspDataSkinGridControl(FSD.CtrlList.Items[FIndex]) do
begin
//
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
//
Self.FixedCellRect := FixedCellRect;
Self.SelectCellRect := SelectCellRect;
Self.FocusCellRect := FocusCellRect;
Self.FixedCellLeftOffset := FixedCellLeftOffset;
Self.FixedCellRightOffset := FixedCellRightOffset;
Self.FixedCellTextRect := FixedCellTextRect;
Self.CellLeftOffset := CellLeftOffset;
Self.CellRightOffset := CellRightOffset;
Self.CellTextRect := CellTextRect;
Self.LinesColor := LinesColor;
Self.BGColor := BGColor;
Self.BGPictureIndex := BGPictureIndex;
//
if (BGPictureIndex <> -1) and (BGPictureIndex < FSD.FActivePictures.Count)
then
BGPicture := TBitMap(FSD.FActivePictures.Items[BGPictureIndex])
else
BGPicture := nil;
//
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.SelectFontColor := SelectFontColor;
Self.FocusFontColor := FocusFontColor;
Self.FixedFontName := FixedFontName;
Self.FixedFontStyle := FixedFontStyle;
Self.FixedFontHeight := FixedFontHeight;
Self.FixedFontColor := FixedFontColor;
if IsNullRect(Self.SelectCellRect)
then
Self.SelectCellRect := Self.FocusCellRect;
if IsNullRect(Self.FocusCellRect)
then
Self.FocusCellRect := Self.SelectCellRect;
if IsNullRect(Self.FixedCellRect)
then
begin
FIndex := -1;
BGPicture := nil;
Picture := nil;
end;
end;
end;
procedure TspSkinCustomGrid.PaintWallPaper;
var
X, Y, XCnt, YCnt: Integer;
begin
if (BGPicture.Width <> 0) and(BGPicture.Height <> 0) then
begin
XCnt := Width div BGPicture.Width;
YCnt := Height div BGPicture.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * BGPicture.Width, Y * BGPicture.Height,
BGPicture);
end;
end;
procedure TspSkinCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
var
NewCur: TGridCoord;
OldRows, OldCols: Longint;
MovementX, MovementY: Longint;
MoveRect: TGridRect;
ScrollArea: TRect;
AbsAmount: Longint;
function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
DefaultExtent: Integer; var Current: Longint): Longint;
var
I: Integer;
NewCount: Longint;
begin
NewCount := Count + Amount;
if NewCount < Index then InvalidOp(STooManyDeleted);
if (Amount < 0) and Assigned(Extents) then
begin
Result := 0;
for I := Index to Index - Amount - 1 do
Inc(Result, PIntArray(Extents)^[I]);
end
else
Result := Amount * DefaultExtent;
if Extents <> nil then
ModifyExtents(Extents, Index, Amount, DefaultExtent);
Count := NewCount;
if Current >= Index then
if (Amount < 0) and (Current < Index - Amount) then Current := Index
else Inc(Current, Amount);
end;
begin
if Amount = 0 then Exit;
NewCur := FCurrent;
OldCols := ColCount;
OldRows := RowCount;
MoveRect.Left := FixedCols;
MoveRect.Right := ColCount - 1;
MoveRect.Top := FixedRows;
MoveRect.Bottom := RowCount - 1;
MovementX := 0;
MovementY := 0;
AbsAmount := Amount;
if AbsAmount < 0 then AbsAmount := -AbsAmount;
if Rows then
begin
MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
MoveRect.Top := Index;
if Index + AbsAmount <= TopRow then MoveRect.Bottom := TopRow - 1;
end
else
begin
MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
MoveRect.Left := Index;
if Index + AbsAmount <= LeftCol then MoveRect.Right := LeftCol - 1;
end;
GridRectToScreenRect(MoveRect, ScrollArea, True);
if not IsRectEmpty(ScrollArea) then
begin
ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
UpdateWindow(Handle);
end;
SizeChanged(OldCols, OldRows);
if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
MoveCurrent(NewCur.X, NewCur.Y, True, True);
end;
function TspSkinCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
var
GridRect: TGridRect;
begin
GridRect.Left := ALeft;
GridRect.Right := ARight;
GridRect.Top := ATop;
GridRect.Bottom := ABottom;
GridRectToScreenRect(GridRect, Result, False);
end;
procedure TspSkinCustomGrid.DoExit;
begin
inherited DoExit;
if not (goAlwaysShowEditor in Options) then HideEditor;
end;
function TspSkinCustomGrid.CellRect(ACol, ARow: Longint): TRect;
begin
Result := BoxRect(ACol, ARow, ACol, ARow);
end;
function TspSkinCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
begin
Result := True;
end;
function TspSkinCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
begin
Result := True;
end;
function TspSkinCustomGrid.CanEditModify: Boolean;
begin
Result := FCanEditModify;
end;
function TspSkinCustomGrid.CanEditShow: Boolean;
begin
Result := ([goRowSelect, goEditing] * Options = [goEditing]) and
FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
((goAlwaysShowEditor in Options) or IsActiveControl);
end;
function TspSkinCustomGrid.IsActiveControl: Boolean;
var
H: Hwnd;
ParentForm: TCustomForm;
begin
Result := False;
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) then
begin
if (ParentForm.ActiveControl = Self) then
Result := True
end
else
begin
H := GetFocus;
while IsWindow(H) and (Result = False) do
begin
if H = WindowHandle then
Result := True
else
H := GetParent(H);
end;
end;
end;
function TspSkinCustomGrid.GetEditMask(ACol, ARow: Longint): string;
begin
Result := '';
end;
function TspSkinCustomGrid.GetEditText(ACol, ARow: Longint): string;
begin
Result := '';
end;
procedure TspSkinCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
end;
function TspSkinCustomGrid.GetEditLimit: Integer;
begin
Result := 0;
end;
procedure TspSkinCustomGrid.HideEditor;
begin
FEditorMode := False;
HideEdit;
end;
procedure TspSkinCustomGrid.ShowEditor;
begin
FEditorMode := True;
UpdateEdit;
end;
procedure TspSkinCustomGrid.ShowEditorChar(Ch: Char);
begin
ShowEditor;
if FInplaceEdit <> nil then
PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0);
end;
procedure TspSkinCustomGrid.InvalidateEditor;
begin
FInplaceCol := -1;
FInplaceRow := -1;
UpdateEdit;
end;
procedure TspSkinCustomGrid.ReadColWidths(Reader: TReader);
var
I: Integer;
begin
with Reader do
begin
ReadListBegin;
for I := 0 to ColCount - 1 do ColWidths[I] := ReadInteger;
ReadListEnd;
end;
end;
procedure TspSkinCustomGrid.ReadRowHeights(Reader: TReader);
var
I: Integer;
begin
with Reader do
begin
ReadListBegin;
for I := 0 to RowCount - 1 do RowHeights[I] := ReadInteger;
ReadListEnd;
end;
end;
procedure TspSkinCustomGrid.WriteColWidths(Writer: TWriter);
var
I: Integer;
begin
with Writer do
begin
WriteListBegin;
for I := 0 to ColCount - 1 do WriteInteger(ColWidths[I]);
WriteListEnd;
end;
end;
procedure TspSkinCustomGrid.WriteRowHeights(Writer: TWriter);
var
I: Integer;
begin
with Writer do
begin
WriteListBegin;
for I := 0 to RowCount - 1 do WriteInteger(RowHeights[I]);
WriteListEnd;
end;
end;
procedure TspSkinCustomGrid.DefineProperties(Filer: TFiler);
function DoColWidths: Boolean;
begin
if Filer.Ancestor <> nil then
Result := not CompareExtents(TspSkinCustomGrid(Filer.Ancestor).FColWidths, FColWidths)
else
Result := FColWidths <> nil;
end;
function DoRowHeights: Boolean;
begin
if Filer.Ancestor <> nil then
Result := not CompareExtents(TspSkinCustomGrid(Filer.Ancestor).FRowHeights, FRowHeights)
else
Result := FRowHeights <> nil;
end;
begin
inherited DefineProperties(Filer);
if FSaveCellExtents then
with Filer do
begin
DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColWidths);
DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowHeights);
end;
end;
procedure TspSkinCustomGrid.MoveColumn(FromIndex, ToIndex: Longint);
var
Rect: TGridRect;
begin
if FromIndex = ToIndex then Exit;
if Assigned(FColWidths) then
begin
MoveExtent(FColWidths, FromIndex + 1, ToIndex + 1);
MoveExtent(FTabStops, FromIndex + 1, ToIndex + 1);
end;
MoveAdjust(FCurrent.X, FromIndex, ToIndex);
MoveAdjust(FAnchor.X, FromIndex, ToIndex);
MoveAdjust(FInplaceCol, FromIndex, ToIndex);
Rect.Top := 0;
Rect.Bottom := VisibleRowCount;
if FromIndex < ToIndex then
begin
Rect.Left := FromIndex;
Rect.Right := ToIndex;
end
else
begin
Rect.Left := ToIndex;
Rect.Right := FromIndex;
end;
InvalidateRect(Rect);
ColumnMoved(FromIndex, ToIndex);
if Assigned(FColWidths) then
ColWidthsChanged;
UpdateEdit;
end;
procedure TspSkinCustomGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
end;
procedure TspSkinCustomGrid.MoveRow(FromIndex, ToIndex: Longint);
begin
if Assigned(FRowHeights) then
MoveExtent(FRowHeights, FromIndex + 1, ToIndex + 1);
MoveAdjust(FCurrent.Y, FromIndex, ToIndex);
MoveAdjust(FAnchor.Y, FromIndex, ToIndex);
MoveAdjust(FInplaceRow, FromIndex, ToIndex);
RowMoved(FromIndex, ToIndex);
if Assigned(FRowHeights) then
RowHeightsChanged;
UpdateEdit;
end;
procedure TspSkinCustomGrid.RowMoved(FromIndex, ToIndex: Longint);
begin
end;
function TspSkinCustomGrid.MouseCoord(X, Y: Integer): TGridCoord;
var
DrawInfo: TGridDrawInfo;
begin
CalcDrawInfo(DrawInfo);
Result := CalcCoordFromPoint(X, Y, DrawInfo);
if Result.X < 0 then Result.Y := -1
else if Result.Y < 0 then Result.X := -1;
end;
procedure TspSkinCustomGrid.MoveColRow(ACol, ARow: Longint; MoveAnchor,
Show: Boolean);
begin
MoveCurrent(ACol, ARow, MoveAnchor, Show);
end;
function TspSkinCustomGrid.SelectCell(ACol, ARow: Longint): Boolean;
begin
Result := True;
end;
procedure TspSkinCustomGrid.SizeChanged(OldColCount, OldRowCount: Longint);
begin
end;
function TspSkinCustomGrid.Sizing(X, Y: Integer): Boolean;
var
DrawInfo: TGridDrawInfo;
State: TGridState;
Index: Longint;
Pos, Ofs: Integer;
begin
State := FGridState;
if State = gsNormal then
begin
CalcDrawInfo(DrawInfo);
CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
end;
Result := State <> gsNormal;
end;
procedure TspSkinCustomGrid.TopLeftChanged;
begin
if FEditorMode and (FInplaceEdit <> nil) then FInplaceEdit.UpdateLoc(CellRect(Col, Row));
end;
procedure FillDWord(var Dest; Count, Value: Integer); register;
asm
XCHG EDX, ECX
PUSH EDI
MOV EDI, EAX
MOV EAX, EDX
REP STOSD
POP EDI
end;
function StackAlloc(Size: Integer): Pointer; register;
asm
POP ECX { return address }
MOV EDX, ESP
ADD EAX, 3
AND EAX, not 3 // round up to keep ESP dword aligned
CMP EAX, 4092
JLE @@2
@@1:
SUB ESP, 4092
PUSH EAX { make sure we touch guard page, to grow stack }
SUB EAX, 4096
JNS @@1
ADD EAX, 4096
@@2:
SUB ESP, EAX
MOV EAX, ESP { function result = low memory address of block }
PUSH EDX { save original SP, for cleanup }
MOV EDX, ESP
SUB EDX, 4
PUSH EDX { save current SP, for sanity check (sp = [sp]) }
PUSH ECX { return to caller }
end;
procedure StackFree(P: Pointer); register;
asm
POP ECX { return address }
MOV EDX, DWORD PTR [ESP]
SUB EAX, 8
CMP EDX, ESP { sanity check #1 (SP = [SP]) }
JNE @@1
CMP EDX, EAX { sanity check #2 (P = this stack block) }
JNE @@1
MOV ESP, DWORD PTR [ESP+4] { restore previous SP }
@@1:
PUSH ECX { return to caller }
end;
procedure TspSkinCustomGrid.Paint;
var
LineColor: TColor;
DrawInfo: TGridDrawInfo;
Sel: TGridRect;
UpdateRect: TRect;
R, AFocRect, FocRect: TRect;
PointsList: PIntArray;
StrokeList: PIntArray;
MaxStroke: Integer;
FrameFlags1, FrameFlags2: DWORD;
B: TBitMap;
procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
const CellBounds: array of Integer; OnColor, OffColor: TColor);
const
FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
Cell, MajorIndex: Integer; UseOnColor: Boolean);
var
Line: Integer;
LogBrush: TLOGBRUSH;
Index: Integer;
Points: PIntArray;
StopMajor, StartMinor, StopMinor: Integer;
begin
with Canvas, AxisInfo do
begin
if EffectiveLineWidth <> 0 then
begin
Pen.Width := GridLineWidth;
if UseOnColor then
Pen.Color := OnColor
else
Pen.Color := OffColor;
if Pen.Width > 1 then
begin
LogBrush.lbStyle := BS_Solid;
LogBrush.lbColor := Pen.Color;
LogBrush.lbHatch := 0;
Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
end;
Points := PointsList;
Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
GetExtent(Cell);
//!!! ??? Line needs to be incremented for RightToLeftAlignment ???
if UseRightToLeftAlignment and (MajorIndex = 0) then Inc(Line);
StartMinor := CellBounds[MajorIndex xor 1];
StopMinor := CellBounds[2 + (MajorIndex xor 1)];
StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
Index := 0;
repeat
Points^[Index + MajorIndex] := Line; { MoveTo }
Points^[Index + (MajorIndex xor 1)] := StartMinor;
Inc(Index, 2);
Points^[Index + MajorIndex] := Line; { LineTo }
Points^[Index + (MajorIndex xor 1)] := StopMinor;
Inc(Index, 2);
Inc(Cell);
Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
until Line > StopMajor;
{ 2 integers per point, 2 points per line -> Index div 4 }
PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
end;
end;
end;
begin
if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
if not DoHorz then
begin
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
end
else
begin
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
end;
end;
procedure DrawSkinCell(B: TBitMap; AState: TGridDrawState; W, H: Integer);
begin
if (gdFixed in AState)
then
begin
CreateHSkinImage(FixedCellLeftOffset, FixedCellRightOffset,
B, Picture, FixedCellRect, W, H);
with Canvas do
begin
Font.Name := FixedFontName;
Font.Height := FixedFontHeight;
Font.Color := FixedFontColor;
Font.Style := FixedFontStyle;
Font.CharSet := Self.Font.CharSet;
end;
end
else
if (gdFocused in AState) or (goRowSelect in Options)
then
begin
CreateHSkinImage(CellLeftOffset, CellRightOffset,
B, Picture, FocusCellRect, W, H);
with Canvas do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FocusFontColor;
Font.Style := FontStyle;
Font.CharSet := Self.Font.CharSet;
end;
end
else
if (gdSelected in AState)
then
begin
CreateHSkinImage(CellLeftOffset, CellRightOffset,
B, Picture, SelectCellRect, W, H);
with Canvas do
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := SelectFontColor;
Font.Style := FontStyle;
Font.CharSet := Self.Font.CharSet;
end;
end;
end;
procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
Color: TColor; IncludeDrawState: TGridDrawState);
var
CurCol, CurRow: Longint;
AWhere, Where, TempRect: TRect;
DrawState: TGridDrawState;
Focused: Boolean;
begin
CurRow := ARow;
Where.Top := StartY;
while (Where.Top < StopY) and (CurRow < RowCount) do
begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + RowHeights[CurRow];
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
DrawState := IncludeDrawState;
Focused := IsActiveControl;
if Focused and (CurRow = Row) and (CurCol = Col) then
Include(DrawState, gdFocused);
if PointInGridRect(CurCol, CurRow, Sel) then
Include(DrawState, gdSelected);
if not (gdFocused in DrawState) or not (goEditing in Options) or
not FEditorMode or (csDesigning in ComponentState) then
begin
if DefaultDrawing or (csDesigning in ComponentState) then
with Canvas do
begin
if FIndex < 0
then
begin
Font := Self.Font;
if (gdSelected in DrawState) and
(not (gdFocused in DrawState) or
([goDrawFocusSelected, goRowSelect] * Options <> []))
then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
FillRect(Where)
end
else
if (not Transparent) or (gdFixed in DrawState)
then
begin
Brush.Color := Color;
FillRect(Where);
if gdFixed in DrawState
then
begin
R := Where;
Frm3D(Canvas, R, clBtnHighLight, clBtnShadow);
end;
end;
end
else
if not (gdSelected in DrawState) and
not (gdFocused in DrawState) and
not (gdFixed in DrawState)
then
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FontColor;
Font.Style := FontStyle;
Font.CharSet := Self.Font.CharSet;
if (BGPicture = nil) and not Transparent
then
begin
Brush.Color := BGColor;
FillRect(Where);
end
end
else
begin
B := TBitMap.Create;
DrawSkinCell(B, DrawState,
RectWidth(Where), RectHeight(Where));
Draw(Where.Left, Where.Top, B);
B.Free;
end;
end;
DrawCell(CurCol, CurRow, Where, DrawState);
if FIndex < 0
then
if DefaultDrawing and not (csDesigning in ComponentState) and
(gdFocused in DrawState) and
([goEditing, goAlwaysShowEditor] * Options <> [goEditing, goAlwaysShowEditor])
and not (goRowSelect in Options)
then
begin
if not UseRightToLeftAlignment
then
DrawFocusRect(Canvas.Handle, Where)
else
begin
AWhere := Where;
AWhere.Left := Where.Right;
AWhere.Right := Where.Left;
DrawFocusRect(Canvas.Handle, AWhere)
end;
end;
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end;
end;
begin
if (Width <= 0) or (Height <=0) then Exit;
GetSkinData;
if UseRightToLeftAlignment then ChangeGridOrientation(True);
UpdateRect := Canvas.ClipRect;
if (FIndex > -1) and (BGPicture <> nil) and not Transparent
then
PaintWallPaper(Canvas)
else
begin
if FTransparent
then
begin
ParentImage := TBitMap.Create;
SetParentImage;
Canvas.Draw(0, 0, ParentImage);
ParentImage.Free;
end;
end;
CalcDrawInfo(DrawInfo);
with DrawInfo do
begin
if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
begin
{ Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
(fixed, variable) and (variable, variable) }
if FIndex > -1
then
LineColor := LinesColor
else
LineColor := FGridLineColor;
MaxStroke := Max(Horz.LastFullVisibleCell - LeftCol + FixedCols,
Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
FillDWord(StrokeList^, MaxStroke, 2);
if ColorToRGB(Color) = clSilver then LineColor := clGray;
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], LineColor{clBlack}, FixedColor);
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
Vert.FixedBoundary], LineColor{clBlack}, FixedColor);
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
Vert.GridBoundary], LineColor{clBlack}, FixedColor);
// skin
DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
Vert.GridBoundary], LineColor, Color);
//
StackFree(StrokeList);
StackFree(PointsList);
end;
{ Draw the cells in the four areas }
Sel := Selection;
FrameFlags1 := 0;
FrameFlags2 := 0;
if goFixedVertLine in Options then
begin
FrameFlags1 := BF_RIGHT;
FrameFlags2 := BF_LEFT;
end;
if goFixedHorzLine in Options then
begin
FrameFlags1 := FrameFlags1 or BF_BOTTOM;
FrameFlags2 := FrameFlags2 or BF_TOP;
end;
DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
[gdFixed]);
DrawCells(LeftCol, 0, Horz.FixedBoundary - FColOffset, 0, Horz.GridBoundary, //!! clip
Vert.FixedBoundary, FixedColor, [gdFixed]);
DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
Vert.GridBoundary, FixedColor, [gdFixed]);
DrawCells(LeftCol, TopRow, Horz.FixedBoundary - FColOffset, //!! clip
Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, Color, []);
if not (csDesigning in ComponentState) and
(goRowSelect in Options) and DefaultDrawing and Focused then
begin
GridRectToScreenRect(GetSelection, FocRect, False);
if FIndex < 0
then
if not UseRightToLeftAlignment
then
Canvas.DrawFocusRect(FocRect)
else
begin
AFocRect := FocRect;
AFocRect.Left := FocRect.Right;
AFocRect.Right := FocRect.Left;
Canvas.DrawFocusRect(AFocRect)
end;
end;
if ((FIndex < 0) or (BGPicture = nil)) and not Transparent
then
begin
{ Fill in area not occupied by cells }
if Horz.GridBoundary < Horz.GridExtent then
begin
if FIndex > -1
then
Canvas.Brush.Color := BGColor
else
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent + 1, Vert.GridBoundary));
end;
if Vert.GridBoundary < Vert.GridExtent then
begin
if FIndex > -1
then
Canvas.Brush.Color := BGColor
else
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
end;
end;
end;
if UseRightToLeftAlignment then ChangeGridOrientation(False);
end;
function TspSkinCustomGrid.CalcCoordFromPoint(X, Y: Integer;
const DrawInfo: TGridDrawInfo): TGridCoord;
function DoCalc(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
var
I, Start, Stop: Longint;
Line: Integer;
begin
with AxisInfo do
begin
if N < FixedBoundary then
begin
Start := 0;
Stop := FixedCellCount - 1;
Line := 0;
end
else
begin
Start := FirstGridCell;
Stop := GridCellCount - 1;
Line := FixedBoundary;
end;
Result := -1;
for I := Start to Stop do
begin
Inc(Line, GetExtent(I) + EffectiveLineWidth);
if N < Line then
begin
Result := I;
Exit;
end;
end;
end;
end;
function DoCalcRightToLeft(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
var
I, Start, Stop: Longint;
Line: Integer;
begin
N := ClientWidth - N;
with AxisInfo do
begin
if N < FixedBoundary then
begin
Start := 0;
Stop := FixedCellCount - 1;
Line := ClientWidth;
end
else
begin
Start := FirstGridCell;
Stop := GridCellCount - 1;
Line := FixedBoundary;
end;
Result := -1;
for I := Start to Stop do
begin
Inc(Line, GetExtent(I) + EffectiveLineWidth);
if N < Line then
begin
Result := I;
Exit;
end;
end;
end;
end;
begin
if not UseRightToLeftAlignment then
Result.X := DoCalc(DrawInfo.Horz, X)
else
Result.X := DoCalcRightToLeft(DrawInfo.Horz, X);
Result.Y := DoCalc(DrawInfo.Vert, Y);
end;
procedure TspSkinCustomGrid.CalcDrawInfo(var DrawInfo: TGridDrawInfo);
begin
CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
end;
procedure TspSkinCustomGrid.CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
UseWidth, UseHeight: Integer);
procedure CalcAxis(var AxisInfo: TGridAxisDrawInfo; UseExtent: Integer);
var
I: Integer;
begin
with AxisInfo do
begin
GridExtent := UseExtent;
GridBoundary := FixedBoundary;
FullVisBoundary := FixedBoundary;
LastFullVisibleCell := FirstGridCell;
for I := FirstGridCell to GridCellCount - 1 do
begin
Inc(GridBoundary, GetExtent(I) + EffectiveLineWidth);
if GridBoundary > GridExtent + EffectiveLineWidth then
begin
GridBoundary := GridExtent;
Break;
end;
LastFullVisibleCell := I;
FullVisBoundary := GridBoundary;
end;
end;
end;
begin
CalcFixedInfo(DrawInfo);
CalcAxis(DrawInfo.Horz, UseWidth);
CalcAxis(DrawInfo.Vert, UseHeight);
end;
procedure TspSkinCustomGrid.CalcFixedInfo(var DrawInfo: TGridDrawInfo);
procedure CalcFixedAxis(var Axis: TGridAxisDrawInfo; LineOptions: TGridOptions;
FixedCount, FirstCell, CellCount: Integer; GetExtentFunc: TGetExtentsFunc);
var
I: Integer;
begin
with Axis do
begin
if LineOptions * Options = [] then
EffectiveLineWidth := 0
else
EffectiveLineWidth := GridLineWidth;
FixedBoundary := 0;
for I := 0 to FixedCount - 1 do
Inc(FixedBoundary, GetExtentFunc(I) + EffectiveLineWidth);
FixedCellCount := FixedCount;
FirstGridCell := FirstCell;
GridCellCount := CellCount;
GetExtent := GetExtentFunc;
end;
end;
begin
CalcFixedAxis(DrawInfo.Horz, [goFixedVertLine, goVertLine], FixedCols,
LeftCol, ColCount, GetColWidths);
CalcFixedAxis(DrawInfo.Vert, [goFixedHorzLine, goHorzLine], FixedRows,
TopRow, RowCount, GetRowHeights);
end;
{ Calculates the TopLeft that will put the given Coord in view }
function TspSkinCustomGrid.CalcMaxTopLeft(const Coord: TGridCoord;
const DrawInfo: TGridDrawInfo): TGridCoord;
function CalcMaxCell(const Axis: TGridAxisDrawInfo; Start: Integer): Integer;
var
Line: Integer;
I, Extent: Longint;
begin
Result := Start;
with Axis do
begin
Line := GridExtent + EffectiveLineWidth;
for I := Start downto FixedCellCount do
begin
Extent := GetExtent(I);
Dec(Line, Extent);
Dec(Line, EffectiveLineWidth);
if Line < FixedBoundary then Break;
if Extent > 0 then Result := I;
end;
end;
end;
begin
Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
end;
procedure TspSkinCustomGrid.CalcSizingState(X, Y: Integer; var State: TGridState;
var Index: Longint; var SizingPos, SizingOfs: Integer;
var FixedInfo: TGridDrawInfo);
procedure CalcAxisState(const AxisInfo: TGridAxisDrawInfo; Pos: Integer;
NewState: TGridState);
var
I, Line, Back, Range: Integer;
begin
if UseRightToLeftAlignment then
Pos := ClientWidth - Pos;
with AxisInfo do
begin
Line := FixedBoundary;
Range := EffectiveLineWidth;
Back := 0;
if Range < 7 then
begin
Range := 7;
Back := (Range - EffectiveLineWidth) shr 1;
end;
for I := FirstGridCell to GridCellCount - 1 do
begin
Inc(Line, GetExtent(I));
if Line > GridBoundary then Break;
if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
begin
State := NewState;
SizingPos := Line;
SizingOfs := Line - Pos;
Index := I;
Exit;
end;
Inc(Line, EffectiveLineWidth);
end;
if (GridBoundary = GridExtent) and (Pos >= GridExtent - Back)
and (Pos <= GridExtent) then
begin
State := NewState;
SizingPos := GridExtent;
SizingOfs := GridExtent - Pos;
Index := LastFullVisibleCell + 1;
end;
end;
end;
function XOutsideHorzFixedBoundary: Boolean;
begin
with FixedInfo do
if not UseRightToLeftAlignment then
Result := X > Horz.FixedBoundary
else
Result := X < ClientWidth - Horz.FixedBoundary;
end;
function XOutsideOrEqualHorzFixedBoundary: Boolean;
begin
with FixedInfo do
if not UseRightToLeftAlignment then
Result := X >= Horz.FixedBoundary
else
Result := X <= ClientWidth - Horz.FixedBoundary;
end;
var
EffectiveOptions: TGridOptions;
begin
State := gsNormal;
Index := -1;
EffectiveOptions := Options;
if csDesigning in ComponentState then
EffectiveOptions := EffectiveOptions + DesignOptionsBoost;
if [goColSizing, goRowSizing] * EffectiveOptions <> [] then
with FixedInfo do
begin
Vert.GridExtent := ClientHeight;
Horz.GridExtent := ClientWidth;
if (XOutsideHorzFixedBoundary) and (goColSizing in EffectiveOptions) then
begin
if Y >= Vert.FixedBoundary then Exit;
CalcAxisState(Horz, X, gsColSizing);
end
else if (Y > Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
begin
if XOutsideOrEqualHorzFixedBoundary then Exit;
CalcAxisState(Vert, Y, gsRowSizing);
end;
end;
end;
procedure TspSkinCustomGrid.ChangeGridOrientation(RightToLeftOrientation: Boolean);
var
Org: TPoint;
Ext: TPoint;
begin
if RightToLeftOrientation then
begin
Org := Point(ClientWidth,0);
Ext := Point(-1,1);
SetMapMode(Canvas.Handle, mm_Anisotropic);
SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil);
SetViewportExtEx(Canvas.Handle, ClientWidth, ClientHeight, nil);
SetWindowExtEx(Canvas.Handle, Ext.X*ClientWidth, Ext.Y*ClientHeight, nil);
end
else
begin
Org := Point(0,0);
Ext := Point(1,1);
SetMapMode(Canvas.Handle, mm_Anisotropic);
SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil);
SetViewportExtEx(Canvas.Handle, ClientWidth, ClientHeight, nil);
SetWindowExtEx(Canvas.Handle, Ext.X*ClientWidth, Ext.Y*ClientHeight, nil);
end;
end;
procedure TspSkinCustomGrid.ChangeSize(NewColCount, NewRowCount: Longint);
var
OldColCount, OldRowCount: Longint;
OldDrawInfo: TGridDrawInfo;
procedure MinRedraw(const OldInfo, NewInfo: TGridAxisDrawInfo; Axis: Integer);
var
R: TRect;
First: Integer;
begin
First := Min(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
// Get the rectangle around the leftmost or topmost cell in the target range.
R := CellRect(First and not Axis, First and Axis);
R.Bottom := Height;
R.Right := Width;
Windows.InvalidateRect(Handle, @R, False);
end;
procedure DoChange;
var
Coord: TGridCoord;
NewDrawInfo: TGridDrawInfo;
begin
if FColWidths <> nil then
begin
UpdateExtents(FColWidths, ColCount, DefaultColWidth);
UpdateExtents(FTabStops, ColCount, Integer(True));
end;
if FRowHeights <> nil then
UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
Coord := FCurrent;
if Row >= RowCount then Coord.Y := RowCount - 1;
if Col >= ColCount then Coord.X := ColCount - 1;
if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
MoveCurrent(Coord.X, Coord.Y, True, True);
if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
MoveAnchor(Coord);
if VirtualView or
(LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
(TopRow <> OldDrawInfo.Vert.FirstGridCell) then
InvalidateGrid
else if HandleAllocated then
begin
CalcDrawInfo(NewDrawInfo);
MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
end;
UpdateScrollRange;
SizeChanged(OldColCount, OldRowCount);
end;
begin
if HandleAllocated then
CalcDrawInfo(OldDrawInfo);
OldColCount := FColCount;
OldRowCount := FRowCount;
FColCount := NewColCount;
FRowCount := NewRowCount;
if FixedCols > NewColCount then FFixedCols := NewColCount - 1;
if FixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
try
DoChange;
except
{ Could not change size so try to clean up by setting the size back }
FColCount := OldColCount;
FRowCount := OldRowCount;
DoChange;
InvalidateGrid;
raise;
end;
end;
{ Will move TopLeft so that Coord is in view }
procedure TspSkinCustomGrid.ClampInView(const Coord: TGridCoord);
var
DrawInfo: TGridDrawInfo;
MaxTopLeft: TGridCoord;
OldTopLeft: TGridCoord;
begin
if not HandleAllocated then Exit;
CalcDrawInfo(DrawInfo);
with DrawInfo, Coord do
begin
if (X > Horz.LastFullVisibleCell) or
(Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then
begin
OldTopLeft := FTopLeft;
MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
Update;
if X < LeftCol then FTopLeft.X := X
else if X > Horz.LastFullVisibleCell then FTopLeft.X := MaxTopLeft.X;
if Y < TopRow then FTopLeft.Y := Y
else if Y > Vert.LastFullVisibleCell then FTopLeft.Y := MaxTopLeft.Y;
TopLeftMoved(OldTopLeft);
end;
end;
end;
procedure TspSkinCustomGrid.DrawSizingLine(const DrawInfo: TGridDrawInfo);
var
OldPen: TPen;
begin
OldPen := TPen.Create;
try
with Canvas, DrawInfo do
begin
OldPen.Assign(Pen);
Pen.Style := psDot;
Pen.Mode := pmXor;
Pen.Width := 1;
try
if FGridState = gsRowSizing then
begin
MoveTo(0, FSizingPos);
LineTo(Horz.GridBoundary, FSizingPos);
end
else
begin
MoveTo(FSizingPos, 0);
LineTo(FSizingPos, Vert.GridBoundary);
end;
finally
Pen := OldPen;
end;
end;
finally
OldPen.Free;
end;
end;
procedure TspSkinCustomGrid.DrawMove;
var
OldPen: TPen;
Pos: Integer;
R: TRect;
begin
OldPen := TPen.Create;
try
with Canvas do
begin
OldPen.Assign(Pen);
try
Pen.Style := psDot;
Pen.Mode := pmXor;
Pen.Width := 5;
if FGridState = gsRowMoving then
begin
R := CellRect(0, FMovePos);
if FMovePos > FMoveIndex then
Pos := R.Bottom else
Pos := R.Top;
MoveTo(0, Pos);
LineTo(ClientWidth, Pos);
end
else
begin
R := CellRect(FMovePos, 0);
if FMovePos > FMoveIndex then
if not UseRightToLeftAlignment then
Pos := R.Right
else
Pos := R.Left
else
if not UseRightToLeftAlignment then
Pos := R.Left
else
Pos := R.Right;
MoveTo(Pos, 0);
LineTo(Pos, ClientHeight);
end;
finally
Canvas.Pen := OldPen;
end;
end;
finally
OldPen.Free;
end;
end;
procedure TspSkinCustomGrid.FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
begin
MoveCurrent(ACol, ARow, MoveAnchor, True);
UpdateEdit;
Click;
end;
procedure TspSkinCustomGrid.GridRectToScreenRect(GridRect: TGridRect;
var ScreenRect: TRect; IncludeLine: Boolean);
function LinePos(const AxisInfo: TGridAxisDrawInfo; Line: Integer): Integer;
var
Start, I: Longint;
begin
with AxisInfo do
begin
Result := 0;
if Line < FixedCellCount then
Start := 0
else
begin
if Line >= FirstGridCell then
Result := FixedBoundary;
Start := FirstGridCell;
end;
for I := Start to Line - 1 do
begin
Inc(Result, GetExtent(I) + EffectiveLineWidth);
if Result > GridExtent then
begin
Result := 0;
Exit;
end;
end;
end;
end;
function CalcAxis(const AxisInfo: TGridAxisDrawInfo;
GridRectMin, GridRectMax: Integer;
var ScreenRectMin, ScreenRectMax: Integer): Boolean;
begin