RichEdit

开发平台：

Delphi

RVTable.pas：源码内容

{*******************************************************}
{ }
{ RichView }
{ TRVTableItemInfo: RichView item type }
{ representing tables. Related types. }
{ }
{ Copyright (c) Sergey Tkachenko }
{ svt@trichview.com }
{ http://www.trichview.com }
{ }
{*******************************************************}
unit RVTable;
interface
{$I RV_Defs.inc}
uses Windows, SysUtils, Classes, Graphics, Controls, Forms,
RVClasses, RVItem, RVDataList, CRVData, CRVFData, RVStyle, RVFuncs,
RVRVData, RVERVData,
DLines, RVBack,
{$IFNDEF RVDONOTUSELISTS}
RVMarker,
{$ENDIF}
RVScroll,RichView, RVEdit, RVFMisc, PtblRV, PtRVData, TypInfo, RVUni, RVUndo,
RVStr;
{.$DEFINE RVDEBUGTABLE}
{$IFNDEF RICHVIEWCBDEF3}
{$O-}
{$ENDIF}
const
rvsTable = -60;
{$R RVTable.res}
crRVSelectRow = 104;
crRVSelectCol = 105;
type
TRVCellHAlign = (rvcLeft, rvcCenter, rvcRight);
TRVCellVAlign = (rvcTop, rvcMiddle, rvcBottom, rvcVDefault);
TRVTableOption = (rvtoEditing, rvtoRowSizing, rvtoColSizing,
rvtoRowSelect, rvtoColSelect, rvtoNoCellSelect,
rvtoRTFSaveCellPixelBestWidth,
rvtoRTFAllowAutofit,
rvtoHideGridLines, rvtoOverlappingCorners, rvtoCellBelowBorders,
rvtoIgnoreContentWidth, rvtoIgnoreContentHeight);
TRVTableOptions = set of TRVTableOption;
TRVTablePrintOption = (rvtoHalftoneBorders, rvtoRowsSplit, rvtoWhiteBackground);
TRVTablePrintOptions = set of TRVTablePrintOption;
const
RVTABLEDEFAULTOPTIONS = [rvtoEditing, rvtoRowSizing, rvtoColSizing,
rvtoRowSelect, rvtoColSelect];
RVTABLEDEFAULTPRINTOPTIONS = [rvtoHalftoneBorders,rvtoRowsSplit];
type
TRVTableBorderStyle = (rvtbRaised, rvtbLowered, rvtbColor, rvtbRaisedColor, rvtbLoweredColor);
TRVHTMLLength = type Integer; // > 0 - pixels
// = 0 - undefined
// < 0 - percents
TRVTableRow = class;
TRVTableRows = class;
TRVTableItemInfo = class;
TRVCellEditingEvent = procedure (Sender: TRVTableItemInfo;
Row, Col : Integer; Automatic: Boolean; var AllowEdit: Boolean) of object;
TRVCellEndEditEvent = procedure (Sender: TRVTableItemInfo; Row, Col: Integer;
Clearing: Boolean)
of object;
TRVTableCellData = class (TRVItemFormattedData)
private
FColor: TColor;
FVAlign: TRVCellVAlign;
FBestWidth: TRVHTMLLength;
FBestHeight: Integer;
FRowSpan: Integer;
FColSpan: Integer;
FLeft, FTop, FWidth, FHeight: Integer;
FVisibleBorders: TRVBooleanRect;
//FReservedRVData: TCustomRVData;
FChosenRVData: TCustomRVFormattedData;
FChosenItem: TCustomRVItemInfo;
ContainerUndoItem: TRVUndoInfo;
FBorderColor: TColor;
FBorderLightColor: TColor;
FBackground: TRVBackground;
FBackgroundImageFileName: String;
{$IFNDEF RVDONOTUSEITEMHINTS}
FHint: String;
{$ENDIF}
procedure SetBestHeight(const Value: Integer);
procedure SetBestWidth(const Value: TRVHTMLLength);
procedure SetVisibleBorders(const Value: TRVBooleanRect);
function CanClear: Boolean;
procedure SetColor(const Value: TColor);
function GetBackgroundImage: TGraphic;
function GetBackgroundStyle: TRVItemBackgroundStyle;
procedure SetBackgroundImage_(const Value: TGraphic; Copy: Boolean);
procedure SetBackgroundImage(const Value: TGraphic);
procedure SetBackgroundStyle(const Value: TRVItemBackgroundStyle);
procedure BackgroundImageWriter(Stream: TStream);
procedure BackgroundImageReader(Stream: TStream);
function StoreVisibleBorders: Boolean;
protected
procedure DefineProperties(Filer: TFiler); override;
procedure AssignSizeFrom(Cell:TRVTableCellData);
function GetRealVAlign: TRVCellVAlign;
function SupportsPageBreaks: Boolean; override;
function GetOptions: TRVOptions; override;
public
{ methods for internal processing }
procedure GetItemBackground(ItemNo: Integer; r: TRect; MakeImageRect: Boolean;
var Color: TColor;
var bmp: TBitmap; var UseBitmap: Boolean); override;
procedure ResetSubCoords; override;
function GetBackground: TRVBackground; override;
function GetExtraVOffs: Integer;
function IsTransparent: Boolean;
procedure GetParentInfo(var ParentItemNo: Integer; var Location: TRVStoreSubRVData); override;
function GetTable: TRVTableItemInfo;
{$IFNDEF RVDONOTUSEITEMHINTS}
function GetItemHint(RVData: TCustomRVData; ItemNo: Integer;
const UpperRVDataHint: String): String; override;
{$ENDIF}
procedure AssignAttributesFrom(Cell:TRVTableCellData; IncludeSize: Boolean;
DivColSpan, DivRowSpan: Integer);
procedure Deselect(NewPartiallySelected: TCustomRVItemInfo; MakeEvent: Boolean); override;
function GetEditor: TWinControl; override;
procedure GetOrigin(var ALeft, ATop: Integer); override;
procedure GetOriginEx(var ALeft, ATop: Integer); override;
function GetWidth: Integer; override;
function GetHeight: Integer; override;
function GetColor: TColor; override;
function GetHOffs: Integer; override;
function GetVOffs: Integer; override;
function GetAreaWidth: Integer; override;
procedure AssignChosenRVData(RVData: TCustomRVFormattedData; Item: TCustomRVItemInfo); override;
procedure UnassignChosenRVData(RVData: TCustomRVData); override;
function GetChosenRVData: TCustomRVData; override;
function GetChosenItem: TCustomRVItemInfo; override;
procedure MovingToUndoList(AContainerUndoItem: TRVUndoInfo);
procedure MovingFromUndoList;
function GetCellHeight(IgnoreContentHeight: Boolean): Integer;
// function GetWidthInFixedTable(TableWidth: Integer): Integer;
function GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas): Integer;
function HasData(CheckStyles: Boolean): Boolean;
function GetRVData: TCustomRVData; override;
procedure DoSelect; override;
procedure ControlAction2(ControlAction: TRVControlAction; ItemNo: Integer; var Control: TControl); override;
procedure ItemAction(ItemAction: TRVItemAction; Item: TCustomRVItemInfo;
var Text: String; RVData: TCustomRVData); override;
procedure AdjustFocus(NewFocusedItemNo: Integer; TopLevelRVData: TPersistent; TopLevelItemNo: Integer); override;
{ public methods and properties }
constructor Create(ARow: TRVTableRow);
destructor Destroy; override;
{$IFNDEF RVDONOTUSELISTS}
function GetMarkers(AllowCreate: Boolean): TRVMarkerList; override;
{$ENDIF}
function Edit: TCustomRVData; override;
property Left:Integer read FLeft;
property Top:Integer read FTop;
property Height:Integer read FHeight;
property Width:Integer read FWidth;
property ColSpan: Integer read FColSpan;
property RowSpan: Integer read FRowSpan;
published
{ published properties }
property Color: TColor read FColor write SetColor default clNone;
property BorderColor: TColor read FBorderColor write FBorderColor default clNone;
property BorderLightColor: TColor read FBorderLightColor write FBorderLightColor default clNone;
property BestWidth: TRVHTMLLength read FBestWidth write SetBestWidth default 0;
property BestHeight: Integer read FBestHeight write SetBestHeight default 0;
property VisibleBorders: TRVBooleanRect read FVisibleBorders write SetVisibleBorders stored StoreVisibleBorders;
property VAlign: TRVCellVAlign read FVAlign write FVAlign default rvcVDefault;
property BackgroundImage: TGraphic read GetBackgroundImage write SetBackgroundImage stored False;
property BackgroundStyle: TRVItemBackgroundStyle read GetBackgroundStyle write SetBackgroundStyle default rvbsColor;
property BackgroundImageFileName: String read FBackgroundImageFileName
write FBackgroundImageFileName;
{$IFNDEF RVDONOTUSEITEMHINTS}
property Hint: String read FHint write FHint;
{$ENDIF}
end;
TRVTableRow = class (TRVDataList)
private
FVAlign: TRVCellVAlign;
function Get(Index: Integer): TRVTableCellData;
procedure Put(Index: Integer; const Value: TRVTableCellData);
procedure InsertEmpty(Index: Integer);
procedure InsertPointer(Index: Integer; Item: TRVTableCellData);
protected
FRows: TRVTableRows;
function GetParentRVData: TCustomRVData; override;
function HasCellsInRange(Index, RangeStart, Count: Integer): Boolean;
public
constructor Create(nCols: Integer; ARows: TRVTableRows; MainRVData: TCustomRVData);
function Add: TRVTableCellData;
function Insert(Index: Integer): TRVTableCellData;
function GetHeight(IgnoreContentHeight: Boolean): Integer;
function GetBestHeight: Integer;
property VAlign: TRVCellVAlign read FVAlign write FVAlign default rvcTop;
property Items[Index: Integer]: TRVTableCellData read Get write Put; default;
end;
TRVTableRows = class (TRVList)
private
function Get(Index: Integer): TRVTableRow;
procedure Put(Index: Integer; const Value: TRVTableRow);
function GetMinColWidth(Col: Integer; sad: PRVScreenAndDevice;
Canvas: TCanvas): Integer;
function GetPercentColWidth(Col, TableWidth: Integer): Integer;
function IsPercentWidthColumn(Col: Integer): Boolean;
function GetPixelColWidth(Col: Integer): Integer;
function StartMergeCells(TopRow, LeftCol:Integer;
var ColSpan, RowSpan: Integer): Boolean;
protected
FMainRVData: TCustomRVData;
FTable : TRVTableItemInfo;
function GetColCount: Integer;
function IsEmptyRows(TopRow, LeftCol, ColSpan, RowSpan,
TopRow2, RowSpan2: Integer): Boolean;
function IsEmptyCols(TopRow, LeftCol, ColSpan,
RowSpan, LeftCol2, ColSpan2: Integer): Boolean;
function GetBestWidth(TopRow, LeftCol, ColSpan, RowSpan: Integer): Integer;
procedure UnmergeCell(Row,Col: Integer; UnmergeRows, UnmergeCols: Boolean);
procedure UnmergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
UnmergeRows, UnmergeCols: Boolean);
procedure InsertRows(Index, Count, CopyIndex: Integer; DivideHeights: Boolean);
procedure InsertCols(Index, Count, CopyIndex: Integer; DivideWidths: Boolean);
procedure DeleteRows(Index, Count: Integer; DecreaseHeight: Boolean);
procedure DeleteCols(Index, Count: Integer; DecreaseWidth: Boolean);
function SplitCellVertically(Row, Col, ColCount: Integer): Integer;
function SplitCellsVertically(TopRow, LeftCol, ColSpan, RowSpan,
ColCount: Integer):Integer;
function SplitCellHorizontally(Row, Col, RowCount: Integer): Integer;
function SplitCellsHorizontally(TopRow, LeftCol, ColSpan, RowSpan,
RowCount: Integer):Integer;
procedure MovingToUndoList(Row, Col, ColSpan, RowSpan: Integer;
AContainerUndoItem: TRVUndoInfo);
procedure MovingFromUndoList(Row, Col, ColSpan, RowSpan: Integer);
procedure Do_BeforeInsertRows(ItemNo,Row,Count: Integer);
procedure Do_InsertRows(Row,Count: Integer);
procedure Do_UnInsertRows(Row,Count: Integer);
procedure Do_BeforeInsertCell(ItemNo,Row,Col: Integer);
procedure Do_BeforeSpreadOverEmptyCells(ItemNo, Row, Col, ColSpan: Integer);
procedure Do_SpreadOverEmptyCells(Row, Col, ColSpan: Integer);
procedure Do_UnSpreadOverEmptyCells(Row, Col, ColSpan: Integer);
procedure Do_SetSpan(ItemNo,Row, Col, Span: Integer; IsColSpan: Boolean);
procedure Do_BeforeFreeEmptyCells(ItemNo,Row, Col, ColSpan, RowSpan: Integer);
procedure Do_FreeEmptyCells(Row, Col, ColSpan, RowSpan: Integer);
procedure Do_UnFreeEmptyCells(Row, Col, ColSpan, RowSpan: Integer);
procedure Do_BeforeInsertEmptyCells(ItemNo,Row, Col, ColCount, RowCount: Integer);
procedure Do_InsertEmptyCells(Row, Col, ColCount, RowCount: Integer);
procedure Do_UnInsertEmptyCells(Row, Col, ColCount, RowCount: Integer);
procedure Do_BeforeSplitCellHorz(ItemNo,Row,Col,Row2: Integer; DecreaseHeight: Boolean);
procedure Do_SplitCellHorz(Row,Col,Row2: Integer; DecreaseHeight: Boolean);
procedure Do_UnSplitCellHorz(Row,Col,Row2: Integer; OldBestHeight: Integer);
procedure Do_BeforeSplitCellVert(ItemNo,Row,Col,Col2: Integer; DecreaseWidth: Boolean);
procedure Do_SplitCellVert(Row,Col,Col2: Integer; DecreaseWidth: Boolean);
procedure Do_UnSplitCellVert(Row,Col,Col2: Integer; OldBestWidth: Integer);
function Do_BeforeDeleteRows(ItemNo,Row,Count: Integer): TRVUndoInfo;
procedure Do_DeleteRows(ItemNo,Row,Count: Integer; ui: TRVUndoInfo);
procedure Do_UnDeleteRows(Row: Integer; RowList: TList);
function Do_BeforeDeleteCols(ItemNo,Col,Count: Integer): TRVUndoInfo;
procedure Do_DeleteCols(ItemNo,Col,Count: Integer;ui: TRVUndoInfo);
procedure Do_UnDeleteCols(Col: Integer; CellList: TList);
function Do_BeforeMergeCells(ItemNo, Row,Col, ColSpan, RowSpan: Integer): TRVUndoInfo;
procedure Do_MergeCells(ItemNo, Row,Col, ColSpan, RowSpan: Integer;
ui: TRVUndoInfo; ChangeBestWidth: Boolean);
procedure Do_UndoMergeCells(ItemNo, Row,Col, OldColSpan, OldRowSpan: Integer;
MergedItemsList: TRVList; OldBestWidth: TRVHTMLLength);
procedure Do_BeforeUnmergeCell(ItemNo, Row,Col: Integer; UnmergeRows, UnmergeCols: Boolean);
procedure Do_UnmergeCell(ItemNo, Row,Col: Integer; UnmergeRows, UnmergeCols: Boolean);
procedure Do_UndoUnmergeCell(ItemNo, Row,Col: Integer;
OldColSpan, OldRowSpan: Integer; OldBestWidth: TRVHTMLLength;
OldBestHeight: Integer);
function Do_BeforeClearCells(ItemNo: Integer; RowList, ColList: TRVIntegerList;
var CellsList: TList): TRVUndoInfo;
procedure Do_AfterFillingCells(CellsList: TList; RowList, ColList: TRVIntegerList;
ui: TRVUndoInfo);
procedure Do_ClearCells(CellsList: TList; RowList, ColList: TRVIntegerList;
ui: TRVUndoInfo);
procedure Do_UnClearCells(CellsList: TList; RowList, ColList: TRVIntegerList);
procedure InsertPointer(Index: Integer; Item: TRVTableRow);
public
constructor Create(nRows, nCols: Integer; AMainRVData: TCustomRVData;
ATable: TRVTableItemInfo);
destructor Destroy; override;
procedure MergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
AllowMergeRC, ChangeBestWidth: Boolean);
function Empty: Boolean;
function Add(nCols: Integer): TRVTableRow;
function GetMainCell(ARow,ACol: Integer; var MRow, MCol: Integer): TRVTableCellData;
function Insert(Index, nCols: Integer): TRVTableRow;
procedure Reset(nRows, nCols: Integer);
function CanMergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
AllowMergeRC: Boolean): Boolean;
property Items[Index: Integer]: TRVTableRow read Get write Put; default;
end;
TRVTableInplaceParamStorage = record
Stored: Boolean;
StartNo, EndNo, StartOffs, EndOffs: Integer;
Row, Col: Integer;
PartialSelected: TCustomRVItemInfo;
end;
TRVTableItemFormattingInfo = class
private
ColWidths, RowHeights, ColStarts,RowStarts: TRVIntegerList;
FWidth, FHeight: Integer;
public
Rows : TRVList;
constructor Create(CreateRows:Boolean);
destructor Destroy; override;
procedure Clear;
procedure QuickClear;
end;
TRVCellDirection = (rvcdLeft, rvcdUp, rvcdRight, rvcdDown,
rvcdDocTop, rvcdDocBottom,
rvcdNext, rvcdPrev);
TRVTableDrawBorderEvent = procedure (Sender: TRVTableItemInfo;
Canvas: TCanvas; Left,Top,Right,Bottom, Width: Integer;
LightColor, Color, BackgroundColor: TColor;
Style: TRVTableBorderStyle; Printing: Boolean;
VisibleBorders: TRVBooleanRect; Row, Col: Integer;
var DoDefault: Boolean) of object;
TRVTableState = (rvtsInserted, rvtsEditMode, rvtsModified, rvtsFormatInplace,
rvtsVerticalDraggedRule, rvtsDRChangeTableWidth,
rvtsJustCreated, rvtsInplaceIsReformatting, rvtsSelExists);
TRVTableStates = set of TRVTableState;
TRVTableItemInfo = class (TRVFullLineItemInfo)
private
FPrintCell: TRVTableCellData;
FPrintCellRect: TRect;
FOnCellEditing: TRVCellEditingEvent;
FOnCellEndEdit: TRVCellEndEditEvent;
FState: TRVTableStates;
CachedItemNo: Integer;
MyTop, MyLeft: Integer;
MyClientTop, MyClientLeft: Integer;
MouseRow, MouseCol: Integer;
DRMin, DRMax, DRNo, DRCoord, DRDelta: Integer;
FRows: TRVTableRows;
FCellVSpacing,FCellHSpacing: Integer;
FCellPadding: Integer;
FBestWidth: TRVHTMLLength;
FBorderWidth: Integer;
FBorderColor: TColor;
FColor: TColor;
FCellBorderWidth: Integer;
FHRuleWidth: Integer;
FVRuleWidth: Integer;
FHRuleColor: TColor;
FCellBorderColor: TColor;
FVRuleColor: TColor;
FBorderStyle: TRVTableBorderStyle;
FCellBorderStyle: TRVTableBorderStyle;
FBorderHSpacing: Integer;
FBorderVSpacing: Integer;
FHOutermostRule: Boolean;
FVOutermostRule: Boolean;
FCellBorderLightColor: TColor;
FBorderLightColor: TColor;
FSelStartCol, FSelStartRow, FSelColOffs, FSelRowOffs: Integer;
BusyCount: Integer;
FOptions: TRVTableOptions;
FPrintOptions: TRVTablePrintOptions;
FStoredInplace: TRVTableInplaceParamStorage;
FMinWidthPlus, FInplaceMinWidthPlus: Integer;
FTextRowSeparator: String;
FTextColSeparator: String;
FocusedCellRow,FocusedCellCol: Integer;
ChosenCellRow,ChosenCellCol: Integer;
StreamStartRow, StreamSaveRowCount: Integer;
StreamSaveHeadingRows: Boolean;
FOnDrawBorder: TRVTableDrawBorderEvent;
FHeadingRowCount: Integer;
FBackground: TRVBackground;
FBackgroundImageFileName: String;
FVisibleBorders: TRVBooleanRect;
function GetItemNoInRootDocument: Integer;
function GetCells(Row, Col: Integer): TRVTableCellData;
procedure SetCells(Row, Col: Integer; const Value: TRVTableCellData);
procedure SetBestWidth(const Value: TRVHTMLLength);
function GetVerticalRuleNo(X: Integer; var MinX, ZeroChangeX: Integer): Integer;
function GetHorizontalRuleNo(Y: Integer; var MinY, ZeroChangeY: Integer): Integer;
function GetColNo(X: Integer): Integer;
function GetRowNo(Y: Integer): Integer;
function GetCrossed(Coord: Integer;List: TRVIntegerList): Integer;
procedure UpdateCellXCoords(Fmt: TRVTableItemFormattingInfo; NoCaching, Reformatting: Boolean);
procedure UpdateCellYCoords(Fmt: TRVTableItemFormattingInfo);
function GetHorzExtra: Integer;
procedure InplaceEditorChange(Sender: TCustomRichViewEdit; ClearRedo: Boolean);
procedure InplaceEditorCaretGetout(Sender: TCustomRichViewEdit; Direction: TRVGetOutDirection);
procedure InplaceEditorMouseDown(Sender: TCustomRichView; Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
procedure InplaceEditorMouseUp(Sender: TCustomRichView; Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
procedure InplaceEditorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure InplaceEditorDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure InplaceEditorDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure InplaceEditorControlAction(Sender: TCustomRichView; ControlAction: TRVControlAction; ItemNo: Integer;
var ctrl: TControl);
procedure DestroyInplace(ReformatCell:Boolean);
procedure StoreRVSelection(RVData: TCustomRVFormattedData;
var storage: TRVTableInplaceParamStorage);
procedure RestoreRVSelection(RVData: TCustomRVFormattedData;
const storage: TRVTableInplaceParamStorage);
procedure Init(nRows, nCols: Integer; AMainRVData: TCustomRVData);
procedure CellsWriter(Writer: TWriter);
procedure CellsReader(Reader: TReader);
procedure ClearTemporal;
procedure SetBorderColor(const Value: TColor);
procedure SetBorderHSpacing(const Value: Integer);
procedure SetBorderLightColor(const Value: TColor);
procedure SetBorderStyle(const Value: TRVTableBorderStyle);
procedure SetBorderVSpacing(const Value: Integer);
procedure SetBorderWidth(const Value: Integer);
procedure SetCellBorderColorProp(const Value: TColor);
procedure SetCellBorderLightColorProp(const Value: TColor);
procedure SetCellBorderWidth(const Value: Integer);
procedure SetCellHSpacing(const Value: Integer);
procedure SetCellPadding(const Value: Integer);
procedure SetCellVSpacing(const Value: Integer);
procedure SetColor(const Value: TColor);
procedure SetHOutermostRule(const Value: Boolean);
procedure SetHRuleColor(const Value: TColor);
procedure SetHRuleWidth(const Value: Integer);
procedure SetVOutermostRule(const Value: Boolean);
procedure SetVRuleColor(const Value: TColor);
procedure SetVRuleWidth(const Value: Integer);
procedure SetCellBorderStyle(const Value: TRVTableBorderStyle);
procedure SetProperty(const PropertyName: String; Value: LongInt;
AffectSize, AffectWidth: Boolean);
procedure SetCellProperty(ItemNo: Integer; const PropertyName: String; Value: LongInt;
Row,Col: Integer;
AffectSize, AffectWidth: Boolean);
function IsFixedWidthTable: Boolean;
function CompletelySelected: Boolean;
procedure UnAssignActiveCell;
function DoOnCellEditing(Row,Col: Integer; Automatic: Boolean): Boolean;
function IsInEditor: Boolean;
function CanUseHeadingRowCount: Boolean;
procedure SetHeadingRowCount(const Value: Integer);
function GetBackgroundImage: TGraphic;
procedure SetBackgroundImage_(const Value: TGraphic; Copy: Boolean);
procedure SetBackgroundImage(const Value: TGraphic);
function GetBackgroundStyle: TRVItemBackgroundStyle;
procedure SetBackgroundStyle(const Value: TRVItemBackgroundStyle);
procedure BackgroundImageWriter(Stream: TStream);
procedure BackgroundImageReader(Stream: TStream);
procedure ResetLiveSpell;
procedure SetVisibleBorders(const Value: TRVBooleanRect);
function StoreVisibleBorders: Boolean;
protected
Fmt: TRVTableItemFormattingInfo;
cursad: PRVScreenAndDevice;
procedure XorDrawing(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DefineProperties(Filer: TFiler); override;
function GetHeight: Integer; override;
function GetWidth: Integer; override;
procedure DrawBorder(Canvas: TCanvas;
Left,Top,Right,Bottom, Width: Integer; LightColor, Color, BackgroundColor: TColor;
Style: TRVTableBorderStyle; DrawEvenEmptyBorder, Editing, Printing: Boolean;
const ClipRect: TRect; VisibleBorders: TRVBooleanRect;
r,c: Integer; ColorMode: TRVColorMode);
function GetCellAt_(X,Y: Integer; var Row,Col: Integer): Boolean;
procedure UpdateCellSel;
procedure PaintTo(Left, Right, Top, FromRow, RowCount: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; Fmt: TRVTableItemFormattingInfo;
UseHeadingRowCount: Boolean; const ClipRect: TRect; ColorMode: TRVColorMode;
RVData: TCustomPrintableRVData);
function GetDevX(x: Integer): Integer;
function GetDevY(y: Integer): Integer;
procedure InternalOnDocWidthChange(DocWidth: Integer;
Fmt: TRVTableItemFormattingInfo; Canvas: TCanvas; NoCaching, Reformatting: Boolean);
procedure Change;
procedure ChangeEx(ClearRedo: Boolean);
function BeginModify(ItemNo: Integer): Integer;
procedure EndModify(ItemNo, Data: Integer);
function GetTableColor(UseParentBackground: Boolean): TColor;
function GetCellColor(Cell: TRVTableCellData): TColor;
function CanSeeBackgroundThroughCell(Cell: TRVTableCellData): Boolean;
function GetSplitRowBelow(Row: Integer): Integer;
function GetSplitRowAbove(Row: Integer): Integer;
function BeforeChange: Boolean;
function CanChange: Boolean;
procedure InitUndo;
procedure DoneUndo;
procedure AssignCellAttributes(ItemNo,Row,Col: Integer; SourceCell: TRVTableCellData;
IncludeSize: Boolean;
DivColSpan, DivRowSpan: Integer);
procedure SetCellBestWidth_(ItemNo: Integer; Value: TRVHTMLLength; Row,Col: Integer);
procedure SetCellBestHeight_(ItemNo: Integer; Value: Integer; Row,Col: Integer);
procedure SetCellColor_(ItemNo: Integer; Value: TColor; Row,Col: Integer);
procedure SetCellBackgroundStyle_(ItemNo: Integer; Value: TRVItemBackgroundStyle; Row,Col: Integer);
procedure SetCellVisibleBorders_(ItemNo: Integer; Left, Top, Right, Bottom: Boolean; Row,Col: Integer);
procedure SetCellBorderColor_(ItemNo: Integer; Value: TColor; Row,Col: Integer);
procedure SetCellBorderLightColor_(ItemNo: Integer; Value: TColor; Row,Col: Integer);
procedure SetCellVAlign_(ItemNo: Integer; Value: TRVCellVAlign; Row,Col: Integer);
procedure SetRowVAlign_(ItemNo: Integer; Value: TRVCellVAlign; Row: Integer);
function GetEditorItemNoForUndo: Integer;
function CreateTemporalEditor: TCustomRichViewEdit;
procedure ApplyToCells(ConvType: TRVEStyleConversionType; UserData: Integer;
SelectedOnly: Boolean);
procedure ValidateFocused;
procedure ValidateChosen;
function CellIsChosen: Boolean;
procedure AdjustFocus(Row,Col: Integer; TopLevelRVData: TPersistent; TopLevelItemNo: Integer);
function UndoEnabled: Boolean;
procedure ChooseSubRVData_(r,c: Integer);
procedure EditCell_(Row,Col: Integer; Unquestioning: Boolean);
function GetRVFExtraPropertyCount: Integer; override;
procedure SaveRVFExtraProperties(Stream: TStream); override;
public
FMakingSelection: Boolean;
FInplaceEditor: TCustomRichViewEdit;
procedure DrawBackgroundUnderCell(Canvas: TCanvas; Cell: TRVTableCellData;
const Rect: TRect);
function IsSemiTransparentBackground: Boolean;
function GetSoftPageBreakDY(Data: Integer): Integer; override;
function GetMyItemNo: Integer;
procedure SaveRowsToStream(Stream: TStream; Index, Count: Integer);
procedure ResetSubCoords; override;
function GetSubRVDataAt(X,Y: Integer): TPersistent; override;
function GetCellWhichOwnsControl(AControl: TControl; var ARow,ACol, AItemNo: Integer): Boolean;
function AdjustFocusToControl(Control: TControl; var TopLevelRVData: TPersistent; var TopLevelItemNo: Integer):Boolean;override;
procedure Print(Canvas: TCanvas; x, y, x2: Integer; Preview, Correction: Boolean;
const sad: TRVScreenAndDevice; RichView: TRVScroller; dli: TRVDrawLineInfo;
Part: Integer; ColorMode: TRVColorMode; RVData: TPersistent); override;
procedure CreateInplace(ItemNo, Row, Col: Integer; BuildJumps, CaretAtStart, CaretAtEnd, SetTime, Unquestioning: Boolean);
procedure SetInplaceBounds(Left, Top, Width, Height: Integer);
function StartSelecting(Row,Col: Integer): Boolean;
procedure MovingToUndoList(ItemNo: Integer; RVData, AContainerUndoItem: TObject); override;
procedure MovingFromUndoList(ItemNo: Integer; RVData: TObject); override;
procedure FinalizeUndoGroup; override;
procedure AdjustInserted(x,y: Integer; adjusty: Boolean); override;
function OwnsControl(AControl: TControl): Boolean; override;
function OwnsInplaceEditor(AEditor: TControl): Boolean; override;
function GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas; RVData: TPersistent): Integer; override;
procedure PaintFullWidth(Left, Right, Top: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
Style: TRVStyle; const ClipRect: TRect; dli: TRVDrawLineInfo); override;
procedure OnDocWidthChange(DocWidth: Integer; dli: TRVDrawLineInfo;
Printing: Boolean; Canvas: TCanvas; RVData: TPersistent; sad: PRVScreenAndDevice;
var HShift, Desc: Integer; NoCaching, Reformatting: Boolean); override;
procedure ResizeRow(Index, Height: Integer);
procedure ResizeCol(Index, Width: Integer; Shift: Boolean);
function MouseMove(Shift: TShiftState; X,Y,ItemNo: Integer; RVData: TObject):Boolean; override;
function MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y,ItemNo: Integer; RVData: TObject):Boolean; override;
function MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y,ItemNo: Integer; RVData: TObject):Boolean; override;
procedure DeselectPartial; override;
procedure MergeInplaceUndo(DestroyLists: Boolean);
procedure InplaceDeleted(Clearing: Boolean);
function PartiallySelected: Boolean; override;
function CanDeletePartiallySelected: Boolean; override;
procedure DoAfterFillingRows(Row, Count: Integer);
procedure DeletePartiallySelected; override;
function GetBoolValue(Prop: TRVItemBoolProperty): Boolean; override;
function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
procedure SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo, ParaNo: Integer; const Name: String; Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean); override;
function ReadRVFLine(const s: String; RVData: TPersistent;
ReadType, LineNo, LineCount: Integer; var Name: String;
var ReadMode: TRVFReadMode;
var ReadState: TRVFReadState): Boolean; override;
procedure BeforeLoading(FileFormat: TRVLoadFormat); override;
{$IFNDEF RVDONOTUSELISTS}
procedure AfterLoading(FileFormat: TRVLoadFormat); override;
{$ENDIF}
function CreatePrintingDrawItem(RVData: TObject;
const sad: TRVScreenAndDevice): TRVDrawLineInfo; override;
procedure DrawBackgroundForPrinting(Canvas: TCanvas;
const Rect, FullRect: TRect; ColorMode: TRVColorMode;
ItemBackgroundLayer: Integer); override;
procedure SaveInplace;
procedure RestoreInplace;
procedure StartExport; override;
procedure EndExport; override;
procedure MarkStylesInUse(Data: TRVDeleteUnusedStylesData); override;
procedure UpdateStyles(Data: TRVDeleteUnusedStylesData); override;
procedure Inserting(RVData: TObject; var Text: String; Safe: Boolean); override;
{$IFNDEF RVDONOTUSELISTS}
procedure Inserted(RVData: TObject; ItemNo: Integer); override;
{$ENDIF}
procedure BeforeUndoChangeProperty; override;
procedure AfterUndoChangeProperty; override;
procedure ApplyStyleConversionToSubRVDatas(UserData: Integer;
SelectedOnly: Boolean; ConvType: TRVEStyleConversionType); override;
function GetCellTo(Row,Col: Integer; Dir:TRVCellDirection;
var NewRow,NewCol: Integer; Quiet: Boolean): Boolean;
{$IFNDEF RVDONOTUSERTF}
procedure SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer;
const Name: String; TwipsPerPixel: Double; Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList); override;
procedure FillRTFTables(ColorList: TRVColorList; ListOverrideCountList: TRVIntegerList;
RVData: TPersistent); override;
{$ENDIF}
function AsText(LineWidth: Integer; RVData: TPersistent;
const Text, Path: String; TextOnly,Unicode: Boolean): String; override;
{$IFNDEF RVDONOTUSEHTML}
procedure SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer; const Text, Path: String;
const imgSavePrefix: String; var imgSaveNo: Integer;
CurrentFileColor: TColor; SaveOptions: TRVSaveOptions;
UseCSS: Boolean; Bullets: TRVList); override;
{$ENDIF}
function EnterItem(From: TRVEnterDirection; Coord: Integer): Boolean; override;
procedure BuildJumps(Left,Top: Integer; var StartJumpNo: Integer; jumps: TList); override;
function GetSubRVData(var StoreState: TRVStoreSubRVData; Position: TRVSubRVDataPos): TPersistent; override;
procedure ChooseSubRVData(StoreState: TRVStoreSubRVData); override;
procedure CleanUpChosen; override;
{ Public }
constructor Create(RVData: TPersistent); override;
constructor CreateEx(nRows, nCols: Integer; AMainRVData: TCustomRVData);
destructor Destroy; override;
procedure UnmergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer; UnmergeRows, UnmergeCols: Boolean);
function CanMergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
AllowMergeRC: Boolean): Boolean;
procedure MergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer; AllowMergeRC: Boolean);
procedure MergeSelectedCells(AllowMergeRC: Boolean);
function CanMergeSelectedCells(AllowMergeRC: Boolean): Boolean;
procedure UnmergeSelectedCells(UnmergeRows, UnmergeCols: Boolean);
procedure SplitSelectedCellsVertically(ColCount: Integer);
procedure SplitSelectedCellsHorizontally(RowCount: Integer);
function IsCellSelected(Row, Col: Integer): Boolean;
procedure InsertRows(Index, Count, CopyIndex: Integer
{$IFDEF RICHVIEWDEF4};Select:Boolean=True{$ENDIF});
procedure InsertCols(Index, Count, CopyIndex: Integer
{$IFDEF RICHVIEWDEF4};Select:Boolean=True{$ENDIF});
procedure InsertColsLeft(Count: Integer);
procedure InsertColsRight(Count: Integer);
procedure InsertRowsAbove(Count: Integer);
procedure InsertRowsBelow(Count: Integer);
procedure DeleteRows(Index, Count: Integer; DecreaseHeight: Boolean);
procedure DeleteCols(Index, Count: Integer; DecreaseWidth: Boolean);
procedure DeleteSelectedRows;
procedure DeleteSelectedCols;
procedure DeleteEmptyRows;
procedure DeleteEmptyCols;
function GetCellAt(X,Y: Integer; var Row,Col: Integer): Boolean;
procedure Select(StartRow, StartCol, RowOffs, ColOffs: Integer);
procedure Deselect;
procedure SelectRows(StartRow, Count: Integer);
procedure SelectCols(StartCol, Count: Integer);
function GetSelectionBounds(var StartRow, StartCol, RowOffs, ColOffs: Integer): Boolean;
function GetNormalizedSelectionBounds(IncludeEditedCell: Boolean; var TopRow, LeftCol, ColSpan, RowSpan: Integer): Boolean;
function GetEditedCell(var Row,Col: Integer): TCustomRichViewEdit;
procedure SaveToStream(Stream: TStream);
procedure LoadFromStream(Stream: TStream);
procedure LoadFromStreamEx(Stream: TStream; StartRow: Integer);
procedure EditCell(Row,Col: Integer);
procedure Changed;
// Data
property Rows: TRVTableRows read FRows;
property Cells[Row, Col: Integer]: TRVTableCellData read GetCells write SetCells;
procedure SetCellBestWidth(Value: TRVHTMLLength; Row,Col: Integer);
procedure SetCellBestHeight(Value: Integer; Row,Col: Integer);
procedure SetCellColor(Value: TColor; Row,Col: Integer);
procedure SetCellBackgroundStyle(Value: TRVItemBackgroundStyle; Row,Col: Integer);
procedure SetCellBackgroundImage(Value: TGraphic; Row,Col: Integer);
procedure SetCellVisibleBorders(Left, Top, Right, Bottom: Boolean; Row,Col: Integer);
procedure SetTableVisibleBorders(Left, Top, Right, Bottom: Boolean);
procedure SetCellBorderColor(Value: TColor; Row,Col: Integer);
procedure SetCellBorderLightColor(Value: TColor; Row,Col: Integer);
procedure SetCellVAlign(Value: TRVCellVAlign; Row,Col: Integer);
procedure SetRowVAlign(Value: TRVCellVAlign; Row: Integer);
function MoveFocus(GoForward: Boolean; var TopLevelRVData: TPersistent; var TopLevelItemNo: Integer): Boolean; override;
procedure ClearFocus; override;
procedure GetCellPosition(Cell: TRVTableCellData; var Row, Col: Integer);
procedure AssignProperties(Source: TRVTableItemInfo);
function SetExtraStrProperty(Prop: TRVExtraItemStrProperty;
const Value: String): Boolean; override;
function GetExtraStrProperty(Prop: TRVExtraItemStrProperty;
var Value: String): Boolean; override;
property BackgroundImageFileName: String read FBackgroundImageFileName
write FBackgroundImageFileName;
published
{ Published properties }
// Table:
property Options: TRVTableOptions read FOptions write FOptions default RVTABLEDEFAULTOPTIONS;
property PrintOptions: TRVTablePrintOptions read FPrintOptions write FPrintOptions default RVTABLEDEFAULTPRINTOPTIONS;
property BestWidth: TRVHTMLLength read FBestWidth write SetBestWidth default 0;
property Color: TColor read FColor write SetColor default clWindow;
property BackgroundImage: TGraphic read GetBackgroundImage write SetBackgroundImage stored False;
property BackgroundStyle: TRVItemBackgroundStyle read GetBackgroundStyle write SetBackgroundStyle default rvbsColor;
property HeadingRowCount: Integer read FHeadingRowCount write SetHeadingRowCount default 0;
property TextRowSeparator: String read FTextRowSeparator write FTextRowSeparator;
property TextColSeparator: String read FTextColSeparator write FTextColSeparator;
// Border around the table:
property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
property BorderColor: TColor read FBorderColor write SetBorderColor default clWindowText;
property BorderLightColor: TColor read FBorderLightColor write SetBorderLightColor default clBtnHighlight;
property BorderStyle: TRVTableBorderStyle read FBorderStyle write SetBorderStyle default rvtbRaised;
property BorderVSpacing: Integer read FBorderVSpacing write SetBorderVSpacing default 2;
property BorderHSpacing: Integer read FBorderHSpacing write SetBorderHSpacing default 2;
property VisibleBorders: TRVBooleanRect read FVisibleBorders write SetVisibleBorders stored StoreVisibleBorders;
// Cells:
property CellBorderWidth: Integer read FCellBorderWidth write SetCellBorderWidth default 0;
property CellBorderColor: TColor read FCellBorderColor write SetCellBorderColorProp default clWindowText;
property CellBorderLightColor: TColor read FCellBorderLightColor write SetCellBorderLightColorProp default clBtnHighlight;
property CellPadding: Integer read FCellPadding write SetCellPadding default 1;
property CellBorderStyle: TRVTableBorderStyle read FCellBorderStyle write SetCellBorderStyle default rvtbLowered;
// Between cells:
property VRuleWidth: Integer read FVRuleWidth write SetVRuleWidth default 0;
property VRuleColor: TColor read FVRuleColor write SetVRuleColor default clWindowText;
property HRuleWidth: Integer read FHRuleWidth write SetHRuleWidth default 0;
property HRuleColor: TColor read FHRuleColor write SetHRuleColor default clWindowText;
property CellVSpacing: Integer read FCellVSpacing write SetCellVSpacing default 2;
property CellHSpacing: Integer read FCellHSpacing write SetCellHSpacing default 2;
property VOutermostRule: Boolean read FVOutermostRule write SetVOutermostRule default False;
property HOutermostRule: Boolean read FHOutermostRule write SetHOutermostRule default False;
// Events
property OnCellEditing: TRVCellEditingEvent read FOnCellEditing write FOnCellEditing;
property OnCellEndEdit: TRVCellEndEditEvent read FOnCellEndEdit write FOnCellEndEdit;
property OnDrawBorder: TRVTableDrawBorderEvent read FOnDrawBorder write FOnDrawBorder;
end;
TRVTableStoreSubRVData = class (TRVStoreSubRVData)
public
Row, Col: Integer;
constructor Create(ARow, ACol: Integer);
function Duplicate: TRVStoreSubRVData; override;
function Compare(StoreSub: TRVStoreSubRVData): Integer; override;
end;
TRVTablePrintInfo = class (TRVMultiDrawItemInfo)
private
sad: TRVScreenAndDevice;
FTable: TRVTableItemInfo;
FUseHeadingRowCount: Boolean;
public
Fmt: TRVTableItemFormattingInfo;
constructor Create(ATable: TRVTableItemInfo);
procedure SetSize(AWidth, AHeight: Integer); override;
destructor Destroy; override;
function InitSplit: Boolean; override;
function CanSplitFirst(Y: Integer): Boolean; override;
function SplitAt(Y: Integer): Boolean; override;
end;
TCellPtblRVData = class (TRectPtblRVData)
public
function GetRVStyle: TRVStyle; override;
end;
ERVTableInplaceError = class (Exception);
const RichViewTableGridStyle: TPenStyle = psDot; // in editor
RichViewTableGridStyle2: TPenStyle = psClear; // in viewer
RichViewTableGridColor: TColor = clBtnFace;
RichViewTableDefaultRTFAutofit: Boolean = False;
implementation
uses RVTInplace;
const errMerge = 'Parameters for cell merging are not correct';
errIso = 'Cannot perform operation for isolated cell';
errReadCells = 'Wrong end of cells list';
errInplaceBusy = 'Cannot destroy cell inplace editor at this time';
errInvalidIndex = 'Invalid row or column index';
errInternalError = 'Internal error';
{==============================================================================}
{ Draws vertical line (X,Y1) - (X, Y2).
Line has the pattern "10101000".
This line is used when resizing table columns. }
procedure DrawFancyVLine(Canvas: TCanvas; X, Y1, Y2: Integer);
var
i: Integer;
begin
i := Y1;
while i<Y2 do
with Canvas do begin
MoveTo(X, i);
LineTo(X, i+1);
inc(i, 2);
MoveTo(X, i);
LineTo(X, i+1);
inc(i, 2);
MoveTo(X, i);
LineTo(X, i+1);
Inc(i, 4);
end;
end;
{------------------------------------------------------------------------------}
{ Draws horizontal line (X1,Y) - (X2, Y).
Line has the pattern "10101000".
This line is used when resizing table rows. }
procedure DrawFancyHLine(Canvas: TCanvas; X1, X2, Y: Integer);
var
i: Integer;
begin
i := X1;
while i<X2 do
with Canvas do begin
MoveTo(i, Y);
LineTo(i+1,Y);
inc(i, 2);
MoveTo(i, Y);
LineTo(i+1,Y);
inc(i, 2);
MoveTo(i, Y);
LineTo(i+1,Y);
Inc(i, 4);
end;
end;
{====================== TRVTableStoreSubRVData ================================}
{ Constructor. This class is used to define a location of RVData (cell) in the
table. }
constructor TRVTableStoreSubRVData.Create(ARow, ACol: Integer);
begin
inherited Create;
Row := ARow;
Col := ACol;
end;
{------------------------------------------------------------------------------}
{ Returns a copy of itself. }
function TRVTableStoreSubRVData.Duplicate: TRVStoreSubRVData;
begin
Result := TRVTableStoreSubRVData.Create(Row,Col);
end;
{------------------------------------------------------------------------------}
{ Compares itself with StoreSub. Self and StoreSub must be of the same item.
Return value: 0 if the same subdocument, <0 if Self is before StoreSub,
> 0 if Self is after StoreSub. }
function TRVTableStoreSubRVData.Compare(StoreSub: TRVStoreSubRVData): Integer;
begin
Result := Row - (StoreSub as TRVTableStoreSubRVData).Row;
if Result=0 then
Result := Col - TRVTableStoreSubRVData(StoreSub).Col;
end;
{============================== TRVTablePrintInfo =============================}
type
TRVTablePrintPart = class (TRVMultiDrawItemPart)
public
StartRow, RowCount: Integer;
function GetSoftPageBreakInfo: Integer; override;
end;
function TRVTablePrintPart.GetSoftPageBreakInfo: Integer;
begin
Result := StartRow;
end;
{------------------------------------------------------------------------------}
constructor TRVTablePrintInfo.Create(ATable: TRVTableItemInfo);
begin
inherited Create;
FTable := ATable;
Fmt := TRVTableItemFormattingInfo.Create(True);
FUseHeadingRowCount := FTable.CanUseHeadingRowCount;
end;
{------------------------------------------------------------------------------}
destructor TRVTablePrintInfo.Destroy;
begin
Fmt.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.InitSplit: Boolean;
var part: TRVTablePrintPart;
begin
if not (rvtoRowsSplit in FTable.PrintOptions) or
(FUseHeadingRowCount and (FTable.HeadingRowCount>=FTable.Rows.Count)) then begin
Result := False;
exit;
end;
part := TRVTablePrintPart.Create;
if FUseHeadingRowCount then begin
part.StartRow := FTable.HeadingRowCount;
if part.StartRow>Fmt.RowStarts.Count then
part.StartRow := Fmt.RowStarts.Count;
end
else
part.StartRow := 0;
part.RowCount := Fmt.RowStarts.Count-part.StartRow;
part.Height := Fmt.FHeight;
PartsList.Add(part);
Result := True;
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.CanSplitFirst(Y: Integer): Boolean;
var BorderHeight, CanSplitHere, hrc: Integer;
begin
if FUseHeadingRowCount then begin
hrc := FTable.HeadingRowCount;
if hrc>FTable.Rows.Count then
hrc := FTable.Rows.Count;
if hrc=FTable.Rows.Count then begin
Result := False;
exit;
end;
end
else
hrc := 0;
BorderHeight := Fmt.RowStarts[hrc]+
Fmt.FHeight-Fmt.RowStarts[Fmt.RowStarts.Count-1]-
Fmt.RowHeights[Fmt.RowStarts.Count-1];
dec(y,BorderHeight);
inc(y, Fmt.RowStarts[hrc]);
CanSplitHere := FTable.GetSplitRowBelow(hrc);
Result := y>Fmt.RowStarts[CanSplitHere]+Fmt.RowHeights[CanSplitHere];
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.SplitAt(Y: Integer): Boolean;
var BorderHeight, r,Count, CanSplitHere: Integer;
part: TRVTablePrintPart;
begin
if PartsList.Count=0 then
raise ERichViewError.Create(errRVPrint);
part := TRVTablePrintPart(PartsList[PartsList.Count-1]);
if (part.RowCount=1) or (part.Height<=Y) then begin
Result := False;
exit;
end;
if FUseHeadingRowCount then begin
r := FTable.HeadingRowCount;
if r>Fmt.RowStarts.Count then
r := Fmt.RowStarts.Count;
if r=Fmt.RowStarts.Count then begin
Result := False;
exit;
end;
end
else
r := 0;
BorderHeight := Fmt.RowStarts[r]+
Fmt.FHeight-Fmt.RowStarts[Fmt.RowStarts.Count-1]-
Fmt.RowHeights[Fmt.RowStarts.Count-1];
dec(y,BorderHeight);
inc(y, Fmt.RowStarts[part.StartRow]);
r := part.StartRow+1;
Count := 1;
while y>Fmt.RowStarts[r]+Fmt.RowHeights[r] do begin
inc(r);
inc(Count);
end;
if Count>=part.RowCount then
raise ERichViewError.Create(errRVPrint);
CanSplitHere := FTable.GetSplitRowAbove(r);
if CanSplitHere<=part.StartRow+1 then
CanSplitHere := FTable.GetSplitRowBelow(part.StartRow)+1;
inc(Count, CanSplitHere-r);
r := CanSplitHere;
if Count>part.RowCount then
raise ERichViewError.Create(errRVPrint);
if Count=part.RowCount then begin
Result := False;
exit;
end;
part.RowCount := Count;
part.Height := BorderHeight+Fmt.RowStarts[r-1]+Fmt.RowHeights[r-1]-Fmt.RowStarts[part.StartRow];
part := TRVTablePrintPart.Create;
part.StartRow := r;
part.RowCount := Fmt.RowStarts.Count-r;
part.Height := BorderHeight+Fmt.RowStarts[Fmt.RowStarts.Count-1]+Fmt.RowHeights[Fmt.RowStarts.Count-1]-
Fmt.RowStarts[r];
PartsList.Add(part);
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVTablePrintInfo.SetSize(AWidth, AHeight: Integer);
begin
// do nothing
end;
{------------------------------------------------------------------------------}
function TCellPtblRVData.GetRVStyle: TRVStyle;
begin
Result := FSourceDataForPrinting.GetRVStyle;
end;
type
TRVUndoModifyCellIntProperty = class(TRVUndoModifyItemIntProperty)
public
Row, Col: Integer;
procedure Undo(RVData: TRichViewRVData); override;
procedure SetOppositeUndoInfoProps(UndoInfo: TRVUndoModifyItemProps); override;
end;
TRVUndoModifyVisibleBorders = class(TRVUndoModifyItemProps)
public
Row, Col: Integer;
Left, Right, Top, Bottom: Boolean;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoModifyBackgroundImage = class(TRVUndoModifyItemProps)
public
Row, Col: Integer;
Image: TGraphic;
procedure Undo(RVData: TRichViewRVData); override;
destructor Destroy; override;
end;
TRVUndoModifyCellIntProperties = class(TRVUndoModifyItemIntProperties)
public
Row, Col: Integer;
procedure Undo(RVData: TRichViewRVData); override;
procedure SetOppositeUndoInfoProps(UndoInfo: TRVUndoModifyItemProps); override;
end;
TRVUndoRowVAlign = class(TRVUndoModifyItemProps)
public
Row: Integer;
OldVAlign: TRVCellVAlign;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoInsertTableRows = class(TRVUndoModifyItemProps)
public
Row, Count: Integer;
Flag: Boolean;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoInsertTableCell = class(TRVUndoModifyItemProps)
public
Row, Col: Integer;
Flag: Boolean;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoSpreadOverEmptyCells = class(TRVUndoModifyItemProps)
public
Row, Col, ColSpan: Integer;
Flag: Boolean;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoSpan = class(TRVUndoModifyItemProps)
public
IsColSpan: Boolean;
Row, Col, OldSpan: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoFreeEmptyCell = class(TRVUndoModifyItemProps)
public
Flag: Boolean;
Row, Col, ColSpan, RowSpan: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoInsertEmptyCell = class(TRVUndoModifyItemProps)
public
Flag: Boolean;
Row, Col, ColCount, RowCount: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoCellSpitHorz = class(TRVUndoModifyItemProps)
public
Flag, DecreaseHeight: Boolean;
Row, Col, Row2, OldBestHeight: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoCellSpitVert = class(TRVUndoModifyItemProps)
public
Flag, DecreaseWidth: Boolean;
Row, Col, Col2: Integer;
OldBestWidth: TRVHTMLLength;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoDeleteRows = class(TRVUndoModifyItemProps)
public
Flag: Boolean;
Row, Count: Integer;
Rows: TList;
procedure Undo(RVData: TRichViewRVData); override;
destructor Destroy; override;
end;
TCustomRVUndoWithCells = class(TRVUndoModifyItemProps)
public
Flag: Boolean;
CellsList: TList;
destructor Destroy; override;
end;
TRVUndoDeleteCols = class(TCustomRVUndoWithCells)
public
Col, Count: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoCellsClear = class (TCustomRVUndoWithCells)
public
RowList, ColList: TRVIntegerList;
procedure Undo(RVData: TRichViewRVData); override;
destructor Destroy; override;
end;
TRVUndoMergeItem = class
public
Row,Col,ItemCount: Integer;
Cell: TRVTableCellData;
constructor Create(Table: TRVTableItemInfo; ARow,ACol,AVampRow,AVampCol: Integer);
end;
TRVUndoMerge = class(TRVUndoModifyItemProps)
public
Flag: Boolean;
Row, Col, OldColSpan, OldRowSpan, NewColSpan,NewRowSpan: Integer;
OldBestWidth: TRVHTMLLength;
MergedItemsList: TRVList;
procedure Undo(RVData: TRichViewRVData); override;
destructor Destroy; override;
end;
TRVUndoUnmerge = class(TRVUndoModifyItemProps)
public
Flag, UnmergeCols, UnmergeRows: Boolean;
Row, Col, OldColSpan, OldRowSpan, OldBestHeight: Integer;
OldBestWidth: TRVHTMLLength;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoCellModify = class(TRVCompositeUndo)
public
Row,Col, CaretItemNo, CaretOffs: Integer;
procedure Undo(RVData: TRichViewRVData); override;
end;
TRVUndoMultiCellsModify = class(TRVCompositeUndo)
public
RowList, ColList, CountList: TRVIntegerList;
OldW: Integer;
procedure Undo(RVData: TRichViewRVData); override;
destructor Destroy; override;
function RequiresFormat: Boolean; override;
function RequiresFullReformat1(RVData: TRichViewRVData): Boolean; override;
function RequiresFullReformat2(RVData: TRichViewRVData): Boolean; override;
end;
function AddTableUndoInfo(RVData: TRichViewRVData; UndoInfoClass: TRVUndoInfoClass;
ItemNo: Integer;
AffectSize, AffectWidth: Boolean): TRVUndoModifyItemProps;
var List: TRVUndoList;
begin
List := TRVEditRVData(RVData).GetUndoList;
if List<>nil then begin
Result := TRVUndoModifyItemProps(UndoInfoClass.Create);
Result.Action := rvuModifyItem;
Result.ItemNo := ItemNo;
Result.AffectSize := AffectSize;
Result.AffectWidth := AffectWidth;
List.AddInfo(Result);
end
else
Result := nil;
end;
{======================== TRVUndoModifyCellIntProperty ========================}
procedure TRVUndoModifyCellIntProperty.SetOppositeUndoInfoProps(UndoInfo: TRVUndoModifyItemProps);
begin
if UndoInfo<>nil then begin
(UndoInfo as TRVUndoModifyCellIntProperty).Row := Row;
TRVUndoModifyCellIntProperty(UndoInfo).Col := Col;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVUndoModifyCellIntProperty.Undo(RVData: TRichViewRVData);
var table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
table.Changed;
SubObject := table.Cells[Row,Col];
inherited Undo(RVData);
end;
{====================== TRVUndoModifyVisibleBorders ===========================}
procedure TRVUndoModifyVisibleBorders.Undo(RVData: TRichViewRVData);
var table: TRVTableItemInfo;
ui: TRVUndoModifyVisibleBorders;
VB: TRVBooleanRect;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
if (Row>=0) and (Col>=0) then begin
SubObject := table.Cells[Row,Col];
VB := table.Cells[Row,Col].VisibleBorders;
end
else begin
SubObject := nil;
VB := table.VisibleBorders;
end;
ui := TRVUndoModifyVisibleBorders(AddTableUndoInfo(RVData, TRVUndoModifyVisibleBorders, ItemNo, False, False));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Left := VB.Left;
ui.Top := VB.Top;
ui.Right := VB.Right;
ui.Bottom := VB.Bottom;
end;
VB.SetValues(Left, Top, Right, Bottom);
table.Changed;
end;
{======================= TRVUndoModifyBackgroundImage =========================}
destructor TRVUndoModifyBackgroundImage.Destroy;
begin
Image.Free;
inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVUndoModifyBackgroundImage.Undo(RVData: TRichViewRVData);
var table: TRVTableItemInfo;
cell: TRVTableCellData;
ui: TRVUndoModifyBackgroundImage;
LImage: TGraphic;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
if (Row>=0) and (Col>=0) then begin
SubObject := table.Cells[Row,Col];
Cell := table.Cells[Row,Col];
LImage := Cell.BackgroundImage;
end
else begin
Cell := nil;
SubObject := nil;
LImage := table.BackgroundImage;
end;
ui := TRVUndoModifyBackgroundImage(AddTableUndoInfo(RVData, TRVUndoModifyBackgroundImage, ItemNo, False, False));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Image := LImage;
end;
if Cell=nil then
Table.SetBackgroundImage_(Image, False)
else
Cell.SetBackgroundImage_(Image, False);
Image := nil;
table.Changed;
end;
{========================= TRVUndoRowVAlign ===================================}
procedure TRVUndoRowVAlign.Undo(RVData: TRichViewRVData);
var table: TRVTableItemInfo;
ui: TRVUndoRowVAlign;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoRowVAlign(AddTableUndoInfo(RVData, TRVUndoRowVAlign, ItemNo, True, False));
if ui<>nil then begin
ui.OldVAlign := table.Rows[Row].VAlign;
ui.Row := Row;
end;
table.Rows[Row].VAlign := OldVAlign;
table.Changed;
end;
{=========================== TRVUndoModifyCellIntProperties ===================}
procedure TRVUndoModifyCellIntProperties.SetOppositeUndoInfoProps(
UndoInfo: TRVUndoModifyItemProps);
begin
if UndoInfo<>nil then begin
(UndoInfo as TRVUndoModifyCellIntProperties).Row := Row;
TRVUndoModifyCellIntProperties(UndoInfo).Col := Col;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVUndoModifyCellIntProperties.Undo(RVData: TRichViewRVData);
var table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
table.Changed;
SubObject := table.Cells[Row,Col];
inherited Undo(RVData);
end;
{========================= TRVUndoInsertTableRows =============================}
procedure TRVUndoInsertTableRows.Undo(RVData: TRichViewRVData);
var ui: TRVUndoInsertTableRows;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoInsertTableRows(AddTableUndoInfo(RVData, TRVUndoInsertTableRows,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Count := Count;
end;
if Flag then
table.Rows.Do_InsertRows(Row,Count)
else
table.Rows.Do_UnInsertRows(Row,Count);
table.Changed;
end;
{========================= TRVUndoInsertTableCell =============================}
procedure TRVUndoInsertTableCell.Undo(RVData: TRichViewRVData);
var ui: TRVUndoInsertTableCell;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoInsertTableCell(AddTableUndoInfo(RVData, TRVUndoInsertTableCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
end;
if Flag then
table.Rows[Row].Insert(Col)
else
table.Rows[Row].Delete(Col);
table.Changed;
end;
{========================== TRVUndoSpreadOverEmptyCells =======================}
procedure TRVUndoSpreadOverEmptyCells.Undo(RVData: TRichViewRVData);
var ui: TRVUndoSpreadOverEmptyCells;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoSpreadOverEmptyCells(AddTableUndoInfo(RVData, TRVUndoSpreadOverEmptyCells,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.ColSpan := ColSpan;
end;
if Flag then
table.Rows.Do_SpreadOverEmptyCells(Row,Col,ColSpan)
else
table.Rows.Do_UnSpreadOverEmptyCells(Row,Col,ColSpan);
table.Changed;
end;
{=============================== TRVUndoSpan ==================================}
procedure TRVUndoSpan.Undo(RVData: TRichViewRVData);
var ui: TRVUndoSpan;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoSpan(AddTableUndoInfo(RVData, TRVUndoSpan,
ItemNo, True, True));
if ui<>nil then begin
ui.IsColSpan := IsColSpan;
if IsColSpan then
ui.OldSpan := table.Cells[Row,Col].ColSpan
else
ui.OldSpan := table.Cells[Row,Col].RowSpan;
ui.Row := Row;
ui.Col := Col;
end;
if IsColSpan then
table.Cells[Row,Col].FColSpan := OldSpan
else
table.Cells[Row,Col].FRowSpan := OldSpan;
table.Changed;
end;
{============================ TRVUndoFreeEmptyCell ============================}
procedure TRVUndoFreeEmptyCell.Undo(RVData: TRichViewRVData);
var ui: TRVUndoFreeEmptyCell;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoFreeEmptyCell(AddTableUndoInfo(RVData, TRVUndoFreeEmptyCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.ColSpan := ColSpan;
ui.RowSpan := RowSpan;
end;
if Flag then
table.Rows.Do_FreeEmptyCells(Row,Col,ColSpan,RowSpan)
else
table.Rows.Do_UnFreeEmptyCells(Row,Col,ColSpan,RowSpan);
table.Changed;
end;
{========================== TRVUndoInsertEmptyCell ============================}
procedure TRVUndoInsertEmptyCell.Undo(RVData: TRichViewRVData);
var ui: TRVUndoInsertEmptyCell;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoInsertEmptyCell(AddTableUndoInfo(RVData, TRVUndoInsertEmptyCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.ColCount := ColCount;
ui.RowCount := RowCount;
end;
if Flag then
table.Rows.Do_InsertEmptyCells(Row,Col,ColCount,RowCount)
else
table.Rows.Do_UnInsertEmptyCells(Row,Col,ColCount,RowCount);
table.Changed;
end;
{============================ TRVUndoCellSpitHorz =============================}
procedure TRVUndoCellSpitHorz.Undo(RVData: TRichViewRVData);
var ui: TRVUndoCellSpitHorz;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoCellSpitHorz(AddTableUndoInfo(RVData, TRVUndoCellSpitHorz,
ItemNo, True, False));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.Row2 := Row2;
ui.OldBestHeight := OldBestHeight;
ui.DecreaseHeight := DecreaseHeight;
end;
if Flag then
table.Rows.Do_SplitCellHorz(Row,Col,Row2,DecreaseHeight)
else
table.Rows.Do_UnSplitCellHorz(Row,Col,Row2,OldBestHeight);
table.Changed;
end;
{============================== TRVUndoCellSpitVert ===========================}
procedure TRVUndoCellSpitVert.Undo(RVData: TRichViewRVData);
var ui: TRVUndoCellSpitVert;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoCellSpitVert(AddTableUndoInfo(RVData, TRVUndoCellSpitVert,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.Col2 := Col2;
ui.OldBestWidth := OldBestWidth;
ui.DecreaseWidth := DecreaseWidth;
end;
if Flag then
table.Rows.Do_SplitCellVert(Row,Col,Col2,DecreaseWidth)
else
table.Rows.Do_UnSplitCellVert(Row,Col,Col2,OldBestWidth);
table.Changed;
end;
{============================== TRVUndoDeleteRows =============================}
procedure TRVUndoDeleteRows.Undo(RVData: TRichViewRVData);
var ui: TRVUndoDeleteRows;
table: TRVTableItemInfo;
i: Integer;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoDeleteRows(AddTableUndoInfo(RVData, TRVUndoDeleteRows,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Count := Count;
if Flag then begin
ui.Rows := TList.Create;
for i := 0 to Count-1 do
ui.Rows.Add(table.Rows[Row+i]);
end;
end;
if Flag then
table.Rows.Do_DeleteRows(ItemNo, Row,Count,ui)
else
table.Rows.Do_UnDeleteRows(Row, Rows);
table.Changed;
end;
{------------------------------------------------------------------------------}
destructor TRVUndoDeleteRows.Destroy;
var i: Integer;
begin
if Rows<>nil then begin
for i := 0 to Rows.Count-1 do
TObject(Rows[i]).Free;
Rows.Free;
end;
inherited Destroy;
end;
{================================= TCustomRVUndoWithCells =====================}
destructor TCustomRVUndoWithCells.Destroy;
var i: Integer;
begin
if CellsList<>nil then begin
for i := 0 to CellsList.Count-1 do
TObject(CellsList[i]).Free;
CellsList.Free;
end;
inherited Destroy;
end;
{=========================== TRVUndoDeleteCols ================================}
procedure TRVUndoDeleteCols.Undo(RVData: TRichViewRVData);
var ui: TRVUndoDeleteCols;
table: TRVTableItemInfo;
r,c: Integer;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoDeleteCols(AddTableUndoInfo(RVData, TRVUndoDeleteCols,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Col := Col;
ui.Count := Count;
if Flag then begin
ui.CellsList := TList.Create;
for r := 0 to table.Rows.Count-1 do
for c := Count-1 downto 0 do
ui.CellsList.Add(table.Cells[r,Col+c]);
end;
end;
if Flag then
table.Rows.Do_DeleteCols(ItemNo, Col,Count, ui)
else
table.Rows.Do_UnDeleteCols(Col, CellsList);
table.Changed;
end;
{================================= TRVUndoCellsClear ==========================}
destructor TRVUndoCellsClear.Destroy;
begin
RowList.Free;
ColList.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVUndoCellsClear.Undo(RVData: TRichViewRVData);
var ui: TRVUndoCellsClear;
table: TRVTableItemInfo;
NewCellsList: TList;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
NewCellsList := nil;
ui := TRVUndoCellsClear(AddTableUndoInfo(RVData, TRVUndoCellsClear,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.RowList := TRVIntegerList.CreateCopy(RowList);
ui.ColList := TRVIntegerList.CreateCopy(ColList);
if Flag then begin
ui.CellsList := TList.Create;
NewCellsList := ui.CellsList;
end;
end;
if Flag then
table.Rows.Do_ClearCells(NewCellsList, RowList, ColList, ui)
else
table.Rows.Do_UnClearCells(CellsList, RowList, ColList);
table.Changed;
end;
{=============================== TRVUndoMergeItem =============================}
constructor TRVUndoMergeItem.Create(Table: TRVTableItemInfo; ARow, ACol,
AVampRow, AVampCol: Integer);
begin
inherited Create;
Row := ARow;
Col := ACol;
Cell := Table.Cells[Row,Col];
if Cell.HasData(False) then
ItemCount := Cell.Items.Count
else
ItemCount := 0;
end;
{============================== TRVUndoMerge ==================================}
procedure TRVUndoMerge.Undo(RVData: TRichViewRVData);
var ui: TRVUndoMerge;
table: TRVTableItemInfo;
r,c: Integer;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoMerge(AddTableUndoInfo(RVData, TRVUndoMerge,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.OldColSpan := OldColSpan;
ui.OldRowSpan := OldRowSpan;
ui.NewColSpan := NewColSpan;
ui.NewRowSpan := NewRowSpan;
ui.OldBestWidth := OldBestWidth;
if Flag then begin
ui.MergedItemsList := TRVList.Create;
for r := Row to Row+NewRowSpan-1 do
for c := Col to Col+NewColSpan-1 do
if (table.Cells[r,c]<>nil) and
(table.Cells[r,c]<>table.Cells[Row,Col]) then
ui.MergedItemsList.Add(TRVUndoMergeItem.Create(table,r,c,Row,Col));
end;
end;
if Flag then
table.Rows.Do_MergeCells(ItemNo, Row,Col, NewColSpan, NewRowSpan, ui, True)
else
table.Rows.Do_UndoMergeCells(ItemNo, Row,Col, OldColSpan, OldRowSpan, MergedItemsList,OldBestWidth);
table.Changed;
end;
{------------------------------------------------------------------------------}
destructor TRVUndoMerge.Destroy;
var i: Integer;
begin
if MergedItemsList<>nil then begin
for i := 0 to MergedItemsList.Count-1 do
TRVUndoMergeItem(MergedItemsList[i]).Cell.Free;
MergedItemsList.Free;
end;
inherited Destroy;
end;
{================================ TRVUndoUnmerge ==============================}
procedure TRVUndoUnmerge.Undo(RVData: TRichViewRVData);
var ui: TRVUndoUnmerge;
table: TRVTableItemInfo;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoUnmerge(AddTableUndoInfo(RVData, TRVUndoUnmerge,
ItemNo, True, True));
if ui<>nil then begin
ui.Flag := not Flag;
ui.Row := Row;
ui.Col := Col;
ui.OldColSpan := OldColSpan;
ui.OldRowSpan := OldRowSpan;
ui.UnmergeCols := UnmergeCols;
ui.UnmergeRows := UnmergeRows;
ui.OldBestWidth := OldBestWidth;
ui.OldBestHeight := OldBestHeight;
end;
if Flag then
table.Rows.Do_UnmergeCell(ItemNo, Row,Col, UnmergeRows, UnmergeCols)
else
table.Rows.Do_UndoUnmergeCell(ItemNo, Row,Col, OldColSpan, OldRowSpan,
OldBestWidth, OldBestHeight);
table.Changed;
end;
{============================= TRVUndoCellModify ==============================}
procedure TRVUndoCellModify.Undo(RVData: TRichViewRVData);
var
table: TRVTableItemInfo;
ERow,ECol,i: Integer;
List: TRVUndoList;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
table.GetEditedCell(ERow,ECol);
if (ERow<>Row) or (ECol<>Col) then
table.EditCell_(Row,Col,True);
if IsRedo then
List := TRVEditRVData(table.FInplaceEditor.RVData).RedoList
else
List := TRVEditRVData(table.FInplaceEditor.RVData).UndoList;
for i := 0 to UndoList.Count-1 do begin
List.AddInfos(TObject(UndoList.Items[i]) as TRVUndoInfos);
end;
for i := UndoList.Count-1 downto 0 do
UndoList.DeleteAsPointer(i);
table.FInplaceEditor.SetSelectionBounds(CaretItemNo, CaretOffs,CaretItemNo, CaretOffs);
table.FInplaceEditor.SetFReadOnly(True);
if IsRedo then
PostMessage(table.FInplaceEditor.Handle, WM_RVINPLACEREDO,0,0)
else
PostMessage(table.FInplaceEditor.Handle, WM_RVINPLACEUNDO,0,0)
end;
{========================== TRVUndoMultiCellsModify ===========================}
destructor TRVUndoMultiCellsModify.Destroy;
begin
RowList.Free;
ColList.Free;
CountList.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVUndoMultiCellsModify.RequiresFormat: Boolean;
begin
Result := True;
end;
{------------------------------------------------------------------------------}
function TRVUndoMultiCellsModify.RequiresFullReformat1(
RVData: TRichViewRVData): Boolean;
begin
OldW := RVData.CalculateMinItemWidthPlusEx(ItemNo);
Result := OldW >= RVData.DocumentWidth;
end;
{------------------------------------------------------------------------------}
function TRVUndoMultiCellsModify.RequiresFullReformat2(
RVData: TRichViewRVData): Boolean;
var NewW: Integer;
begin
NewW := RVData.CalculateMinItemWidthPlusEx(ItemNo);
Result := (NewW<>OldW) and (NewW>RVData.DocumentWidth);
end;
{------------------------------------------------------------------------------}
procedure TRVUndoMultiCellsModify.Undo(RVData: TRichViewRVData);
var ui: TRVUndoMultiCellsModify;
table: TRVTableItemInfo;
Editor: TCustomRichViewEdit;
i: Integer;
begin
table := RVData.GetItem(ItemNo) as TRVTableItemInfo;
ui := TRVUndoMultiCellsModify(AddTableUndoInfo(RVData, TRVUndoMultiCellsModify,
ItemNo, True, True));
if ui<>nil then begin
ui.IsRedo := not IsRedo;
ui.RowList := TRVIntegerList.Create;
ui.ColList := TRVIntegerList.Create;
ui.CountList := TRVIntegerList.Create;
ui.UndoList := TRVUndoList.Create(GetUndoListOwnerRVData);
end;
Editor := table.CreateTemporalEditor;
try
while UndoList.Count>0 do begin
Editor.RVData.Clear;
Editor.RVData.DrainFrom(table.Cells[RowList[0],ColList[0]]);
Editor.Format;
Editor.SelectAll;
for i := 0 to CountList[0]-1 do begin
TRVEditRVData(Editor.RVData).UndoList.AddInfos(TObject(UndoList.Items[0]) as TRVUndoInfos);
UndoList.DeleteAsPointer(0);
end;
Editor.RVData.State := Editor.RVData.State + [rvstSkipFormatting];
Editor.Undo;
Editor.RVData.State := Editor.RVData.State - [rvstSkipFormatting];
if ui<>nil then begin
ui.RowList.Add(RowList[0]);
ui.ColList.Add(ColList[0]);
ui.CountList.Add(TRVEditRVData(Editor.RVData).RedoList.Count);
for i := 0 to TRVEditRVData(Editor.RVData).RedoList.Count-1 do
ui.UndoList.AddInfos(TObject(TRVEditRVData(Editor.RVData).RedoList.Items[i]) as TRVUndoInfos);
for i := TRVEditRVData(Editor.RVData).RedoList.Count-1 downto 0 do
TRVEditRVData(Editor.RVData).RedoList.DeleteAsPointer(i);
end;
table.Cells[RowList[0],ColList[0]].DrainFrom(Editor.RVData);
RowList.Delete(0);
ColList.Delete(0);
CountList.Delete(0);
end;
finally
Editor.Free;
end;
table.Changed;
end;
{========================== TRVTableCellData ==================================}
constructor TRVTableCellData.Create(ARow: TRVTableRow);
begin
inherited Create(ARow);
FVisibleBorders := TRVBooleanRect.Create(True);
FColSpan := 1;
FRowSpan := 1;
FColor := clNone;
FBorderColor := clNone;
FBorderLightColor := clNone;
FValign := rvcVDefault;
State := [];
AddNL('',0,0);
end;
{------------------------------------------------------------------------------}
destructor TRVTableCellData.Destroy;
begin
FVisibleBorders.Free;
FBackground.Free;
FBackground := nil;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.Edit: TCustomRVData;
var table: TRVTableItemInfo;
Row,Col: Integer;
begin
Result := GetRVData;
if Result<>Self then
exit;
table := GetTable;
table.GetCellPosition(Self,Row,Col);
table.EditCell(Row,Col);
Result := GetRVData;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetTable: TRVTableItemInfo;
begin
if (ContainerUndoItem<>nil) or (FList=nil) or (TRVTableRow(FList).FRows=nil) then
Result := nil
else
Result := TRVTableRow(FList).FRows.FTable;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.GetParentInfo(var ParentItemNo: Integer;
var Location: TRVStoreSubRVData);
var r,c: Integer;
table: TRVTableItemInfo;
begin
table := GetTable;
table.GetCellPosition(Self, r, c);
Location := TRVTableStoreSubRVData.Create(r,c);
ParentItemNo := table.GetMyItemNo;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEITEMHINTS}
function TRVTableCellData.GetItemHint(RVData: TCustomRVData; ItemNo: Integer;
const UpperRVDataHint: String): String;
begin
Result := GetAbsoluteParentData.GetItemHint(RVData, ItemNo,
{$IFNDEF RVDONOTUSEITEMHINTS}Hint{$ELSE}UpperRVDataHint{$ENDIF});
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVTableCellData.IsTransparent: Boolean;
begin
Result := (Color=clNone);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetBestHeight(const Value: Integer);
begin
FBestHeight := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetBestWidth(const Value: TRVHTMLLength);
begin
FBestWidth := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetColor(const Value: TColor);
var table: TRVTableItemInfo;
begin
FColor := Value;
table := GetTable;
if table=nil then exit;
if (table.FInplaceEditor<>nil) and (TRVTableInplaceEdit(table.FInplaceEditor).FCell=Self) then begin
table.FInplaceEditor.Color := table.GetCellColor(Self);
TRVTableInplaceEdit(table.FInplaceEditor).Transparent := table.CanSeeBackgroundThroughCell(Self);
end;
{$IFNDEF RVDONOTUSEANIMATION}
if table.Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(table.Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetBackgroundImage: TGraphic;
begin
if FBackground<>nil then
Result := FBackground.Image
else
Result := nil;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetBackgroundStyle: TRVItemBackgroundStyle;
begin
if FBackground<>nil then
Result := FBackground.ItemBackStyle
else
Result := rvbsColor;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetBackgroundImage_(const Value: TGraphic; Copy: Boolean);
var table: TRVTableItemInfo;
begin
table := GetTable;
if Value=BackgroundImage then
exit;
if (FBackground=nil) and (Value<>nil) and not Value.Empty then
FBackground := TRVBackground.Create(False);
if FBackground<>nil then begin
FBackground.AssignImage(Value, table.Rows.FMainRVData, Copy);
if FBackground.Empty then begin
FBackground.Free;
FBackground := nil;
end
end;
if (table.FInplaceEditor<>nil) and (TRVTableInplaceEdit(table.FInplaceEditor).FCell=Self) then
table.FInplaceEditor.Invalidate;
{$IFNDEF RVDONOTUSEANIMATION}
if table.Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(table.Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetBackgroundImage(const Value: TGraphic);
begin
SetBackgroundImage_(Value, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetBackgroundStyle(
const Value: TRVItemBackgroundStyle);
var table: TRVTableItemInfo;
begin
if Value=BackgroundStyle then
exit;
if (FBackground=nil) and (Value<>rvbsColor) then
FBackground := TRVBackground.Create(False);
if FBackground<>nil then begin
FBackground.ItemBackStyle := Value;
if FBackground.Empty then begin
FBackground.Free;
FBackground := nil;
end
end;
table := GetTable;
if (table.FInplaceEditor<>nil) and (TRVTableInplaceEdit(table.FInplaceEditor).FCell=Self) then
table.FInplaceEditor.Invalidate;
{$IFNDEF RVDONOTUSEANIMATION}
if table.Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(table.Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.BackgroundImageReader(Stream: TStream);
var s: String;
v: Integer;
gr: TGraphic;
begin
Stream.ReadBuffer(v, sizeof(v));
SetLength(s, v);
Stream.ReadBuffer(PChar(s)^, v);
gr := RV_CreateGraphics(TGraphicClass(GetClass(s)));
RVFLoadPictureBinary2(Stream, gr);
BackgroundImage := gr;
gr.Free;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.BackgroundImageWriter(Stream: TStream);
var s: String;
v: Integer;
begin
s := FBackground.Image.ClassName;
v := Length(s);
Stream.WriteBuffer(v, sizeof(v));
Stream.WriteBuffer(PChar(s)^, v);
RVFSavePictureBinary(Stream, FBackground.Image);
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetBackground: TRVBackground;
begin
Result := FBackground;
end;
{------------------------------------------------------------------------------}
type
TBackgroundKind =
(bckTransparent, bckColor, bckImage, bckSemitransparent);
procedure TRVTableCellData.GetItemBackground(ItemNo: Integer; r: TRect; MakeImageRect: Boolean;
var Color: TColor; var bmp: TBitmap; var UseBitmap: Boolean);
var item: TRVRectItemInfo;
ditem: TRVDrawLineInfo;
table: TRVTableItemInfo;
ParentRect: TRect;
CellBK, TableBK: TBackgroundKind;
ParaColor: TColor;
TableX, TableY: Integer;
CP: Integer;
procedure MakeBitmap;
begin
UseBitmap := True;
if bmp=nil then
bmp := TBitmap.Create;
bmp.Width := r.Right-r.Left;
bmp.Height := r.Bottom-r.Top;
bmp.Canvas.Brush.Style := bsSolid;
if Color<>clNone then begin
bmp.Canvas.Brush.Color := Color;
bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
end;
end;
begin
UseBitmap := False;
Color := GetRVStyle.ParaStyles[GetRVData.GetItemPara(ItemNo)].Background.Color;
if Color<>clNone then
exit;
table := GetTable;
if (rvstCompletelySelected in State) or table.CompletelySelected then begin
Color := GetRVStyle.SelColor;
if Color<>clNone then
exit;
end;
Color := Self.Color;
item := TRVRectItemInfo(GetRVData.GetItem(ItemNo));
ditem := TCustomRVFormattedData(GetRVData).DrawItems[item.DrawItemNo];
if GetRVData=Self then
CP := table.CellPadding
else
CP := 0;
if MakeImageRect then
r := Bounds(
ditem.Left+item.GetBorderWidth+CP, ditem.Top+ item.GetBorderHeight+CP,
item.GetImageWidth(nil), item.GetImageHeight(nil));
if BackgroundStyle=rvbsColor then
if Color=clNone then
CellBK := bckTransparent
else
CellBk := bckColor
else
if (Color=clNone) and FBackground.IsSemitransparent then
CellBk := bckSemitransparent
else
CellBk := bckImage;
case CellBk of
bckColor:
exit;
bckImage:
begin
MakeBitmap;
FBackground.Draw(bmp.Canvas, r, 0, 0, 0, 0, Width, Height, Color, False);
exit;
end;
end;
ParaColor := table.FRows.FMainRVData.GetRVStyle.ParaStyles[
table.FRows.FMainRVData.GetItemPara(table.GetMyItemNo)
].Background.Color;
if table.BackgroundStyle=rvbsColor then
if (table.Color=clNone) and (ParaColor=clNone) then
TableBK := bckTransparent
else
TableBk := bckColor
else
if (table.Color=clNone) and (ParaColor=clNone) and table.FBackground.IsSemitransparent then
TableBk := bckSemitransparent
else
TableBk := bckImage;
case TableBk of
bckColor:
begin
Color := table.Color;
if Color=clNone then
Color := ParaColor;
if CellBk=bckTransparent then
exit;
MakeBitmap;
FBackground.Draw(bmp.Canvas, r, 0, 0, 0, 0, Width, Height, Color, False);
exit;
end;
bckImage:
begin
Color := table.Color;
if Color=clNone then
Color := ParaColor;
MakeBitmap;
table.FBackground.Draw(bmp.Canvas, r, 0, 0, -Left, -Top, table.Width, table.Height, Color, False);
if CellBk<>bckTransparent then
FBackground.Draw(bmp.Canvas, r, 0, 0, 0, 0, Width, Height, clNone, False);
exit;
end;
end;
TCustomRVFormattedData(table.Rows.FMainRVData).GetItemCoords(table.GetMyItemNo,
TableX, TableY);
ParentRect := Bounds(
TableX+Left+table.CellPadding+ditem.Left+item.GetBorderWidth,
TableY+Top+ table.CellPadding+ditem.Top+ item.GetBorderHeight,
r.Right-r.Left, r.Bottom-r.Top);
TCustomRVFormattedData(table.Rows.FMainRVData).GetItemBackground(
table.GetMyItemNo, ParentRect, False, Color, bmp, UseBitmap);
if TableBk=bckSemitransparent then begin
if not UseBitmap then
MakeBitmap;
table.FBackground.Draw(bmp.Canvas, r, 0, 0, -Left, -Top, table.Width, table.Height, table.Color, False);
end;
if CellBk=bckSemitransparent then begin
if not UseBitmap then
MakeBitmap;
FBackground.Draw(bmp.Canvas, r, 0, 0, 0, 0, Width, Height, clNone, False);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetCellHeight(IgnoreContentHeight: Boolean): Integer;
begin
if (BestHeight=0) or not IgnoreContentHeight then begin
if (TRVTableRow(FList).FRows.FTable.FInplaceEditor<>nil) and
(TRVTableInplaceEdit(TRVTableRow(FList).FRows.FTable.FInplaceEditor).FCell=Self) then begin
Result := TRVTableRow(FList).FRows.FTable.FInplaceEditor.DocumentHeight-
TRVTableRow(FList).FRows.FTable.CellPadding*2;
end
else
Result := DocumentHeight;
end
else
Result := 0;
if BestHeight>Result then
Result := BestHeight;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas): Integer;
var ARVData: TCustomRVData;
begin
ARVData := GetRVData;
if (ARVData.Items.Count=0) then begin
Result := 0;
exit;
end;
if ((ARVData.Items.Count=1) and (ARVData.GetItemStyle(0)>=0) and (ARVData.Items[0]='')) then begin
with GetRVStyle.ParaStyles[ARVData.GetItemPara(0)] do
Result := LeftIndent+RightIndent+FirstIndent;
if sad<>nil then
Result := MulDiv(Result, sad.ppixDevice, sad.ppixScreen);
exit;
end;
if (TRVTableRow(FList).FRows.FTable.FInplaceEditor<>nil) and
(TRVTableInplaceEdit(TRVTableRow(FList).FRows.FTable.FInplaceEditor).FCell=Self) then
Result := TRVTableRow(FList).FRows.FTable.FInplaceEditor.RVData.CalculateMinDocWidthPlus(sad, Canvas)
else begin
Result := CalculateMinDocWidthPlus(sad, Canvas);
if Result=0 then
Result := 10; // temporal;
end;
end;
{------------------------------------------------------------------------------}
{
function TRVTableCellData.GetWidthInFixedTable(TableWidth: Integer): Integer;
begin
if BestWidth>0 then
Result := BestWidth
else if BestWidth<0 then
Result := -TableWidth*BestWidth div 100
else
Result := GetMinWidth;
end;
}
{------------------------------------------------------------------------------}
function TRVTableCellData.GetHeight: Integer;
begin
Result := Height-TRVTableRow(FList).FRows.FTable.CellPadding*2;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetWidth: Integer;
begin
Result := Width-TRVTableRow(FList).FRows.FTable.CellPadding*2;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetAreaWidth: Integer;
begin
Result := GetWidth;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetColor: TColor;
begin
Result := GetTable.GetCellColor(Self); // Result := clNone;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.AssignChosenRVData(RVData: TCustomRVFormattedData;
Item: TCustomRVItemInfo);
var r,c: Integer;
begin
GetTable.GetCellPosition(Self,r,c);
GetTable.ChooseSubRVData_(r,c);
inherited;
{
with GetTable do
if not FInserted or FEditMode then
exit;
}
if FChosenRVData<>RVData then
UnassignChosenRVData(FChosenRVData);
FChosenRVData := RVData;
FChosenItem := Item;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.UnassignChosenRVData(RVData: TCustomRVData);
begin
inherited;
if rvstUnAssigningChosen in State then
exit;
State := State+[rvstUnAssigningChosen];
if GetRVData is TCustomRVFormattedData then
TCustomRVFormattedData(GetRVData).State := State + [rvstUnAssigningChosen];
try
{
with GetTable do
if not FInserted or FEditMode then
exit;
}
if (RVData=FChosenRVData) or
((FChosenRVData<>nil) and (TCustomRVData(FChosenRVData).GetRVData=RVData)) then begin
if FChosenRVData<>nil then
TCustomRVFormattedData(FChosenRVData.GetRVData).Deselect(nil,False);
FChosenRVData := nil;
if FChosenItem<>nil then
FChosenItem.CleanUpChosen;
FChosenItem := nil;
end;
finally
if GetRVData is TCustomRVFormattedData then
TCustomRVFormattedData(GetRVData).State := State-[rvstUnAssigningChosen];
State := State-[rvstUnAssigningChosen];
end;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetChosenRVData: TCustomRVData;
begin
Result := FChosenRVData;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetChosenItem: TCustomRVItemInfo;
begin
Result := FChosenItem;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetHOffs: Integer;
begin
Result := - (TRVTableRow(FList).FRows.FTable.MyClientLeft +
TRVTableRow(FList).FRows.FTable.CellPadding +
Left);
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetEditor: TWinControl;
begin
Result := TRVTableRow(FList).FRows.FTable.FInplaceEditor;
if (Result<>nil) and
(TRVTableInplaceEdit(Result).FCell<>Self) then
Result := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.Deselect(
NewPartiallySelected: TCustomRVItemInfo; MakeEvent: Boolean);
var table: TRVTableItemInfo;
begin
inherited;
if ContainerUndoItem<>nil then
exit;
if rvstDeselecting in State then
exit;
State := State + [rvstDeselecting];
if GetRVData is TCustomRVFormattedData then
TCustomRVFormattedData(GetRVData).State := TCustomRVFormattedData(GetRVData).State + [rvstDeselecting];
try
table := GetTable;
if (NewPartiallySelected=nil) and (table<>nil) and (table.FRows.FMainRVData is TCustomRVFormattedData) then
TCustomRVFormattedData(table.FRows.FMainRVData).UnassignChosenRVData(Self);
finally
if GetRVData is TCustomRVFormattedData then
TCustomRVFormattedData(GetRVData).State := TCustomRVFormattedData(GetRVData).State - [rvstDeselecting];
State := State - [rvstDeselecting];
end;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetVOffs: Integer;
var table: TRVTableItemInfo;
begin
table := GetTable;
Result := - (table.MyClientTop + table.CellPadding +
GetExtraVOffs +
Top);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.ResetSubCoords;
begin
inherited;
TCustomRVFormattedData(GetParentData).ResetSubCoords;
GetTable.ResetSubCoords;
end;
{------------------------------------------------------------------------------}
{ Coordinates of the top left corner of this RVData relative to the closest
parent RichView (root one or inplace editor) }
procedure TRVTableCellData.GetOrigin(var ALeft, ATop: Integer);
var table: TRVTableItemInfo;
x,y: Integer;
begin
table := GetTable;
TCustomRVFormattedData(table.FRows.FMainRVData).GetOrigin(x,y);
TCustomRVFormattedData(table.FRows.FMainRVData).GetItemCoords(table.GetMyItemNo, ALeft, ATop);
inc(ALeft, x+FLeft+table.CellPadding);
inc(ATop, y+FTop+table.CellPadding);
inc(ATop,GetExtraVOffs);
end;
{------------------------------------------------------------------------------}
{ Coordinates of the top left corner of this RVData relative to the root
parent RichView }
procedure TRVTableCellData.GetOriginEx(var ALeft, ATop: Integer);
var table: TRVTableItemInfo;
x,y: Integer;
begin
table := GetTable;
TCustomRVFormattedData(table.FRows.FMainRVData).GetOriginEx(x,y);
TCustomRVFormattedData(table.FRows.FMainRVData).GetItemCoords(table.GetMyItemNo, ALeft, ATop);
inc(ALeft, x+FLeft+table.CellPadding);
inc(ATop, y+FTop+table.CellPadding);
inc(ATop,GetExtraVOffs);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.MovingToUndoList(AContainerUndoItem: TRVUndoInfo);
var i: Integer;
begin
{$IFNDEF RVDONOTUSELIVESPELL}
TCustomRichView(TRichViewRVData(GetAbsoluteRootData).RichView).RemoveRVDataFromLiveSpelling(Self);
{$ENDIF}
for i := 0 to Items.Count-1 do
GetItem(i).MovingToUndoList(i,Self,AContainerUndoItem);
ContainerUndoItem := AContainerUndoItem;
FList := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.MovingFromUndoList;
var i: Integer;
begin
ContainerUndoItem := nil;
for i := 0 to Items.Count-1 do
GetItem(i).MovingFromUndoList(i,Self);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.SetVisibleBorders(const Value: TRVBooleanRect);
begin
FVisibleBorders.Assign(Value);
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.StoreVisibleBorders: Boolean;
begin
Result := not FVisibleBorders.IsAllEqual(True);
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.HasData(CheckStyles: Boolean): Boolean;
begin
with GetRVData do
Result :=
(Items.Count>1) or
(
(Items.Count=1) and
not
(
(CheckStyles and (GetItemStyle(0)=0) and (GetItemPara(0)=0) and (Items[0]='')) or
(not CheckStyles and (GetItemStyle(0)>=0) and (Items[0]=''))
)
)
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineBinaryProperty( 'Data', DataReader, DataWriter, HasData(True));
Filer.DefineBinaryProperty('BackgroundImg', BackgroundImageReader, BackgroundImageWriter,
(FBackground<>nil) and not FBackground.Empty);
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetRVData: TCustomRVData;
begin
if (TRVTableRow(FList).FRows.FTable.FInplaceEditor<>nil) and
(TRVTableInplaceEdit(TRVTableRow(FList).FRows.FTable.FInplaceEditor).FCell=Self) then
Result := TRVTableInplaceEdit(TRVTableRow(FList).FRows.FTable.FInplaceEditor).RVData
else
Result := Self;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.AssignAttributesFrom(Cell: TRVTableCellData;
IncludeSize: Boolean;
DivColSpan, DivRowSpan: Integer);
begin
FColor := Cell.Color;
FBorderColor := Cell.BorderColor;
FBorderLightColor := Cell.BorderLightColor;
VisibleBorders.Assign(Cell.VisibleBorders);
FValign := Cell.VAlign;
BackgroundImage := Cell.BackgroundImage;
BackgroundStyle := Cell.BackgroundStyle;
BackgroundImageFileName := Cell.BackgroundImageFileName;
{$IFNDEF RVDONOTUSEITEMHINTS}
Hint := Cell.Hint;
{$ENDIF}
if IncludeSize then begin
FBestWidth := Cell.FBestWidth div DivColSpan;
FBestHeight := Cell.FBestHeight div DivRowSpan;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.AssignSizeFrom(Cell:TRVTableCellData);
begin
FLeft := Cell.FLeft;
FTop := Cell.FTop;
FWidth := Cell.FWidth;
FHeight := Cell.FHeight;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetRealVAlign: TRVCellVAlign;
begin
if VAlign<>rvcVDefault then
Result := VAlign
else begin
Result := TRVTableRow(FList).VAlign;
if Result=rvcVDefault then
Result := rvcMiddle;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetExtraVOffs: Integer;
var RVData: TCustomRVFormattedData;
begin
case GetRealVAlign of
rvcBottom:
begin
RVData := TCustomRVFormattedData(GetRVData);
Result := Height-RVData.DocumentHeight;
if RVData=Self then
dec(Result,GetTable.CellPadding*2);
end;
rvcMiddle:
begin
RVData := TCustomRVFormattedData(GetRVData);
Result := (Height-RVData.DocumentHeight) div 2;
if RVData=Self then
dec(Result,GetTable.CellPadding);
end;
else
Result := 0;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.GetOptions: TRVOptions;
begin
if ContainerUndoItem<>nil then
Result := ContainerUndoItem.GetUndoListOwnerRVData.Options
else
Result := inherited GetOptions;
Exclude(Result, rvoClientTextWidth);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSELISTS}
function TRVTableCellData.GetMarkers(AllowCreate: Boolean): TRVMarkerList;
begin
if ContainerUndoItem<>nil then
Result := nil // in undo list
else begin
if (GetTable.GetMyItemNo<0) then
Result := nil // not inserted yet
else
Result := inherited GetMarkers(AllowCreate);
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVTableCellData.SupportsPageBreaks: Boolean;
begin
Result := False;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.DoSelect;
begin
// do not perform inherited actions
end;
{------------------------------------------------------------------------------}
function TRVTableCellData.CanClear: Boolean;
var i: Integer;
item: TCustomRVItemInfo;
RVStyle: TRVStyle;
begin
Result := True;
RVStyle := GetRVStyle;
if RVStyle=nil then
exit;
for i := 0 to Items.Count-1 do begin
item := GetItem(i);
if ((item.StyleNo>=0) and (rvprDeleteProtect in RVStyle.TextStyles[item.StyleNo].Protection)) or
((item.StyleNo<0) and TRVNonTextItemInfo(item).DeleteProtect) then begin
Result := False;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.ControlAction2(ControlAction: TRVControlAction;
ItemNo: Integer; var Control: TControl);
begin
if ContainerUndoItem<>nil then
ContainerUndoItem.GetUndoListOwnerRVData.ControlAction2(ControlAction,-1,Control)
else begin
ItemNo := TRVTableRow(FList).FRows.FTable.GetMyItemNo;
TRVTableRow(FList).FRows.FMainRVData.ControlAction2(ControlAction,ItemNo,Control);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.ItemAction(ItemAction: TRVItemAction; Item: TCustomRVItemInfo;
var Text: String; RVData: TCustomRVData);
begin
if ContainerUndoItem<>nil then
ContainerUndoItem.GetUndoListOwnerRVData.ItemAction(ItemAction, Item, Text, RVData)
else
TRVTableRow(FList).FRows.FMainRVData.ItemAction(ItemAction, Item, Text, RVData);
end;
{------------------------------------------------------------------------------}
procedure TRVTableCellData.AdjustFocus(NewFocusedItemNo: Integer;
TopLevelRVData: TPersistent; TopLevelItemNo: Integer);
var r,c: Integer;
begin
inherited AdjustFocus(NewFocusedItemNo, TopLevelRVData, TopLevelItemNo);
with GetTable do begin
GetCellPosition(Self,r,c);
AdjustFocus(r,c,TopLevelRVData,TopLevelItemNo);
end;
end;
{=============================== TRVTableRow ==================================}
constructor TRVTableRow.Create(nCols: Integer; ARows: TRVTableRows;
MainRVData: TCustomRVData);
var i: Integer;
begin
inherited Create(MainRVData);
FRows := ARows;
Capacity := nCols;
Valign := rvcTop;
for i := 0 to nCols-1 do
Add
end;
{------------------------------------------------------------------------------}
function TRVTableRow.GetParentRVData: TCustomRVData;
begin
Result := FRows.FMainRVData;
end;
{------------------------------------------------------------------------------}
function TRVTableRow.HasCellsInRange(Index, RangeStart, Count: Integer): Boolean;
var c, RangeEnd, LastCellRow: Integer;
begin
Result := False;
if RangeStart>Index then
exit;
RangeEnd := RangeStart+Count-1;
for c := 0 to Self.Count-1 do
if Items[c]<>nil then begin
LastCellRow := Index+Items[c].RowSpan-1;
if LastCellRow<=RangeEnd then begin
Result := True;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRow.Add: TRVTableCellData;
begin
Result := TRVTableCellData.Create(Self);
inherited Add(Result);
end;
{------------------------------------------------------------------------------}
function TRVTableRow.Insert(Index: Integer): TRVTableCellData;
begin
Result := TRVTableCellData.Create(Self);
inherited Insert(Index, Result);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRow.InsertEmpty(Index: Integer);
begin
inherited Insert(Index, nil);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRow.InsertPointer(Index: Integer; Item: TRVTableCellData);
begin
if Item<>nil then
Item.FList := Self;
inherited Insert(Index, Item);
end;
{------------------------------------------------------------------------------}
function TRVTableRow.Get(Index: Integer): TRVTableCellData;
begin
Result := TRVTableCellData(inherited Get(Index));
end;
{------------------------------------------------------------------------------}
procedure TRVTableRow.Put(Index: Integer; const Value: TRVTableCellData);
begin
if Value<>nil then
Value.FList := Self;
inherited Put(Index, Value);
end;
{------------------------------------------------------------------------------}
function TRVTableRow.GetBestHeight: Integer;
var i,h: Integer;
begin
Result := 0;
for i := 0 to Count-1 do
if (Items[i]<>nil) and (Items[i].RowSpan<=1) then begin
h := Items[i].BestHeight;
if h>Result then
Result := h;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRow.GetHeight(IgnoreContentHeight: Boolean): Integer;
var i,h: Integer;
begin
Result := 0;
for i := 0 to Count-1 do
if (Items[i]<>nil) and (Items[i].RowSpan<=1) then begin
h := Items[i].GetCellHeight(IgnoreContentHeight);
if h>Result then
Result := h;
end;
if Result = 0 then
Result := 10; // temporary
end;
{============================== TRVTableRows ==================================}
constructor TRVTableRows.Create(nRows, nCols: Integer; AMainRVData: TCustomRVData;
ATable: TRVTableItemInfo);
begin
inherited Create;
FMainRVData := AMainRVData;
FTable := ATable;
Reset(nRows, nCols);
end;
{------------------------------------------------------------------------------}
destructor TRVTableRows.Destroy;
begin
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Reset(nRows, nCols: Integer);
var i: Integer;
begin
Clear;
Capacity := nRows;
for i := 0 to nRows-1 do
Add(nCols);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Empty: Boolean;
begin
Result := (Count=0) or (Items[0].Count=0);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Add(nCols: Integer): TRVTableRow;
begin
Result := TRVTableRow.Create(nCols, Self, FMainRVData);
inherited Add(Result);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Insert(Index, nCols: Integer): TRVTableRow;
begin
Result := TRVTableRow.Create(nCols, Self, FMainRVData);
inherited Insert(Index, Result);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.InsertPointer(Index: Integer; Item: TRVTableRow);
begin
Item.FRows := Self;
inherited Insert(Index, Item);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Get(Index: Integer): TRVTableRow;
begin
Result := TRVTableRow(inherited Get(Index));
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Put(Index: Integer; const Value: TRVTableRow);
begin
Value.FRows := Self;
inherited Put(Index, Value);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetBestWidth(TopRow, LeftCol, ColSpan, RowSpan: Integer): Integer;
var r,c,bw: Integer;
begin
Result := 0;
for r := TopRow to TopRow+RowSpan-1 do begin
bw := 0;
with Items[r] do
for c := LeftCol to LeftCol+ColSpan-1 do
if Items[c]<>nil then begin
if Items[c].BestWidth>0 then begin
if bw>=0 then
inc(bw,Items[c].BestWidth);
end
else if Items[c].BestWidth<0 then begin
if bw>0 then
bw := 0;
inc(bw,Items[c].BestWidth);
end;
end;
if ((Result>=0) and ((bw<0) or (bw>Result))) or
((Result<0) and (bw<Result)) then
Result := bw;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.IsEmptyCols(TopRow, LeftCol, ColSpan, RowSpan, LeftCol2, ColSpan2: Integer): Boolean;
var r,c: Integer;
empty: Boolean;
begin
Result := True;
for r := TopRow to TopRow+RowSpan-1 do begin
empty := True;
for c := LeftCol to LeftCol+ColSpan-1 do
if Items[r].Items[c]<>nil then begin
empty := False;
break;
end;
if empty then
for c := LeftCol2 to LeftCol2+ColSpan2-1 do
if Items[r].Items[c]<>nil then begin
empty := False;
break;
end;
if empty then
exit;
end;
Result := False;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetColCount: Integer;
begin
if Count>0 then
Result := Items[0].Count
else
Result := 0;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.IsEmptyRows(TopRow, LeftCol, ColSpan, RowSpan, TopRow2, RowSpan2: Integer): Boolean;
var r,c: Integer;
empty: Boolean;
begin
Result := True;
for c := LeftCol to LeftCol+ColSpan-1 do begin
empty := True;
for r := TopRow to TopRow+RowSpan-1 do
if Items[r].Items[c]<>nil then begin
empty := False;
break;
end;
if empty then
for r := TopRow2 to TopRow2+RowSpan2-1 do
if Items[r].Items[c]<>nil then begin
empty := False;
break;
end;
if empty then
exit;
end;
Result := False;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.UnmergeCell(Row, Col: Integer; UnmergeRows, UnmergeCols: Boolean);
var MainCell: TRVTableCellData;
ItemNo: Integer;
begin
MainCell := Items[Row].Items[Col];
if (MainCell=nil) or
(((MainCell.ColSpan=1) or not UnmergeCols) and
((MainCell.RowSpan=1) or not UnmergeRows)) then
exit;
ItemNo := FTable.GetEditorItemNoForUndo;
Do_BeforeUnmergeCell(ItemNo, Row, Col, UnmergeRows, UnmergeCols);
Do_UnmergeCell(ItemNo, Row, Col, UnmergeRows, UnmergeCols);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.UnmergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
UnmergeRows, UnmergeCols: Boolean);
var r,c: Integer;
begin
for r := TopRow+RowSpan-1 downto TopRow do
for c := LeftCol+ColSpan-1 downto LeftCol do
UnmergeCell(r, c, UnmergeRows, UnmergeCols);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.StartMergeCells(TopRow, LeftCol: Integer;
var ColSpan, RowSpan: Integer): Boolean;
var MainCell: TRVTableCellData;
begin
Result := False;
if TopRow+RowSpan>Count then
RowSpan := Count - TopRow;
if LeftCol+ColSpan>Items[TopRow].Count then
ColSpan := Items[TopRow].Count - LeftCol;
if (RowSpan<2) and (ColSpan<2) then exit;
if (RowSpan<1) or (ColSpan<1) then
raise ERichViewError.Create(errMerge);
MainCell := Items[TopRow].Items[LeftCol];
Result := (MainCell<>nil) and
(
(MainCell.RowSpan<RowSpan)
or
(MainCell.ColSpan<ColSpan)
);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.CanMergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
AllowMergeRC: Boolean): Boolean;
var r,c,mr,mc: Integer;
MainCell, Cell: TRVTableCellData;
Flag: Boolean;
{...............................................}
begin
Result := StartMergeCells(TopRow, LeftCol, ColSpan, RowSpan);
if not Result then
exit;
Result := False;
MainCell := GetMainCell(TopRow, LeftCol, mr, mc);
Flag := False;
for r := TopRow to TopRow+RowSpan-1 do
with Items[r] do
for c := LeftCol to LeftCol+ColSpan-1 do begin
if Items[c]<>nil then begin
Cell := Items[c];
mr := r;
mc := c;
end
else
Cell := GetMainCell(r,c,mr,mc);
if (mr<TopRow) or (mc<LeftCol) or
(mr+Cell.RowSpan>TopRow+RowSpan) or
(mc+Cell.ColSpan>LeftCol+ColSpan) then
exit;
if Cell<>MainCell then
Flag := True;
end;
if AllowMergeRC then begin
Result := Flag;
exit;
end;
// testing if merging removes row
if (ColSpan>1) and
IsEmptyRows(0, LeftCol+1, ColSpan-1, TopRow, TopRow+RowSpan, Count-(TopRow+RowSpan)) then
exit;
if (RowSpan>1) and
IsEmptyCols(TopRow+1, 0, LeftCol, RowSpan-1, LeftCol+ColSpan, Items[0].Count-(LeftCol+ColSpan)) then
exit;
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.MergeCells(TopRow, LeftCol, ColSpan, RowSpan: Integer;
AllowMergeRC, ChangeBestWidth: Boolean);
var ItemNo: Integer;
ui: TRVUndoInfo;
begin
if not StartMergeCells(TopRow, LeftCol, ColSpan, RowSpan) then
exit;
if not CanMergeCells(TopRow, LeftCol, ColSpan, RowSpan, AllowMergeRC) then begin
FMainRVData.Beep;
exit;
end;
ItemNo := FTable.GetEditorItemNoForUndo;
ui := Do_BeforeMergeCells(ItemNo, TopRow,LeftCol,ColSpan,RowSpan);
Do_MergeCells(ItemNo, TopRow,LeftCol,ColSpan,RowSpan, ui, ChangeBestWidth);
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetMinColWidth(Col: Integer; sad: PRVScreenAndDevice;
Canvas: TCanvas): Integer;
var i,w: Integer;
begin
Result := 0;
for i := 0 to Count-1 do
if (Items[i].Items[Col]<>nil) and
(Items[i].Items[Col].ColSpan<=1) then begin
w := Items[i].Items[Col].GetMinWidth(sad, Canvas);
if (w>Result) then
Result := w;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.IsPercentWidthColumn(Col: Integer): Boolean;
var i,w,a,b: Integer;
Cell: TRVTableCellData;
begin
for i := 0 to Count-1 do
if (Items[i].Items[Col]<>nil) then begin
if (Items[i].Items[Col].ColSpan<=1) then begin
w := Items[i].Items[Col].BestWidth;
if (w<0) then begin
Result := True;
exit;
end;
end
end
else begin
Cell := GetMainCell(i,Col,a,b);
if (Cell.BestWidth<0) and
(
(Col=Items[i].Count-1) or
(Items[i].Items[Col+1]<>nil) or
(Cell<>GetMainCell(i,Col+1,a,b))
) then begin
Result := True;
exit;
end;
end;
Result := False;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetPercentColWidth(Col, TableWidth: Integer): Integer;
var i,w: Integer;
begin
Result := 0;
for i := 0 to Count-1 do
if (Items[i].Items[Col]<>nil) and
(Items[i].Items[Col].ColSpan<=1) then begin
w := Items[i].Items[Col].BestWidth;
if (w<0) then begin
w := -w*TableWidth div 100;
if (w>Result) then
Result := w;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetPixelColWidth(Col: Integer): Integer;
var i,w: Integer;
begin
Result := 0;
for i := 0 to Count-1 do
if (Items[i].Items[Col]<>nil) and
(Items[i].Items[Col].ColSpan<=1) then begin
w := Items[i].Items[Col].BestWidth;
if w<0 then begin
Result := 0;
exit;
end;
if (w>Result) then
Result := w;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.GetMainCell(ARow, ACol: Integer; var MRow, MCol: Integer): TRVTableCellData;
begin
MRow := ARow;
MCol := ACol;
if Items[MRow][MCol]<>nil then begin
Result := Items[MRow][MCol];
exit;
end;
while True do
with Items[MRow] do begin
while (Items[MCol]=nil) and (MCol>0) do
dec(MCol);
if (Items[MCol]<>nil) and
(Items[MCol].ColSpan>ACol-MCol) and
(Items[MCol].RowSpan>ARow-MRow) then begin
Result := Items[MCol];
exit;
end;
MCol := ACol;
dec(MRow);
//Assert(MRow>=0);
end;
Result := Items[MRow].Items[MCol];
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.MovingFromUndoList(Row, Col, ColSpan,
RowSpan: Integer);
var r,c: Integer;
begin
for r := Row to Row+RowSpan-1 do
with Items[r] do
for c := Col to Col+ColSpan-1 do
if (Items[c]<>nil) then begin
Items[c].FList := Self.Items[r];
Items[c].MovingFromUndoList;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.MovingToUndoList(Row, Col, ColSpan,
RowSpan: Integer; AContainerUndoItem: TRVUndoInfo);
var r,c: Integer;
begin
for r := Row to Row+RowSpan-1 do
with Items[r] do
for c := Col to Col+ColSpan-1 do
if (Items[c]<>nil) then begin
Items[c].MovingToUndoList(AContainerUndoItem);
Items[c].FList := nil;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeInsertRows(ItemNo,Row,Count: Integer);
var ui: TRVUndoInsertTableRows;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
if ItemNo=-1 then
ItemNo := FTable.GetMyItemNo;
ui := TRVUndoInsertTableRows(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoInsertTableRows,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Count := Count;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_InsertRows(Row, Count: Integer);
var r: Integer;
begin
for r := 0 to Count-1 do
Insert(Row, GetColCount);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnInsertRows(Row, Count: Integer);
var r: Integer;
begin
for r := 0 to Count-1 do
Delete(Row);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeInsertCell(ItemNo, Row, Col: Integer);
var ui: TRVUndoInsertTableCell;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
if ItemNo=-1 then
ItemNo := FTable.GetMyItemNo;
ui := TRVUndoInsertTableCell(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoInsertTableCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeSpreadOverEmptyCells(ItemNo, Row, Col,
ColSpan: Integer);
var ui: TRVUndoSpreadOverEmptyCells;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoSpreadOverEmptyCells(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoSpreadOverEmptyCells,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.ColSpan := ColSpan;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_SpreadOverEmptyCells(Row, Col, ColSpan: Integer);
var c: Integer;
begin
Items[Row][Col].FColSpan := ColSpan;
for c := Col+1 to Col+ColSpan-1 do begin
Items[Row][c].Free;
Items[Row][c] := nil;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnSpreadOverEmptyCells(Row, Col, ColSpan: Integer);
var c: Integer;
begin
Items[Row][Col].FColSpan := 1;
for c := Col+1 to Col+ColSpan-1 do begin
//Assert(Items[Row][c]=nil);
Items[Row][c] := TRVTableCellData.Create(Items[Row]);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_SetSpan(ItemNo, Row, Col, Span: Integer;
IsColSpan: Boolean);
var ui: TRVUndoSpan;
begin
if (IsColSpan and (Items[Row][Col].FColSpan = Span)) or
(not IsColSpan and (Items[Row][Col].FRowSpan = Span)) then
exit;
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
if ItemNo=-1 then
ItemNo := FTable.GetMyItemNo;
ui := TRVUndoSpan(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoSpan,
ItemNo, True, IsColSpan));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.IsColSpan := IsColSpan;
if IsColSpan then
ui.OldSpan := Items[Row][Col].ColSpan
else
ui.OldSpan := Items[Row][Col].RowSpan;
end;
end;
if IsColSpan then
Items[Row][Col].FColSpan := Span
else
Items[Row][Col].FRowSpan := Span;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeFreeEmptyCells(ItemNo, Row, Col, ColSpan,
RowSpan: Integer);
var ui: TRVUndoFreeEmptyCell;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoFreeEmptyCell(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoFreeEmptyCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.RowSpan := RowSpan;
ui.ColSpan := ColSpan;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_FreeEmptyCells(Row, Col, ColSpan,
RowSpan: Integer);
var r,c: Integer;
begin
for r := Row to Row+RowSpan-1 do
for c := Col to Col+ColSpan-1 do begin
Items[r][c].Free;
Items[r][c] := nil;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnFreeEmptyCells(Row, Col, ColSpan,
RowSpan: Integer);
var r,c: Integer;
begin
for r := Row to Row+RowSpan-1 do
for c := Col to Col+ColSpan-1 do begin
//Assert(Items[r][c]=nil);
Items[r][c] := TRVTableCellData.Create(Items[r]);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeInsertEmptyCells(ItemNo, Row, Col, ColCount,
RowCount: Integer);
var ui: TRVUndoInsertEmptyCell;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor and (ColCount>0) and (RowCount>0) then begin
ui := TRVUndoInsertEmptyCell(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoInsertEmptyCell,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.RowCount := RowCount;
ui.ColCount := ColCount;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_InsertEmptyCells(Row, Col, ColCount,
RowCount: Integer);
var r,c: Integer;
begin
for r := Row to Row+RowCount-1 do
for c := Col to Col+ColCount-1 do begin
Items[r].InsertEmpty(Col);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnInsertEmptyCells(Row, Col, ColCount,
RowCount: Integer);
var r,c: Integer;
begin
for r := Row to Row+RowCount-1 do
for c := Col to Col+ColCount-1 do begin
Items[r].Delete(Col);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeSplitCellHorz(ItemNo,Row,Col,Row2: Integer; DecreaseHeight: Boolean);
var ui: TRVUndoCellSpitHorz;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoCellSpitHorz(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoCellSpitHorz,
ItemNo, True, False));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Row2 := Row2;
ui.DecreaseHeight := DecreaseHeight;
ui.OldBestHeight := Items[Row][Col].BestHeight;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_SplitCellHorz(Row,Col,Row2: Integer; DecreaseHeight: Boolean);
var MainCell,NewCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
NewCell := TRVTableCellData.Create(Items[Row2]);
NewCell.AssignAttributesFrom(MainCell,True,1,1);
NewCell.FColSpan := MainCell.ColSpan;
NewCell.FRowSpan := Row+MainCell.RowSpan-Row2;
NewCell.FBestHeight := MainCell.BestHeight * NewCell.RowSpan div MainCell.RowSpan;
Items[Row2][Col] := NewCell;
if DecreaseHeight then
MainCell.BestHeight := MainCell.BestHeight * (MainCell.RowSpan-NewCell.RowSpan) div MainCell.RowSpan;
MainCell.FRowSpan := MainCell.RowSpan-NewCell.RowSpan;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnSplitCellHorz(Row,Col,Row2: Integer; OldBestHeight: Integer);
var MainCell,NewCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
NewCell := Items[Row2][Col];
MainCell.BestHeight := OldBestHeight;
inc(MainCell.FRowSpan, NewCell.FRowSpan);
NewCell.Free;
Items[Row2][Col] := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeSplitCellVert(ItemNo, Row, Col,
Col2: Integer; DecreaseWidth: Boolean);
var ui: TRVUndoCellSpitVert;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoCellSpitVert(
AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoCellSpitVert,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Col2 := Col2;
ui.DecreaseWidth := DecreaseWidth;
ui.OldBestWidth := Items[Row][Col].BestWidth;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_SplitCellVert(Row, Col, Col2: Integer;
DecreaseWidth: Boolean);
var MainCell,NewCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
NewCell := TRVTableCellData.Create(Items[Row]);
NewCell.AssignAttributesFrom(MainCell,True,1,1);
NewCell.FRowSpan := MainCell.RowSpan;
NewCell.FColSpan := Col+MainCell.ColSpan-Col2;
NewCell.FBestWidth := MainCell.BestWidth * NewCell.ColSpan div MainCell.ColSpan;
Items[Row][Col2] := NewCell;
if DecreaseWidth then
MainCell.BestWidth := MainCell.BestWidth * (MainCell.ColSpan-NewCell.ColSpan) div MainCell.ColSpan;
MainCell.FColSpan := MainCell.ColSpan-NewCell.ColSpan;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnSplitCellVert(Row, Col, Col2,
OldBestWidth: Integer);
var MainCell,NewCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
NewCell := Items[Row][Col2];
MainCell.BestWidth := OldBestWidth;
inc(MainCell.FColSpan, NewCell.FColSpan);
NewCell.Free;
Items[Row][Col2] := nil;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Do_BeforeDeleteRows(ItemNo, Row, Count: Integer): TRVUndoInfo;
var ui: TRVUndoDeleteRows;
i: Integer;
begin
ui := nil;
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoDeleteRows(AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoDeleteRows,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Count := Count;
ui.Rows := TList.Create;
for i := 0 to Count-1 do
ui.Rows.Add(FTable.Rows[Row+i]);
end;
end;
Result := ui;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_DeleteRows(ItemNo, Row, Count: Integer; ui: TRVUndoInfo);
begin
if ItemNo=-1 then
while Count>0 do begin
Delete(Row);
dec(Count);
end
else begin
MovingToUndoList(Row,0,Items[Row].Count,Count,ui);
while Count>0 do begin
DeleteAsPointer(Row);
dec(Count);
end
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnDeleteRows(Row: Integer; RowList: TList);
var i,c: Integer;
begin
for i := RowList.Count-1 downto 0 do begin
InsertPointer(Row, RowList[i]);
for c := 0 to Items[Row].Count-1 do
if Items[Row][c]<>nil then
Items[Row][c].FList := Items[Row];
end;
MovingFromUndoList(Row,0,Items[Row].Count,RowList.Count);
RowList.Clear;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Do_BeforeDeleteCols(ItemNo, Col, Count: Integer): TRVUndoInfo;
var ui: TRVUndoDeleteCols;
r,c: Integer;
begin
ui := nil;
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoDeleteCols(AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoDeleteCols,
ItemNo, True, True));
if ui<>nil then begin
ui.Col := Col;
ui.Count := Count;
ui.CellsList := TList.Create;
for r := 0 to Self.Count-1 do
for c := Count-1 downto 0 do
ui.CellsList.Add(Items[r][Col+c]);
end;
end;
Result := ui;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_DeleteCols(ItemNo, Col, Count: Integer; ui: TRVUndoInfo);
var r,c: Integer;
begin
if ItemNo=-1 then
for r := 0 to Self.Count-1 do
for c := 0 to Count-1 do
Items[r].Delete(Col)
else begin
MovingToUndoList(0,Col,Count,Self.Count, ui);
for r := 0 to Self.Count-1 do
for c := 0 to Count-1 do
Items[r].DeleteAsPointer(Col);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnDeleteCols(Col: Integer; CellList: TList);
var r,c,idx,DelCount: Integer;
begin
idx := 0;
DelCount := CellList.Count div Self.Count;
for r := 0 to Self.Count-1 do
for c := 0 to DelCount-1 do begin
Items[r].InsertPointer(Col, CellList.Items[idx]);
inc(idx);
end;
MovingFromUndoList(0,Col,DelCount,Self.Count);
CellList.Clear;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Do_BeforeClearCells(ItemNo: Integer; RowList, ColList: TRVIntegerList;
var CellsList: TList): TRVUndoInfo;
var ui: TRVUndoCellsClear;
begin
ui := nil;
CellsList := nil;
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoCellsClear(AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoCellsClear,
ItemNo, True, True));
if ui<>nil then begin
ui.RowList := TRVIntegerList.CreateCopy(RowList);
ui.ColList := TRVIntegerList.CreateCopy(ColList);
ui.CellsList := TList.Create;
CellsList := ui.CellsList;
end;
end;
Result := ui;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_AfterFillingCells(CellsList: TList;
RowList, ColList: TRVIntegerList; ui: TRVUndoInfo);
begin
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_ClearCells(CellsList: TList; RowList, ColList: TRVIntegerList;
ui: TRVUndoInfo);
var i: Integer;
Cell,Cell2: TRVTableCellData;
ChosenCell: TCustomRVData;
begin
for i := 0 to RowList.Count-1 do begin
Cell := Items[RowList[i]][ColList[i]];
if CellsList<>nil then begin
if (FMainRVData is TCustomRVFormattedData) and (TCustomRVFormattedData(FMainRVData).GetChosenRVData<>nil) then
ChosenCell := TCustomRVFormattedData(FMainRVData).GetChosenRVData.GetSourceRVData
else
ChosenCell := nil;
CellsList.Add(Cell);
Cell.Deselect(nil, True);
Cell.State := Cell.State - [rvstCompletelySelected];
Cell.MovingToUndoList(ui);
Cell2 := TRVTableCellData.Create(Items[RowList[i]]);
Items[RowList[i]][ColList[i]] := Cell2;
Cell2.AssignAttributesFrom(Cell,True,1,1);
Cell2.AssignSizeFrom(Cell);
Cell2.FColSpan := Cell.ColSpan;
Cell2.FRowSpan := Cell.RowSpan;
if ChosenCell=Cell then
TCustomRVFormattedData(FMainRVData).SilentReplaceChosenRVData(Cell2);