summaryrefslogtreecommitdiff
path: root/extras
diff options
context:
space:
mode:
Diffstat (limited to 'extras')
-rw-r--r--extras/contributed/nicegrid/fpg_nicegrid.pas3429
-rw-r--r--extras/contributed/nicegrid/fpg_types.pas131
-rw-r--r--extras/contributed/nicegrid/main1.pas368
-rw-r--r--extras/contributed/nicegrid/main2.pas104
-rw-r--r--extras/contributed/nicegrid/main3.pas204
-rw-r--r--extras/contributed/nicegrid/nicegrid1.lpi72
-rw-r--r--extras/contributed/nicegrid/nicegrid1.lpr32
-rw-r--r--extras/contributed/nicegrid/nicegrid2.lpi72
-rw-r--r--extras/contributed/nicegrid/nicegrid2.lpr32
-rw-r--r--extras/contributed/nicegrid/nicegrid3.lpi73
-rw-r--r--extras/contributed/nicegrid/nicegrid3.lpr32
-rw-r--r--extras/contributed/nicegrid/readme.txt42
12 files changed, 4591 insertions, 0 deletions
diff --git a/extras/contributed/nicegrid/fpg_nicegrid.pas b/extras/contributed/nicegrid/fpg_nicegrid.pas
new file mode 100644
index 00000000..21ff81c0
--- /dev/null
+++ b/extras/contributed/nicegrid/fpg_nicegrid.pas
@@ -0,0 +1,3429 @@
+unit fpg_nicegrid;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpg_base, fpg_main, fpg_panel, fpg_scrollbar, fpg_types, fpg_edit;
+
+type
+ PHeaderInfo = ^THeaderInfo;
+ THeaderInfo = record
+ Str: string;
+ Rc: TfpgRect;
+ end;
+
+ THorzAlign = (haLeft, haCenter, haRight);
+ TVertAlign = (vaTop, vaCenter, vaBottom);
+ TGutterKind = (gkNone, gkBlank, gkPointer, gkNumber, gkString);
+ TGridHittest = (gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox);
+
+ TfpgNiceGrid = class;
+
+ TfpgNiceColumn = class(TCollectionItem)
+ private
+ FTitle: string;
+ FFooter: string;
+ FWidth: Integer;
+ FFont: string;
+ FFontColor: TfpgColor;
+ FColor: TfpgColor;
+ FHorzAlign: THorzAlign;
+ FVertAlign: TVertAlign;
+ FVisible: Boolean;
+ FStrings: TStrings;
+ FTag: Integer;
+ FTag2: Integer;
+ FCanResize: Boolean;
+ FHint: string;
+ FReadOnly: Boolean;
+ function GetGrid: TfpgNiceGrid;
+ function IsFontStored: Boolean;
+ procedure SetTitle(Value: string);
+ procedure SetWidth(Value: Integer);
+ procedure SetFont(Value: string);
+ procedure SetColor(Value: TfpgColor);
+ procedure SetHorzAlign(Value: THorzAlign);
+ procedure SetVertAlign(Value: TVertAlign);
+ procedure SetVisible(Value: Boolean);
+ procedure SetStrings(Value: TStrings);
+ procedure SetFooter(const Value: string);
+ protected
+ function GetDisplayName: string; override;
+ public
+ constructor Create(Collec: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Grid: TfpgNiceGrid read GetGrid;
+ property Title: string read FTitle write SetTitle;
+ property Footer: string read FFooter write SetFooter;
+ property Width: Integer read FWidth write SetWidth;
+ property Font: string read FFont write SetFont stored IsFontStored;
+ property FontColor: TfpgColor read FFontColor write FFontColor;
+ property Color: TfpgColor read FColor write SetColor default clGray; //clWindow;
+ property HorzAlign: THorzAlign read FHorzAlign write SetHorzAlign default haLeft;
+ property VertAlign: TVertAlign read FVertAlign write SetVertAlign default vaCenter;
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property Tag: Integer read FTag write FTag default 0;
+ property Tag2: Integer read FTag2 write FTag2 default 0;
+ property Hint: string read FHint write FHint;
+ property Strings: TStrings read FStrings write SetStrings;
+ property CanResize: Boolean read FCanResize write FCanResize default True;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
+ end;
+
+
+ TfpgNiceColumns = class(TOwnedCollection)
+ private
+ FGrid: TfpgNiceGrid;
+ function GetItem(Index: Integer): TfpgNiceColumn;
+ procedure SetItem(Index: Integer; Value: TfpgNiceColumn);
+ protected
+ function GetOwner: TPersistent; override;
+ procedure Update(Item: TCollectionItem); override;
+ public
+ constructor Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
+ property Grid: TfpgNiceGrid read FGrid;
+ property Items[Index: Integer]: TfpgNiceColumn read GetItem write SetItem; default;
+ function Add: TfpgNiceColumn;
+ function AddItem(Item: TfpgNiceColumn; Index: Integer): TfpgNiceColumn;
+ function Insert(Index: Integer): TfpgNiceColumn;
+ end;
+
+
+ TfpgNiceInplace = class(TfpgEdit)
+ private
+ FGrid: TfpgNiceGrid;
+ FAlignment: THorzAlign;
+ CellX, CellY: Integer;
+ BuffTmp: string;
+ procedure SetAlignment(Value: THorzAlign);
+ protected
+ procedure Change(Sender: TObject);
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);override;
+ public
+ constructor Create(AGrid: TfpgNiceGrid);reintroduce;
+ procedure ShowEdit(X, Y: Integer);
+ procedure HideEdit;
+ end;
+
+ TfpgMergeCell = class(TObject)
+ public
+ Text: string;
+ Rc: TfpgRect;
+ Color: TfpgColor;
+ Font: string;
+ HorzAlign: THorzAlign;
+ VertAlign: TVertAlign;
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+ TOnDrawCellEvent = procedure (Sender: TObject; ACanvas: TfpgCanvas; X, Y: Integer;
+ Rc: TfpgRect; var Handled: Boolean) of object;
+
+ TOnDrawHeaderEvent = procedure (Sender: TObject; ACanvas: TfpgCanvas; Rc: TfpgRect;
+ Str: string; var Handled: Boolean) of object;
+
+ TOnHeaderClick = procedure (Sender: TObject; ACol: Integer;
+ Button: TMouseButton; Shift: TShiftState) of object;
+
+ TOnGutterClick = procedure (Sender: TObject; ARow: Integer;
+ Button: TMouseButton; Shift: TShiftState) of object;
+
+ TOnCellAssignment = procedure (Sender: TObject; ACol, ARow: Integer;
+ var Str: string) of object;
+
+ TOnCellChange = procedure (Sender: TObject; ACol, ARow: Integer; var Str: string)
+ of object;
+
+ TOnCellChanging = procedure (Sender: TObject; ACol, ARow: Integer;
+ var CanChange: Boolean) of object;
+
+ TOnRowEvent = procedure (Sender: TObject; ARow: Integer) of object;
+
+ TOnColRowChanged = procedure (Sender: TObject; ACol, ARow: Integer) of object;
+
+ TfpgNiceGridSync = class;
+
+ TfpgNiceGrid = class(TfpgPanel)
+ private
+ ForcedColumn: Integer;
+ FixedWidth, FixedHeight: Integer;
+ BodyWidth, BodyHeight: Integer;
+ AllWidth, AllHeight: Integer;
+ FooterTop: Integer;
+ CellBox: TfpgRect;
+
+ FHorzOffset: Integer;
+ FVertOffset: Integer;
+ FMaxHScroll: Integer;
+ FMaxVScroll: Integer;
+ FSmallChange: Integer;
+ FLargeChange: Integer;
+
+ FAutoAddRow: Boolean;
+ FRowCount: Integer;
+ FDefRowHeight: Integer;
+ FDefColWidth: Integer;
+ FFlat: Boolean;
+
+ FHeaderLine: Integer;
+ FHeaderInfos: TList;
+ FUpdating: Boolean;
+ FColor: TfpgColor;
+ FAlternateColor: TfpgColor;
+ FGridColor: TfpgColor;
+ FShowGrid: Boolean;
+ FHeaderColor: TfpgColor;
+ FHeaderLightColor: TfpgColor;
+ FHeaderDarkColor: TfpgColor;
+ FSelectionColor: TfpgColor;
+ FHeaderFont: string;
+ FHeaderFontColor: TfpgColor;
+ FGutterFont: string;
+ FGutterFontColor: TfpgColor;
+ FFooterFont: string;
+ FFooterFontColor: TfpgColor;
+
+ FGutterKind: TGutterKind;
+ FGutterWidth: Integer;
+
+ FFitToWidth: Boolean;
+ FAutoColWidth: Boolean;
+ FReadOnly: Boolean;
+ FColumns: TfpgNiceColumns;
+
+ FEdit: TfpgNiceInplace;
+ FCol: Integer;
+ FRow: Integer;
+ FCol2, FRow2: Integer; // Selection
+ FSelectArea: TfpgRect;
+
+ SmallBox: TfpgRect;
+ SmallBoxArea: TfpgRect;
+ SmallBoxPos: Byte;
+
+ BuffString: string;
+ IsEditing: Boolean;
+ SizingCol: Integer;
+ SizingColX: Integer;
+ LastHover: Integer;
+ Sync: TfpgNiceGridSync;
+ Mergeds: TList;
+
+ FOnDrawCell: TOnDrawCellEvent;
+ FOnDrawHeader: TOnDrawHeaderEvent;
+ FOnDrawGutter: TOnDrawHeaderEvent;
+ FOnDrawFooter: TOnDrawHeaderEvent;
+ FOnHeaderClick: TOnHeaderClick;
+ FOnGutterClick: TOnGutterClick;
+ FOnCellChange: TOnCellChange;
+ FOnCellChanging: TOnCellChanging;
+ FOnColRowChanged: TOnColRowChanged;
+ FOnInsertRow: TOnRowEvent;
+ FOnDeleteRow: TOnRowEvent;
+ FOnCellAssignment: TOnCellAssignment;
+ FGutterStrings: TStrings;
+ FShowFooter: Boolean;
+
+ //*************************
+ FVScrollBar: TfpgScrollBar;
+ FHScrollBar: TfpgScrollBar;
+ procedure UpdateScrollBars; virtual;
+ procedure HScrollBarMove(Sender: TObject; position: integer);
+ procedure VScrollBarMove(Sender: TObject; position: integer);
+ //*****************************
+
+ function TotalWidth: Integer;
+ procedure ClearHeaderInfos;
+
+ procedure ClearUnused;
+ procedure RenderGutter;
+ procedure RenderHeader;
+ procedure DrawSelection;
+
+ procedure SetHorzOffset(Value: Integer);
+ procedure SetVertOffset(Value: Integer);
+ function GetColCount: Integer;
+ procedure SetColCount(Value: Integer);
+ procedure SetRowCount(Value: Integer);
+ procedure SetDefColWidth(Value: Integer);
+ procedure SetDefRowHeight(Value: Integer);
+ procedure SetFlat(Value: Boolean);
+ procedure SetColor(Value: TfpgColor);
+ procedure SetAlternateColor(Value: TfpgColor);
+ procedure SetGridColor(Value: TfpgColor);
+ procedure SetShowGrid(Value: Boolean);
+ procedure SetHeaderLine(Value: Integer);
+ procedure SetHeaderColor(Value: TfpgColor);
+ procedure SetHeaderLightColor(Value: TfpgColor);
+ procedure SetHeaderDarkColor(Value: TfpgColor);
+ procedure SetHeaderFont(Value: string);
+ procedure SetHeaderFontColor(Value: TfpgColor);
+ procedure SetSelectionColor(Value: TfpgColor);
+ procedure SetFitToWidth(Value: Boolean);
+ procedure SetAutoColWidth(Value: Boolean);
+ procedure SetReadOnly(Value: Boolean);
+ procedure InternalSetCell(X, Y: Integer; Value: string; FireOnChange: Boolean);
+ procedure SetCell(X, Y: Integer; Value: string);
+ function GetColWidths(Idx: Integer): Integer;
+ procedure SetColWidths(Idx: Integer; Value: Integer);
+ procedure SetColumns(Value: TfpgNiceColumns);
+ procedure SetCol(Value: Integer);
+ procedure SetRow(Value: Integer);
+ procedure AdjustSelection(Value: TfpgRect; Force: Boolean);
+ procedure SetSelectArea(Value: TfpgRect);
+ procedure SetGutterKind(Value: TGutterKind);
+ procedure SetGutterWidth(Value: Integer);
+ procedure SetGutterFont(const Value: string);
+ procedure SetGutterFontColor(Value: TfpgColor);
+ procedure SetFooterFont(const Value: string);
+ procedure SetFooterFontColor(Value: TfpgColor);
+ function CreateColumn: TfpgNiceColumn;
+ procedure UpdateColumn(Index: Integer);
+ procedure UpdateColumns;
+ procedure UpdateHeader;
+
+ function GetCellRect(x, y: Integer): TfpgRect;
+ function CellRectToClient(R: TfpgRect): TfpgRect;
+ function GetCellAtPos(X, Y: Integer): TPoint;
+ function GetColFromX(X: Integer): Integer;
+ function GetRowFromY(Y: Integer): Integer;
+ function GetColCoord(I: Integer): Integer;
+ function GetCell(X, Y: Integer): string;
+ function SafeGetCell(X, Y: Integer): string;
+ function GetCellColor(X, Y: Integer): TfpgColor;
+ procedure DrawCell(X, Y: Integer);
+ function FastDrawCell(X, Y: Integer): TPoint;
+ procedure NormalizeVertOffset;
+
+ function GetFirstVisible: Integer;
+ function GetLastVisible: Integer;
+ function GetNextVisible(Index: Integer): Integer;
+ function GetPrevVisible(Index: Integer): Integer;
+ procedure ColRowChanged;
+ procedure SetGutterStrings(const Value: TStrings);
+ function GetObject(X, Y: Integer): TObject;
+ procedure SetObject(X, Y: Integer; const Value: TObject);
+ procedure BuildMergeData;
+ procedure DrawMergedCell(Index: Integer);
+ procedure SetShowFooter(const Value: Boolean);
+ procedure RenderFooter;
+ procedure DrawFixCell(Rc: TfpgRect; Str: string; AFont: string;AFontColor: TfpgColor; AEvent: TOnDrawHeaderEvent);
+ procedure SetEnabled(const Value: Boolean); reintroduce;
+
+ protected
+// *******************************************
+ property VScrollBar: TfpgScrollBar read FVScrollBar write FVScrollBar;
+ property HScrollBar: TfpgScrollBar read FHSCrollBar write FHScrollBar;
+ procedure HandleShow; override;
+//*******************************************
+
+ function GetMergedCellsData: TList;
+ function GetHeaderInfo: TList;
+ procedure SetScrollBar(AKind: TfpgScrollBar; AMax, APos, AStep: Integer); virtual;
+ procedure ShowHideScrollBar(HorzVisible, VertVisible: Boolean); virtual;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure Recalculate; virtual;
+ procedure HandlePaint; override;
+ //*********************************
+ procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);override;
+ procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState);override;
+ procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);override;
+ procedure HandleResize(awidth, aheight: TfpgCoord); override;
+// ****************
+
+ public
+ ClientWidth: integer;
+ ClientHeight: integer;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ procedure Clear;
+ property Cells[X, Y: Integer]: string read GetCell write SetCell; default;
+ property Objects[X, Y: Integer]: TObject read GetObject write SetObject;
+ property ColWidths[Index: Integer]: Integer read GetColWidths write SetColWidths;
+ procedure EnsureVisible(X, Y: Integer); overload;
+ procedure CutToClipboard;
+ procedure CopyToClipboard;
+ procedure PasteFromClipboard;
+ function GetHitTestInfo(X, Y: Integer): TGridHitTest;
+ function HeaderCellsCount: Integer;
+ function HeaderCells(I: Integer): THeaderInfo;
+ property Col: Integer read FCol write SetCol;
+ property Row: Integer read FRow write SetRow;
+ property SelectArea: TfpgRect read FSelectArea write SetSelectArea;
+ procedure DeleteRow(ARow: Integer);
+ procedure InsertRow(ARow: Integer);
+ function AddRow: Integer;
+ property HorzOffset: Integer read FHorzOffset write SetHorzOffset;
+ property VertOffset: Integer read FVertOffset write SetVertOffset;
+ function MergeCells(const X1, Y1, X2, Y2: Integer; ACaption: string): TfpgMergeCell;
+ procedure ClearMergeCells;
+
+ published
+ property Enabled: Boolean read FEnabled write SetEnabled default True;
+ property ColCount: Integer read GetColCount write SetColCount;
+ property RowCount: Integer read FRowCount write SetRowCount default 5;
+ property AutoAddRow: Boolean read FAutoAddRow write FAutoAddRow default False;
+ property DefRowHeight: Integer read FDefRowHeight write SetDefRowHeight default 18;
+ property DefColWidth: Integer read FDefColWidth write SetDefColWidth default 80;
+ property Flat: Boolean read FFlat write SetFlat default True;
+ property Color: TfpgColor read FColor write SetColor default clGray;
+ property AlternateColor: TfpgColor read FAlternateColor write SetAlternateColor default clGray;
+ property GridColor: TfpgColor read FGridColor write SetGridColor default clButtonFace;
+ property ShowGrid: Boolean read FShowGrid write SetShowGrid default True;
+ property HeaderLine: Integer read FHeaderLine write SetHeaderLine default 1;
+ property HeaderColor: TfpgColor read FHeaderColor write SetHeaderColor default clButtonFace;
+ property HeaderLightColor: TfpgColor read FHeaderLightColor write SetHeaderLightColor default clHilite1;
+ property HeaderDarkColor: TfpgColor read FHeaderDarkColor write SetHeaderDarkColor default clHilite2;
+ property HeaderFont: string read FHeaderFont write SetHeaderFont;
+ property HeaderFontColor: TfpgColor read FHeaderFontColor write SetHeaderFontColor;
+ property FooterFont: string read FFooterFont write SetFooterFont;
+ property FooterFontColor: TfpgColor read FFooterFontColor write SetFooterFontColor;
+ property SelectionColor: TfpgColor read FSelectionColor write SetSelectionColor default $00CAFFFF;
+ property FitToWidth: Boolean read FFitToWidth write SetFitToWidth default False;
+ property AutoColWidth: Boolean read FAutoColWidth write SetAutoColWidth default False;
+ property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
+ property Columns: TfpgNiceColumns read FColumns write SetColumns;
+ property GutterKind: TGutterKind read FGutterKind write SetGutterKind default gkBlank;
+ property GutterWidth: Integer read FGutterWidth write SetGutterWidth default 20;
+ property GutterFont: string read FGutterFont write SetGutterFont;
+ property GutterFontColor: TfpgColor read FGutterFontColor write SetGutterFontColor;
+ property GutterStrings: TStrings read FGutterStrings write SetGutterStrings;
+ property ShowFooter: Boolean read FShowFooter write SetShowFooter;
+ property OnDrawCell: TOnDrawCellEvent read FOnDrawCell write FOnDrawCell;
+ property OnDrawHeader: TOnDrawHeaderEvent read FOnDrawHeader write FOnDrawHeader;
+ property OnDrawGutter: TOnDrawHeaderEvent read FOnDrawGutter write FOnDrawGutter;
+ property OnDrawFooter: TOnDrawHeaderEvent read FOnDrawFooter write FOnDrawFooter;
+ property OnHeaderClick: TOnHeaderClick read FOnHeaderClick write FOnHeaderClick;
+ property OnGutterClick: TOnGutterClick read FOnGutterClick write FOnGutterClick;
+ property OnCellChange: TOnCellChange read FOnCellChange write FOnCellChange;
+ property OnCellChanging: TOnCellChanging read FOnCellChanging write FOnCellChanging;
+ property OnColRowChanged: TOnColRowChanged read FOnColRowChanged write FOnColRowChanged;
+ property OnInsertRow: TOnRowEvent read FOnInsertRow write FOnInsertRow;
+ property OnDeleteRow: TOnRowEvent read FOnDeleteRow write FOnDeleteRow;
+ property OnCellAssignment: TOnCellAssignment read FOnCellAssignment write FOnCellAssignment;
+ property Font;
+ property Anchors;
+ property Align;
+ property BorderStyle default bsSingle;
+ property TabOrder;
+ property Tag;
+ property OnClick;
+ property OnDoubleClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnKeyPress;
+ end;
+
+ TfpgNiceGridSync = class(TfpgNiceGrid)
+ private
+ FMasterGrid: TfpgNiceGrid;
+ procedure SetMasterGrid(const Value: TfpgNiceGrid);
+ procedure SyncDeleteRow(Sender: TObject; ARow: Integer);
+ procedure SyncInsertRow(Sender: TObject; ARow: Integer);
+ procedure SyncColRow(Sender: TObject; ACol, ARow: Integer);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetScrollBar(AKind: TfpgScrollBar; AMax, APos,AStep: Integer); override;
+ procedure ShowHideScrollBar(HorzVisible, VertVisible: Boolean); override;
+ property OnDeleteRow;
+ property OnInsertRow;
+ property OnColRowChanged;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property MasterGrid: TfpgNiceGrid read FMasterGrid write SetMasterGrid;
+ end;
+
+
+ function DrawStringUni(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect;
+ HorzAlign: THorzAlign; VertAlign: TVertAlign): TPoint;
+
+ procedure DrawStringMulti(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect;
+ HorzAlign: THorzAlign; VertAlign: TVertAlign);
+
+
+implementation
+
+uses
+ Math;
+
+const
+ { crPlus = 101;
+ crSmallCross = 102;
+ crRight = 103;
+ crDown = 104;
+ crLeftTop = 105;}
+
+ CursorArray: array [TGridHitTest] of TMouseCursor =
+ //(gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox);
+ // (crDefault, crLeftTop, crRight, crDown, crPlus, crHSplit, crSmallCross);
+ (mcDefault,mcSizeNWSE ,mcSizeEW,mcSizeNS, mcCross,mcMove,mcHand);
+
+ MergeID = -2;
+
+
+{ TfpgNiceGrid }
+
+constructor TfpgNiceGrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FisContainer:=true;
+ Width := 200;
+ Height := 200;
+ BorderStyle := bsSingle;
+ Text:='';
+ FFlat := True;
+ FEnabled := True;
+ FColor := clWindowBackground;
+ FAlternateColor := clWindowBackground;
+ FGridColor := clButtonFace;
+ FShowGrid := True;
+ FHeaderColor := clButtonface;
+ FHeaderLightColor := clHilite1;
+ FHeaderDarkColor := clShadow1;
+ FHeaderFont:='Arial-8';
+ FSelectionColor := $00CAFFFF;
+ FFooterFont := 'Arial-8';
+ FooterFontColor := clRed;
+ FDefRowHeight := 18;
+ FDefColWidth := 60;
+ FRowCount := 5;
+ FAutoAddRow := False;
+ FGutterKind := gkBlank;
+ FGutterWidth := 20;
+ FGutterFont:='Arial-8';
+ FGutterFontColor:=clBlack;
+
+ FHorzOffset := 0;
+ FVertOffset := 0;
+ FMaxHScroll := 0;
+ FMaxVScroll := 0;
+ FSmallChange := FDefRowHeight;
+ FLargeChange := FDefRowHeight * 5;
+ ForcedColumn := -1;
+ AllWidth := 200;
+ AllHeight := 200;
+ ClientWidth:=Width -2;
+ ClientHeight:=Height -2;
+
+ FHeaderLine := 1;
+ FHeaderInfos := TList.Create;
+
+ CellBox:=fpgRect(0, 0, 0, 0);
+ FCol := 0;
+ FRow := 0;
+ FCol2 := 0;
+ FRow2 := 0;
+ FSelectArea:=fpgRect(0, 0, 0, 0);
+ IsEditing := False;
+ BuffString := '';
+ SmallBox := fpgRect(-1, -1,0, 0);
+ SmallBoxArea:=fpgRect(-1, -1, 0,0);
+ SmallBoxPos := 0;
+ SizingCol := -1;
+ SizingColX := -1;
+ MouseCursor := mcCross;
+ FColumns := TfpgNiceColumns.Create(Self,TfpgNiceColumn);
+ FEdit := TfpgNiceInplace.Create(Self);
+
+ FGutterStrings := TStringList.Create;
+ Mergeds := TList.Create;
+ Sync:=nil;
+// ************************
+ FVScrollBar := TfpgScrollBar.Create(self);
+ FVScrollBar.Orientation := orVertical;
+ FVScrollBar.Visible := false;
+ FVScrollBar.ScrollStep:= FDefRowHeight;
+ FVScrollBar.OnScroll:=@VScrollBarMove;
+
+ FHScrollBar := TfpgScrollBar.Create(self);
+ FHScrollBar.Orientation := orHorizontal;
+ FHScrollBar.Visible := false;
+ FHScrollBar.ScrollStep := 5;
+ FHScrollBar.OnScroll:=@HScrollBarMove;
+//*******************************
+
+end;
+
+destructor TfpgNiceGrid.Destroy;
+begin
+ ClearMergeCells;
+ Mergeds.Free;
+ FGutterStrings.Free;
+ FEdit.Free;
+ FColumns.Free;
+ ClearHeaderInfos;
+ FHeaderInfos.Free;
+ inherited Destroy;
+end;
+
+procedure TfpgNiceGrid.SetScrollBar(AKind: TfpgScrollbar; AMax, APos, AStep: Integer);
+begin
+ with AKind do
+ begin
+ Min:=0;
+ Max:=AMax;
+ ScrollStep:=AStep;
+ Position:=APos;
+ RepaintSlider;
+ end;
+ if (AKind = FVScrollBar) and Assigned(Sync) then
+ begin
+ Sync.FMaxVScroll := AMax;
+ Sync.VertOffset := APos;
+ end;
+end;
+
+procedure TfpgNiceGrid.ShowHideScrollBar(HorzVisible, VertVisible: Boolean);
+begin
+ FVScrollBar.Visible:= VertVisible;
+ FHScrollBar.Visible:= HorzVisible;
+end;
+
+procedure TfpgNiceGrid.HScrollBarMove(Sender: TObject; position: integer);
+begin
+ if FHorzOffset <> position then
+ begin
+ if Position < 0 then
+ Position := 0;
+ FHorzOffset:= position;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.VScrollBarMove(Sender: TObject; position: integer);
+begin
+ FVertOffset := position;
+ FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset));
+ NormalizeVertOffset;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.HandleShow;
+begin
+ inherited HandleShow;
+ if (csLoading in ComponentState) then
+ Exit;
+ UpdateScrollBars;
+end;
+
+procedure TfpgNiceGrid.SetColCount(Value: Integer);
+begin
+ if (ColCount <> Value) then
+ begin
+ FColumns.BeginUpdate;
+ while (ColCount > Value)
+ do FColumns.Delete(FColumns.Count-1);
+ while (ColCount < Value)
+ do FColumns.Add;
+ FHorzOffset := 0;
+ FVertOffset := 0;
+ FCol := Max(0, Min(FCol, ColCount-1));
+ FRow := Max(0, Min(FRow, FRowCount-1));
+ if (FRowCount = 0) or (ColCount = 0) then
+ begin
+ FCol := -1;
+ FRow := -1;
+ end;
+ FSelectArea:=fpgRect(FCol, FRow, FCol, FRow);
+ FColumns.EndUpdate;
+ ColRowChanged;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetRowCount(Value: Integer);
+begin
+ if (FRowCount <> Value) then
+ begin
+ FRowCount := Value;
+ FCol := Max(0, Min(FCol, ColCount-1));
+ FRow := Max(0, Min(FRow, FRowCount-1));
+ if (FRowCount = 0) or (ColCount = 0) then
+ begin
+ FCol := -1;
+ FRow := -1;
+ end;
+ FSelectArea:=fpgRect(FCol, FRow, FCol, FRow);
+ Recalculate;
+ Invalidate;
+ UpdateScrollBars;
+ ColRowChanged;
+ end;
+end;
+
+procedure TfpgNiceGrid.ClearHeaderInfos;
+var
+ x: Integer;
+ P: PHeaderInfo;
+begin
+ for x := 0 to FHeaderInfos.Count-1 do
+ begin
+ P := PHeaderInfo(FHeaderInfos[x]);
+ Dispose(P);
+ end;
+ FHeaderInfos.Clear;
+end;
+
+procedure TfpgNiceGrid.Recalculate;
+var
+ x: Integer;
+ HVisible, VVisible: Boolean;
+ VisCount: Integer;
+ WidthAvail, HeightAvail: Integer;
+ v: Integer;
+ LastBodyWidth: Integer;
+
+ function GetColAutoWidth(i: Integer): Integer;
+ var
+ n: Integer;
+ t: TStrings;
+ begin
+ Result := 0;
+ t := Columns[i].FStrings;
+ for n := 0 to t.Count-1
+ do Result := Max(Result, Canvas.Font.TextWidth(t[n]) + 7);
+ Result := Max(Result, 20);
+ end;
+
+begin
+
+ BuildMergeData;
+
+ VisCount := 0;
+ for x := 0 to FColumns.Count-1 do
+ begin
+ if FColumns[x].FVisible
+ then Inc(VisCount);
+ end;
+
+ if (VisCount = 0) then
+ begin
+ FixedHeight := 0;
+ FixedWidth := 0;
+ BodyWidth := 0;
+ BodyHeight := 0;
+ ShowHideScrollBar(False, False);
+ Exit;
+ end;
+
+ ClientHeight:= Height-2;
+ ClientWidth:= Width-2;
+
+ if FAutoColWidth then
+ begin
+ for x := 0 to FColumns.Count-1
+ do FColumns[x].FWidth := Max(FDefColWidth, GetColAutoWidth(x));
+ end;
+
+ FixedWidth := 0;
+ if (FGutterKind <> gkNone)
+ then FixedWidth := FGutterWidth;
+
+ FixedHeight := FHeaderLine * FDefRowHeight;
+ BodyHeight := FRowCount * FDefRowHeight;
+
+ WidthAvail := ClientWidth - FixedWidth;
+ HeightAvail := ClientHeight - FixedHeight;
+ if FShowFooter then
+ HeightAvail := HeightAvail - FDefRowHeight;
+
+ BodyWidth := 0;
+ for x := 0 to FColumns.Count-1 do
+ begin
+ if FColumns[x].FVisible
+ then BodyWidth := BodyWidth + FColumns[x].FWidth;
+ end;
+
+ if FFitToWidth then
+ begin
+ if (BodyWidth < WidthAvail) then
+ begin
+ LastBodyWidth := BodyWidth;
+ x := 0;
+ while (BodyWidth < WidthAvail) do
+ begin
+ if (x > ColCount-1) then
+ begin
+ if (BodyWidth = LastBodyWidth)
+ then Break
+ else x := 0;
+ end;
+ if FColumns[x].FVisible and FColumns[x].FCanResize then
+ begin
+ FColumns[x].FWidth := FColumns[x].FWidth + 1;
+ Inc(BodyWidth);
+ end;
+ Inc(x);
+ end;
+ end;
+ if (BodyWidth > WidthAvail) then
+ begin
+ LastBodyWidth := BodyWidth;
+ x := 0;
+ while (BodyWidth > WidthAvail) do
+ begin
+ if (x > ColCount-1) then
+ begin
+ if (BodyWidth = LastBodyWidth)
+ then Break
+ else x := 0;
+ end;
+ if FColumns[x].FVisible and (x <> ForcedColumn) and FColumns[x].FCanResize then
+ begin
+ FColumns[x].FWidth := FColumns[x].FWidth - 1;
+ Dec(BodyWidth);
+ end;
+ Inc(x);
+ end;
+ end;
+ ForcedColumn := -1;
+ end;
+
+ if (BodyWidth < WidthAvail)
+ then FHorzOffset := 0;
+
+ if (BodyHeight < HeightAvail)
+ then FVertOffset := 0;
+
+ HVisible := BodyWidth > WidthAvail;
+ VVisible := BodyHeight > HeightAvail;
+
+ ShowHideScrollBar(HVisible, VVisible);
+
+ if FHScrollBar.Visible then
+ dec(ClientHeight,FHScrollBar.Height);
+ if FVScrollBar.Visible then
+ dec(ClientWidth,FVScrollBar.Width);
+
+ FMaxHScroll := Max(0, BodyWidth - ClientWidth + FixedWidth);
+
+ if FShowFooter
+ then FMaxVScroll := Max(0, BodyHeight - ClientHeight + FixedHeight + FDefRowHeight)
+ else FMaxVScroll := Max(0, BodyHeight - ClientHeight + FixedHeight);
+
+ // Align to FDefRowHeight
+ v := FMaxVScroll div FDefRowHeight;
+ if (FMaxVScroll mod FDefRowHeight) > 0
+ then Inc(v);
+ FMaxVScroll := v * FDefRowHeight;
+
+ if FShowFooter then
+ begin
+ if VVisible then
+ FooterTop := (((ClientHeight div FDefRowHeight) - 1) * FDefRowHeight) - 1
+ else FooterTop := (FDefRowHeight * (FHeaderLine + FRowCount)) - 1;
+ end;
+
+ FHorzOffset := Max(0, Min(FHorzOffset, FMaxHScroll));
+ FVertOffset := Max(0, Min(FVertOffset, FMaxVScroll));
+
+ SetScrollBar(FHScrollBar, FMaxHScroll, FHorzOffset, 1);
+ SetScrollBar(FVScrollBar, FMaxVScroll, FVertOffset, FDefRowHeight);
+
+ AllWidth := Min(ClientWidth, BodyWidth + FixedWidth);
+ if FShowFooter then
+ begin
+ AllHeight := Min(ClientHeight, BodyHeight + FixedHeight + FDefRowHeight);
+ CellBox:=fpgRect(FixedWidth, FixedHeight, ClientWidth, FooterTop);
+ end else
+ begin
+ AllHeight := Min(ClientHeight, BodyHeight + FixedHeight);
+ CellBox:=fpgRect(FixedWidth, FixedHeight, ClientWidth, ClientHeight);
+ end;
+end;
+
+function DrawStringUni(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect;
+ HorzAlign: THorzAlign; VertAlign: TVertAlign): TPoint;
+var
+ w, h, x, y: Integer;
+ rw: Integer;
+begin
+ w := Canvas.Font.TextWidth(Str);
+ h := Canvas.Font.Height;
+ x := 0;
+ y := 0;
+ rw := Rc.Right - rc.Left;
+ case HorzAlign of
+ haLeft: x := Rc.Left;
+ haCenter: x := Rc.Left + ((rw - w) div 2);
+ haRight: x := Rc.Right - w;
+ end;
+ case VertAlign of
+ vaTop: y := Rc.Top;
+ vaCenter: y := Rc.Top + (((Rc.Bottom - Rc.Top) - h) div 2);
+ vaBottom: y := Rc.Bottom - h;
+ end;
+ Canvas.DrawString(x, y, Str);
+ // Return next cursor position
+ Result := Point(Min(x + w + 1, Rc.Right), Rc.Top - 1);
+end;
+
+procedure DrawStringMulti(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect;
+ HorzAlign: THorzAlign; VertAlign: TVertAlign);
+var
+ w, h, x, y: Integer;
+ t: TStringList;
+ i: Integer;
+ dh: Integer;
+
+begin
+ if Pos(';', Str) = 0 then
+ begin
+ DrawStringUni(Canvas, Str, Rc, HorzAlign, VertAlign);
+ Exit;
+ end;
+
+ t := TStringList.Create;
+ t.Text := StringReplace(Str, ';', #13, [rfReplaceAll]);
+ h := Canvas.Font.Height;
+ dh := Rc.Top + (((Rc.Bottom - Rc.Top) - (h * t.Count)) div 2);
+ for i := 0 to t.Count-1 do
+ begin
+ w := Canvas.Font.TextWidth(t[i]);
+ x := 0;
+ y := 0;
+ case HorzAlign of
+ haLeft: x := Rc.Left;
+ haCenter: x := Rc.Left + (((Rc.Right - Rc.Left) - w) div 2);
+ haRight: x := Rc.Right - w;
+ end;
+ case VertAlign of
+ vaTop: y := Rc.Top + (i * h);
+ vaCenter: y := dh + (i * h);
+ vaBottom: y := Rc.Bottom - (h * (t.Count-i));
+ end;
+ Canvas.DrawString(x, y, t[i]);
+ end;
+ t.Free;
+end;
+
+Function PtInSelectArea(ARect: TfpgRect; P: TPoint): boolean;
+begin
+ Result:=(p.y >= ARect.Top) and
+ (p.y <= ARect.Height) and
+ (p.x >= ARect.Left) and
+ (p.x <= ARect.Width);
+end;
+
+function TfpgNiceGrid.GetCellColor(X, Y: Integer): TfpgColor;
+var
+ cl: TfpgColor;
+ R: TfpgRect;
+begin
+ cl := FColumns[x].Color;
+ if FEnabled then
+ begin
+ with FSelectArea
+ do R:=fpgRect(Left, Top, Width, Height);
+
+ if PtInSelectArea(R, Point(X, Y)) then
+ begin
+ if not ((X = FCol) and (y = FRow))
+ then cl := FSelectionColor;
+ end;
+ end;
+ Result := cl;
+end;
+
+procedure TfpgNiceGrid.DrawFixCell(Rc: TfpgRect; Str: string; AFont: string;AFontColor: TfpgColor; AEvent: TOnDrawHeaderEvent);
+var
+ Rt: TfpgRect;
+ Handled: Boolean;
+begin
+ Handled := False;
+ with Canvas do
+ begin
+ Font := fpgGetFont(AFont);
+ if not FEnabled then
+ SetTextColor(FHeaderDarkColor)
+ else SetTextColor(AFontColor);
+
+ if Assigned(AEvent)
+ then AEvent(Self, Canvas, Rc, Str, Handled);
+ if Handled
+ then Exit;
+
+ SetColor(FHeaderColor);
+ FillRectangle(Rc);
+ SetColor(FHeaderDarkColor);
+ DrawRectangle(Rc);
+
+ // Draw text immediately
+ Rt := fpgRect(Rc.Left + 2, Rc.Top + 2, Rc.Width - 4, Rc.Height - 4);
+ DrawStringMulti(Canvas, Str, Rt, haCenter, vaCenter);
+
+ // cosmetics
+ SetColor(FHeaderLightColor);
+ DrawLine(Rc.Left + 1, Rc.Bottom - 2, Rc.Left + 1, Rc.Top + 1);
+ DrawLine(Rc.Left + 1, Rc.Top + 1, Rc.Right - 1, Rc.Top + 1);
+
+ if not FFlat then
+ begin
+ SetColor(clBlack);
+ DrawLine(Rc.Right - 2, Rc.Top + 1,Rc.Right - 2, Rc.Bottom - 2);
+ DrawLine(Rc.Right - 2, Rc.Bottom - 2,Rc.Left, Rc.Bottom - 2);
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.RenderGutter;
+const
+ ArrowWidth = 8;
+var
+ x: Integer;
+ R, Dummy: TfpgRect;
+ Str: string;
+ l, t, m: Integer;
+ GutterBox: TfpgRect;
+begin
+ if (FGutterKind = gkNone)
+ then Exit;
+ CopyfpgRect(GutterBox, CellBox);
+ GutterBox.Left := 0;
+ for x := 0 to FRowCount-1 do
+ begin
+ R := fpgRect(-1, (x * FDefRowHeight) -1, FGutterWidth, FDefRowHeight +1);
+ OffsetfpgRect(R, 2, -FVertOffset + FixedHeight);
+ if IntersectfpgRect(Dummy, R, GutterBox) then
+ begin
+ case FGutterKind of
+ gkBlank, gkPointer:
+ Str := '';
+ gkNumber:
+ Str := IntToStr(x + 1);
+ gkString:
+ if (x > FGutterStrings.Count-1)
+ then Str := ''
+ else Str := FGutterStrings[x];
+ end;
+ DrawFixCell(R, Str, FGutterFont, FGutterFontColor, FOnDrawGutter);
+ // Draw pointer triangle
+ if (FGutterKind = gkpointer) and (x = FRow) then
+ begin
+ with Canvas do
+ begin
+ l := (FGutterWidth - ArrowWidth) div 2;
+ t := (FDefRowHeight - ArrowWidth) div 2;
+ m := R.Top + (FDefRowHeight div 2);
+ SetColor(FHeaderDarkColor);
+ DrawLine(l, R.Bottom - t,l, R.Top + t);
+ DrawLine(l, R.Top + t,l + ArrowWidth, m);
+ SetColor(FHeaderLightColor);
+ DrawLine(l + ArrowWidth, m,l, R.Bottom - t);
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.RenderHeader;
+var
+ x: Integer;
+ R, Dummy: TfpgRect;
+ P: PHeaderInfo;
+begin
+ for x := 0 to FHeaderInfos.Count-1 do
+ begin
+ P := PHeaderInfo(FHeaderInfos[x]);
+ R := fpgRect(
+ GetColCoord(P^.Rc.Left)-1 ,
+ FDefRowHeight * P^.Rc.Top,
+ GetColCoord(P^.Rc.Width+1) - GetColCoord(P^.Rc.Left)+1,
+ FDefRowHeight * (P^.Rc.Height+1)+1
+ );
+ OffsetfpgRect(R, -FHorzOffset + FixedWidth, 0);
+ if IntersectfpgRect(Dummy, R, fpgRect(1,1,ClientWidth,ClientHeight))
+ then DrawFixCell(R, P^.Str, FHeaderFont, FHeaderFontColor, FOnDrawHeader);
+ end;
+ R := fpgRect(1,1, FixedWidth, FixedHeight );
+ DrawFixCell(R, '', FHeaderFont, FHeaderFontColor, FOnDrawHeader);
+end;
+
+procedure TfpgNiceGrid.RenderFooter;
+var
+ x: Integer;
+ R, Dummy: TfpgRect;
+ FooterBottom: Integer;
+ ARight: Integer;
+begin
+ FooterBottom := FooterTop + FDefRowHeight+1;
+ for x := 0 to FColumns.Count-1 do
+ begin
+ R := fpgRect(GetColCoord(x)-1,
+ FooterTop,
+ GetColCoord(x+1)-GetColCoord(x)+1,
+ FooterBottom-FooterTop+1
+ );
+ OffsetfpgRect(R, -FHorzOffset + FixedWidth, 0);
+
+ if IntersectfpgRect(Dummy, R, fpgRect(1,1,ClientWidth,ClientHeight))
+ then DrawFixCell(R, FColumns[x].FFooter, FFooterFont, FFooterFontColor, FOnDrawFooter);
+ end;
+ R := fpgRect(1, FooterTop, FixedWidth, FooterBottom-FooterTop);
+ DrawFixCell(R, '', FFooterFont, FFooterFontColor, FOnDrawFooter);
+ ARight := Min(AllWidth, ClientWidth);
+
+ R := fpgRect(1, FooterBottom, ARight-1, ClientHeight-FooterBottom+1);
+ DrawFixCell(R, '', FFooterFont, FFooterFontColor, FOnDrawFooter);
+end;
+
+procedure TfpgNiceGrid.DrawCell(X, Y: Integer);
+var
+ Rc, Dummy: TfpgRect;
+ Column: TfpgNiceColumn;
+ Handled: Boolean;
+begin
+ Handled := False;
+ Rc := GetCellRect(x, y);
+ OffsetfpgRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
+ if IntersectfpgRect(Dummy, Rc, CellBox) then
+ begin
+ Column := FColumns[x];
+ with Canvas do
+ begin
+ Font:=fpgGetFont(Column.Font);
+ SetTextColor(Column.FontColor);
+
+ if not FEnabled
+ then SetTextColor(FGridColor);
+
+ SetColor(GetCellColor(X, Y));
+ if Assigned(FOnDrawCell)
+ then FOnDrawCell(Self, Canvas, X, Y, Rc, Handled);
+
+ if not Handled then
+ begin
+ FillRectangle(Rc);
+ if FShowGrid then
+ begin
+ SetColor(FGridColor);
+ inc(Rc.Width,1);
+ inc(Rc.Height,1);
+ DrawRectangle(Rc);
+ end;
+ InflatefpgRect(Rc, -4, -2);
+ DrawStringUni(Canvas, SafeGetCell(x, y), Rc, Column.HorzAlign,
+ Column.VertAlign);
+ end;
+ end;
+ end;
+end;
+
+function TfpgNiceGrid.FastDrawCell(X, Y: Integer): TPoint;
+var
+ R, Dummy: TfpgRect;
+ Handled: Boolean;
+ Column: TfpgNiceColumn;
+begin
+ Handled := False;
+ Result := Point(-1, -1);
+ R := GetCellRect(x, y);
+ OffsetfpgRect(R, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
+ if IntersectfpgRect(Dummy, R, CellBox) then
+ begin
+ Column := FColumns[x];
+ with Canvas do
+ begin
+ Font:=fpgGetFont(Column.Font);
+ end;
+ if Assigned(FOnDrawCell)
+ then FOnDrawCell(Self, Canvas, X, Y, R, Handled);
+ if not Handled then
+ begin
+ with Canvas do
+ begin
+ InflateRect(R, -4, -2);
+ FillRectangle(R);
+ end;
+ Result := DrawStringUni(Canvas, SafeGetCell(x, y), R, Column.HorzAlign,
+ Column.VertAlign);
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.DrawSelection;
+var
+ R, R1, R2: TfpgRect;
+ HOffset, VOffset: Integer;
+
+begin
+
+ if (FCol = -1) or (FRow = -1)
+ then Exit;
+
+ HOffset := - FHorzOffset + FixedWidth;
+ VOffset := - FVertOffset + FixedHeight;
+ R1 := GetCellRect(FSelectArea.Left, FSelectArea.Top);
+ R2 := GetCellRect(FSelectArea.Width, FSelectArea.Height);
+ R := fpgRect(R1.Left+2, R1.Top+2, R2.Right - R1.Left, R2.Bottom - R1.Top);
+ OffsetfpgRect(R, HOffset, VOffset);
+
+ with Canvas do
+ begin
+ if Focused then
+ SetColor(clBlack)
+ else
+ SetColor(FGridColor);
+ SetLineStyle(2, lsDash);
+ DrawRectangle(R);
+ SetLineStyle(1, lsSolid);
+ SetColor(clRed);
+ case SmallBoxPos of
+ 0: SmallBox := fpgRect(R.Right - 3, R.Bottom - 3, 6,6);
+ 1: SmallBox := fpgRect(R.Right - 3, R.Top + 2, 6,8);
+ 2: SmallBox := fpgRect(R.Left - 3 + 5, R.Bottom - 3,8,3);
+ end;
+
+ FillRectangle(SmallBox);
+ SmallBoxPos := 0; // Reset to Right Bottom
+ end;
+end;
+
+procedure TfpgNiceGrid.ClearUnused;
+var
+ t: Integer;
+begin
+ if (AllWidth < ClientWidth) then
+ begin
+ with Canvas do
+ begin
+ SetColor(FColor);
+ FillRectangle(fpgRect(AllWidth, 0, ClientWidth, ClientHeight));
+ end;
+ end;
+ if FShowFooter
+ then Exit;
+ if (AllHeight < ClientHeight) then
+ begin
+ with Canvas do
+ begin
+ SetColor(FColor);
+ FillRectangle(fpgRect(0, AllHeight, ClientWidth, ClientHeight));
+ end;
+ end;
+ if ((FMaxVScroll - FVertOffset) < FDefRowHeight) then
+ begin
+ with Canvas do
+ begin
+ SetColor(FColor);
+ t := FixedHeight + (((ClientHeight - FixedHeight) div FDefRowHeight) * FDefRowHeight);
+ FillRectangle(fpgRect(0, t, ClientWidth, ClientHeight));
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.HandlePaint;
+var
+ x, y: Integer;
+ R1: TfpgRect;
+begin
+ if FUpdating then Exit;
+ if not (HasHandle) then Exit;
+ Canvas.Setcolor(FColor);
+ Canvas.FillRectangle(fpgRect(0, 0, Width, Height));
+
+ if (FRowCount > 0) then
+ begin
+ for x := 0 to ColCount-1 do
+ begin
+ if FColumns[x].FVisible then
+ begin
+ for y := 0 to FRowCount-1 do
+ begin
+ if (GetObject(x, y) <> TObject(MergeID)) then
+ DrawCell(X, Y);
+ end;
+ end;
+ end;
+ for x := 0 to Mergeds.Count-1 do
+ DrawMergedCell(x);
+ if FEnabled then
+ DrawSelection;
+ end
+ else
+ ClearUnused;
+ RenderGutter;
+ RenderHeader;
+ if FShowFooter then RenderFooter;
+ // The little square in the bottom right corner
+ if FHScrollBar.Visible and FVScrollBar.Visible then
+ begin
+ Canvas.ClearClipRect;
+ Canvas.SetColor(clButtonFace);
+ R1:=fpgRect(HScrollBar.Left+FHScrollBar.Width,
+ FVScrollBar.Top+FVScrollBar.Height,
+ FVScrollBar.Width,
+ FHScrollBar.Height);
+ Canvas.FillRectangle(R1);
+ SetColor(FHeaderLightColor);
+ Canvas.DrawLine(R1.Left + 1, R1.Bottom+1, R1.Left + 1, R1.Top + 1);
+ Canvas.DrawLine(R1.Left + 1, R1.Top + 1, R1.Right - 1, R1.Top + 1);
+ end;
+ Canvas.Setcolor(clBlack);
+ Canvas.DrawRectangle(fpgRect(0, 0, Width, Height));
+end;
+
+procedure TfpgNiceGrid.UpdateHeader;
+var
+ P: PHeaderInfo;
+ x, y: Integer;
+ t: TStringList;
+ s: string;
+ LastX: TList;
+ LastY: PHeaderInfo;
+ Blank: PHeaderInfo;
+
+begin
+ ClearHeaderInfos;
+
+ LastX := TList.Create;
+ t := TStringList.Create;
+
+ Blank := New(PHeaderInfo);
+ Blank^.Str := '^%%%%%^******^';
+ Blank^.Rc:=fpgRect(0,0,0,0);
+
+ while (LastX.Count < FHeaderLine)
+ do LastX.Add(Blank);
+
+ P := nil;
+ for x := 0 to FColumns.Count-1 do
+ begin
+ if not FColumns[x].FVisible then
+ begin
+ for y := 0 to FHeaderLine-1
+ do LastX[y] := Blank;
+ Continue;
+ end;
+ t.Text := StringReplace(FColumns[x].Title, '|', #13, [rfReplaceAll]);
+ while (t.Count < FHeaderLine) do
+ begin
+ if (t.Count = 0)
+ then t.Add('')
+ else t.Add( t[t.Count-1]);
+ end;
+ LastY := Blank;
+ for y := 0 to FHeaderLine-1 do
+ begin
+ s := t[y];
+ if (s = LastY^.Str) then
+ begin
+ LastY^.Rc.Height := Min(FHeaderLine-1, Max(LastY^.Rc.Height, y));
+ end
+ else
+ begin
+ if (s = PHeaderInfo(LastX[y])^.Str) then
+ begin
+ P := PHeaderInfo(LastX[y]);
+ P^.Rc.Width := P^.Rc.Width + 1;
+ end
+ else
+ begin
+ P := New(PHeaderInfo);
+ P^.Rc := fpgRect(x, y, x,0);
+ P^.Str := s;
+ FHeaderInfos.Add(P);
+ end;
+ LastX[y] := P;
+ end;
+ LastY := P;
+ end;
+ end;
+
+ LastX.Free;
+ t.Free;
+ Dispose(Blank);
+ Recalculate;
+end;
+
+function TfpgNiceGrid.GetColCoord(I: Integer): Integer;
+var
+ x: Integer;
+ Column: TfpgNiceColumn;
+begin
+ Result := 0;
+ for x := 0 to I-1 do
+ begin
+ Column := FColumns[x];
+ if Column.FVisible
+ then Result := Result + Column.FWidth;
+ end;
+end;
+
+function TfpgNiceGrid.GetCellRect(x, y: Integer): TfpgRect;
+var
+ l, t, w, h: Integer;
+begin
+ if (x = -1) or (y = -1) then
+ begin
+ Result := fpgRect(0, 0, 0, 0);
+ Exit;
+ end;
+ l := GetColCoord(x);
+ t := FDefRowheight * y;
+ w := 0;
+ if (FColumns[x].FVisible)
+ then w := FColumns[x].FWidth;
+ h := FDefRowHeight;
+ Result := fpgRect(l-1, t-1, w, h);
+end;
+
+function TfpgNiceGrid.CellRectToClient(R: TfpgRect): TfpgRect;
+begin
+ Result := R;
+ OffsetfpgRect(Result, - FHorzOffset + FixedWidth, - FVertOffset + FixedHeight);
+end;
+
+function TfpgNiceGrid.GetCellAtPos(X, Y: Integer): TPoint;
+var
+ ax, ay: Integer;
+begin
+ ax := (FHorzOffset + X) - FixedWidth;
+ ay := (FVertOffset + Y) - FixedHeight;
+ Result.X := 0;
+ while (GetColCoord(Result.X) < ax) do
+ begin
+ Result.X := Result.X + 1;
+ if (Result.X > FColumns.Count-1)
+ then Break;
+ end;
+ Result.X := Max(0, Result.X - 1);
+ Result.Y := Max(0, Min(ay div FDefRowHeight, FRowCount-1));
+end;
+
+function TfpgNiceGrid.GetColFromX(X: Integer): Integer;
+var
+ ax: Integer;
+begin
+ if (X < FixedWidth) then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ Result := 0;
+ ax := (FHorzOffset + X) - FixedWidth;
+ while (GetColCoord(Result) < ax) do
+ begin
+ Result := Result + 1;
+ if (Result > FColumns.Count-1)
+ then Break;
+ end;
+ Result := Result - 1;
+ if (Result > FColumns.Count-1) or (Result < 0)
+ then Result := -1;
+end;
+
+function TfpgNiceGrid.GetRowFromY(Y: Integer): Integer;
+var
+ ay: Integer;
+begin
+ if (Y < FixedHeight) then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ ay := (FVertOffset + Y) - FixedHeight;
+ Result := ay div FDefRowHeight;
+ if (Result > FRowCount-1)
+ then Result := -1;
+end;
+
+function TfpgNiceGrid.SafeGetCell(X, Y: Integer): string;
+var
+ t: TStringList;
+begin
+ Result := '';
+ t := TStringList(Columns[X].FStrings);
+ if (Y < t.Count)
+ then Result := t[Y];
+end;
+
+function TfpgNiceGrid.GetCell(X, Y: Integer): string;
+var
+ t: TStrings;
+begin
+ Result := '';
+ if (X > ColCount-1) or (Y > FRowCount-1)
+ then raise Exception.Create('Cell Index out of bound.');
+ t := Columns[X].FStrings;
+ if (Y < t.Count)
+ then Result := t[Y];
+end;
+
+procedure TfpgNiceGrid.InternalSetCell(X, Y: Integer; Value: string;
+ FireOnChange: Boolean);
+var
+ t: TStringList;
+ s: string;
+ CanChange: Boolean;
+begin
+ if (ColCount = 0) or (FRowCount = 0)
+ then Exit;
+ if FireOnChange and FColumns[X].FReadOnly
+ then Exit;
+ if (X > ColCount-1) or (Y > FRowCount-1)
+ then raise Exception.Create('Cell Index out of bound.');
+ t := TStringList(FColumns[X].FStrings);
+ while (Y > t.Count-1)
+ do t.Add('');
+ if (t[Y] = Value)
+ then Exit;
+ if FireOnChange then
+ begin
+ s := Value;
+ CanChange := True;
+ if Assigned(FOnCellChanging)
+ then FOnCellChanging(Self, X, Y, CanChange);
+ if not CanChange
+ then Exit;
+ if Assigned(FOnCellChange)
+ then FOnCellChange(Self, X, Y, s);
+ t[Y] := s;
+ end else
+ t[Y] := Value;
+ if (not FUpdating) and (not IsEditing) then
+ FastDrawCell(X, Y);
+end;
+
+procedure TfpgNiceGrid.SetCell(X, Y: Integer; Value: string);
+begin
+ InternalSetCell(X, Y, Value, False);
+end;
+
+procedure TfpgNiceGrid.BeginUpdate;
+begin
+ FUpdating := True;
+end;
+
+procedure TfpgNiceGrid.EndUpdate;
+begin
+ FUpdating := False;
+ UpdateHeader;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.SetFlat(Value: Boolean);
+begin
+ if (FFlat <> Value) then
+ begin
+ FFlat := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetColor(Value: TfpgColor);
+begin
+ if (FColor <> Value) then
+ begin
+ FColor := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetAlternateColor(Value: TfpgColor);
+begin
+ if (FAlternateColor <> Value) then
+ begin
+ FAlternateColor := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetGridColor(Value: TfpgColor);
+begin
+ if (FGridColor <> Value) then
+ begin
+ FGridColor := Value;
+ Invalidate;
+ end;
+end;
+
+function TfpgNiceGrid.GetColWidths(Idx: Integer): Integer;
+begin
+ Result := FColumns[Idx].FWidth;
+end;
+
+procedure TfpgNiceGrid.SetColWidths(Idx, Value: Integer);
+begin
+ if not FAutoColWidth then
+ begin
+ if (ColWidths[Idx] <> Value)
+ then FColumns[Idx].Width := Value;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetAutoColWidth(Value: Boolean);
+begin
+ if (FAutoColWidth <> Value) then
+ begin
+ FAutoColWidth := Value;
+ Recalculate;
+ Invalidate;
+ UpdateScrollbars;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetDefColWidth(Value: Integer);
+begin
+ if (FDefColWidth <> Value) then
+ begin
+ FDefColWidth := Value;
+ if not FAutoColWidth then
+ begin
+ Recalculate;
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetDefRowHeight(Value: Integer);
+begin
+ if (FDefRowHeight <> Value) then
+ begin
+ FDefRowHeight := Value;
+ FSmallChange := Value;
+ FLargeChange := Value * 5;
+ Recalculate;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetFitToWidth(Value: Boolean);
+begin
+ if (FFitToWidth <> Value) then
+ begin
+ FFitToWidth := Value;
+ FHorzOffset := 0;
+ Recalculate;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetHeaderColor(Value: TfpgColor);
+begin
+ if (FHeaderColor <> Value) then
+ begin
+ FHeaderColor := Value;
+ if not FUpdating then
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetHeaderDarkColor(Value: TfpgColor);
+begin
+ if (FHeaderDarkColor <> Value) then
+ begin
+ FHeaderDarkColor := Value;
+ if not FUpdating then
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetHeaderLightColor(Value: TfpgColor);
+begin
+ if (FHeaderLightColor <> Value) then
+ begin
+ FHeaderLightColor := Value;
+ if not FUpdating then
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetHeaderLine(Value: Integer);
+begin
+ if (FHeaderLine <> Value) then
+ begin
+ FHeaderLine := Value;
+ UpdateHeader;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetSelectionColor(Value: TfpgColor);
+begin
+ if (FSelectionColor <> Value) then
+ begin
+ FSelectionColor := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
+var
+ l, t, r, b: Integer;
+ x, y: Integer;
+ Empty: Boolean;
+ Str: string;
+ Old: Integer;
+ OldS: string;
+
+ procedure UpdateColRow;
+ begin
+ FUpdating := True;
+ BuffString := '';
+ FCol2 := FCol;
+ FRow2 := FRow;
+ EnsureVisible(FCol, FRow);
+ FUpdating := False;
+ SetSelectArea(fpgRect(FCol, FRow, FCol, FRow));
+ ColRowChanged;
+ SetScrollBar(FVScrollBar,FMaxVScroll, FVertOffset,FDefRowHeight);
+ SetScrollBar(FHScrollBar, FMaxHScroll, FHorzOffset, 1);
+ end;
+
+ procedure UpdateSelectArea;
+ begin
+ l := Min(FCol2, FCol);
+ t := Min(FRow2, FRow);
+ r := Max(FCol2, FCol);
+ b := Max(FRow2, FRow);
+ SetSelectArea(fpgRect(l, t, r, b));
+ EnsureVisible(FCol2, FRow2);
+ end;
+
+begin
+ if not FEnabled
+ then Exit;
+
+ if (ColCount = 0) or (FRowCount = 0)
+ then Exit;
+
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
+
+ Consumed := true;
+ if (ssCtrl in shiftstate) then
+ begin
+ case KeyCode of
+
+ Ord('X'), Ord('x'):
+ if not FReadOnly then CutToClipboard;
+
+ Ord('C'), Ord('c'):
+ CopyToClipboard;
+
+ Ord('V'), Ord('v'):
+ if not FReadOnly
+ then PasteFromClipboard;
+
+ Ord('E'), Ord('e'):
+ begin
+ if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then
+ begin
+ IsEditing := True;
+ FEdit.ShowEdit(FCol, FRow);
+ end;
+ end;
+
+ keyHome :
+ begin
+ FCol := GetFirstVisible;
+ FRow := 0;
+ UpdateColRow;
+ end;
+
+ keyEnd :
+ begin
+ FCol := GetLastVisible;
+ FRow := FRowCount-1;
+ UpdateColRow;
+ end;
+
+ keyDelete :
+ begin
+ if not FReadOnly and (FRowCount > 1) then
+ begin
+ Old := FRow;
+ DeleteRow(FRow);
+ if Assigned(FOnDeleteRow)
+ then FOnDeleteRow(Self, Old);
+ UpdateColRow;
+ end;
+ end;
+
+ keyInsert:
+ begin
+ if not FReadOnly then
+ begin
+ InsertRow(Max(0, FRow));
+ if Assigned(FOnInsertRow)
+ then FOnInsertRow(Self, FRow);
+ UpdateColRow;
+ end;
+ end;
+ else Consumed:=false;
+ end; {case}
+ end
+ else
+ if (ssShift in ShiftState) then
+ begin
+ case KeyCode of
+ keyLeft:
+ begin
+ FCol2 := Max(GetPrevVisible(FCol2), GetFirstVisible);
+ UpdateSelectArea;
+ end;
+
+ keyRight:
+ begin
+ FCol2 := Min(GetNextVisible(FCol2), GetLastVisible);
+ UpdateSelectArea;
+ end;
+
+ keyUp:
+ begin
+ FRow2 := Max(FRow2 - 1, 0);
+ UpdateSelectArea;
+ end;
+
+ keyDown:
+ begin
+ FRow2 := Min(FRow2 + 1, FRowCount-1);
+ UpdateSelectArea;
+ end;
+ else Consumed:=false;
+ end; {case}
+
+ end else
+ begin
+ case KeyCode of
+ keyHome:
+ begin
+ FCol := GetFirstVisible;
+ UpdateColRow;
+ end;
+
+ keyEnd:
+ begin
+ FCol := GetLastVisible;
+ UpdateColRow;
+ end;
+
+ keyPrior:
+ begin
+ FRow := 0;
+ UpdateColRow;
+ end;
+
+ keyNext:
+ begin
+ FRow := FRowCount-1;
+ UpdateColRow;
+ end;
+
+ keyLeft:
+ begin
+ FCol := Max(GetPrevVisible(FCol), GetFirstVisible);
+ UpdateColRow;
+ end;
+
+ keyRight:
+ begin
+ FCol := Min(GetNextVisible(FCol), GetLastVisible);
+ UpdateColRow;
+ end;
+
+ keyUp:
+ begin
+ if FAutoAddRow and (FRow = (FRowCount-1)) and (FRow > 0) and not FReadOnly then
+ begin
+ Empty := True;
+ for x := 0 to ColCount-1 do
+ begin
+ if (SafeGetCell(x, FRowCount-1) <> '') then
+ begin
+ Empty := False;
+ Break;
+ end;
+ end;
+ if Empty then
+ begin
+ RowCount := RowCount - 1;
+ FRow := FRowCount - 1;
+ if Assigned(FOnDeleteRow)
+ then FOnDeleteRow(Self, FRowCount);
+ end else
+ FRow := Max(0, FRow - 1);
+ end else
+ FRow := Max(0, FRow - 1);
+ UpdateColRow;
+ end;
+
+ keyDown:
+ begin
+ if FAutoAddRow and (FRow = (FRowCount-1)) and not FReadOnly then
+ begin
+ Inc(FRow);
+ RowCount := RowCount + 1;
+ if Assigned(FOnInsertRow)
+ then FOnInsertRow(Self, FRow);
+ end
+ else
+ FRow := Min(FRowCount - 1, FRow + 1);
+ UpdateColRow;
+ end;
+
+ keyReturn, keyPEnter:
+ begin
+ OldS := GetCell(Col, Row);
+ Str := OldS;
+ if Assigned(FOnCellAssignment)
+ then FOnCellAssignment(Self, Col, Row, Str);
+ if (Str <> Olds)
+ then InternalSetCell(Col, Row, Str, True);
+ if (FSelectArea.Left = FSelectArea.Width) and
+ (FSelectArea.Top = FSelectArea.Height) then
+ begin
+ FRow := Min(FRowCount - 1, FRow + 1);
+ UpdateColRow;
+ end
+ else
+ begin
+ if (FCol = FSelectArea.Width) and (FRow = FSelectArea.Height) then
+ begin
+ FCol := FSelectArea.Left;
+ FRow := FSelectArea.Top;
+ end
+ else if (FRow = FSelectArea.Height) then
+ begin
+ FCol := FCol + 1;
+ FRow := FSelectArea.Top;
+ end
+ else
+ begin
+ FRow := Row + 1;
+ end;
+ BuffString := '';
+ EnsureVisible(FCol, FRow);
+ ColRowChanged;
+ end;
+ end;
+
+ keyDelete:
+ begin
+ if (BuffString = '') then
+ begin
+ if not FReadOnly then
+ begin
+ FUpdating := True;
+ for x := SelectArea.Left to SelectArea.Width do
+ begin
+ for y := SelectArea.Top to SelectArea.Height
+ do InternalSetCell(X, Y, '', True);
+ end;
+ FUpdating := False;
+ end;
+ end;
+ end;
+ else Consumed:=false;
+ end; {case}
+
+ end;
+ if consumed then Invalidate;
+end;
+
+
+function TfpgNiceGrid.GetHitTestInfo(X, Y: Integer): TGridHitTest;
+var
+ a, i1, i2: Integer;
+ ax, ay: Integer;
+ IsSizing: Boolean;
+
+begin
+ Result := gtNone;
+ IsSizing := False;
+
+ ax := (FHorzOffset + X) - FixedWidth;
+ ay := (FVertOffset + Y) - FixedHeight;
+
+ if not FAutoColWidth then
+ begin
+ for a := 1 to ColCount do
+ begin
+ i1 := GetColCoord(a);
+ i2 := X + FHorzOffset - FixedWidth;
+ if (i2 > (i1-2)) and (i2 < (i1+2)) then
+ begin
+ SizingCol := a - 1;
+ IsSizing := FColumns[SizingCol].FCanResize;
+ Break;
+ end;
+ end;
+ end;
+
+ if PtInfpgRect(SmallBox, Point(X, Y))
+ then Result := gtSmallBox else
+ if IsSizing
+ then Result := gtColSizing else
+ if ((X < FixedWidth) and (Y < FixedHeight))
+ then Result := gtLeftTop else
+ if ((X < FixedWidth) and (Y > FixedHeight) and (ay < BodyHeight))
+ then Result := gtLeft else
+ if ((Y < FixedHeight) and (X > FixedWidth) and (ax < BodyWidth))
+ then Result := gtTop else
+ if ((X > FixedWidth) and (Y > FixedHeight) and (ax < BodyWidth) and (ay < BodyHeight))
+ then Result := gtCell;
+
+end;
+
+procedure TfpgNiceGrid.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
+var
+ Pt: TPoint;
+begin
+ if not FEnabled then
+ begin
+ inherited;
+ Exit;
+ end;
+ if (MouseCursor = mcMove) then
+ begin
+ SizingColX := GetColCoord(SizingCol);
+ end else
+ if (MouseCursor = mcHand) then
+ begin
+ SmallBoxArea := FSelectArea;
+ end
+ else
+ if (MouseCursor = mcSizeNWSE) then
+ begin
+ FRow := 0;
+ FCol := 0;
+ BuffString := '';
+ EnsureVisible(0, 0);
+ FCol2 := ColCount-1;
+ FRow2 := FRowCount-1;
+ SetSelectArea(fpgRect(0, 0, ColCount-1, FRowCount-1));
+ ColRowChanged;
+ end
+ else
+ if (MouseCursor = mcSizeEW) then
+ begin
+ FRow := GetRowFromY(Y);
+ FCol := 0;
+ LastHover := FRow;
+ BuffString := '';
+ EnsureVisible(FCol, FRow);
+ FCol2 := ColCount-1;
+ FRow2 := FRow;
+ SmallBoxPos := 2;
+ AdjustSelection(fpgRect(0, FRow, ColCount-1, FRow), True);
+ ColRowChanged;
+ if Assigned(OnGutterClick)
+ then FOnGutterClick(Self, FRow, mbLeft, ShiftState);
+ end
+ else
+ if (MouseCursor = mcSizeNS) then
+ begin
+ FCol := GetColFromX(X);
+ FRow := 0;
+ LastHover := FCol;
+ BuffString := '';
+ EnsureVisible(FCol, FRow);
+ FCol2 := FCol;
+ FRow2 := FRowCount-1;
+ SmallBoxPos := 1;
+ AdjustSelection(fpgRect(FCol, 0, FCol, FRowCount-1), True);
+ ColRowChanged;
+ if Assigned(FOnHeaderClick)
+ then FOnHeaderClick(Self, FCol, mbLeft, ShiftState);
+ end
+ else
+ if (MouseCursor = mcCross) then
+ begin
+ BuffString := '';
+ Pt := GetCellAtPos(X, Y);
+ if (Pt.X = FCol) and (Pt.Y = FRow) then
+ begin
+ EnsureVisible(FCol, FRow);
+ if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then
+ begin
+ IsEditing := True;
+ FEdit.ShowEdit(FCol, FRow);
+ end;
+ end
+ else
+ if (Pt.X <> -1) and (pt.Y <> -1) then
+ begin
+ FEdit.HideEdit;
+ IsEditing := False;
+
+ EnsureVisible(Pt.X, Pt.Y);
+ FCol := Pt.X;
+ FRow := Pt.Y;
+ BuffString := '';
+ FCol2 := FCol;
+ FRow2 := FRow;
+ SetSelectArea(fpgRect(FCol, FRow, FCol, FRow));
+ end;
+ ColRowChanged;
+ end;
+
+ CaptureMouse;
+ Invalidate;
+ inherited;
+end;
+
+procedure TfpgNiceGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
+var
+ Total2Col: Integer;
+ Suggested: Integer;
+ Pt: TPoint;
+ l, t, r, b: Integer;
+ i: Integer;
+
+begin
+ if not FEnabled then
+ begin
+ MouseCursor := mcDefault;
+ inherited;
+ Exit;
+ end;
+
+ if (ssLeft in ShiftState) then
+ begin
+
+ if (MouseCursor = mcCross) then
+ begin
+ Pt := GetCellAtPos(X, Y);
+ if (Pt.X <> -1) and (Pt.Y <> -1) then
+ begin
+ l := Min(Pt.X, FCol);
+ t := Min(Pt.Y, FRow);
+ r := Max(Pt.X, FCol);
+ b := Max(Pt.Y, FRow);
+ FCol2 := Pt.X;
+ FRow2 := Pt.Y;
+ SetSelectArea(fpgRect(l, t, r, b));
+ EnsureVisible(FCol2, FRow2);
+ Invalidate;
+ end;
+ end else
+
+ if (MouseCursor = mcHand) then
+ begin
+ Pt := GetCellAtPos(X, Y);
+ if (Pt.X <> -1) and (Pt.Y <> -1) then
+ begin
+ l := Min(Pt.X, SmallBoxArea.Left);
+ t := Min(Pt.Y, SmallBoxArea.Top);
+ r := Max(Pt.X, SmallBoxArea.Width);
+ b := Max(Pt.Y, SmallBoxArea.Height);
+ FCol2 := Pt.X;
+ FRow2 := Pt.Y;
+ SetSelectArea(fpgRect(l, t, r, b));
+ EnsureVisible(FCol2, FRow2);
+ Invalidate;
+ end;
+ end else
+
+ if (MouseCursor = mcSizeEW) then
+ begin
+ i := GetRowFromY(Y);
+ if (i <> -1) and (i <> LastHover) then
+ begin
+ LastHover := i;
+ t := Min(i, FRow);
+ b := Max(i, FRow);
+ FRow2 := i;
+ SmallBoxPos := 2;
+ AdjustSelection(fpgRect(0, t, ColCount-1, b), True);
+ Invalidate;
+ end;
+ end else
+
+ if (MouseCursor = mcSizeNS) then
+ begin
+ i := GetColFromX(X);
+ if (i <> -1) and (i <> LastHover) then
+ begin
+ LastHover := i;
+ l := Min(i, FCol);
+ r := Max(i, FCol);
+ FCol2 := i;
+ SmallBoxPos := 1;
+ AdjustSelection(fpgRect(l, 0, r, FRowCount-1), True);
+ Invalidate;
+ end;
+ end else
+
+ if (MouseCursor = mcMove) then
+ begin
+ Suggested := Max(5, X + FHorzOffset - SizingColX - FixedWidth);
+ if FFitToWidth then
+ begin
+ if (SizingCol = ColCount-1) or (SizingCol = -1) then
+ begin
+ inherited;
+ Exit;
+ end;
+ Total2Col := (ClientWidth - FixedWidth) - (TotalWidth - Columns[SizingCol].FWidth - Columns[SizingCol+1].FWidth);
+ if (Total2Col > 10) then
+ begin
+ Columns[SizingCol].FWidth := Suggested;
+ Columns[SizingCol+1].FWidth := Total2Col - Suggested;
+ end;
+ if (Columns[SizingCol+1].FWidth < 5) then
+ begin
+ Columns[SizingCol].FWidth := Total2Col - 5;
+ Columns[SizingCol+1].FWidth := 5;
+ end;
+ end else
+ begin
+ Columns[SizingCol].FWidth := Suggested;
+ end;
+ Recalculate;
+ Invalidate;
+ end;
+ end
+ else
+ MouseCursor := CursorArray[GetHitTestInfo(X, Y)];
+ inherited;
+end;
+
+procedure TfpgNiceGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+var
+ Ls: TList;
+ ax, ay: Integer;
+ l, t, w, h: Integer;
+
+ function GetCopy(nx, ny: Integer): string;
+ var
+ ix, iy: Integer;
+ begin
+ ix := nx;
+ iy := ny;
+ while (ix < l)
+ do ix := ix + w;
+ while (iy < t)
+ do iy := iy + h;
+ ix := ((ix - l) mod w) + l;
+ iy := ((iy - t) mod h) + t;
+ Result := SafeGetCell(TfpgNiceColumn(Ls[ix]).Index, iy);
+ end;
+
+begin
+ if (MouseCursor = mcHand) then
+ begin
+ if FReadOnly then
+ begin
+ SmallBoxArea := fpgRect(-1, -1, -1,-1);
+ Invalidate;
+ end
+ else
+ begin
+ FUpdating := True;
+ Ls := TList.Create;
+ for ax := FSelectArea.Left to FSelectArea.Width do
+ if FColumns[ax].FVisible
+ then Ls.Add(FColumns[ax]);
+ l := 0;
+ for ax := 0 to Ls.Count-1 do
+ begin
+ if (TfpgNiceColumn(Ls[ax]).Index = SmallBoxArea.Left) then
+ begin
+ l := ax;
+ Break;
+ end;
+ end;
+ t := SmallBoxArea.Top;
+ w := (SmallBoxArea.Width - SmallBoxArea.Left) + 1;
+ h := (SmallBoxArea.Height- SmallBoxArea.Top) + 1;
+ for ax := 0 to Ls.Count-1 do
+ for ay := FSelectArea.Top to FSelectArea.Height
+ do InternalSetCell(TfpgNiceColumn(Ls[ax]).Index, ay, GetCopy(ax, ay), True);
+ Ls.Free;
+ SmallBoxArea := fpgRect(-1, -1, -1,-1);
+ BuffString := '';
+ FUpdating := False;
+ Invalidate;
+ end;
+ end;
+
+ MouseCursor := CursorArray[GetHitTestInfo(X, Y)];
+ ReleaseMouse;
+ LastHover := -1;
+
+ inherited;
+end;
+
+procedure TfpgNiceGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
+begin
+ inherited HandleMouseScroll(x, y, shiftstate, delta);
+ FVertOffset := FVertOffset + (delta*FDefRowHeight);
+ FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset));
+ NormalizeVertOffset;
+ SetScrollBar(FVScrollBar, FMaxVScroll, FVertOffset, FDefRowHeight);
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.SetColumns(Value: TfpgNiceColumns);
+begin
+ FColumns.Assign(Value);
+end;
+
+function TfpgNiceGrid.CreateColumn: TfpgNiceColumn;
+begin
+ Result := TfpgNiceColumn.Create(Columns);
+end;
+
+procedure TfpgNiceGrid.UpdateColumn(Index: Integer);
+var
+ i: Integer;
+begin
+ for i := 0 to FRowCount-1 do
+ if (GetObject(Index, i) <> TObject(MergeID)) then
+ DrawCell(Index, i);
+end;
+
+procedure TfpgNiceGrid.UpdateColumns;
+begin
+ UpdateHeader;
+ Invalidate;
+end;
+
+function TfpgNiceGrid.GetColCount: Integer;
+begin
+ Result := FColumns.Count;
+end;
+
+function TfpgNiceGrid.TotalWidth: Integer;
+var
+ x: Integer;
+begin
+ Result := 0;
+ for x := 0 to FColumns.Count-1 do
+ begin
+ if FColumns[x].FVisible
+ then Result := Result + FColumns[x].FWidth;
+ end;
+end;
+
+procedure TfpgNiceGrid.HandleResize(awidth, aheight: TfpgCoord);
+begin
+ inherited HandleResize(awidth, aheight);
+ if (csLoading in ComponentState) then
+ Exit; //==>
+ if csUpdating in ComponentState then
+ Exit; //==>
+ Recalculate;
+ if (FColumns.Count > 0)
+ then EnsureVisible(FCol, FRow);
+ if HasHandle then
+ UpdateScrollBars;
+end;
+
+procedure TfpgNiceGrid.UpdateScrollBars;
+var
+ HWidth: integer;
+ VHeight: integer;
+ HeightAvail: integer;
+ vw: integer;
+ cw: integer;
+ i: integer;
+begin
+ VHeight := Height -2;
+ HWidth := Width - 2;
+
+ if FVScrollBar.Visible then
+ vw := Width - FVScrollBar.Width
+ else
+ vw := Width;
+
+ cw := 0;
+ for i := 0 to FColumns.Count-1 do
+ cw := cw + FColumns[i].Width;
+
+ // This needs improving while resizing
+ if cw > vw then
+ FHScrollBar.Visible := true
+ else
+ begin
+ FHScrollBar.Visible := False;
+ FHorzOffset:=0;
+ end;
+
+ HeightAvail := Height - FixedHeight;
+ if FShowFooter
+ then HeightAvail := HeightAvail - FDefRowHeight;
+
+ if FVScrollBar.Visible then
+ begin
+ Dec(HWidth, FVScrollBar.Width);
+ if FRowCount > 0 then
+ FVScrollBar.SliderSize := HeightAvail / BodyHeight
+ else
+ FVScrollBar.SliderSize := 0;
+ FVScrollBar.Max:= FMaxVScroll;
+ FVScrollBar.Position:=FVertOffset;
+ FVScrollBar.RepaintSlider;
+ end;
+
+ if FHScrollBar.Visible then
+ begin
+ Dec(VHeight, FHScrollBar.Height);
+ FHScrollBar.SliderSize := 0.2;
+ FHScrollBar.RepaintSlider;
+ end;
+
+ FHScrollBar.Top := Height -FHScrollBar.Height-1;
+ FHScrollBar.Left := 1;
+ FHScrollBar.Width := HWidth;
+
+ FVScrollBar.Top := 1;
+ FVScrollBar.Left := Width - FVScrollBar.Width-1;
+ FVScrollBar.Height := VHeight;
+
+ FVScrollBar.UpdateWindowPosition;
+ FHScrollBar.UpdateWindowPosition;
+end;
+
+procedure TfpgNiceGrid.SetShowGrid(Value: Boolean);
+begin
+ if (FShowGrid <> Value) then
+ begin
+ FShowGrid := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetShowFooter(const Value: Boolean);
+begin
+ if (FShowFooter <> Value) then
+ begin
+ FShowFooter := Value;
+ Recalculate;
+ Invalidate;
+ UpdateScrollBars;
+ end;
+end;
+
+procedure TfpgNiceGrid.Clear;
+var
+ x: Integer;
+begin
+ for x := 0 to ColCount-1
+ do FColumns[x].FStrings.Clear;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.SetHorzOffset(Value: Integer);
+begin
+ if (FHorzOffset <> Value) then
+ begin
+ FHorzOffset := Max(0, Min(FMaxHScroll, Value));
+ SetScrollBar(FHScrollBar, 0, FHorzOffset, 1);
+ end;
+end;
+
+procedure TfpgNiceGrid.SetVertOffset(Value: Integer);
+begin
+ if (FVertOffset <> Value) then
+ begin
+ FVertOffset := Max(0, Min(FMaxVScroll, Value));
+ NormalizeVertOffset;
+ SetScrollBar(FVScrollBar, 0, FVertOffset, FDefRowHeight);
+ end;
+end;
+
+procedure TfpgNiceGrid.EnsureVisible(X, Y: Integer);
+var
+ t, b, h: Integer;
+ l, r: Integer;
+ Horz, Vert: Boolean;
+ SuggestedHorz, SuggestedVert: Integer;
+
+begin
+
+ if (X = -1) or (Y = -1)
+ then Exit;
+
+ if (AllWidth < ClientWidth) and (AllHeight < ClientHeight)
+ then Exit;
+
+ SuggestedVert := FVertOffset;
+ t := FVertOffset div FDefRowHeight;
+ h := ((ClientHeight - FixedHeight) div FDefRowHeight) - 1;
+ if FShowFooter
+ then h := h-1;
+ b := t + h;
+ Vert := (Y < t) or (Y > b);
+ if (Y < t)
+ then SuggestedVert := Y * FDefRowHeight;
+ if (Y > b)
+ then SuggestedVert := (Y - h) * FDefRowHeight;
+
+ SuggestedHorz := FHorzOffset;
+ l := GetColCoord(X) - FHorzOffset + FixedWidth;
+ r := l + FColumns[x].FWidth;
+ Horz := (l < FixedWidth) or (r > ClientWidth);
+ if (l < FixedWidth)
+ then SuggestedHorz := Max(0, SuggestedHorz + (l - FixedWidth));
+ if (r > ClientWidth)
+ then SuggestedHorz := Min(FMaxHScroll, SuggestedHorz - (ClientWidth - r) + 1);
+
+ if Vert and not Horz
+ then SetVertOffset(SuggestedVert) else
+
+ if Horz and not Vert
+ then SetHorzOffset(SuggestedHorz) else
+
+ if Horz and Vert
+ then
+ begin
+ FHorzOffset := SuggestedHorz;
+ FVertOffset := SuggestedVert;
+ SetScrollBar(FHScrollBar, 0, FHorzOffset, 1);
+ SetScrollBar(FVScrollBar, 0, FVertOffset, FDefRowHeight);
+ Invalidate;
+ end;
+end;
+
+function TfpgNiceGrid.HeaderCells(I: Integer): THeaderInfo;
+begin
+ Result := PHeaderInfo(FHeaderInfos[I])^;
+end;
+
+function TfpgNiceGrid.HeaderCellsCount: Integer;
+begin
+ Result := FHeaderInfos.Count;
+end;
+
+procedure TfpgNiceGrid.SetReadOnly(Value: Boolean);
+begin
+ if (FReadOnly <> Value) then
+ begin
+ FReadOnly := Value;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetCol(Value: Integer);
+begin
+ if (FCol <> Value) then
+ begin
+ FCol := Value;
+ FCol2 := Value;
+ FRow2 := FRow;
+ BuffString := '';
+ SetSelectArea(fpgRect(FCol, FRow, FCol, FRow));
+ ColRowChanged;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetRow(Value: Integer);
+begin
+ if (FRow <> Value) then
+ begin
+ FRow := Value;
+ FRow2 := Value;
+ FCol2 := FCol;
+ BuffString := '';
+ SetSelectArea(fpgRect(FCol, FRow, FCol, FRow));
+ ColRowChanged;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.AdjustSelection(Value: TfpgRect; Force: Boolean);
+begin
+ if EqualfpgRect(FSelectArea, Value) and not Force
+ then Exit; //==>
+ FSelectArea := Value;
+end;
+
+procedure TfpgNiceGrid.SetSelectArea(Value: TfpgRect);
+begin
+ AdjustSelection(Value, False);
+end;
+
+procedure TfpgNiceGrid.SetGutterKind(Value: TGutterKind);
+var
+ Old: TGutterKind;
+begin
+ Old := FGutterKind;
+ if (FGutterKind <> Value) then
+ begin
+ FGutterKind := Value;
+ Recalculate;
+ if (Old = gkNone) or (Value = gkNone) then
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetGutterWidth(Value: Integer);
+begin
+ if (FGutterWidth <> Value) then
+ begin
+ FGutterWidth := Value;
+ Recalculate;
+ Invalidate;
+ UpdateScrollBars;
+ end;
+end;
+
+procedure TfpgNiceGrid.CopyToClipboard;
+var
+ s: string;
+ t: TStringList;
+ x, y: Integer;
+begin
+ t := TStringList.Create;
+ with Fselectarea do
+ for y := FSelectArea.Top to FSelectArea.Height do
+ begin
+ s := '';
+ for x := FSelectArea.Left to FSelectArea.Width do
+ begin
+ if FColumns[x].FVisible then
+ begin
+ if (x = FSelectArea.Left)
+ then s := SafeGetCell(X, Y)
+ else s := s + #9 + SafeGetCell(X, Y);
+ end;
+ end;
+ t.Add(s);
+ end;
+ fpgClipboard.Text := t.Text;
+ t.Free;
+end;
+
+procedure TfpgNiceGrid.CutToClipboard;
+var
+ s: string;
+ t: TStringList;
+ x, y: Integer;
+begin
+ FUpdating := True;
+ t := TStringList.Create;
+ for y := FSelectArea.Top to FSelectArea.Height do
+ begin
+ s := '';
+ for x := FSelectArea.Left to FSelectArea.Width do
+ begin
+ if FColumns[x].FVisible then
+ begin
+ if (x = FSelectArea.Left)
+ then s := SafeGetCell(X, Y)
+ else s := s + #9 + SafeGetCell(X, Y);
+ InternalSetCell(X, Y, '', True);
+ end;
+ end;
+ t.Add(s);
+ end;
+ fpgClipboard.Text := t.Text;
+ t.Free;
+ FUpdating := False;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.PasteFromClipboard;
+var
+ tr, tc: TStringList;
+ x, y: Integer;
+ s: string;
+ n: Integer;
+ TabCnt: Integer;
+ ax, ay: Integer;
+ ColCnt: Integer;
+
+begin
+ FUpdating := True;
+ tr := TStringList.Create;
+ tc := TStringList.Create;
+ tr.Text := fpgClipboard.Text;
+ TabCnt := 1;
+
+ for y := 0 to tr.Count-1 do
+ begin
+ n := 1;
+ s := tr[y];
+ for x := 1 to Length(s) do
+ if (s[x] = #9)
+ then Inc(n);
+ TabCnt := Max(TabCnt, n);
+ end;
+
+ ColCnt := ColCount; // Just to make it fast
+
+ if (FSelectArea.Left = FSelectArea.Width) and (FSelectArea.Top = FSelectArea.Height) then
+ begin
+
+ for y := 0 to tr.Count-1 do
+ begin
+ tc.Text := StringReplace(tr[y], #9, #13#10, [rfReplaceAll]);
+ while (tc.Count < TabCnt)
+ do tc.Add('');
+ x := 0;
+ ax := FCol;
+ while (x < tc.Count) do
+ begin
+ ay := FRow + y;
+ if FColumns[ax].FVisible then
+ begin
+ if (ax < ColCnt) and (ay < FRowCount)
+ then InternalSetCell(ax, ay, tc[x], True);
+ Inc(x);
+ end;
+ Inc(ax);
+ end;
+ end;
+
+ end else
+ begin
+
+ ay := FSelectArea.Top;
+ while (ay <= FSelectArea.Height) do
+ begin
+ tc.Text := StringReplace(tr[(ay - FSelectArea.Top) mod tr.Count], #9, #13#10, [rfReplaceAll]);
+ while (tc.Count < TabCnt)
+ do tc.Add('');
+ ax := FSelectArea.Left;
+ x := 0;
+ while (ax <= FSelectArea.Width) do
+ begin
+ if FColumns[ax].FVisible then
+ begin
+ InternalSetCell(ax, ay, tc[x], True);
+ Inc(x);
+ if (x = tc.Count)
+ then x := 0;
+ end;
+ Inc(ax);
+ end;
+ Inc(ay);
+ end;
+
+ end;
+
+ tr.Free;
+ tc.Free;
+
+ FUpdating := False;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.NormalizeVertOffset;
+begin
+ FVertOffset := (FVertOffset div FDefRowHeight) * FDefRowHeight;
+end;
+
+procedure TfpgNiceGrid.SetGutterFont(const Value: string);
+begin
+ if FGutterFont <> Value then
+ begin
+ FGutterFont:= Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetGutterFontColor(Value: TfpgColor);
+begin
+ if FGutterFontColor <> Value then
+ begin
+ FGutterFontColor:= Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetHeaderFont(Value: string);
+begin
+ FHeaderFont:=Value;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.SetHeaderFontColor(Value: TfpgColor);
+begin
+ if FHeaderFontColor <> Value then
+ begin
+ FHeaderFontColor:= Value;
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.SetFooterFont(const Value: string);
+begin
+ FFooterFont:= Value;
+ Invalidate;
+end;
+
+procedure TfpgNiceGrid.SetFooterFontColor(Value: TfpgColor);
+begin
+ if FFooterFontColor <> Value then
+ begin
+ FFooterFontColor:= Value;
+ Invalidate;
+ end;
+end;
+
+function TfpgNiceGrid.GetFirstVisible: Integer;
+var
+ x: Integer;
+begin
+ Result := -1;
+ if (ColCount > 0) then
+ begin
+ for x := 0 to ColCount-1 do
+ begin
+ if Columns[x].Visible then
+ begin
+ Result := x;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function TfpgNiceGrid.GetLastVisible: Integer;
+var
+ x: Integer;
+begin
+ Result := -1;
+ if (ColCount > 0) then
+ begin
+ for x := ColCount-1 downto 0 do
+ begin
+ if Columns[x].Visible then
+ begin
+ Result := x;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function TfpgNiceGrid.GetNextVisible(Index: Integer): Integer;
+var
+ x: Integer;
+begin
+ Result := Index;
+ if (ColCount > 0) and (Index < ColCount) then
+ begin
+ for x := (Index + 1) to (ColCount - 1) do
+ begin
+ if Columns[x].Visible then
+ begin
+ Result := x;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function TfpgNiceGrid.GetPrevVisible(Index: Integer): Integer;
+var
+ x: Integer;
+begin
+ Result := Index;
+ if (ColCount > 0) and (Index > 0) then
+ begin
+ for x := (Index - 1) downto 0 do
+ begin
+ if Columns[x].Visible then
+ begin
+ Result := x;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.DeleteRow(ARow: Integer);
+var
+ x, y: Integer;
+begin
+ if (ARow >= 0) and (ARow < FRowCount) then
+ begin
+ for x := 0 to ColCount-1 do
+ begin
+ with FColumns[x].Strings do
+ begin
+ if (Count > ARow) then
+ begin
+ for y := ARow to Count-2
+ do Strings[y] := Strings[y + 1];
+ Strings[Count-1] := '';
+ end;
+ end;
+ end;
+ if (FRow = FRowCount-1)
+ then Dec(FRow);
+ RowCount := RowCount - 1;
+ UpdateScrollBars;
+ end;
+end;
+
+procedure TfpgNiceGrid.InsertRow(ARow: Integer);
+var
+ x: Integer;
+begin
+ if (ARow >= 0) and (ARow < FRowCount) then
+ begin
+ for x := 0 to ColCount-1 do
+ begin
+ with FColumns[x].Strings do
+ begin
+ while (Count < ARow)
+ do Add('');
+ Insert(ARow, '');
+ end;
+ end;
+ RowCount := RowCount + 1;
+ end;
+ UpdateScrollBars;
+end;
+
+function TfpgNiceGrid.AddRow: Integer;
+var
+ x: Integer;
+ n: Integer;
+begin
+ n := FRowCount + 1;
+ for x := 0 to ColCount-1 do
+ begin
+ with FColumns[x].Strings do
+ begin
+ while (Count < n)
+ do Add('');
+ Strings[FRowCount] := '';
+ end;
+ end;
+ RowCount := RowCount + 1;
+ Result := FRowCount-1;
+end;
+
+procedure TfpgNiceGrid.ColRowChanged;
+begin
+ if Assigned(Sync)
+ then Sync.Row := FRow;
+ if Assigned(FOnColRowChanged)
+ then FOnColRowChanged(Self, FCol, FRow);
+end;
+
+procedure TfpgNiceGrid.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ if (AComponent = Sync) and (Operation = opRemove)
+ then Sync := nil;
+ inherited;
+end;
+
+procedure TfpgNiceGrid.SetGutterStrings(const Value: TStrings);
+begin
+ FGutterStrings.Assign(Value);
+ if (FGutterKind = gkString) then
+ Invalidate;
+end;
+
+function TfpgNiceGrid.GetObject(X, Y: Integer): TObject;
+var
+ t: TStrings;
+begin
+ Result := nil;
+ if (X > ColCount-1) or (Y > FRowCount-1)
+ then raise Exception.Create('Cell Index out of bound.');
+ t := Columns[X].FStrings;
+ if (Y < t.Count)
+ then Result := t.Objects[Y];
+end;
+
+procedure TfpgNiceGrid.SetObject(X, Y: Integer; const Value: TObject);
+var
+ t: TStrings;
+begin
+ if (X > ColCount-1) or (Y > FRowCount-1)
+ then raise Exception.Create('Cell Index out of bound.');
+ t := Columns[X].FStrings;
+ while (Y > t.Count-1)
+ do t.Add('');
+ t.Objects[Y] := Value;
+end;
+
+procedure TfpgNiceGrid.ClearMergeCells;
+var
+ x, y: Integer;
+ List: TStrings;
+begin
+ for x := 0 to FColumns.Count-1 do
+ begin
+ List := FColumns[x].FStrings;
+ for y := 0 to List.Count-1
+ do List.Objects[y] := nil;
+ end;
+ for x := 0 to Mergeds.Count-1
+ do TfpgMergeCell(Mergeds[x]).Free;
+ Mergeds.Clear;
+end;
+
+function TfpgNiceGrid.MergeCells(const X1, Y1, X2, Y2: Integer;
+ ACaption: string): TfpgMergeCell;
+begin
+ Result := TfpgMergeCell.Create;
+ Result.Font:= Font.FontDesc;
+ Result.Color := Color;
+ Result.Text := ACaption;
+ Result.HorzAlign := haCenter;
+ Result.VertAlign := vaCenter;
+ Result.Rc := fpgRect(Min(X1, X2), Min(Y1, Y2), Max(X1, X2)-Min(X1, X2), Max(Y1, Y2)-Min(Y1, Y2));
+ Mergeds.Add(Result);
+ if not FUpdating then
+ begin
+ Recalculate;
+ writeln('MergeCells');
+ Invalidate;
+ end;
+end;
+
+procedure TfpgNiceGrid.BuildMergeData;
+var
+ Rc: TfpgRect;
+ x, y, z: Integer;
+begin
+ for x := 0 to Mergeds.Count-1 do
+ begin
+ CopyfpgRect(Rc, TfpgMergeCell(Mergeds[x]).Rc);
+ for y := Rc.Left to Rc.Right do
+ begin
+ if (y >= FColumns.Count)
+ then Continue;
+ for z := Rc.Top to Rc.Bottom do
+ begin
+ InternalSetCell(y, z, '', False);
+ SetObject(y, z, TObject(MergeID));
+ end;
+ end;
+ end;
+end;
+
+procedure TfpgNiceGrid.DrawMergedCell(Index: Integer);
+var
+ Data: TfpgMergeCell;
+ Rc, Dummy: TfpgRect;
+ l1, l2, t, h: Integer;
+begin
+ Data := TfpgMergeCell(Mergeds[Index]);
+ l1 := GetColCoord(Data.Rc.Left);
+ l2 := GetColCoord(Data.Rc.Right + 1);
+ t := FDefRowHeight * Data.Rc.Top;
+ h := FDefRowHeight * (Data.Rc.Bottom - Data.Rc.Top + 1);
+ Rc := fpgRect(l1-1, t-1, l2-l1, h);
+ OffsetfpgRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
+ if IntersectfpgRect(Dummy, Rc, CellBox) then
+ begin
+ with Canvas do
+ begin
+ Font:= fpgGetFont(Data.Font);
+ if not FEnabled
+ then SetTextColor(FGridColor);
+ if FShowGrid then
+ begin
+ SetColor(FGridColor);
+ DrawRectangle(Rc);
+ end
+ else
+ begin
+ SetColor(Data.Color);
+ FillRectangle(Rc);
+ end;
+ InflatefpgRect(Rc, -4, -2);
+ DrawStringUni(Canvas, Data.Text, Rc, Data.HorzAlign, Data.VertAlign);
+ end;
+ end;
+end;
+
+function TfpgNiceGrid.GetHeaderInfo: TList;
+begin
+ Result := FHeaderInfos;
+end;
+
+function TfpgNiceGrid.GetMergedCellsData: TList;
+begin
+ Result := Mergeds;
+end;
+
+procedure TfpgNiceGrid.SetEnabled(const Value: Boolean);
+begin
+ if (FEnabled <> Value) then
+ begin
+ FEnabled := Value;
+ Invalidate;
+ end;
+end;
+
+{ TfpgNiceColumn }
+
+constructor TfpgNiceColumn.Create(Collec: TCollection);
+begin
+ FStrings := TStringList.Create;
+ FFont:= 'Arial-8';
+ FHorzAlign := haLeft;
+ FVertAlign := vaCenter;
+ FVisible := True;
+ FCanResize := True;
+ FReadOnly := False;
+ FTag := 0;
+ FTag2 := 0;
+ with TfpgNiceColumns(Collec).Grid do
+ begin
+ Self.FFont:=Font.FontDesc;
+ Self.FWidth := DefColWidth;
+ Self.FColor := Color;
+ end;
+ inherited Create(Collec);
+end;
+
+destructor TfpgNiceColumn.Destroy;
+begin
+ inherited Destroy;
+ FStrings.Free;
+end;
+
+procedure TfpgNiceColumn.Assign(Source: TPersistent);
+begin
+ if (Source is TfpgNiceColumn) then
+ begin
+ Title := TfpgNiceColumn(Source).Title;
+ Footer := TfpgNiceColumn(Source).Footer;
+ Width := TfpgNiceColumn(Source).Width;
+ Font := TfpgNiceColumn(Source).Font;
+ Color := TfpgNiceColumn(Source).Color;
+ HorzAlign := TfpgNiceColumn(Source).HorzAlign;
+ VertAlign := TfpgNiceColumn(Source).VertAlign;
+ Visible := TfpgNiceColumn(Source).Visible;
+ Tag := TfpgNiceColumn(Source).Tag;
+ Tag2 := TfpgNiceColumn(Source).Tag2;
+ Hint := TfpgNiceColumn(Source).Hint;
+ CanResize := TfpgNiceColumn(Source).CanResize;
+ ReadOnly := TfpgNiceColumn(Source).ReadOnly;
+ Strings.Assign(TfpgNiceColumn(Source).Strings);
+ Changed(False);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetColor(Value: TfpgColor);
+begin
+ if (FColor <> Value) then
+ begin
+ FColor := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetFont(Value: string);
+begin
+ FFont:=Value;
+ Changed(False);
+end;
+
+procedure TfpgNiceColumn.SetHorzAlign(Value: THorzAlign);
+begin
+ if (FHorzAlign <> Value) then
+ begin
+ FHorzAlign := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetTitle(Value: string);
+begin
+ if (FTitle <> Value) then
+ begin
+ FTitle := Value;
+ Changed(True);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetFooter(const Value: string);
+begin
+ if (FFooter <> Value) then
+ begin
+ FFooter := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetVertAlign(Value: TVertAlign);
+begin
+ if (FVertAlign <> Value) then
+ begin
+ FVertAlign := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetWidth(Value: Integer);
+begin
+ if (FWidth <> Value) then
+ begin
+ FWidth := Value;
+ Changed(True);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetVisible(Value: Boolean);
+begin
+ if (FVisible <> Value) then
+ begin
+ FVisible := Value;
+ TfpgNiceColumns(Collection).FGrid.ForcedColumn := Index;
+ Changed(True);
+ end;
+end;
+
+procedure TfpgNiceColumn.SetStrings(Value: TStrings);
+begin
+ FStrings.Assign(Value);
+ Changed(False);
+end;
+
+function TfpgNiceColumn.IsFontStored: Boolean;
+begin
+ Result := True;
+ if (TfpgNiceColumns(Collection).FGrid.Font.FontDesc = FFont) then
+ Result:= false;
+end;
+
+function TfpgNiceColumn.GetGrid: TfpgNiceGrid;
+begin
+ Result := TfpgNiceColumns(Collection).FGrid;
+end;
+
+function TfpgNiceColumn.GetDisplayName: string;
+begin
+ if (FTitle <> '')
+ then Result := FTitle
+ else Result := 'Column ' + IntToStr(Index);
+end;
+
+{ TfpgNiceColumns }
+
+constructor TfpgNiceColumns.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
+begin
+ FGrid := TfpgNiceGrid(AOwner);
+ inherited Create(FGrid,TfpgNiceColumn);
+end;
+
+function TfpgNiceColumns.Add: TfpgNiceColumn;
+begin
+ Result := TfpgNiceColumn(inherited Add);
+end;
+
+function TfpgNiceColumns.GetItem(Index: Integer): TfpgNiceColumn;
+begin
+ Result := TfpgNiceColumn(inherited GetItem(Index));
+end;
+
+procedure TfpgNiceColumns.SetItem(Index: Integer; Value: TfpgNiceColumn);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+function TfpgNiceColumns.GetOwner: TPersistent;
+begin
+ Result := FGrid;
+end;
+
+function TfpgNiceColumns.Insert(Index: Integer): TfpgNiceColumn;
+begin
+ Result := AddItem(nil, Index);
+end;
+
+function TfpgNiceColumns.AddItem(Item: TfpgNiceColumn;
+ Index: Integer): TfpgNiceColumn;
+begin
+ if (Item = nil)
+ then Result := FGrid.CreateColumn
+ else
+ begin
+ Result := Item;
+ if Assigned(Item) then
+ begin
+ Result.Collection := Self;
+ if (Index < 0)
+ then Index := Count - 1;
+ Result.Index := Index;
+ end;
+ end;
+end;
+
+procedure TfpgNiceColumns.Update(Item: TCollectionItem);
+begin
+ if not (Grid.HasHandle) then
+ Exit; // ==>
+ if (Item <> nil)
+ then FGrid.UpdateColumn(Item.Index)
+ else FGrid.UpdateColumns;
+end;
+
+
+{ TInplaceEdit }
+
+constructor TfpgNiceInplace.Create(AGrid: TfpgNiceGrid);
+begin
+ inherited Create(AGrid);
+ FGrid := AGrid;
+ Name:='EditGrid';
+ BorderStyle:=ebsSingle;
+ Left := 0;
+ Top := 0;
+ BuffTmp:='';
+ Visible := False;
+ OnChange:=@Change;
+end;
+
+procedure TfpgNiceInplace.SetAlignment(Value: THorzAlign);
+begin
+ if (FAlignment <> Value) then
+ FAlignment := Value;
+end;
+
+procedure TfpgNiceInplace.ShowEdit(X, Y: Integer);
+var
+ Rc: TfpgRect;
+ Column: TfpgNiceColumn;
+begin
+ CellX := X;
+ CellY := Y;
+ Column := FGrid.FColumns[x];
+
+ SetAlignment(Column.FHorzAlign);
+ BackgroundColor := FGrid.GetCellColor(X, Y);
+
+ FontDesc:=Column.Font;
+ Text := Trim(FGrid.SafeGetCell(X, Y));
+ BuffTmp:= Text;
+
+ Rc := FGrid.GetCellRect(X, Y);
+ Rc := FGrid.CellRectToClient(Rc);
+ InflatefpgRect(Rc, -2, -2);
+ SetPosition(Rc.Left, Rc.Top,Rc.Width,Rc.Height);
+ Visible:=true;
+ SetFocus;
+end;
+
+procedure TfpgNiceInplace.HideEdit;
+begin
+ KillFocus;
+ if Visible
+ then Visible:=false;
+ FGrid.IsEditing := False;
+end;
+
+procedure TfpgNiceInplace.Change(Sender: TObject);
+begin
+ if Visible then // Because when tfpgWidget is disabled it still receive keyboard msg
+ FGrid.InternalSetCell(CellX, CellY, Text, True);
+end;
+
+procedure TfpgNiceInplace.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
+begin
+ if not Visible then
+Exit; //==>
+ if not Visible then
+ exit;
+ case KeyCode of
+ KeyEscape :
+ begin
+ Text:= BuffTmp;
+ HideEdit;
+ end;
+ KeyReturn, KeyPEnter, KeyUp, keyDown:
+ begin
+ HideEdit;
+ end;
+ else
+ begin
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
+ if (keycode= KeyLeft) and (FCursorPos=0) then
+ consumed:=true;
+ end;
+ end;
+end;
+
+
+{ TfpgNiceGridSync }
+
+constructor TfpgNiceGridSync.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnDeleteRow := @SyncDeleteRow;
+ FOnInsertRow := @SyncInsertRow;
+ FOnColRowChanged := @SyncColRow;
+ FMasterGrid:=nil;
+end;
+
+procedure TfpgNiceGridSync.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ if (AComponent = FMasterGrid) and (Operation = opRemove)
+ then FMasterGrid := nil;
+ inherited;
+end;
+
+procedure TfpgNiceGridSync.SetMasterGrid(const Value: TfpgNiceGrid);
+begin
+ if (FMasterGrid <> Value) then
+ begin
+ FMasterGrid := Value;
+ FMasterGrid.Sync := Self;
+ FMasterGrid.RowCount := RowCount;
+ end;
+end;
+
+procedure TfpgNiceGridSync.SetScrollBar(AKind: TfpgScrollbar; AMax, APos, AStep: Integer);
+begin
+ if (AKind = FVScrollBar) and Assigned(FMasterGrid) then
+ FMasterGrid.VertOffset := APos;
+end;
+
+procedure TfpgNiceGridSync.ShowHideScrollBar(HorzVisible,
+ VertVisible: Boolean);
+begin
+ FVScrollBar.Visible:= VertVisible;
+ FHScrollBar.Visible:= HorzVisible;
+ FHScrollBar.Enabled:=false;
+end;
+
+procedure TfpgNiceGridSync.SyncColRow(Sender: TObject; ACol, ARow: Integer);
+begin
+ if Assigned(FMasterGrid)
+ then FMasterGrid.Row := ARow;
+end;
+
+procedure TfpgNiceGridSync.SyncDeleteRow(Sender: TObject; ARow: Integer);
+begin
+ if Assigned(FMasterGrid)
+ then FMasterGrid.DeleteRow(ARow);
+end;
+
+procedure TfpgNiceGridSync.SyncInsertRow(Sender: TObject; ARow: Integer);
+begin
+ if Assigned(FMasterGrid) then
+ begin
+ if (ARow = FMasterGrid.RowCount)
+ then FMasterGrid.AddRow
+ else FMasterGrid.InsertRow(ARow);
+ end;
+end;
+
+{ TfpgMergeCell }
+
+constructor TfpgMergeCell.Create;
+begin
+ inherited Create;
+ Font := fpgApplication.DefaultFont.FontDesc;
+end;
+
+destructor TfpgMergeCell.Destroy;
+begin
+ inherited Destroy;
+end;
+
+end.
diff --git a/extras/contributed/nicegrid/fpg_types.pas b/extras/contributed/nicegrid/fpg_types.pas
new file mode 100644
index 00000000..96d5cbc2
--- /dev/null
+++ b/extras/contributed/nicegrid/fpg_types.pas
@@ -0,0 +1,131 @@
+unit fpg_types;
+{$mode objfpc}{$H+}
+
+interface
+
+uses SysUtils, Classes, fpg_base;
+
+function EqualfpgRect(const r1,r2 : TfpgRect) : Boolean;
+function PtInfpgRect(const ARect : TfpgRect; const p : TPoint) : Boolean;
+function IntersectfpgRect(out ARect : TfpgRect; const R1,R2 : TfpgRect) : Boolean;
+function UnionfpgRect(out ARect : TfpgRect; const R1,R2 : TfpgRect) : Boolean;
+function IsfpgRectEmpty(const ARect : TfpgRect) : Boolean;
+function OffsetfpgRect(var ARect : TfpgRect;DX : Integer;DY : Integer) : Boolean;
+function InflatefpgRect(var ARect: TfpgRect; dx: Integer; dy: Integer): Boolean;
+function CopyfpgRect(out Ds: TfpgRect;const Sc : TfpgRect): Boolean;
+
+implementation
+
+
+function EqualfpgRect(const r1,r2 : TfpgRect) : Boolean;
+begin
+ Result:= (r1.Left=r2.Left) and (r1.Right=r2.Right) and (r1.Width=r2.Width) and (r1.Height=r2.Height);
+end;
+
+function PtInfpgRect(const ARect : TfpgRect;const p : TPoint) : Boolean;
+begin
+ Result:=(p.y >= ARect.Top) and
+ (p.y <= ARect.Bottom) and
+ (p.x >= ARect.Left) and
+ (p.x <= ARect.Right);
+end;
+
+function IsfpgRectEmpty(const ARect : TfpgRect) : Boolean;
+begin
+ Result:=(ARect.Width <= 0) or (ARect.Height <= 0);
+end;
+
+function IntersectfpgRect(out ARect : TfpgRect;const R1,R2 : TfpgRect) : Boolean;
+begin
+ ARect:=R1;
+ with R2 do
+ begin
+ if Left > R1.Left then
+ ARect.Left:=Left;
+ if Top > R1.Top then
+ ARect.Top:=Top;
+ if Right < R1.Right then
+ ARect.Width:= ARect.Left + Right;
+ if Bottom < R1.Bottom then
+ ARect.Height:= ARect.Top + Bottom;
+ end;
+ if IsfpgRectEmpty(ARect) then
+ begin
+ FillChar(ARect,SizeOf(ARect),0);
+ Result:=false;
+ end
+ else
+ Result:=true;
+end;
+
+function UnionfpgRect(out ARect : TfpgRect;const R1,R2 : TfpgRect) : Boolean;
+begin
+ ARect:=R1;
+ with R2 do
+ begin
+ if Left < R1.Left then
+ ARect.Left:=Left;
+ if Top < R1.Top then
+ ARect.Top:=Top;
+ if Right > R1.Right then
+ ARect.Width:= ARect.Left + Right;
+ if Bottom>R1.Bottom then
+ ARect.Height:= ARect.Top + Bottom;
+ end;
+ if IsfpgRectEmpty(ARect) then
+ begin
+ FillChar(ARect,SizeOf(ARect),0);
+ Result:=false;
+ end
+ else
+ Result:=true;
+end;
+
+
+
+function OffsetfpgRect(var ARect : TfpgRect;DX : Integer;DY : Integer) : Boolean;
+begin
+ if assigned(@ARect) then
+ begin
+ with ARect do
+ begin
+ inc(Left,dx);
+ inc(Top,dy);
+ end;
+ Result:=true;
+ end
+ else
+ Result:=false;
+end;
+
+function InflatefpgRect(var ARect: TfpgRect; dx: Integer; dy: Integer): Boolean;
+begin
+ if Assigned(@ARect) then
+ begin
+ with ARect do
+ begin
+ dec(Left, dx);
+ dec(Top, dy);
+ inc(Width, dx*2);
+ inc(Height, dy*2);
+ end;
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+function CopyfpgRect(out Ds: TfpgRect;const Sc : TfpgRect): Boolean;
+begin
+ Ds:=Sc;
+ if IsfpgRectEmpty(Ds) then
+ begin
+ FillChar(Ds,SizeOf(Ds),0);
+ Result:=false;
+ end
+ else
+ Result:=true;
+end;
+
+
+end.
diff --git a/extras/contributed/nicegrid/main1.pas b/extras/contributed/nicegrid/main1.pas
new file mode 100644
index 00000000..67a39621
--- /dev/null
+++ b/extras/contributed/nicegrid/main1.pas
@@ -0,0 +1,368 @@
+unit main1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_menu,
+ fpg_nicegrid, fpg_button, fpg_checkbox, fpg_label;
+
+type
+
+ TfrmMain = class(TfpgForm)
+ private
+ FFileSubMenu: TfpgPopupMenu;
+ FMenuBar : TfpgMenuBar;
+ Grid1: TfpgNiceGrid;
+ CheckBox1: TfpgCheckBox;
+ CheckBox2: TfpgCheckBox;
+ CheckBox3: TfpgCheckBox;
+ CheckBox4: TfpgCheckBox;
+ CheckBox5: TfpgCheckBox;
+ CheckBox6: TfpgCheckBox;
+ Label1: TfpgLabel;
+ Button1: TfpgButton;
+ Button2: TfpgButton;
+ Button3: TfpgButton;
+ Button4: TfpgButton;
+ procedure CheckBox1Click(Sender: TObject);
+ procedure CheckBox2Click(Sender: TObject);
+ procedure CheckBox3Click(Sender: TObject);
+ procedure CheckBox4Click(Sender: TObject);
+ procedure CheckBox5Click(Sender: TObject);
+ procedure CheckBox6Click(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure Button3Click(Sender: TObject);
+ procedure Button4Click(Sender: TObject);
+ procedure Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas;
+ Rc: TfpgRect; Str: string; var Handled: Boolean);
+ procedure Grid1InsertRow(Sender: TObject; ARow: Integer);
+
+ procedure miExitClicked(Sender: TObject);
+ public
+ procedure AfterCreate; override;
+ end;
+
+
+implementation
+
+
+procedure TfrmMain.AfterCreate;
+var x: integer;
+begin
+ Name := 'frmMain';
+ SetPosition(252, 121, 638, 575);
+ WindowTitle := 'NiceGrid - Demo 1';
+ Hint := '';
+ FFileSubMenu := TfpgPopupMenu.Create(self);
+ with FFileSubMenu do
+ begin
+ Name := 'FFileSubMenu';
+ SetPosition(0, 0, 120, 32);
+ end;
+ FFileSubMenu.AddMenuItem('&Quit', 'Ctrl-Q', @miExitClicked);
+ FMenuBar := CreateMenuBar(self);
+ FMenuBar.AddMenuItem('&File', nil).SubMenu := FFileSubMenu;
+
+ Grid1 := TfpgNiceGrid.Create(self);
+ with Grid1 do
+ begin
+ Name := 'Grid1';
+ SetPosition(16, 88, 597, 370);
+ Anchors := [anLeft,anRight,anTop,anBottom];
+ FontDesc := '#Grid';
+ Hint := '';
+ // Cursor = 1
+ RowCount := 20;
+ AutoAddRow := True;
+ DefColWidth := 100;
+ Color:=$ECE9D8;
+ GridColor := clSilver;
+ HeaderLine := 2;
+ HeaderColor := clButtonFace;
+ HeaderLightColor := clHilite1;
+ HeaderDarkColor := clShadow1;
+ HeaderFontColor := clWhite;
+ HeaderFont := 'MS Sans Serif';
+ FooterFontColor := clRed;
+ SelectionColor := 13816575;
+ BeginUpdate; // JP
+ with Columns.Add do
+ begin
+ Title := 'Merged;Multilined|Merged;Multilined';
+ Footer := 'Footer 0';
+ Font:='Arial-8';
+ FontColor:=clBlack;
+ Width := 100;
+ CanResize := False;
+ end;
+ with Columns.Add do
+ begin
+ Title:='First Group|One';
+ Footer:='Footer 1';
+ Width:=100;
+ Font:='Arial-8';
+ FontColor:=clRed;
+ Color:=$FFFACD;//14024703;
+ HorzAlign:=haCenter;
+ end;
+ with Columns.Add do
+ begin
+ Title:='First Group|Two';
+ Footer:='Footer 2';
+ Font:='Arial-8';
+ FontColor:=clBlack;
+ Width:=100;
+ end;
+ with Columns.Add do
+ begin
+ Title:='Second Group|One';
+ Footer:='Footer 3';
+ Width:=100;
+ Font:='Arial-8';
+ FontColor:=clBlack;
+ Color:=clWhite;
+ HorzAlign:=haRight;
+ end;
+ with Columns.Add do
+ begin
+ Title:='Second Group|Two';
+ Footer:='Footer 4';
+ Font:='Arial-8';
+ FontColor:=clBlack;
+ Width:=100;
+ HorzAlign:=haCenter;
+ end;
+ GutterKind:=gkNumber;
+ GutterWidth:=40;
+ GutterFont:='Arial-8';
+ GutterFontColor:=clBlack;
+ ShowFooter:=True;
+ OnDrawHeader:=@Grid1DrawHeader;
+ OnInsertRow:=@Grid1InsertRow;
+ TabOrder:=0;
+ EndUpdate;
+ end; {Grid1}
+
+ Label1:= TfpgLabel.Create(self);
+ with Label1 do
+ begin
+ SetPosition(16, 42, 300, 18);
+ Text:= '- Try to copy paste a cell with Ctrl+c and Ctrl+v'
+ end;
+ CheckBox1:= TfpgCheckBox.Create(self);
+ with CheckBox1 do
+ begin
+ Name:='CheckBox1';
+ SetPosition(16,470,49,17);
+ Anchors := [anLeft, anBottom];
+ Text := 'Flat';
+ Checked := True;
+ TabOrder := 1;
+ OnChange := @CheckBox1Click;
+ end;
+ CheckBox2:= TfpgCheckBox.Create(self);
+ with CheckBox2 do
+ begin
+ Name:='CheckBox2';
+ SetPosition(78,470,110,17);
+ Anchors := [anLeft, anBottom];
+ Text:= 'System Colors';
+ Checked := True;
+ TabOrder := 2;
+ OnChange := @CheckBox2Click;
+ end;
+ CheckBox3:= TfpgCheckBox.Create(self);
+ with CheckBox3 do
+ begin
+ Name:='CheckBox3';
+ SetPosition(192,470,90,17);
+ Anchors := [anLeft, anBottom];
+ Text := 'Fit to Width';
+ TabOrder := 3;
+ OnChange := @CheckBox3Click;
+ end;
+ CheckBox4:= TfpgCheckBox.Create(self);
+ with CheckBox4 do
+ begin
+ Name:='CheckBox4';
+ SetPosition(288,470,135,17);
+ Anchors := [anLeft, anBottom];
+ Text := 'Auto Column Width';
+ TabOrder := 4;
+ OnChange := @CheckBox4Click;
+ end;
+ CheckBox5:= TfpgCheckBox.Create(self);
+ with CheckBox5 do
+ begin
+ Name:='CheckBox5';
+ SetPosition(424,470,90,17);
+ Anchors := [anLeft, anBottom];
+ Text := 'Show Grids';
+ Checked := True;
+ TabOrder := 5;
+ OnChange := @CheckBox5Click;
+ end;
+ CheckBox6:= TfpgCheckBox.Create(self);
+ with CheckBox6 do
+ begin
+ Name:='CheckBox6';
+ SetPosition(528,470,95,17);
+ Anchors := [anLeft, anBottom];
+ Text := 'Show Footer';
+ Checked := True;
+ TabOrder := 10;
+ OnChange:= @CheckBox6Click;
+ end;
+
+ Button1:= TfpgButton.Create(self);
+ with Button1 do
+ begin
+ Name:='Button1';
+ SetPosition(272,505,129,25);
+ Anchors:= [anLeft, anBottom];
+ Text:= 'Hide 3rd Column';
+ TabOrder:= 8;
+ OnClick:= @Button1Click;
+ end;
+ Button2:= TfpgButton.Create(self);
+ with Button2 do
+ begin
+ Name:='Button2';
+ SetPosition(16,505,121,25);
+ Anchors:= [anLeft, anBottom];
+ Text:= 'Insert New Row';
+ TabOrder:= 6;
+ OnClick:= @Button2Click;
+ end;
+ Button3:= TfpgButton.Create(self);
+ with Button3 do
+ begin
+ Name:='Button3';
+ SetPosition(144,505,121,25);
+ Anchors:= [anLeft, anBottom];
+ Text:= 'Delete Current Row';
+ TabOrder:= 7;
+ OnClick:= @Button3Click;
+ end;
+ Button4:= TfpgButton.Create(self);
+ with Button4 do
+ begin
+ Name:='Button4';
+ SetPosition(416,505,180,25);
+ Anchors:= [anLeft, anBottom];
+ Text:= 'Toggle ReadOnly 3rd Column';
+ TabOrder:= 9;
+ OnClick:=@Button4Click;
+ end;
+
+ Grid1.BeginUpdate;
+ for x := 0 to 9 do
+ begin
+ Grid1[0, x] := 'Sample Text';
+ Grid1[1, x] := 'Centered Text';
+ Grid1[2, x] := 'Left Alignment';
+ Grid1[3, x] := FormatFloat('### ### ##0.##', Random(20000000));
+ Grid1[4, x] := IntToStr(Random(2000));
+ end;
+ Grid1.EndUpdate;
+end;
+
+procedure TfrmMain.miExitClicked(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfrmMain.CheckBox1Click(Sender: TObject);
+begin
+ Grid1.Flat := CheckBox1.Checked;
+end;
+
+procedure TfrmMain.CheckBox2Click(Sender: TObject);
+begin
+ if CheckBox2.Checked then
+ begin
+ with Grid1 do
+ begin
+ BeginUpdate;
+ GridColor := clSilver;
+ HeaderColor := clButtonFace;
+ HeaderDarkColor := clShadow1;
+ HeaderLightColor := clHilite1;
+ HeaderFontColor := clBlack;
+ GutterFontColor:=clBlack;
+ EndUpdate;
+ end;
+ end
+ else
+ begin
+ with Grid1 do
+ begin
+ BeginUpdate;
+ GridColor := clGray;
+ HeaderColor := $000000DF;
+ HeaderDarkColor := clBlack;
+ HeaderLightColor := $000080FF;
+ HeaderFontColor := clWhite;
+ GutterFontColor:=clWhite;
+ EndUpdate;
+ end;
+ end;
+ Grid1.Invalidate;
+end;
+
+procedure TfrmMain.CheckBox3Click(Sender: TObject);
+begin
+ Grid1.FitToWidth := CheckBox3.Checked;
+end;
+
+procedure TfrmMain.CheckBox4Click(Sender: TObject);
+begin
+ Grid1.AutoColWidth := CheckBox4.Checked;
+end;
+
+procedure TfrmMain.CheckBox5Click(Sender: TObject);
+begin
+ Grid1.ShowGrid := CheckBox5.Checked;
+end;
+
+procedure TfrmMain.CheckBox6Click(Sender: TObject);
+begin
+ Grid1.ShowFooter := CheckBox6.Checked;
+end;
+
+procedure TfrmMain.Button1Click(Sender: TObject);
+begin
+ Grid1.Columns[2].Visible := not Grid1.Columns[2].Visible;
+end;
+
+procedure TfrmMain.Button2Click(Sender: TObject);
+begin
+ Grid1.InsertRow(Grid1.Row);
+end;
+
+procedure TfrmMain.Button3Click(Sender: TObject);
+begin
+ Grid1.DeleteRow(Grid1.Row);
+end;
+
+procedure TfrmMain.Button4Click(Sender: TObject);
+begin
+ Grid1.Columns[2].ReadOnly := not Grid1.Columns[2].ReadOnly;
+end;
+
+procedure TfrmMain.Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas;
+ Rc: TfpgRect; Str: String; var Handled: Boolean);
+begin
+ if (Str = 'One')
+ then ACanvas.SetTextColor(clRed);
+end;
+
+procedure TfrmMain.Grid1InsertRow(Sender: TObject; ARow: Integer);
+begin
+ Grid1.Cells[0, ARow] := 'New Row';
+end;
+
+end.
diff --git a/extras/contributed/nicegrid/main2.pas b/extras/contributed/nicegrid/main2.pas
new file mode 100644
index 00000000..11696d0d
--- /dev/null
+++ b/extras/contributed/nicegrid/main2.pas
@@ -0,0 +1,104 @@
+unit main2;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_nicegrid;
+
+type
+ TfrmMain = class(TfpgForm)
+ private
+ Grid1: TfpgNiceGrid;
+ procedure Grid1DrawCell(Sender: TObject; ACanvas: TfpgCanvas; X, Y: Integer; Rc: TfpgRect; var Handled: Boolean);
+ public
+ procedure AfterCreate; override;
+ end;
+
+
+implementation
+
+
+procedure TfrmMain.AfterCreate;
+var
+ x: Integer;
+begin
+ Name := 'frmMain';
+ SetPosition(471, 120, 472, 419);
+ WindowTitle := 'Customizing Cells Based on Conditions';
+ Hint := '';
+ Grid1 := TfpgNiceGrid.Create(self);
+ with Grid1 do
+ begin
+ BeginUpdate; //JP
+ Name := 'Grid1';
+ SetPosition(16, 16, 441, 385);
+ Anchors := [anLeft,anRight,anTop,anBottom];
+ FontDesc := '#Grid';
+ Color:=$ECE9D8;
+ GridColor := clSilver;
+ ColCount:= 5;
+ RowCount:= 20;
+ FooterFontColor:= clBlack;
+ FitToWidth:= True;
+
+ with Columns.Items[0]do
+ begin
+ Title:= 'Column 1';
+ Width:= 84;
+ end;
+ with Columns.Items[1]do
+ begin
+ Title:= 'Column 2';
+ Width:= 84;
+ end;
+ with Columns.Items[2]do
+ begin
+ Title:= 'Column 3';
+ Width:= 83;
+ end;
+ with Columns.Items[3]do
+ begin
+ Title:= 'Column 4';
+ Width:= 83;
+ end;
+ with Columns.Items[4]do
+ begin
+ Title:= 'Column 5';
+ Width:= 83;
+ end;
+ GutterFont:='Arial-8';
+ GutterFontColor:=clBlack;
+ ShowFooter:= False;
+ OnDrawCell:= @Grid1DrawCell;
+ TabOrder:= 0;
+ EndUpdate; //JP
+ end;
+
+ Grid1.BeginUpdate; //JP
+ for x := 0 to 19 do
+ begin
+ Grid1.Cells[0, x] := IntToStr(Random(100));
+ Grid1.Cells[1, x] := IntToStr(Random(100));
+ Grid1.Cells[2, x] := IntToStr(Random(100));
+ Grid1.Cells[3, x] := IntToStr(Random(100));
+ Grid1.Cells[4, x] := IntToStr(Random(100));
+ end;
+ Grid1.EndUpdate; //JP
+end;
+
+procedure TfrmMain.Grid1DrawCell(Sender: TObject; ACanvas: TfpgCanvas; X,
+ Y: Integer; Rc: TfpgRect; var Handled: Boolean);
+var
+ i: Integer;
+begin
+ i := StrToIntDef(Grid1.Cells[X, Y], 0);
+ if Odd(i)
+ then ACanvas.SetTextColor (clRed);
+ if ((i mod 10) = 0)
+ then ACanvas.SetColor(clYellow);
+end;
+
+
+end.
diff --git a/extras/contributed/nicegrid/main3.pas b/extras/contributed/nicegrid/main3.pas
new file mode 100644
index 00000000..84853b42
--- /dev/null
+++ b/extras/contributed/nicegrid/main3.pas
@@ -0,0 +1,204 @@
+unit main3;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_panel, fpg_splitter,
+ fpg_nicegrid;
+
+type
+ TfrmMain = class(TfpgForm)
+ private
+ Panel1: TfpgPanel;
+ Splitter1: TfpgSplitter;
+ Grid1: TfpgNiceGrid;
+ GridSync1: TfpgNiceGridSync;
+ public
+ procedure AfterCreate; override;
+ end;
+
+
+
+implementation
+
+procedure TfrmMain.AfterCreate;
+begin
+ Name := 'frmMain';
+ SetPosition(260, 99, 719, 570);
+ WindowTitle := 'Tabel Budget';
+ Hint := '';
+ WindowAttributes := [waSizeable, waScreenCenterPos];
+
+ Panel1:= TfpgPanel.Create(self);
+ with Panel1 do
+ begin
+ Left:= 16;
+ Top:= 16;
+ Width:= 682;
+ Height:= 504;
+ Anchors:= [anLeft, anTop, anRight, anBottom];
+ TabOrder:= 0;
+ end;
+
+ GridSync1:= TfpgNiceGridSync.Create(Panel1);
+ with GridSync1 do
+ begin
+ BeginUpdate;
+ Name := 'GridSync1';
+ Left:= 1;
+ Top:= 1;
+ Width:= 329;
+ Height:= 502;
+ ColCount:= 3;
+ RowCount:= 20;
+ AutoAddRow:= True;
+ GridColor:= clSilver;
+ HeaderLine:= 2;
+ FooterFontColor:= clBlack;
+ FitToWidth:= True;
+
+ with Columns.Items[0]do
+ begin
+ Title:= 'Unit Name';
+ Width:= 135;
+ end;
+ with Columns.Items[1]do
+ begin
+ Title:= 'Unit Cost|Capital';
+ Width:= 80;
+ Color:= 15790335;
+ CanResize:= False;
+ end;
+ with Columns.Items[2]do
+ begin
+ Title:= 'Unit Cost|Non Capital';
+ Width:= 80;
+ Color:= 14671871;
+ CanResize:= False;
+ end;
+ GutterKind:= gkNumber;
+ GutterWidth:= 30;
+ ShowFooter:= False;
+ GutterFont:='Arial-8';
+ GutterFontColor:=clBlack;
+ Align:= alLeft;
+ TabOrder:= 1;
+ EndUpdate;
+ end;
+
+ Splitter1:= TfpgSplitter.Create(Panel1);
+ with Splitter1 do
+ begin
+ Name:='Splitter1';
+ SetPosition(330,1,8,502);
+ Align := alLeft;
+ end;
+
+ Grid1:= TfpgNiceGrid.Create(Panel1);
+ with Grid1 do
+ begin
+ BeginUpdate;
+ Name := 'Grid1';
+ Left:= 338;
+ Top:= 1;
+ Width:= 344;
+ Height:= 502;
+ ColCount:= 12;
+ RowCount:= 20;
+ GridColor:= clSilver;
+ HeaderLine:= 2;
+ HeaderColor := clButtonFace;
+ HeaderLightColor := clHilite1;
+ HeaderDarkColor := clShadow1;
+ FooterFontColor:= clBlack;
+
+ with Columns.Items[0]do
+ begin
+ Title:= '0|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[1]do
+ begin
+ Title:= '0|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ with Columns.Items[2]do
+ begin
+ Title:= '2000|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[3]do
+ begin
+ Title:= '2000|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ with Columns.Items[4]do
+ begin
+ Title:= '2001|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[5]do
+ begin
+ Title:= '2001|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ with Columns.Items[6]do
+ begin
+ Title:= '2002|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[7]do
+ begin
+ Title:= '2002|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ with Columns.Items[8]do
+ begin
+ Title:= '2003|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[9]do
+ begin
+ Title:= '2003|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ with Columns.Items[10]do
+ begin
+ Title:= '2004|Capital';
+ Width:= 80;
+ Color:= 16775924;
+ end;
+ with Columns.Items[11]do
+ begin
+ Title:= '2004|Non Capital';
+ Width:= 80;
+ Color:= 16773601;
+ end;
+ GutterKind:= gkNone;
+ GutterWidth:= 40;
+ Align:= alClient;
+
+ GutterFont:='Arial-8';
+ GutterFontColor:=clBlack;
+ ShowFooter:=True;
+
+ TabOrder:= 0;
+ EndUpdate;
+ end;
+
+ GridSync1.MasterGrid:= Grid1;
+end;
+
+end.
diff --git a/extras/contributed/nicegrid/nicegrid1.lpi b/extras/contributed/nicegrid/nicegrid1.lpi
new file mode 100644
index 00000000..d135cef7
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid1.lpi
@@ -0,0 +1,72 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <General>
+ <Flags>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="nicegrid1"/>
+ <UseAppBundle Value="False"/>
+ <ResourceType Value="res"/>
+ </General>
+ <i18n>
+ <EnableI18N LFM="False"/>
+ </i18n>
+ <VersionInfo>
+ <StringTable ProductVersion=""/>
+ </VersionInfo>
+ <BuildModes Count="1">
+ <Item1 Name="default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_toolkit"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="2">
+ <Unit0>
+ <Filename Value="nicegrid1.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="main1.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="main1"/>
+ </Unit1>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <Target>
+ <Filename Value="nicegrid1"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <OtherUnitFiles Value="."/>
+ <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Parsing>
+ <SyntaxOptions>
+ <AllowLabel Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/extras/contributed/nicegrid/nicegrid1.lpr b/extras/contributed/nicegrid/nicegrid1.lpr
new file mode 100644
index 00000000..c63e4942
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid1.lpr
@@ -0,0 +1,32 @@
+program nicegrid1;
+
+{$mode objfpc}
+{$h+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils,
+ fpg_base, fpg_main, fpg_form,
+ main1;
+
+
+procedure MainProc;
+var
+ frm: TfrmMain;
+begin
+ fpgApplication.Initialize;
+ frm := TfrmMain.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/extras/contributed/nicegrid/nicegrid2.lpi b/extras/contributed/nicegrid/nicegrid2.lpi
new file mode 100644
index 00000000..71538a5e
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid2.lpi
@@ -0,0 +1,72 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <General>
+ <Flags>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="nicegrid2"/>
+ <UseAppBundle Value="False"/>
+ <ResourceType Value="res"/>
+ </General>
+ <i18n>
+ <EnableI18N LFM="False"/>
+ </i18n>
+ <VersionInfo>
+ <StringTable ProductVersion=""/>
+ </VersionInfo>
+ <BuildModes Count="1">
+ <Item1 Name="default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_toolkit"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="2">
+ <Unit0>
+ <Filename Value="nicegrid2.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="main2.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="main2"/>
+ </Unit1>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <Target>
+ <Filename Value="nicegrid2"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <OtherUnitFiles Value="."/>
+ <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Parsing>
+ <SyntaxOptions>
+ <AllowLabel Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/extras/contributed/nicegrid/nicegrid2.lpr b/extras/contributed/nicegrid/nicegrid2.lpr
new file mode 100644
index 00000000..db26713f
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid2.lpr
@@ -0,0 +1,32 @@
+program nicegrid2;
+
+{$mode objfpc}
+{$h+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils,
+ fpg_base, fpg_main, fpg_form,
+ main2;
+
+
+procedure MainProc;
+var
+ frm: TfrmMain;
+begin
+ fpgApplication.Initialize;
+ frm := TfrmMain.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/extras/contributed/nicegrid/nicegrid3.lpi b/extras/contributed/nicegrid/nicegrid3.lpi
new file mode 100644
index 00000000..8efb6f56
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid3.lpi
@@ -0,0 +1,73 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <General>
+ <Flags>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ <UseDefaultCompilerOptions Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="nicegrid3"/>
+ <UseAppBundle Value="False"/>
+ <ResourceType Value="res"/>
+ </General>
+ <i18n>
+ <EnableI18N LFM="False"/>
+ </i18n>
+ <VersionInfo>
+ <StringTable ProductVersion=""/>
+ </VersionInfo>
+ <BuildModes Count="1">
+ <Item1 Name="default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_toolkit"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="2">
+ <Unit0>
+ <Filename Value="nicegrid3.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="main3.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="main3"/>
+ </Unit1>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <Target>
+ <Filename Value="nicegrid3"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <OtherUnitFiles Value="."/>
+ <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Parsing>
+ <SyntaxOptions>
+ <AllowLabel Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/extras/contributed/nicegrid/nicegrid3.lpr b/extras/contributed/nicegrid/nicegrid3.lpr
new file mode 100644
index 00000000..d54eb521
--- /dev/null
+++ b/extras/contributed/nicegrid/nicegrid3.lpr
@@ -0,0 +1,32 @@
+program nicegrid3;
+
+{$mode objfpc}
+{$h+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils,
+ fpg_base, fpg_main,
+ main3;
+
+
+procedure MainProc;
+var
+ frm: TfrmMain;
+begin
+ fpgApplication.Initialize;
+ frm := TfrmMain.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/extras/contributed/nicegrid/readme.txt b/extras/contributed/nicegrid/readme.txt
new file mode 100644
index 00000000..0ed766d5
--- /dev/null
+++ b/extras/contributed/nicegrid/readme.txt
@@ -0,0 +1,42 @@
+Name: NiceGrid
+Author: "Jean Pierre Anghel" <jean-pierre.anghel@orange.fr>
+Date: 2012-01-21
+Description:
+This grid widget is a port of the VCL NiceGrid component found at
+[http://www.priyatna.org]. The original author gave permission to port this
+component to Free Pascal and fpGUI. Below is the emails giving permission.
+
+
+
+********************************************************************************
+Dear Jean-Pierre,
+
+Sure, I will be glad if NiceGrid can be ported to FreePascal.
+
+There's however an important bug that needs to be solved. It's when
+handling scrollbar messages. Current version can only handle 2 bytes
+(word) scrollbar offset, due to Windows limitation in the past. This
+will limit NiceGrid to only able to handle only a few thousands rows.
+Current Windows OS-es use 4 bytes (integer) scrollbar offsets. It should
+be easy to fix, I can help.
+
+Also I prefer to have one source code for NiceGrid using IFDEFs, instead
+a version for Delphi and another for FreePascal. I don't have much
+experience in LCL or fpGUI. Is it possible?
+
+Regards,
+Priyatna
+
+
+On 8/10/2011 2:52 PM, jean-pierre anghel wrote:
+> Hello,
+> I participate, modestly, in the fpGui project which works under FreePascal and allows to have,
+> with the same source code, executables files under Linux and Windows : http://fpgui.sourceforge.net/
+> I was seduced by your NiceGrid and I adapted it to FreePascal.
+> Before passing on the result to Graeme Geldenhuys I wanted at first to present it to you and to have
+> your agreement.
+> Regards.
+> Jean Pierre ANGHEL
+>
+********************************************************************************
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 07:31:30 +0000