RichEdit

开发平台：

Delphi

RVTable.pas：源码内容

begin
if ((FSelStartRow<0) or (FSelStartCol<0)) and
(rvtsSelExists in FState) then begin
Exclude(FState, rvtsSelExists);
TCustomRVFormattedData(FRows.FMainRVData).ReleaseMouseCapture(Self);
if (TCustomRVFormattedData(FRows.FMainRVData).GetChosenRVData<>nil) then
TCustomRVFormattedData(FRows.FMainRVData).SilentReplaceChosenRVData(nil);
FMakingSelection := False;
end;
if not (rvtsSelExists in FState) then begin
if IncludeEditedCell and (FInplaceEditor<>nil) then begin
TopRow := TRVTableInplaceEdit(FInplaceEditor).FRow;
LeftCol := TRVTableInplaceEdit(FInplaceEditor).FCol;
Cell := Cells[TopRow,LeftCol];
ColSpan := Cell.ColSpan;
RowSpan := Cell.RowSpan;
Result := True;
exit;
end
else
Result := False;
exit;
end;
Cell := Rows.GetMainCell(FSelStartRow,FSelStartCol,TopRow,LeftCol);
ColSpan := LeftCol+Cell.ColSpan-1;
RowSpan := TopRow+Cell.RowSpan-1;
Cell := Rows.GetMainCell(FSelStartRow+FSelRowOffs,
FSelStartCol+FSelColOffs,
r,c);
if r<TopRow then
TopRow := r;
if c<LeftCol then
LeftCol := c;
if r+Cell.RowSpan-1>RowSpan then
RowSpan := r+Cell.RowSpan-1;
if c+Cell.ColSpan-1>ColSpan then
ColSpan := c+Cell.ColSpan-1;
dec(ColSpan, LeftCol-1);
dec(RowSpan, TopRow-1);
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UpdateCellSel;
var r,c: Integer;
begin
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if Items[c]<>nil then begin
if IsCellSelected(r,c) then
Include(Items[c].State, rvstCompletelySelected)
else begin
if not ({not CanChange and} (r=FSelStartRow) and (c=FSelStartCol)) then
Items[c].Deselect(nil, True);
Exclude(Items[c].State, rvstCompletelySelected);
end;
end;
{$IFNDEF RVDONOTUSEANIMATION}
if Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeselectPartial;
begin
Deselect;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.PartiallySelected: Boolean;
begin
Result := rvtsSelExists in FState;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.AdjustInserted(x, y: Integer; adjusty: Boolean);
var r,c: Integer;
begin
if (FInplaceEditor<>nil) and
(TRVTableInplaceEdit(FInplaceEditor).FCell<>nil) then
with TRVTableInplaceEdit(FInplaceEditor).FCell do begin
FInplaceEditor.Tag := y+Top+GetExtraVOffs;
SetInplaceBounds(x+Left, RV_GetYByTag(FInplaceEditor), Width, Height-GetExtraVOffs);
FInplaceEditor.RVData.Format_(True,False,False,0,FInplaceEditor.Canvas,
False,False,False);
end;
MyClientLeft := x;
MyClientTop := y;
for r := 0 to Rows.Count-1 do begin
with Rows[r] do
for c := 0 to Count-1 do
if Items[c]<>nil then
Items[c].AdjustChildrenCoords;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.OwnsControl(AControl: TControl): Boolean;
var r,c,i: Integer;
begin
Result := GetCellWhichOwnsControl(AControl, r,c,i);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.OwnsInplaceEditor(AEditor: TControl): Boolean;
begin
Result := FInplaceEditor=AEditor;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCellWhichOwnsControl(AControl: TControl; var ARow,ACol,AItemNo: Integer): Boolean;
var r,c: Integer;
begin
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) then begin
AItemNo := Items[c].GetRVData.FindControlItemNo(AControl);
if (AItemNo<>-1) then begin
ARow := r;
ACol := c;
Result := True;
exit;
end;
end;
Result := False;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MergeInplaceUndo(DestroyLists: Boolean);
{........................................................}
procedure AddList(var List: TRVUndoList; DestList: TRVUndoList; IsRedo: Boolean);
var ui: TRVUndoCellModify;
UndoLimit: Integer;
begin
// DestList.PopIfEmpty;
if List.Count>0 then begin
UndoLimit := List.Limit;
if IsRedo then
TRVEditRVData(FRows.FMainRVData).BeginRedoSequence(rvutModifyItem,'')
else
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, False);
ui := TRVUndoCellModify.Create;
ui.Row := TRVTableInplaceEdit(FInplaceEditor).FRow;
ui.Col := TRVTableInplaceEdit(FInplaceEditor).FCol;
ui.CaretItemNo := FInplaceEditor.CurItemNo;
ui.CaretOffs := FInplaceEditor.OffsetInCurItem;
ui.UndoList := List;
ui.Action := rvuModifyItem;
ui.ItemNo := GetEditorItemNoForUndo;
ui.IsRedo := IsRedo;
DestList.AddInfo(ui);
TRVUndoInfos(DestList.Items[DestList.Count-1]).CaretItemNo := TRVUndoInfos(List.Items[List.Count-1]).CaretItemNo;
TRVUndoInfos(DestList.Items[DestList.Count-1]).CaretOffs := TRVUndoInfos(List.Items[List.Count-1]).CaretOffs;
if DestroyLists then
List := nil
else begin
List := TRVUndoList.Create(DestList.FRVData);
List.Limit := UndoLimit;
end;
end
else
DestList.PopIfEmpty;
end;
{........................................................}
begin
if FInplaceEditor=nil then
exit;
AddList(TRVEditRVData(FInplaceEditor.RVData).UndoList,
TRVEditRVData(FRows.FMainRVData).UndoList, False);
AddList(TRVEditRVData(FInplaceEditor.RVData).RedoList,
TRVEditRVData(FRows.FMainRVData).RedoList, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceDeleted(Clearing: Boolean);
var Clr: Boolean;
strg: TRVTableInplaceParamStorage;
Cell: TCustomRVFormattedData;
RVData: TRichViewRVData;
Row, Col: Integer;
ie: TCustomRichViewEdit;
begin
Clr := Clearing or (rvstClearing in TCustomRVFormattedData(Rows.FMainRVData).State) or
not FRows.FMainRVData.GetParentControl.HandleAllocated;
MergeInplaceUndo(True);
Cell := TRVTableInplaceEdit(FInplaceEditor).FCell;
Row := TRVTableInplaceEdit(FInplaceEditor).FRow;
Col := TRVTableInplaceEdit(FInplaceEditor).FCol;
StoreRVSelection(FInplaceEditor.RVData, strg);
Cell.DrainFrom(FInplaceEditor.RVData);
if not Clr then begin
TCustomRVFormattedData(Rows.FMainRVData).GetItemClientCoords(GetMyItemNo,MyClientLeft,MyClientTop);
ie := FInplaceEditor;
FInplaceEditor := nil;
Cell.Format(False);
FInplaceEditor := ie;
RestoreRVSelection(Cell, strg);
end;
FInplaceEditor := nil;
if not Clr then begin
TRVEditRVData(Rows.FMainRVData).Invalidate;
TCustomRichViewEdit(TRichViewRVData(Rows.FMainRVData.GetRootData).RichView).AfterCaretMove;
RVData := FRows.FMainRVData.GetRootData as TRichViewRVData;
if IsInEditor and TCustomRichViewEdit(RVData.RichView).ReadOnly then
TRVEditRVData(RVData).BuildJumpsCoords(True);
end;
if Assigned(FOnCellEndEdit) then
FOnCellEndEdit(Self, Row, Col, Clr);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MovingToUndoList(ItemNo: Integer;
RVData, AContainerUndoItem: TObject);
begin
DestroyInplace(False);
if Rows.Count>0 then
Rows.MovingToUndoList(0,0,Rows[0].Count,Rows.Count, TRVUndoInfo(AContainerUndoItem));
Rows.FMainRVData := nil;
inherited MovingToUndoList(ItemNo, RVData, AContainerUndoItem);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MovingFromUndoList(ItemNo: Integer;
RVData: TObject);
begin
Rows.FMainRVData := TCustomRVData(RVData);
if Rows.Count>0 then
Rows.MovingFromUndoList(0,0,Rows[0].Count,Rows.Count);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.FinalizeUndoGroup;
begin
MergeInplaceUndo(False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorChange(Sender: TCustomRichViewEdit; ClearRedo: Boolean);
var FullReformat: Boolean;
nwp: Integer;
L,T,W,H: Integer;
begin
if not (rvtsInplaceIsReformatting in FState) and
(FInplaceEditor<>nil) and TRVTableInplaceEdit(FInplaceEditor).Resized then begin
Fmt.FWidth := 0;
Include(FState, rvtsInplaceIsReformatting);
L := FInplaceEditor.Left;
T := FInplaceEditor.Top;
W := FInplaceEditor.Width;
H := FInplaceEditor.Height;
try
nwp := FInplaceEditor.RVData.CalculateMinDocWidthPlus(nil,nil);
FullReformat := FInplaceMinWidthPlus<>nwp;
if FullReformat then begin
FInplaceMinWidthPlus := nwp;
nwp := TCustomRVFormattedData(Rows.FMainRVData).CalculateMinItemWidthPlusEx(GetMyItemNo);
FullReformat := (nwp<>FMinWidthPlus) and
((nwp>TCustomRVFormattedData(Rows.FMainRVData).DocumentWidth) or
(FMinWidthPlus>=TCustomRVFormattedData(Rows.FMainRVData).DocumentWidth));
FMinWidthPlus := nwp;
end;
TRVEditRVData(Rows.FMainRVData).Reformat(FullReformat, False, True,
GetMyItemNo,
False);
finally
TRVTableInplaceEdit(FInplaceEditor).Resized;
Exclude(FState, rvtsInplaceIsReformatting);
end;
if (L<>FInplaceEditor.Left) or (T<>FInplaceEditor.Top) or
(W<>FInplaceEditor.Width) or (H<>FInplaceEditor.Height) then
TCustomRVFormattedData(Rows.FMainRVData).Refresh;
end;
ChangeEx(ClearRedo);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DestroyInplace(ReformatCell:Boolean);
begin
if FInplaceEditor<>nil then begin
if csDestroying in FInplaceEditor.ComponentState then
exit;
if False and TRVTableInplaceEdit(FInplaceEditor).Busy then
raise ERVTableInplaceError.Create(errInplaceBusy);
if not ReformatCell then
TRVTableInplaceEdit(FInplaceEditor).SetClearingState
else
TCustomRVFormattedData(FRows.FMainRVData).UnassignChosenRVData(TRVTableInplaceEdit(FInplaceEditor).FCell);
FInplaceEditor.Free;
FInplaceEditor := nil;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.StartSelecting(Row,Col: Integer):Boolean;
begin
Result := False;
if not (rvoAllowSelection in Rows.FMainRVData.Options) or
(rvtoNoCellSelect in Options) then
exit;
FSelStartCol := Col;
FSelStartRow := Row;
FSelColOffs := 0;
FSelRowOffs := 0;
Exclude(FState, rvtsSelExists);
TCustomRVFormattedData(FRows.FMainRVData).PartialSelectedItem := Self;
TCustomRVFormattedData(FRows.FMainRVData).SetMouseCapture(Self,MyLeft,MyTop);
UpdateCellSel;
FMakingSelection := True;
Result := True;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpDrawingChangesFont, rvbpCanSaveUnicode,
rvbpAlwaysInText, rvbpHasSubRVData, rvbpNoHTML_P:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpPrintToBMP:
Result := False;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.StoreRVSelection(RVData: TCustomRVFormattedData;
var storage: TRVTableInplaceParamStorage);
begin
with storage do begin
RVData.GetSelectionBoundsEx(StartNo, StartOffs, EndNo, EndOffs, False);
PartialSelected := RVData.PartialSelectedItem;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.RestoreRVSelection(RVData: TCustomRVFormattedData;
const storage: TRVTableInplaceParamStorage);
begin
with storage do begin
RVData.SetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs);
if PartialSelected<>nil then
RVData.PartialSelectedItem := PartialSelected;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SaveInplace;
begin
if FInplaceEditor<>nil then begin
if TRVTableInplaceEdit(FInplaceEditor).Busy then
raise ERVTableInplaceError.Create(errInplaceBusy);
StoreRVSelection(FInplaceEditor.RVData, FStoredInplace);
FStoredInplace.Row := TRVTableInplaceEdit(FInplaceEditor).FRow;
FStoredInplace.Col := TRVTableInplaceEdit(FInplaceEditor).FCol;
FStoredInplace.Stored := True;
DestroyInplace(True);
end
else begin
// FStoredInplace.Stored := False;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.RestoreInplace;
begin
if FStoredInplace.Stored then begin
CreateInplace(-1, FStoredInplace.Row, FStoredInplace.Col, False, True, False, False, True);
if FInplaceEditor=nil then
exit;
RestoreRVSelection(FInplaceEditor.RVData, FStoredInplace);
FInplaceEditor.Invalidate;
FStoredInplace.Stored := False;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorCaretGetout(Sender: TCustomRichViewEdit;
Direction: TRVGetOutDirection);
var Dir: TRVCellDirection;
begin
Dir := TRVCellDirection(ord(Direction));
PostMessage(FInplaceEditor.Handle, WM_RVMOVEEDITOR, ord(Dir), 0);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorControlAction(Sender: TCustomRichView;
ControlAction: TRVControlAction; ItemNo: Integer; var ctrl: TControl);
begin
Rows.FMainRVData.ControlAction2(ControlAction,
TRVTableInplaceEdit(FInplaceEditor).FTableItemNo, ctrl);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorMouseDown(Sender: TCustomRichView;
Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
var p: TPoint;
data: TRVMouseUpDownMessageData;
begin
if (Rows.FMainRVData is TCustomRVFormattedData) then begin
p := FInplaceEditor.ClientToScreen(Point(X,Y));
p := TCustomRVFormattedData(Rows.FMainRVData).GetParentControl.ScreenToClient(p);
data := TRVMouseUpDownMessageData.Create;
data.Event := rvetRVMouseDown;
data.X := p.X;
data.Y := p.Y;
data.ItemNo := GetItemNoInRootDocument;
data.Shift := Shift;
data.Button := Button;
PostMessage(TCustomRVFormattedData(Rows.FMainRVData).GetParentControl.Handle,
WM_RVEVENT, Integer(data), 0);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorMouseUp(Sender: TCustomRichView;
Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
var p: TPoint;
data: TRVMouseUpDownMessageData;
begin
if (Rows.FMainRVData is TCustomRVFormattedData) then begin
p := FInplaceEditor.ClientToScreen(Point(X,Y));
p := TCustomRVFormattedData(Rows.FMainRVData).GetParentControl.ScreenToClient(p);
data := TRVMouseUpDownMessageData.Create;
data.Event := rvetRVMouseUp;
data.X := p.X;
data.Y := p.Y;
data.ItemNo := GetItemNoInRootDocument;
data.Shift := Shift;
data.Button := Button;
PostMessage(TCustomRVFormattedData(Rows.FMainRVData).GetParentControl.Handle,
WM_RVEVENT, Integer(data), 0);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var editor: TCustomRichViewEdit;
begin
editor := TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData).RichView);
if Assigned(editor.OnMouseMove) then
editor.OnMouseMove(editor, Shift, X+TControl(Sender).Left, Y+TControl(Sender).Top);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var editor: TCustomRichViewEdit;
begin
editor := TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData).RichView);
if Assigned(editor.OnDragOver) then
editor.OnDragOver(editor, Source, X+TControl(Sender).Left, Y+TControl(Sender).Top, State, Accept);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InplaceEditorDragDrop(Sender, Source: TObject; X, Y: Integer);
var editor: TCustomRichViewEdit;
begin
editor := TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData).RichView);
if Assigned(editor.OnDragDrop) then
editor.OnDragDrop(editor, Source, X+TControl(Sender).Left, Y+TControl(Sender).Top);
end;
{------------------------------------------------------------------------------}
type
TD = class (TComponent)
private
FCellCount: Integer;
FRVTableSW: TComponent;
protected
procedure Loaded; override;
public
FCell: TRVTableCellData;
constructor Create(AOwner: TComponent); override;
procedure DecRef;
published
property C: TRVTableCellData read FCell write FCell;
end;
TRVTableSW = class (TComponent)
public
FTable: TRVTableItemInfo;
FTD: TD;
protected
procedure DefineProperties(Filer: TFiler); override;
procedure RowVAlignWriter(Writer: TWriter);
procedure RowVAlignReader(Reader: TReader);
function RowVAlignHasData: Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property T: TRVTableItemInfo read FTable write FTable;
end;
constructor TD.Create(AOwner: TComponent);
begin
inherited;
FCellCount := 1;
end;
procedure TD.Loaded;
begin
inherited;
DecRef;
end;
procedure TD.DecRef;
begin
dec(FCellCount);
if FCellCount=0 then
FRVTableSW.Free;
end;
constructor TRVTableSW.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTD := TD.Create(nil);
FTD.FRVTableSW := Self;
end;
destructor TRVTableSW.Destroy;
begin
FTD.Free;
inherited Destroy;
end;
function TRVTableSW.RowVAlignHasData: Boolean;
var r, count: Integer;
begin
Result := False;
if T.StreamSaveHeadingRows then begin
count := T.HeadingRowCount;
if count>T.Rows.Count then
count := T.Rows.Count;
for r := 0 to count-1 do
if T.Rows[r].VAlign<>rvcTop then begin
Result := True;
exit;
end;
end;
for r := T.StreamStartRow to T.StreamStartRow+T.StreamSaveRowCount-1 do
if T.Rows[r].VAlign<>rvcTop then begin
Result := True;
exit;
end;
end;
procedure TRVTableSW.RowVAlignReader(Reader: TReader);
var r: Integer;
begin
Reader.ReadListBegin;
for r := 0 to T.Rows.Count-1 do
T.Rows[T.StreamStartRow+r].VAlign := TRVCellVAlign(Reader.ReadInteger);
Reader.ReadListEnd;
end;
procedure TRVTableSW.RowVAlignWriter(Writer: TWriter);
var r, count: Integer;
begin
Writer.WriteListBegin;
if T.StreamSaveHeadingRows then begin
count := T.HeadingRowCount;
if count>T.Rows.Count then
count := T.Rows.Count;
for r := 0 to count-1 do
Writer.WriteInteger(Integer(T.Rows[r].VAlign));
end;
for r := T.StreamStartRow to T.StreamStartRow+T.StreamSaveRowCount-1 do
Writer.WriteInteger(Integer(T.Rows[r].VAlign));
Writer.WriteListEnd;
end;
procedure TRVTableSW.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('C', T.CellsReader, T.CellsWriter, True);
Filer.DefineProperty('RowVAlign', RowVAlignReader, RowVAlignWriter, RowVAlignHasData);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo, ParaNo: Integer; const Name: String; Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
var SaveType, LineCount: Integer;
StreamWrapper: TRVTableSW;
begin
LineCount := 3+GetRVFExtraPropertyCount;
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, LineCount,
RVFSavePara(TCustomRVData(RVData).GetRVStyle,
rvfoUseStyleNames in TCustomRVData(RVData).RVFOptions,
ParaNo),
Byte(ItemOptions) and RVItemOptionsMask,
SaveType,
RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
SaveRVFHeaderTail(RVData)]));
RVFWriteLine(Stream, Name);
SaveRVFExtraProperties(Stream);
RVFWriteLine(Stream, '1');
StreamWrapper := TRVTableSW.Create(nil);
try
if (Part=nil) or not (Part is TRVTablePrintPart) then begin
StreamSaveHeadingRows := False;
StreamStartRow := 0;
StreamSaveRowCount := Rows.Count;
end
else begin
StreamSaveHeadingRows := True;
StreamStartRow := TRVTablePrintPart(Part).StartRow;
StreamSaveRowCount := TRVTablePrintPart(Part).RowCount;
end;
StreamWrapper.T := Self;
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
RVFSaveControlBinary(Stream, StreamWrapper)
else
RVFWriteLine(Stream, RVFSaveControl(StreamWrapper));
finally
StreamWrapper.Free;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.ReadRVFLine(const s: String; RVData: TPersistent;
ReadType, LineNo, LineCount: Integer; var Name: String; var ReadMode: TRVFReadMode;
var ReadState: TRVFReadState): Boolean;
var StreamWrapper: TRVTableSW;
begin
Result := True;
if LineNo=0 then begin
Name := s;
exit;
end;
case LineCount-LineNo of
2:
begin
// do nothing; this line contains version of table stream format; currently '1'
if ReadType=2 then
ReadMode := rmBeforeBinary;
end;
1:
begin
StreamWrapper := TRVTableSW.Create(nil);
try
StreamWrapper.T := Self;
StreamStartRow := 0;
if ReadType=2 then
Result := RVFLoadControlBinary(s, TComponent(StreamWrapper), '', nil)
else
Result := RVFLoadControl(s, TComponent(StreamWrapper), '', nil);
ReadState := rstSkip;
finally
StreamWrapper.FTD.DecRef;
end;
end;
else
SetExtraPropertyFromRVFStr(s);
end;
end;
{------------------------------------------------------------------------------}
// rvtsJustCreated is set in constructor. This method is called just after
// constructor when loading table from RTF or RVF.
procedure TRVTableItemInfo.BeforeLoading(FileFormat: TRVLoadFormat);
begin
if FileFormat in [rvlfRVF, rvlfRTF, rvlfOther] then
Exclude(FState, rvtsJustCreated);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSELISTS}
// This function is used to update list of marker when table is inserted from
// RVF or RTF
// When inserting nested tables, this method is called only for root table
// See also comments to Inserted
procedure TRVTableItemInfo.AfterLoading(FileFormat: TRVLoadFormat);
var r,c,i: Integer;
begin
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then
with Cells[r,c].GetRVData do
for i := 0 to Items.Count-1 do begin
AddMarkerInList(i);
GetItem(i).AfterLoading(FileFormat);
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure ReadError;
begin
raise EReadError.Create(errReadCells);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.CellsReader(Reader: TReader);
var r,c, RowCount, ColCount, colspan,rowspan: Integer;
CellWrapper:TD;
begin
ClearTemporal;
RowCount := Reader.ReadInteger;
if RowCount=0 then begin
Rows.Reset(0,0);
exit;
end;
ColCount := Reader.ReadInteger;
if StreamStartRow=0 then
Rows.Reset(RowCount,ColCount)
else
if ColCount>Rows[0].Count then
ReadError;
Reader.ReadListBegin;
CellWrapper := (Reader.Root as TRVTableSW).FTD;
for r := StreamStartRow to StreamStartRow+RowCount-1 do
for c := 0 to ColCount-1 do
if Cells[r,c]<>nil then begin
if Reader.EndOfList then
ReadError;
colspan := Reader.ReadInteger;
rowspan := Reader.ReadInteger;
Rows.MergeCells(r,c,colspan,rowspan,True,True);
CellWrapper.C := Cells[r,c];
Reader.ReadComponent(CellWrapper);
inc(CellWrapper.FCellCount);
end;
if not Reader.EndOfList then
ReadError;
Reader.ReadListEnd;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.CellsWriter(Writer: TWriter);
var CellWrapper:TD;
r, count: Integer;
{........................................................}
procedure WriteRow(r: Integer);
var c: Integer;
begin
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
CellWrapper.C := Cells[r,c];
Writer.WriteInteger(CellWrapper.C.ColSpan);
Writer.WriteInteger(CellWrapper.C.RowSpan);
Writer.WriteComponent(CellWrapper);
end;
end;
{........................................................}
begin
StartExport;
try
if StreamSaveHeadingRows then begin
count := HeadingRowCount;
if count>Rows.Count then
count := Rows.Count;
end
else
count := 0;
Writer.WriteInteger(StreamSaveRowCount+count);
if StreamSaveRowCount+count>0 then begin
Writer.WriteInteger(Rows[0].Count);
Writer.WriteListBegin;
CellWrapper := (Writer.Root as TRVTableSW).FTD;
for r := 0 to count-1 do
WriteRow(r);
for r := StreamStartRow to StreamStartRow+StreamSaveRowCount-1 do
WriteRow(r);
Writer.WriteListEnd;
end;
finally
EndExport;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer;
Preview, Correction: Boolean; const sad: TRVScreenAndDevice;
RichView: TRVScroller; dli: TRVDrawLineInfo;
Part: Integer; ColorMode: TRVColorMode; RVData: TPersistent);
var State: TRVItemDrawStates;
TablePart : TRVTablePrintPart;
StartRow, RowCount: Integer;
UHRC: Boolean;
begin
if Part>=0 then begin
TablePart := TRVTablePrintPart((dli as TRVTablePrintInfo).PartsList[Part]);
StartRow := TablePart.StartRow;
RowCount := TablePart.RowCount;
UHRC := TRVTablePrintInfo(dli).FUseHeadingRowCount;
end
else begin
StartRow := 0;
RowCount := Rows.Count;
UHRC := False;
end;
State := [rvidsPrinting];
if Preview then
Include(State, rvidsPreview);
if Correction then
Include(State, rvidsPreviewCorrection);
cursad := @(TRVTablePrintInfo(dli).sad);
try
PaintTo(x,x2,y, StartRow, RowCount, Canvas, State, nil,
TRVTablePrintInfo(dli).Fmt, UHRC,
Rect(x,y,x+TRVTablePrintInfo(dli).Fmt.FWidth,y+TRVTablePrintInfo(dli).Fmt.FHeight),
ColorMode, TCustomPrintableRVData(RVData));
finally
cursad := nil;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CreatePrintingDrawItem(RVData: TObject; const sad: TRVScreenAndDevice): TRVDrawLineInfo;
var r,c: Integer;
item : TCellPtblRVData;
data: TCustomRVFormattedData;
Cell: TRVTableCellData;
begin
Result := TRVTablePrintInfo.Create(Self);
TRVTablePrintInfo(Result).sad := sad;
TRVTablePrintInfo(Result).Fmt.Rows.Capacity := Rows.Count*Rows[0].Count;
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do begin
Cell := Cells[r,c];
if (Cell<>nil) then begin
data := TCustomRVFormattedData(Cell.GetRVData);
if (Cell.ColSpan=1) and (Cell.RowSpan=1) and not Cell.HasData(True) then
data := nil;
if data<>nil then begin
item := TCellPtblRVData.Create(
(TCustomRVData(RVData).GetRootData as TCustomMainPtblRVData).RichView,
data, RVData as TCustomPrintableRVData);
item.FColor := GetCellColor(Cell);
item.ParentDrawsBack := True;
item.Transparent := Cell.IsTransparent;
end
else
item := nil;
end
else
item := nil;
TRVTablePrintInfo(Result).Fmt.Rows.Add(item);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DrawBackgroundForPrinting(Canvas: TCanvas;
const Rect, FullRect: TRect; ColorMode: TRVColorMode; ItemBackgroundLayer: Integer);
var Clr: TColor;
r: TRect;
begin
if ItemBackgroundLayer=0 then
exit;
if FColor=clNone then
Clr := clNone
else if (rvtoWhiteBackground in PrintOptions) then
Clr := clWhite
else
Clr := RV_GetBackColor(FColor, ColorMode);
if FBackground<>nil then begin
FBackground.Draw(Canvas, Rect, 0, 0, FullRect.Left, FullRect.Top,
FullRect.Right-FullRect.Left, FullRect.Bottom-FullRect.Top, Clr, False);
end
else if Clr<>clNone then begin
Canvas.Brush.Color := Clr;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect);
end;
if (ItemBackgroundLayer=1) or (FPrintCell=nil) then
exit;
if FPrintCell.Color=clNone then
Clr := clNone
else if (rvtoWhiteBackground in PrintOptions) then
Clr := clWhite
else
Clr := RV_GetBackColor(FPrintCell.Color, ColorMode);
if FPrintCell.FBackground<>nil then begin
r := FPrintCellRect;
OffsetRect(r, -Rect.Left+FullRect.Left, -Rect.Top+FullRect.Top);
FPrintCell.FBackground.Draw(Canvas, Rect, 0, 0, r.Left, r.Top,
r.Right-r.Left, r.Bottom-r.Top, Clr, True);
end
else if Clr<>clNone then begin
Canvas.Brush.Color := Clr;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetDevX(x: Integer): Integer;
begin
if cursad=nil then
Result := x
else
Result := MulDiv(x, cursad.ppixDevice, cursad.ppixScreen);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetDevY(y: Integer): Integer;
begin
if cursad=nil then
Result := y
else
Result := MulDiv(y, cursad.ppiyDevice, cursad.ppiyScreen);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.LoadFromStreamEx(Stream: TStream; StartRow: Integer);
var StreamWrapper :TRVTableSW;
begin
StreamStartRow := StartRow;
StreamWrapper := TRVTableSW.Create(nil);
try
StreamWrapper.T := Self;
Stream.ReadComponent(StreamWrapper);
finally
StreamWrapper.FTD.DecRef;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.LoadFromStream(Stream: TStream);
begin
LoadFromStreamEx(Stream, 0);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SaveRowsToStream(Stream: TStream; Index,
Count: Integer);
var StreamWrapper :TRVTableSW;
begin
StreamSaveHeadingRows := False;
StreamStartRow := Index;
StreamSaveRowCount := Count;
StreamWrapper := TRVTableSW.Create(nil);
try
StreamWrapper.T := Self;
Stream.WriteComponent(StreamWrapper);
finally
StreamWrapper.Free;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SaveToStream(Stream: TStream);
begin
SaveRowsToStream(Stream, 0, Rows.Count);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.StartExport;
begin
inc(BusyCount);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.EndExport;
begin
dec(BusyCount);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Inserting(RVData: TObject; var Text: String; Safe: Boolean);
var r,c: Integer;
begin
Rows.FMainRVData := TCustomRVData(RVData);
if RVData<>nil then
Include(FState, rvtsInserted)
else
Exclude(FState, rvtsInserted);
if (rvtsInserted in FState) and (TCustomRVData(RVData).GetRootData is TRVEditRVData) then
Include(FState, rvtsEditMode)
else
Exclude(FState, rvtsEditMode);
for r := 0 to Rows.Count-1 do begin
for c := 0 to Rows[r].Count-1 do
if (Cells[r,c]<>nil) then begin
if Cells[r,c].ItemCount=0 then
Cells[r,c].AddNL('',0,0);
Cells[r,c].FList := Rows[r];
Cells[r,c].Inserting(Cells[r,c], Safe);
end;
end;
inherited Inserting(RVData, Text, Safe);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSELISTS}
// This method is called after the table is inserted in RVData.
// We processing only the first direct inserting
// For RVF and RTF, we use AfterLoading
procedure TRVTableItemInfo.Inserted(RVData: TObject; ItemNo: Integer);
var r,c,i: Integer;
CellRVData: TCustomRVData;
Location: TRVStoreSubRVData;
begin
inherited;
if not (rvtsJustCreated in FState) then
exit;
// May be this table was inserted in table that was not inserted yet?
// If yes, exiting (this procedure will be called later again recursively when
// the parent table will be inserted).
if not (rvflRoot in TCustomRVData(RVData).Flags) then begin
TCustomRVData(RVData).GetParentInfo(i, Location);
Location.Free;
if i<0 then
exit;
end;
try
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
CellRVData := Cells[r,c].GetRVData;
for i := 0 to CellRVData.Items.Count-1 do begin
CellRVData.AddMarkerInList(i);
CellRVData.GetItem(i).Inserted(CellRVData, i);
end;
end;
finally
Exclude(FState, rvtsJustCreated);
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.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 TRVTableItemInfo.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;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineBinaryProperty('BackgroundImg', BackgroundImageReader, BackgroundImageWriter,
(FBackground<>nil) and not FBackground.Empty);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetBestWidth(const Value: TRVHTMLLength);
begin
if rvtsInserted in FState then
SetProperty('BestWidth', ord(Value), True, True)
else
FBestWidth := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetBorderColor(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('BorderColor', ord(Value), False, False)
else
FBorderColor := Value;
end;
procedure TRVTableItemInfo.SetBorderHSpacing(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('BorderHSpacing', ord(Value), True, True)
else
FBorderHSpacing := Value;
end;
procedure TRVTableItemInfo.SetBorderLightColor(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('BorderLightColor', ord(Value), False, False)
else
FBorderLightColor := Value;
end;
procedure TRVTableItemInfo.SetBorderStyle(const Value: TRVTableBorderStyle);
begin
if rvtsInserted in FState then
SetProperty('BorderStyle', ord(Value), False, False)
else
FBorderStyle := Value;
end;
procedure TRVTableItemInfo.SetBorderVSpacing(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('BorderVSpacing', ord(Value), True, False)
else
FBorderVSpacing := Value;
end;
procedure TRVTableItemInfo.SetBorderWidth(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('BorderWidth', ord(Value), True, True)
else
FBorderWidth := Value;
end;
procedure TRVTableItemInfo.SetCellBorderColorProp(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('CellBorderColor', ord(Value), False, False)
else
FCellBorderColor := Value;
end;
procedure TRVTableItemInfo.SetCellBorderLightColorProp(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('CellBorderLightColor', ord(Value), False, False)
else
FCellBorderLightColor := Value;
end;
procedure TRVTableItemInfo.SetCellBorderWidth(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('CellBorderWidth', ord(Value), True, True)
else
FCellBorderWidth := Value;
end;
procedure TRVTableItemInfo.SetCellHSpacing(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('CellHSpacing', ord(Value), True, True)
else
FCellHSpacing := Value;
end;
procedure TRVTableItemInfo.SetCellPadding(const Value: Integer);
begin
if FInplaceEditor<>nil then begin
FInplaceEditor.LeftMargin := Value;
FInplaceEditor.TopMargin := Value;
FInplaceEditor.RightMargin := Value;
FInplaceEditor.BottomMargin := Value;
Include(FState, rvtsFormatInplace);
end;
if rvtsInserted in FState then
SetProperty('CellPadding', ord(Value), True, True)
else
FCellPadding := Value;
end;
procedure TRVTableItemInfo.SetCellVSpacing(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('CellVSpacing', ord(Value), True, False)
else
FCellVSpacing := Value;
end;
procedure TRVTableItemInfo.SetColor(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('Color', ord(Value), False, False)
else
FColor := Value;
if FInplaceEditor<>nil then begin
FInplaceEditor.Color := GetCellColor(TRVTableInplaceEdit(FInplaceEditor).FCell);
TRVTableInplaceEdit(FInplaceEditor).Transparent :=
CanSeeBackgroundThroughCell(TRVTableInplaceEdit(FInplaceEditor).FCell);
end;
{$IFNDEF RVDONOTUSEANIMATION}
if Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
procedure TRVTableItemInfo.SetHeadingRowCount(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('HeadingRowCount', ord(Value), False, False)
else
FHeadingRowCount := Value;
end;
procedure TRVTableItemInfo.SetHOutermostRule(const Value: Boolean);
begin
if rvtsInserted in FState then
SetProperty('HOutermostRule', ord(Value), False, False)
else
FHOutermostRule := Value;
end;
procedure TRVTableItemInfo.SetHRuleColor(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('HRuleColor', ord(Value), False, False)
else
FHRuleColor := Value;
end;
procedure TRVTableItemInfo.SetHRuleWidth(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('HRuleWidth', ord(Value), False, False)
else
FHRuleWidth := Value;
end;
procedure TRVTableItemInfo.SetVOutermostRule(const Value: Boolean);
begin
if rvtsInserted in FState then
SetProperty('VOutermostRule', ord(Value), False, False)
else
FVOutermostRule := Value;
end;
procedure TRVTableItemInfo.SetVRuleColor(const Value: TColor);
begin
if rvtsInserted in FState then
SetProperty('VRuleColor', ord(Value), False, False)
else
FVRuleColor := Value;
end;
procedure TRVTableItemInfo.SetVRuleWidth(const Value: Integer);
begin
if rvtsInserted in FState then
SetProperty('VRuleWidth', ord(Value), False, False)
else
FVRuleWidth := Value;
end;
procedure TRVTableItemInfo.SetCellBorderStyle(
const Value: TRVTableBorderStyle);
begin
if rvtsInserted in FState then
SetProperty('CellBorderStyle', ord(Value), False, False)
else
FCellBorderStyle := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellProperty(ItemNo: Integer; const PropertyName: String;
Value: LongInt; Row, Col: Integer; AffectSize, AffectWidth: Boolean);
var fi:Boolean;
ui: TRVUndoModifyCellIntProperty;
begin
if (rvtsInserted in FState) and IsInEditor then
try
Exclude(FState, rvtsInserted);
if ItemNo=-1 then
ItemNo := GetMyItemNo;
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVEditRVData(FRows.FMainRVData).Do_ModifyItemIntProperty(
ItemNo, Cells[Row,Col], PropertyName, Value,
AffectSize, AffectWidth, TRVUndoModifyCellIntProperty) as TRVUndoModifyCellIntProperty;
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
end;
finally
Include(FState, rvtsInserted);
end
else begin
fi := rvtsInserted in FState;
try
Exclude(FState, rvtsInserted);
SetOrdProp(Cells[Row,Col], GetPropInfo(Cells[Row,Col].ClassInfo, PropertyName), Value);
finally
if fi then
Include(FState, rvtsInserted);
end;
end;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.AssignCellAttributes(ItemNo,Row, Col: Integer;
SourceCell: TRVTableCellData;IncludeSize: Boolean;
DivColSpan, DivRowSpan: Integer);
var ui: TRVUndoModifyCellIntProperties;
Cell: TRVTableCellData;
PropList: TStringList;
begin
Cell := Cells[Row,Col];
if (rvtsInserted in FState) and IsInEditor then
try
if ItemNo=-1 then
ItemNo := GetMyItemNo;
with SourceCell.VisibleBorders do
SetCellVisibleBorders_(ItemNo, Left,Top,Right,Bottom,Row,Col);
SetCellBackgroundImage(SourceCell.BackgroundImage, Row,Col);
PropList := TStringList.Create;
try
PropList.AddObject('Color', TObject(SourceCell.Color));
PropList.AddObject('BorderColor', TObject(SourceCell.BorderColor));
PropList.AddObject('BorderLightColor', TObject(SourceCell.BorderLightColor));
PropList.AddObject('VAlign', TObject(SourceCell.VAlign));
PropList.AddObject('BackgroundStyle', TObject(SourceCell.BackgroundStyle));
if IncludeSize then begin
PropList.AddObject('BestWidth', TObject(SourceCell.BestWidth div DivColSpan));
PropList.AddObject('BestHeight', TObject(SourceCell.BestHeight div DivRowSpan));
end;
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVEditRVData(FRows.FMainRVData).Do_ModifyItemIntProperties(
ItemNo, Cell, PropList,
IncludeSize, IncludeSize, TRVUndoModifyCellIntProperties) as TRVUndoModifyCellIntProperties;
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
end;
finally
PropList.Free;
end;
finally
Include(FState, rvtsInserted);
end
else begin
Cells[Row,Col].AssignAttributesFrom(SourceCell, IncludeSize, DivColSpan, DivRowSpan);
end;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetProperty(const PropertyName: String; Value: LongInt;
AffectSize, AffectWidth: Boolean);
var fi:Boolean;
begin
if (rvtsInserted in FState) and IsInEditor then
try
MergeInplaceUndo(False);
Exclude(FState, rvtsInserted);
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
TRVEditRVData(FRows.FMainRVData).Do_ModifyItemIntProperty(
GetMyItemNo, Self, PropertyName, Value,
AffectSize, AffectWidth, TRVUndoModifyItemIntProperty);
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
finally
Include(FState, rvtsInserted);
end
else begin
fi := rvtsInserted in FState;
try
Exclude(FState, rvtsInserted);
SetOrdProp(Self, GetPropInfo(Self.ClassInfo, PropertyName), Value);
finally
if fi then
Include(FState, rvtsInserted);
end;
end;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.BeforeUndoChangeProperty;
begin
Exclude(FState, rvtsInserted)
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.AfterUndoChangeProperty;
begin
Include(FState, rvtsInserted);
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SplitSelectedCellsVertically(ColCount: Integer);
var r,c,cs,rs: Integer;
ColsAdded: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then
exit;
DestroyInplace(True);
InitUndo;
try
ColsAdded := Rows.SplitCellsVertically(r,c,cs,rs, ColCount);
Select(r,c,rs-1,cs+ColsAdded-1);
finally
DoneUndo;
end;
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SplitSelectedCellsHorizontally(
RowCount: Integer);
var r,c,cs,rs: Integer;
RowsAdded: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then
exit;
DestroyInplace(True);
InitUndo;
try
RowsAdded := Rows.SplitCellsHorizontally(r,c,cs,rs, RowCount);
Select(r,c,rs+RowsAdded-1,cs-1);
finally
DoneUndo;
end;
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanMergeSelectedCells(AllowMergeRC: Boolean): Boolean;
var r,c,cs,rs: Integer;
begin
Result := False;
if not (rvtsSelExists in FState) then
exit;
GetNormalizedSelectionBounds(False, r,c,cs,rs);
Result := Rows.CanMergeCells(r,c,cs,rs, AllowMergeRC);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanMergeCells(TopRow, LeftCol, ColSpan,
RowSpan: Integer; AllowMergeRC: Boolean): Boolean;
begin
Result := Rows.CanMergeCells(TopRow, LeftCol, ColSpan, RowSpan, AllowMergeRC);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MergeCells(TopRow, LeftCol, ColSpan,
RowSpan: Integer; AllowMergeRC: Boolean);
begin
DestroyInplace(True);
InitUndo;
try
Rows.MergeCells(TopRow, LeftCol, ColSpan, RowSpan, AllowMergeRC, True);
finally
DoneUndo;
end;
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MergeSelectedCells(AllowMergeRC: Boolean);
var r,c,cs,rs: Integer;
begin
if not (rvtsSelExists in FState) then
exit;
GetNormalizedSelectionBounds(False, r,c,cs,rs);
MergeCells(r,c,cs,rs,AllowMergeRC);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UnmergeCells(TopRow, LeftCol, ColSpan,
RowSpan: Integer; UnmergeRows, UnmergeCols: Boolean);
begin
SaveInplace;
InitUndo;
try
Rows.UnmergeCells(TopRow, LeftCol, ColSpan, RowSpan, UnmergeRows, UnmergeCols);
finally
DoneUndo;
RestoreInplace;
ResetLiveSpell;
Changed;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UnmergeSelectedCells(UnmergeRows, UnmergeCols: Boolean);
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then
exit;
UnmergeCells(r,c,cs,rs,UnmergeRows, UnmergeCols);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetEditedCell(var Row, Col: Integer): TCustomRichViewEdit;
begin
if FInplaceEditor<>nil then begin
Result := FInplaceEditor;
Row := TRVTableInplaceEdit(FInplaceEditor).FRow;
Col := TRVTableInplaceEdit(FInplaceEditor).FCol;
end
else begin
Result := nil;
Row := -1;
Col := -1;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Change;
begin
ChangeEx(True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ChangeEx(ClearRedo: Boolean);
begin
if (rvtsInserted in FState) and (Rows.FMainRVData is TRVEditRVData) then
TRVEditRVData(Rows.FMainRVData).ChangeEx(ClearRedo);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.BeginModify(ItemNo: Integer): Integer;
begin
if (rvtsInserted in FState) and (Rows.FMainRVData is TRVEditRVData) then
TRVEditRVData(Rows.FMainRVData).BeginItemModify(ItemNo, Result)
else
Result := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.EndModify(ItemNo, Data: Integer);
begin
if (rvtsInserted in FState) and (Rows.FMainRVData is TRVEditRVData) then
TRVEditRVData(Rows.FMainRVData).EndItemModify(ItemNo, data);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CreateTemporalEditor: TCustomRichViewEdit;
var ParentEditor: TCustomRichViewEdit;
begin
Result := TCustomRichViewEdit.Create(nil);
ParentEditor := TRVEditRVData(Rows.FMainRVData).RichView as TCustomRichViewEdit;
Result.Visible := False;
Result.Parent := ParentEditor;
Result.Options := ParentEditor.Options;
Result.EditorOptions := ParentEditor.EditorOptions;
Result.Style := ParentEditor.Style;
if ParentEditor.UndoLimit=0 then
Result.UndoLimit := 0
else
Result.UndoLimit := -1;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ApplyToCells(ConvType: TRVEStyleConversionType;
UserData: Integer; SelectedOnly: Boolean);
var tr,lc,rs,cs,r,c,i: Integer;
ItemNo, Data: Integer;
Editor: TCustomRichViewEdit;
ParentEditor: TCustomRichViewEdit;
ui: TRVUndoMultiCellsModify;
begin
if not (rvtoEditing in Options) then
exit;
ItemNo := GetMyItemNo;
Data := 0;
if SelectedOnly then begin
if not GetNormalizedSelectionBounds(False, tr, lc,cs,rs) or not BeforeChange then
exit;
Data := BeginModify(ItemNo);
InitUndo;
end;
Editor := CreateTemporalEditor;
try
ParentEditor := TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData).RichView);
ui := TRVUndoMultiCellsModify(
AddTableUndoInfo(TRVEditRVData(Rows.FMainRVData), TRVUndoMultiCellsModify,
ItemNo, True, True));
if ui<>nil then begin
ui.ItemNo := ItemNo;
ui.UndoList := TRVUndoList.Create(TCustomRVFormattedData(ParentEditor.RVData.GetAbsoluteRootData));
ui.RowList := TRVIntegerList.Create;
ui.ColList := TRVIntegerList.Create;
ui.CountList := TRVIntegerList.Create;
end;
case ConvType of
rvscParaStyleConversion:
Editor.OnParaStyleConversion := ParentEditor.OnParaStyleConversion;
rvscTextStyleConversion:
Editor.OnStyleConversion := ParentEditor.OnStyleConversion;
end;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) and (not SelectedOnly or IsCellSelected(r,c)) and
DoOnCellEditing(r,c,True) then begin
Editor.RVData.Clear;
Editor.RVData.DrainFrom(Items[c]);
Editor.Format;
Editor.SelectAll;
Editor.RVData.State := Editor.RVData.State + [rvstSkipFormatting];
case ConvType of
rvscParaStyle:
Editor.ApplyParaStyle(UserData);
rvscTextStyle:
Editor.ApplyTextStyle(UserData);
rvscParaStyleConversion:
Editor.ApplyParaStyleConversion(UserData);
rvscTextStyleConversion:
Editor.ApplyStyleConversion(UserData);
{$IFNDEF RVDONOTUSESTYLETEMPLATES}
rvscParaStyleTemplate:
Editor.ApplyParaStyleTemplate(UserData);
rvscTextStyleTemplate:
Editor.ApplyTextStyleTemplate(UserData, False);
{$ENDIF}
end;
Editor.RVData.State := Editor.RVData.State - [rvstSkipFormatting];
if TRVEditRVData(Editor.RVData).UndoList.Count>0 then begin
if ui<>nil then begin
ui.RowList.Add(r);
ui.ColList.Add(c);
ui.CountList.Add(TRVEditRVData(Editor.RVData).UndoList.Count);
for i := 0 to TRVEditRVData(Editor.RVData).UndoList.Count-1 do
ui.UndoList.AddInfos(TObject(TRVEditRVData(Editor.RVData).UndoList.Items[i]) as TRVUndoInfos);
for i := TRVEditRVData(Editor.RVData).UndoList.Count-1 downto 0 do
TRVEditRVData(Editor.RVData).UndoList.DeleteAsPointer(i);
end;
Changed;
end;
Items[c].DrainFrom(Editor.RVData);
end;
finally
Editor.Free;
end;
if ConvType in [rvscTextStyle, rvscTextStyleConversion, rvscTextStyleTemplate] then
ResetLiveSpell;
if SelectedOnly then begin
if rvtsModified in FState then
EndModify(ItemNo, Data);
DoneUndo;
Change;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ApplyStyleConversionToSubRVDatas(UserData: Integer;
SelectedOnly: Boolean; ConvType: TRVEStyleConversionType);
begin
ApplyToCells(ConvType, UserData, SelectedOnly);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanDeletePartiallySelected: Boolean;
var tr,lc,rs,cs,r,c: Integer;
begin
Result := rvtoEditing in Options;
if not Result then
exit;
if not GetNormalizedSelectionBounds(False, tr, lc,cs,rs) then
exit;
if not (Rows.FMainRVData is TRVEditRVData) then
exit;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) and IsCellSelected(r,c) then
if not Items[c].CanClear then begin
Result := False;
exit;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeletePartiallySelected;
var tr,lc,rs,cs,r,c: Integer;
ItemNo, Data: Integer;
RowList, ColList: TRVIntegerList;
CellsList: TList;
ui: TRVUndoInfo;
begin
if not GetNormalizedSelectionBounds(False, tr, lc,cs,rs) or not BeforeChange then
exit;
ItemNo := GetMyItemNo;
RowList := TRVIntegerList.Create;
ColList := TRVIntegerList.Create;
try
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) and IsCellSelected(r,c) and
DoOnCellEditing(r,c, True) then begin
RowList.Add(r);
ColList.Add(c);
end;
if RowList.Count>0 then begin
Data := BeginModify(ItemNo);
InitUndo;
try
ui := Rows.Do_BeforeClearCells(ItemNo, RowList, ColList, CellsList);
Rows.Do_ClearCells(CellsList, RowList, ColList, ui);
finally
DoneUndo;
EndModify(ItemNo,Data);
ResetLiveSpell;
Change;
end;
end;
finally
RowList.Free;
ColList.Free;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DoAfterFillingRows(Row, Count: Integer);
var r,c: Integer;
ItemNo: Integer;
RowList, ColList: TRVIntegerList;
CellsList: TList;
ui: TRVUndoInfo;
begin
if (Count=0) or (Row>=Rows.Count) then
exit;
if Row+Count>Rows.Count then
Count := Rows.Count-Row;
ItemNo := GetEditorItemNoForUndo;
RowList := TRVIntegerList.Create;
ColList := TRVIntegerList.Create;
try
for r := Row to Row+Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
RowList.Add(r);
ColList.Add(c);
end;
if RowList.Count>0 then begin
InitUndo;
try
ui := Rows.Do_BeforeClearCells(ItemNo, RowList, ColList, CellsList);
if ui<>nil then begin
TRVUndoCellsClear(ui).CellsList.Free;
TRVUndoCellsClear(ui).CellsList := nil;
TRVUndoCellsClear(ui).Flag := True;
end;
finally
DoneUndo;
Change;
end;
end;
finally
RowList.Free;
ColList.Free;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCellTo(Row, Col: Integer;
Dir: TRVCellDirection; var NewRow, NewCol: Integer;
Quiet: Boolean): Boolean;
var r,c: Integer;
begin
case Dir of
rvcdUp:
begin
Result := Row>0;
if Result then
Rows.GetMainCell(Row-1,Col,NewRow,NewCol);
end;
rvcdLeft:
begin
Result := (Col>0) or (Row>0) ;
if Result then
if Col>0 then
Rows.GetMainCell(Row,Col-1,NewRow,NewCol)
else
Result := GetCellTo(Row, Col, rvcdPrev, NewRow,NewCol, True);
end;
rvcdRight:
begin
Result := (Col+Cells[Row,Col].ColSpan<Rows[Row].Count) or
(Row+Cells[Row,Col].RowSpan<Rows.Count);
if Result then
if (Col+Cells[Row,Col].ColSpan<Rows[Row].Count) then
Rows.GetMainCell(Row,Col+Cells[Row,Col].ColSpan,NewRow,NewCol)
else
Result := GetCellTo(Row, Col, rvcdNext, NewRow,NewCol, True);
end;
rvcdDown:
begin
Result := Row+Cells[Row,Col].RowSpan<Rows.Count;
if Result then
Rows.GetMainCell(Row+Cells[Row,Col].RowSpan,Col,NewRow,NewCol);
end;
rvcdNext:
begin
NewRow := Row;
NewCol := Col+1;
Result := True;
while NewCol<Rows[NewRow].Count do begin
if Cells[NewRow,NewCol]<>nil then
exit;
inc(NewCol);
end;
for r := Row+1 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if (Cells[r,c]<>nil) then begin
NewRow := r;
NewCol := c;
exit;
end;
Result := False;
if not Quiet then Beep;
end;
rvcdPrev:
begin
NewRow := Row;
NewCol := Col-1;
Result := True;
while NewCol>=0 do begin
if Cells[NewRow,NewCol]<>nil then
exit;
dec(NewCol);
end;
for r := Row-1 downto 0 do
for c := Rows[r].Count-1 downto 0 do
if (Cells[r,c]<>nil) then begin
NewRow := r;
NewCol := c;
exit;
end;
Result := False;
if not Quiet then Beep;
end;
else
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanSeeBackgroundThroughCell(Cell: TRVTableCellData): Boolean;
begin
Result := (Cell.Color=clNone) and (Color=clNone);
if Result and (Rows.FMainRVData is TCustomRVFormattedData) then
Result := Rows.FMainRVData.GetRVStyle.ParaStyles[ParaNo].Background.Color=clNone;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetTableColor(UseParentBackground: Boolean): TColor;
begin
Result := Color;
if Result=clNone then
if Rows.FMainRVData is TCustomRVFormattedData then begin
Result := Rows.FMainRVData.GetRVStyle.ParaStyles[ParaNo].Background.Color;
if UseParentBackground and (Result=clNone) then
Result := TCustomRVFormattedData(Rows.FMainRVData).GetColor;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCellColor(Cell: TRVTableCellData): TColor;
begin
Result := Cell.Color;
if Result=clNone then begin
Result := Color;
if Result=clNone then
if Rows.FMainRVData is TCustomRVFormattedData then begin
Result := Rows.FMainRVData.GetRVStyle.ParaStyles[ParaNo].Background.Color;
if Result=clNone then
Result := TCustomRVFormattedData(Rows.FMainRVData).GetColor;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSplitRowBelow(Row: Integer): Integer;
var r,c,mr,mc: Integer;
Cell:TRVTableCellData;
CanSplit:Boolean;
begin
r := Row;
while r<Rows.Count-1 do begin
c := Rows[r].Count-1;
CanSplit := True;
while c>=0 do begin
Cell := Rows.GetMainCell(r,c,mr,mc);
mr := mr+Cell.RowSpan-1;
if mr>r then begin
r := mr;
CanSplit := False;
break;
end;
c := mc-1;
end;
if CanSplit then
break;
end;
Result := r;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSplitRowAbove(Row: Integer): Integer;
var r,c,mr,mc: Integer;
CanSplit:Boolean;
begin
r := Row;
while r>0 do begin
c := Rows[r].Count-1;
CanSplit := True;
while c>=0 do begin
Rows.GetMainCell(r,c,mr,mc);
if mr<r then begin
r := mr;
CanSplit := False;
break;
end;
c := mc-1;
end;
if CanSplit then
break;
end;
Result := r;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERTF}
procedure TRVTableItemInfo.FillRTFTables(ColorList: TRVColorList;
ListOverrideCountList: TRVIntegerList; RVData: TPersistent);
var r,c: Integer;
begin
ColorList.AddUnique(Color);
case BorderStyle of
rvtbRaised, rvtbLowered:
begin
ColorList.AddUnique(clBtnHighlight);
ColorList.AddUnique(clBtnShadow);
ColorList.AddUnique(clBtnFace);
end;
rvtbColor:
ColorList.AddUnique(BorderColor);
rvtbRaisedColor, rvtbLoweredColor:
begin
ColorList.AddUnique(BorderColor);
ColorList.AddUnique(BorderLightColor);
end;
end;
case CellBorderStyle of
rvtbRaised, rvtbLowered:
begin
ColorList.AddUnique(clBtnHighlight);
ColorList.AddUnique(clBtnShadow);
ColorList.AddUnique(clBtnFace);
end;
rvtbColor:
ColorList.AddUnique(CellBorderColor);
rvtbRaisedColor, rvtbLoweredColor:
begin
ColorList.AddUnique(CellBorderColor);
ColorList.AddUnique(CellBorderLightColor);
end;
end;
if VRuleWidth>0 then
ColorList.AddUnique(VRuleColor);
if HRuleWidth>0 then
ColorList.AddUnique(HRuleColor);
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) then begin
ColorList.AddUnique(Items[c].Color);
ColorList.AddUnique(Items[c].BorderColor);
ColorList.AddUnique(Items[c].BorderLightColor);
Items[c].MakeRTFTables(ColorList, ListOverrideCountList, False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.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);
{......................................................}
function GetBorderString(BorderStyle:TRVTableBorderStyle; Width: Integer; Color: Integer): String;
begin
case BorderStyle of
rvtbColor:
Result := Format('brdrsbrdrw%dbrdrcf%d',[Width,ColorList.IndexOf(Pointer(Color))]);
rvtbLowered:
Result := Format('brdrinsetbrdrw%d',[Width]);
rvtbRaised:
Result := Format('brdroutsetbrdrw%d',[Width]);
rvtbLoweredColor:
Result := Format('brdrsbrdrw%dbrdrcf%d',[Width,ColorList.IndexOf(Pointer(Color))]);
rvtbRaisedColor:
Result := Format('brdrsbrdrw%dbrdrcf%d',[Width,ColorList.IndexOf(Pointer(Color))]);
end;
end;
{......................................................}
procedure SaveBorder(BorderStyle:TRVTableBorderStyle; Width: Integer; Color, LightColor: TColor;
VisibleBorders: TRVBooleanRect;
const prefix: String; MainRow, MainCol, Row, Col: Integer);
var LTColor,RBColor: TColor;
function IsLeftSideVisible: Boolean;
begin
Result := (VisibleBorders=nil);
if Result then
exit;
Result := {(Col=MainCol) and }VisibleBorders.Left;
end;
function IsTopSideVisible: Boolean;
begin
Result := (VisibleBorders=nil);
if Result then
exit;
Result := {(Row=MainRow) and }VisibleBorders.Top;
end;
function IsRightSideVisible: Boolean;
begin
Result := (VisibleBorders=nil);
if Result then
exit;
Result := {(Col=MainCol+Cells[MainRow,MainCol].ColSpan-1) and }VisibleBorders.Right;
end;
function IsBottomSideVisible: Boolean;
begin
Result := (VisibleBorders=nil);
if Result then
exit;
Result := {(Row=MainRow+Cells[MainRow,MainCol].RowSpan-1) and }VisibleBorders.Bottom;
end;
begin
if Width<=0 then
exit;
Width := Round(Width*TwipsPerPixel);
case BorderStyle of
rvtbRaisedColor:
begin
LTColor := LightColor;
RBColor := Color;
end;
rvtbLoweredColor:
begin
LTColor := Color;
RBColor := LightColor;
end;
else
begin
LTColor := Color;
RBColor := Color;
end;
end;
if IsLeftSideVisible then
RVFWrite(Stream, Format('%sbrdrl%s', [prefix, GetBorderString(BorderStyle, Width, LTColor)]));
if IsTopSideVisible then
RVFWrite(Stream, Format('%sbrdrt%s', [prefix, GetBorderString(BorderStyle, Width, LTColor)]));
if IsRightSideVisible then
RVFWrite(Stream, Format('%sbrdrr%s', [prefix, GetBorderString(BorderStyle, Width, RBColor)]));
if IsBottomSideVisible then
RVFWrite(Stream, Format('%sbrdrb%s', [prefix, GetBorderString(BorderStyle, Width, RBColor)]));
end;
{......................................................}
var r,c,mr,mc,h: Integer;
Nested: Boolean;
NestS,s: String;
Right: Integer;
Cell: TRVTableCellData;
val1,val2, gaph2: Integer;
BColor, BLColor: TColor;
begin
if (Fmt.FWidth=0) then
OnDocWidthChange(600, nil, False,nil,nil,nil,r,r,False,False);
Nested := Level>0;
NestS := '';
for r := 0 to Rows.Count-1 do begin
if Nested then
NestS := '*nesttableprops';
RVFWrite(Stream, Format('{%s',[NestS]));
case TCustomRVData(RVData).GetRVStyle.ParaStyles[TCustomRVData(RVData).GetItemPara(ItemNo)].Alignment of
rvaRight:
s := 'trqr';
rvaCenter:
s := 'trqc';
end;
gaph2 := (CellHSpacing+(CellPadding+CellBorderWidth)*2);
RVFWrite(Stream, Format('trowd%strgaph%dtrleft%ditap%d',
[s, Round(gaph2*TwipsPerPixel/2), 0, Level+1]));
if r<HeadingRowCount then
RVFWrite(Stream, 'trhdr');
h := Rows[r].GetBestHeight;
if h>0 then
RVFWrite(Stream, Format('trrh%d',[Round(h*TwipsPerPixel)]));
val1 := Round(CellPadding*TwipsPerPixel);
RVFWrite(Stream, Format('trpaddl%dtrpaddt%dtrpaddr%dtrpaddb%dtrpaddfl3trpaddft3trpaddfr3trpaddfb3',
[val1,val1,val1,val1]));
val1 := Round(CellHSpacing*TwipsPerPixel/2);
//if val1>=0 then
RVFWrite(Stream, Format('trspdl%dtrspdr%dtrspdfl3trspdfr3',[val1,val1]));
// not sure about dividing by 2 below, but result looks much better:
if r=0 then
val1 := Round(BorderVSpacing*TwipsPerPixel/2)
else
val1 := Round(CellVSpacing*TwipsPerPixel/2);
if r=Rows.Count-1 then
val2 := Round(BorderVSpacing*TwipsPerPixel/2)
else
val2 := Round(CellVSpacing*TwipsPerPixel/2);
//if val1>=0 then
RVFWrite(Stream, Format('trspdt%dtrspdft3',[val1]));
//if val2>=0 then
RVFWrite(Stream, Format('trspdb%dtrspdfb3',[val2]));
{ does not work...
val1 := Round(BorderHSpacing*TwipsPerPixel);
RVFWrite(Stream, Format('trftsWidthB3trftsWidthB3trwWidthB%dtrwWidthA%d',[val1,val1]));
}
if BestWidth>0 then
RVFWrite(Stream, Format('trwWidth%dtrftsWidth3',[Round((BestWidth+BorderWidth*2)*TwipsPerPixel)]))
else if BestWidth<0 then
RVFWrite(Stream, Format('trwWidth%dtrftsWidth2',[-BestWidth*50]))
else begin
RVFWrite(Stream, 'trftsWidth1');
if RichViewTableDefaultRTFAutofit or (rvtoRTFAllowAutofit in Options) then
RVFWrite(Stream, 'trautofit1');
end;
if not (rvtoRowsSplit in PrintOptions) then
RVFWrite(Stream, 'trkeeptrkeepfollow');
RVFWrite(Stream, Format('richviewtbw%d',[BestWidth])); // for RichView only
SaveBorder(BorderStyle, BorderWidth, BorderColor, BorderLightColor, VisibleBorders, 'tr',
-1, -1, -1, -1);
RVFWrite(Stream, Rows.FMainRVData.GetExtraRTFCode(rv_rtfs_RowProps, Self, r, -1, False));
with Rows[r] do begin
for c := 0 to Count-1 do begin
Cell := Rows.GetMainCell(r,c,mr,mc);
if c>mc then
continue;
if Items[c]=nil then begin
if (r=mr) and (Cell.RowSpan>1) then
RVFWrite(Stream, 'clvmgf');
if (r>mr) then
RVFWrite(Stream, 'clvmrg');
end
else begin
if (Cell.RowSpan>1) then
RVFWrite(Stream, 'clvmgf');
end;
if Items[c]<>nil then begin
if Cell.BestWidth>0 then begin
if rvtoRTFSaveCellPixelBestWidth in Options then
RVFWrite(Stream,Format('clwWidth%dclftsWidth3',[Round(Cell.BestWidth*TwipsPerPixel)]))
else
RVFWrite(Stream, 'clwWidth0')
end
else if Cell.BestWidth<0 then
RVFWrite(Stream,Format('clwWidth%dclftsWidth2',[-Cell.BestWidth*50]))
else
RVFWrite(Stream,'clftsWidth1');
RVFWrite(Stream, Format('richviewcbw%drichviewcbh%d',[Cell.BestWidth,Cell.BestHeight])); // for RichView only
end;
if Cell.BorderColor<>clNone then
BColor := Cell.BorderColor
else
BColor := CellBorderColor;
if Cell.BorderLightColor<>clNone then
BLColor := Cell.BorderLightColor
else
BLColor := CellBorderLightColor;
SaveBorder(CellBorderStyle, CellBorderWidth, BColor, BLColor, Cell.VisibleBorders, 'cl',
mr, mc, r, c);
if GetCellColor(Cell)<>clNone then
RVFWrite(Stream, Format('clcbpat%d',[ColorList.IndexOf(Pointer(GetCellColor(Cell)))]));
case Cell.GetRealVAlign of
//rvcTop: {default}
// RVFWrite(Stream, 'clvertalt');
rvcMiddle:
RVFWrite(Stream, 'clvertalc');
rvcBottom:
RVFWrite(Stream, 'clvertalb');
end;
RVFWrite(Stream, Rows.FMainRVData.GetExtraRTFCode(rv_rtfs_CellProps, Self, r, c, False));
//Right := Fmt.ColStarts[c]+Fmt.ColWidths[c];
Right := Fmt.ColStarts[mc+Cell.ColSpan-1]+Fmt.ColWidths[mc+Cell.ColSpan-1];
RVFWrite(Stream,Format('cellx%d',[Round(Right*TwipsPerPixel+CellHSpacing*TwipsPerPixel/2)]));
end;
RVFWrite(Stream, Format('pardintblitap%d{',[Level+1]));
for c := 0 to Count-1 do begin
Rows.GetMainCell(r,c,mr,mc);
if c>mc then
continue;
RVFWrite(Stream, '{');
if (Items[c]<>nil) then begin
Items[c].GetRVData.SaveRTFToStream(Stream, Path, False, Level+1, clNone, nil,
ColorList, StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2,
TRVRTFFontTable(FontTable), TwipsPerPixel);
end;
if Nested then
NestS := 'nest';
RVFWrite(Stream,Format('%scell}',[NestS]));
end;
end;
RVFWrite(Stream, Format('}pardintblitap%d',[Level+1]));
if Nested then
NestS := 'nest';
RVFWrite(Stream,Format('%srow}',[NestS]));
end;
Include(TCustomRVData(RVData).State, rvstRTFSkipPar);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
procedure TRVTableItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer;
const Text, Path, imgSavePrefix: String; var imgSaveNo: Integer;
CurrentFileColor: TColor; SaveOptions: TRVSaveOptions; UseCSS: Boolean;
Bullets: TRVList);
var ThisUseCSS: Boolean;
CellSpacing: Integer;
const VAlignStr: array[TRVCellVAlign] of String =
('top', 'middle', 'bottom', '');
{.....................................................}
function GetHTMLLength(v: TRVHTMLLength; Quotes: Boolean): String;
begin
if v=0 then
Result := ''
else if v>0 then
Result := IntToStr(v)
else begin
Result := IntToStr(-v)+'%';
if Quotes then
Result := '"'+Result+'"';
end;
end;
{.....................................................}
function GetCellCSS(Cell: TRVTableCellData): String;
var BColor, BLColor: TColor;
begin
Result := '';
if not ThisUseCSS then
exit;
if (Cell<>nil) and (Cell.BorderColor<>clNone) then
BColor := Cell.BorderColor
else
BColor := CellBorderColor;
if (Cell<>nil) and (Cell.BorderLightColor<>clNone) then
BLColor := Cell.BorderLightColor
else
BLColor := CellBorderLightColor;
if ((CellBorderWidth<>BorderWidth) or (BorderWidth>1)) and
not ((CellBorderWidth=1) and (BorderWidth>1)) then
Result := Format('border-width : %dpx;', [CellBorderWidth]);
if CellBorderWidth>0 then
case CellBorderStyle of
rvtbColor:
{
if BorderWidth=0 then
RV_AddStr(Result, Format('border-color: %s; border-style: solid;',
[RV_GetHTMLRGBStr(BColor, False)]))
else
}
RV_AddStr(Result, Format('border-color: %s;',
[RV_GetHTMLRGBStr(BColor, False)]));
rvtbRaisedColor:
RV_AddStr(Result, Format('border-color : %s %s %s %s; border-style: solid;',
[RV_GetHTMLRGBStr(BLColor, False),RV_GetHTMLRGBStr(BColor, False),
RV_GetHTMLRGBStr(BColor, False),RV_GetHTMLRGBStr(BLColor, False)]));
rvtbLoweredColor:
if (BColor<>BorderColor) or (BLColor<>BorderLightColor) or
not (BorderStyle in [rvtbLoweredColor,rvtbRaisedColor]) then
RV_AddStr(Result, Format('border-color : %s %s %s %s; border-style: solid;',
[RV_GetHTMLRGBStr(BColor, False),RV_GetHTMLRGBStr(BLColor, False),
RV_GetHTMLRGBStr(BLColor, False), RV_GetHTMLRGBStr(BColor, False)]));
rvtbRaised:
RV_AddStr(Result, 'border-style: outset;');
rvtbLowered:
RV_AddStr(Result, 'border-style: inset;');
end;
end;
{.....................................................}
function GetBackgroundFileName(Background: TRVBackground; Color: TColor;
ItemNo: Integer; ARVData: TCustomRVData;
const BackgroundImageFileName: String) : String;
var Location: String;
DoDefault: Boolean;
begin
Result := '';
if (Background=nil) or not Background.Visible then
exit;
if Color=clNone then
Color := CurrentFileColor;
if (BackgroundImageFileName<>'') and (rvsoUseItemImageFileNames in SaveOptions) then
Location := ExtractRelativePath(Path, BackgroundImageFileName)
else
Location := '';
ARVData.HTMLSaveImage(ARVData, ItemNo, Path, Color, Location, DoDefault);
if DoDefault then begin
if (BackgroundImageFileName<>'') and (rvsoUseItemImageFileNames in SaveOptions) then
Location := ExtractRelativePath(Path, BackgroundImageFileName)
else
Location := TCustomRVData(RVData).DoSavePicture(rvsfHTML, imgSavePrefix, Path,
imgSaveNo, rvsoOverrideImages in SaveOptions, Color, Background.Image);
end;
if Location<>'' then
Result := RV_GetHTMLPath(Location, SaveOptions, ARVData.GetRVStyle.DefCodePage);
end;
{.....................................................}
function GetThisCellCSS(Cell : TRVTableCellData; const DefCss: String): String;
var bss, s: String;
begin
if (Cell.BorderColor<>clNone) or (Cell.BorderLightColor<>clNone) then
Result := GetCellCSS(Cell)
else
Result := DefCss;
if not ThisUseCSS then
exit;
if (Cell.FBackground=nil) or not Cell.FBackground.Visible then
bss := ''
else begin
if Cell.BackgroundStyle in [rvbsCentered, rvbsStretched] then
bss := 'background-position: center center; background-repeat: no-repeat;'
else if BackgroundStyle in [rvbsCentered, rvbsStretched] then
bss := 'background-position: left top; background-repeat: repeat;'
else
bss := '';
if UseCSS then begin
s := GetBackgroundFileName (Cell.FBackground, GetCellColor(Cell), -1, Cell,
Cell.BackgroundImageFileName);
if s<>'' then
RV_AddStr(bss, Format('background-image: url(''%s'');', [s]));
end;
end;
RV_AddStr(Result, bss);
if CellBorderWidth>0 then begin
if not Cell.VisibleBorders.Top then
RV_AddStr(Result, 'border-top: none;');
if not Cell.VisibleBorders.Right then
RV_AddStr(Result, 'border-right: none;');
if not Cell.VisibleBorders.Bottom then
RV_AddStr(Result, 'border-bottom: none;');
if not Cell.VisibleBorders.Left then
RV_AddStr(Result, 'border-left: none;');
end;
if Cell.Color<>Color then begin
s := RV_GetHTMLRGBStr(Cell.Color, False);
if s<>'' then
RV_AddStr(Result, Format('background-color: %s;', [s]));
end;
if UseCSS and (rvsoXHTML in SaveOptions) then begin
s := GetHTMLLength(Cell.BestWidth, False);
if s<>'' then
RV_AddStr(Result, Format('width: %s;', [s]));
s := GetHTMLLength(Cell.BestHeight, False);
if s<>'' then
RV_AddStr(Result, Format('height: %s;', [s]));
end;
if Result<>'' then
Result := Format(' style="{%s}"',[Result]);
end;
{.....................................................}
function GetRules: String;
begin
{
if HRuleWidth>0 then
if VRuleWidth>0 then
Result := 'all'
else
Result := 'cols'
else
if VRuleWidth>0 then
Result := 'rows'
else
}
Result := ''
end;
{.....................................................}
function AddAttribute(const Name, Value, DefValue: String): String;
begin
if (Value<>DefValue) and (Value<>'') then
Result := Format(' %s=%s',[Name, RV_HTMLGetStrAttrVal(Value, SaveOptions)])
else
Result := '';
end;
{.....................................................}
function AddBorderColorAttr(BorderStyle: TRVTableBorderStyle;
BorderColor, BorderLightColor: TColor): String;
begin
Result := '';
if UseCSS then
exit;
case BorderStyle of
rvtbColor:
Result := AddAttribute('bordercolor', RV_GetHTMLRGBStr(BorderColor, True), '');
rvtbRaisedColor:
begin
Result := AddAttribute('bordercolorlight', RV_GetHTMLRGBStr(BorderLightColor, True), '')+
AddAttribute('bordercolordark', RV_GetHTMLRGBStr(BorderColor, True), '');
end;
rvtbLoweredColor:
begin
Result := AddAttribute('bordercolorlight', RV_GetHTMLRGBStr(BorderColor, True), '')+
AddAttribute('bordercolordark', RV_GetHTMLRGBStr(BorderLightColor, True), '');
end;
end;
end;
{.....................................................}
function GetTableCSS: String;
var s: String;
begin
Result := '';
if not ThisUseCSS then
exit;
case BorderStyle of
rvtbLoweredColor:
Result := Format('border-color: %s %s %s %s; border-style: solid;',
[RV_GetHTMLRGBStr(BorderColor, False),RV_GetHTMLRGBStr(BorderLightColor, False),
RV_GetHTMLRGBStr(BorderLightColor, False), RV_GetHTMLRGBStr(BorderColor, False)]);
rvtbRaisedColor:
Result := Format('border-color: %s %s %s %s; border-style: solid;',
[RV_GetHTMLRGBStr(BorderLightColor, False),RV_GetHTMLRGBStr(BorderColor, False),
RV_GetHTMLRGBStr(BorderColor, False), RV_GetHTMLRGBStr(BorderLightColor, False)]);
rvtbLowered:
Result := 'border-style: inset;';
rvtbColor:
if UseCSS then
Result := Format('border-color: %s;', [RV_GetHTMLRGBStr(BorderColor, False)]);
end;
if BackgroundStyle in [rvbsCentered, rvbsStretched] then
RV_AddStr(Result, 'background-position: center center; background-repeat: no-repeat;');
if UseCSS and (FBackground<>nil) and FBackground.Visible then begin
s := GetBackgroundFileName(FBackground, Color, ItemNo, TCustomRVData(RVData),
BackgroundImageFileName);
if s<>'' then
RV_AddStr(Result, Format('background-image: url(''%s'');', [s]));
end;
s := RV_GetHTMLRGBStr(Color, False);
if s<>'' then
RV_AddStr(Result, Format('background-color: %s;', [s]));
if CellSpacing<0 then
RV_AddStr(Result, 'border-collapse: collapse;');
if BorderWidth>0 then begin
if not VisibleBorders.Top then
RV_AddStr(Result, 'border-top: none;');
if not VisibleBorders.Right then
RV_AddStr(Result, 'border-right: none;');
if not VisibleBorders.Bottom then
RV_AddStr(Result, 'border-bottom: none;');
if not VisibleBorders.Left then
RV_AddStr(Result, 'border-left: none;');
end;
if Result<>'' then
Result := Format(' style="{%s}"',[Result]);
end;
{.....................................................}
function AddTableBorderAttribute: String;
begin
if not ThisUseCSS or (BorderWidth>0) or (CellBorderWidth=0) then
Result := Format(' border=%s', [RV_HTMLGetIntAttrVal(BorderWidth, SaveOptions)])
else
Result := Format(' border=%s style="{border-width : 0px}"', [RV_HTMLGetIntAttrVal(1, SaveOptions)])
end;
{.....................................................}
function AddBackgroundAttribute(Background: TRVBackground; RealColor, Color, DefColor: TColor;
ItemNo: Integer; ARVData: TCustomRVData;
const BackgroundImageFileName: String) : String;
var Location: String;
begin
Result := '';
if not UseCSS then
Result := AddAttribute('bgcolor', RV_GetHTMLRGBStr(Color, True), RV_GetHTMLRGBStr(DefColor, True));
if UseCSS or (Background=nil) or not Background.Visible then
exit;
Location := GetBackgroundFileName(Background, RealColor, ItemNo, ARVData, BackgroundImageFileName);
if Location<>'' then
Result := Result+Format(' background="%s"', [Location]);
end;
{.....................................................}
function AddWidthAndHeightAttrs(Cell: TRVTableCellData): String;
begin
if not UseCSS or not (rvsoXHTML in SaveOptions) then
Result := AddAttribute('width', GetHTMLLength(Cell.BestWidth, True), '')+
AddAttribute('height', GetHTMLLength(Cell.BestHeight, True), '');
end;
{.....................................................}
{
function GetTableAlign: String;
begin
case TCustomRVData(Rows.FMainRVData).GetRVStyle.ParaStyles[ParaNo].Alignment of
rvaCenter:
Result := 'center';
rvaRight:
Result := 'right';
else
Result := 'left';
end;
end;
}
var
Cell: TRVTableCellData;
r,c: Integer;
Options:TRVSaveOptions;
CellCSS: String;
begin
ThisUseCSS := UseCSS or (rvsoForceNonTextCSS in SaveOptions);
CellCSS := GetCellCSS(nil);
Options := SaveOptions;
Include(Options, rvsoMiddleOnly);
Exclude(Options, rvsoFirstOnly);
Exclude(Options, rvsoLastOnly);
CellSpacing := Round((CellVSpacing+CellHSpacing)/2);
RVFWriteLine(Stream, Format('<table%s%s%s%s%s%s%s%s>',
[
//AddAttribute('align', GetTableAlign, ''),
AddAttribute('width', GetHTMLLength(BestWidth, True), ''),
AddTableBorderAttribute,
AddAttribute('cellpadding', IntToStr(CellPadding), ''),
AddBorderColorAttr(BorderStyle, BorderColor, BorderLightColor),
AddAttribute('cellspacing', IntToStr(CellSpacing), ''),
AddAttribute('rules',GetRules,''),
AddBackgroundAttribute(FBackground, Color, Color, clNone, ItemNo, TCustomRVData(RVData),
BackgroundImageFileName),
GetTableCSS]));
for r := 0 to Rows.Count-1 do begin
RVFWriteLine(Stream, Format('<tr%s>',[AddAttribute('valign', VAlignStr[Rows[r].VAlign], '')]));
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
Cell := Cells[r,c];
RVFWrite(Stream, Format('<td%s%s%s%s%s%s>',
[
AddAttribute('colspan', IntToStr(Cell.ColSpan), '1'),
AddAttribute('rowspan', IntToStr(Cell.RowSpan), '1'),
AddWidthAndHeightAttrs(Cell),
AddAttribute('valign', VAlignStr[Cell.VAlign], ''),
AddBackgroundAttribute(Cell.FBackground, GetCellColor(Cell),
Cell.Color, Color, -1, Cell, Cell.BackgroundImageFileName),
GetThisCellCSS(Cell, CellCSS)
]));
if Cell.HasData(True) then
if UseCSS then
Cell.GetRVData.SaveHTMLToStreamEx(Stream, Path, '', imgSavePrefix, '','', '',Options,
GetCellColor(Cell), CurrentFileColor, imgSaveNo,
0,0,0,0,nil,Bullets)
else
Cell.GetRVData.SaveHTMLToStream(Stream,Path, '', imgSavePrefix, Options,
GetCellColor(Cell), imgSaveNo,
0,0,0,0,nil,Bullets)
else
RVFWriteLine(Stream, Format('<br%s>',[RV_HTMLGetEndingSlash(SaveOptions)]));
RVFWriteLine(Stream, '</td>');
end;
RVFWriteLine(Stream, '</tr>');
end;
RVFWriteLine(Stream, '</table>');
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVTableItemInfo.AsText(LineWidth: Integer; RVData: TPersistent;
const Text, Path: String; TextOnly,Unicode: Boolean): String;
var r,c: Integer;
Stream: TMemoryStream;
RSep,CSep:String;
{$IFNDEF RVDONOTUSEUNICODE}
CP: TRVCodePage;
{$ENDIF}
begin
Result := '';
{$IFNDEF RVDONOTUSEUNICODE}
if Unicode then begin
CP := TCustomRVData(RVData).GetRVStyle.DefCodePage;
RSep := RVU_AnsiToUnicode(cp, TextRowSeparator);
CSep := RVU_AnsiToUnicode(cp, TextColSeparator);
end
else
{$ENDIF}
begin
RSep := TextRowSeparator;
CSep := TextColSeparator;
end;
Stream := TMemoryStream.Create;
try
for r := 0 to Rows.Count-1 do begin
for c := 0 to Rows[r].Count-1 do begin
if Cells[r,c]<>nil then
Cells[r,c].GetRVData.SaveTextToStream(Path, Stream, LineWidth, False,
TextOnly, Unicode, False);
if c<Rows[r].Count-1 then
RVFWrite(Stream, CSep);
end;
RVFWrite(Stream, RSep);
end;
Stream.Position := 0;
SetLength(Result,Stream.Size);
Stream.ReadBuffer(PChar(Result)^,Stream.Size);
finally
Stream.Free;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.BeforeChange: Boolean;
begin
Result := IsInEditor and
TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData).RichView).BeforeChange(True);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanChange: Boolean;
begin
Result := IsInEditor;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBestHeight_(ItemNo, Value, Row,
Col: Integer);
begin
SetCellProperty(ItemNo, 'BestHeight', LongInt(Value), Row, Col, True, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBestWidth_(ItemNo: Integer;
Value: TRVHTMLLength; Row, Col: Integer);
begin
SetCellProperty(ItemNo, 'BestWidth', LongInt(Value), Row, Col, True, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellColor_(ItemNo: Integer; Value: TColor;
Row, Col: Integer);
begin
SetCellProperty(ItemNo, 'Color', LongInt(Value), Row, Col, False, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBackgroundStyle_(ItemNo: Integer;
Value: TRVItemBackgroundStyle; Row,Col: Integer);
begin
SetCellProperty(ItemNo, 'BackgroundStyle', LongInt(Value), Row, Col, False, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellVisibleBorders_(ItemNo: Integer; Left, Top, Right, Bottom: Boolean; Row,Col: Integer);
var ui: TRVUndoModifyVisibleBorders;
Cell: TRVTableCellData;
begin
Cell := Cells[Row, Col];
if Cell.VisibleBorders.IsEqual2(Left,Top,Right,Bottom) then
exit;
if (rvtsInserted in FState) and IsInEditor then begin
if ItemNo=-1 then
ItemNo := GetMyItemNo;
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVUndoModifyVisibleBorders(AddTableUndoInfo(TRichViewRVData(FRows.FMainRVData), TRVUndoModifyVisibleBorders, ItemNo, False, False));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Left := Cell.VisibleBorders.Left;
ui.Top := Cell.VisibleBorders.Top;
ui.Right := Cell.VisibleBorders.Right;
ui.Bottom := Cell.VisibleBorders.Bottom;
end;
end;
Cell.VisibleBorders.SetValues(Left,Top,Right,Bottom);
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetTableVisibleBorders(Left, Top, Right, Bottom: Boolean);
var ui: TRVUndoModifyVisibleBorders;
ItemNo: Integer;
begin
if VisibleBorders.IsEqual2(Left,Top,Right,Bottom) then
exit;
if (rvtsInserted in FState) and IsInEditor then begin
ItemNo := GetMyItemNo;
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVUndoModifyVisibleBorders(AddTableUndoInfo(TRichViewRVData(FRows.FMainRVData), TRVUndoModifyVisibleBorders, ItemNo, False, False));
if ui<>nil then begin
ui.Row := -1;
ui.Col := -1;
ui.Left := VisibleBorders.Left;
ui.Top := VisibleBorders.Top;
ui.Right := VisibleBorders.Right;
ui.Bottom := VisibleBorders.Bottom;
end;
end;
VisibleBorders.SetValues(Left,Top,Right,Bottom);
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBorderColor_(ItemNo: Integer; Value: TColor;
Row, Col: Integer);
begin
SetCellProperty(ItemNo, 'BorderColor', LongInt(Value), Row, Col, False, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBorderLightColor_(ItemNo: Integer; Value: TColor;
Row, Col: Integer);
begin
SetCellProperty(ItemNo, 'BorderLightColor', LongInt(Value), Row, Col, False, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellVAlign_(ItemNo: Integer; Value: TRVCellVAlign; Row,Col: Integer);
begin
SetCellProperty(ItemNo, 'VAlign', LongInt(Value), Row, Col, True, False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetRowVAlign_(ItemNo: Integer;
Value: TRVCellVAlign; Row: Integer);
var
ui: TRVUndoRowVAlign;
begin
if Rows[Row].VAlign<>Value then begin
if (rvtsInserted in FState) and IsInEditor then begin
MergeInplaceUndo(False);
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
if ItemNo=-1 then
ItemNo := GetMyItemNo;
ui := TRVUndoRowVAlign(AddTableUndoInfo(TRVEditRVData(FRows.FMainRVData), TRVUndoRowVAlign, ItemNo, True, False));
if ui<>nil then begin
ui.OldVAlign := Rows[Row].VAlign;
ui.Row := Row;
end;
end;
Rows[Row].VAlign := Value;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBestHeight(Value, Row, Col: Integer);
begin
SetCellBestHeight_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBestWidth(Value: TRVHTMLLength; Row,
Col: Integer);
begin
SetCellBestWidth_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellColor(Value: TColor; Row, Col: Integer);
begin
SetCellColor_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBackgroundStyle(Value: TRVItemBackgroundStyle; Row,Col: Integer);
begin
SetCellBackgroundStyle_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellVisibleBorders(Left, Top, Right, Bottom: Boolean; Row,Col: Integer);
begin
SetCellVisibleBorders_(-1, Left, Top, Right, Bottom, Row,Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBorderColor(Value: TColor; Row, Col: Integer);
begin
SetCellBorderColor_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBorderLightColor(Value: TColor; Row, Col: Integer);
begin
SetCellBorderLightColor_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellVAlign(Value: TRVCellVAlign; Row,
Col: Integer);
begin
SetCellVAlign_(-1, Value, Row, Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetRowVAlign(Value: TRVCellVAlign; Row: Integer);
begin
SetRowVAlign_(-1, Value, Row);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DoneUndo;
begin
if (rvtsInserted in FState) and (FRows.FMainRVData is TRVEditRVData) then
TRVEditRVData(FRows.FMainRVData).SetUndoGroupMode(False);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InitUndo;
begin
if (rvtsInserted in FState) and (FRows.FMainRVData is TRVEditRVData) then begin
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
TRVEditRVData(FRows.FMainRVData).SetUndoGroupMode(True);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetEditorItemNoForUndo: Integer;
begin
if (rvtsInserted in FState) and IsInEditor and UndoEnabled then
Result := GetMyItemNo
else
Result := -1;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.IsInEditor: Boolean;
begin
Result := FRows.FMainRVData is TRVEditRVData;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetMyItemNo: Integer;
begin
if (CachedItemNo<0) or (CachedItemNo>=FRows.FMainRVData.Items.Count) or
(FRows.FMainRVData.GetItem(CachedItemNo)<>Self) then
CachedItemNo := FRows.FMainRVData.GetItemNo(Self);
Result := CachedItemNo;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.EditCell_(Row,Col: Integer; Unquestioning: Boolean);
var PRow,PCol: Integer;
Ptable : TRVTableItemInfo;
begin
if not (rvtsInserted in FState) then
exit;
if not (rvtsEditMode in FState) then begin
if FRows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(FRows.FMainRVData).AssignChosenRVData(Cells[Row,Col], Self);
exit;
end;
if not Unquestioning and not (rvtoEditing in Options) then
exit;
if FRows.FMainRVData is TRVTableCellData then begin
Ptable := TRVTableCellData(FRows.FMainRVData).GetTable;
Ptable.GetCellPosition(TRVTableCellData(FRows.FMainRVData), PRow, PCol);
if PRow=-1 then
ERichViewError.Create(errInternalError);
Ptable.EditCell_(PRow, PCol, Unquestioning);
end;
if FRows.FMainRVData is TRVTableCellData then
exit;
CreateInplace(-1, Row, Col, False, True, False, False, Unquestioning);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.EditCell(Row, Col: Integer);
begin
EditCell_(Row,Col,False);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.EnterItem(From: TRVEnterDirection; Coord: Integer): Boolean;
var r,c: Integer;
begin
Result := False;
if Rows.Empty or not (rvtoEditing in Options) then
exit;
case From of
rvedLeft:
begin
CreateInplace(-1, 0, 0, False, True, False, False, False);
Result := True;
end;
rvedRight:
begin
Rows.GetMainCell(Rows.Count-1, Rows[0].Count-1, r,c);
CreateInplace(-1, r,c, False, False, True, False, False);
Result := True;
end;
rvedTop:
begin
c := GetColNo(Coord);
if c<0 then exit;
Rows.GetMainCell(0,c, r,c);
CreateInplace(-1, r,c, False, True, True, False, False);
Result := True;
end;
rvedBottom:
begin
c := GetColNo(Coord);
if c<0 then exit;
Rows.GetMainCell(Rows.Count-1,c, r,c);
CreateInplace(-1, r,c, False, False, True, False, False);
Result := True;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.BuildJumps(Left,Top: Integer; var StartJumpNo: Integer;
jumps: TList);
var r,c, i, cnt: Integer;
begin
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
cnt := jumps.Count;
Cells[r,c].FirstJumpNo := FRows.FMainRVData.FirstJumpNo ;//StartJumpNo;
if (FInplaceEditor<>nil) and (TRVTableInplaceEdit(FInplaceEditor).FCell=Cells[r,c]) then begin
FInplaceEditor.FirstJumpNo := StartJumpNo+FRows.FMainRVData.FirstJumpNo;
StartJumpNo := FInplaceEditor.FirstJumpNo+TRVTableInplaceRVData(TRVTableInplaceEdit(FInplaceEditor).RVData).ReallyBuildJumpsCoords-FRows.FMainRVData.FirstJumpNo;
end
else begin
Cells[r,c].BuildJumpsCoords(StartJumpNo, jumps);
for i := cnt to jumps.Count-1 do
with TRVJumpInfo(jumps.Items[i]) do begin
inc(l, Left+Cells[r,c].Left+CellPadding);
inc(t, Top+Cells[r,c].Top+CellPadding+Cells[r,c].GetExtraVOffs);
end;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Changed;
begin
Include(FState, rvtsModified);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ValidateFocused;
begin
if (FocusedCellRow<0) or (FocusedCellRow>=Rows.Count) or
(FocusedCellCol<0) or (FocusedCellCol>=Rows[0].Count) then begin
FocusedCellRow := -1;
FocusedCellCol := -1;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ValidateChosen;
begin
if (ChosenCellRow<0) or (ChosenCellRow>=Rows.Count) or
(ChosenCellCol<0) or (ChosenCellCol>=Rows[0].Count) then begin
ChosenCellRow := -1;
ChosenCellCol := -1;
end;
if (ChosenCellRow<>-1) and (ChosenCellCol<>-1) then
Rows.GetMainCell(ChosenCellRow, ChosenCellCol, ChosenCellRow, ChosenCellCol);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.MoveFocus(GoForward: Boolean;
var TopLevelRVData: TPersistent;
var TopLevelItemNo: Integer): Boolean;
var Cell: TCustomRVFormattedData;
Dir: TRVCellDirection;
begin
ValidateFocused;
Result := False;
if (FocusedCellRow=-1) then
if GoForward then begin
FocusedCellRow := 0;
FocusedCellCol := 0;
end
else
Rows.GetMainCell(Rows.Count-1, Rows[0].Count-1,FocusedCellRow,FocusedCellCol);
if GoForward then
Dir := rvcdNext
else
Dir := rvcdPrev;
while True do begin
Cell := Cells[FocusedCellRow,FocusedCellCol];
Cell.FocusedItemNo := Cell.GetNextFocusedItem(Cell.FocusedItemNo, GoForward, TCustomRVFormattedData(TopLevelRVData), TopLevelItemNo);
if Cell.FocusedItemNo<>-1 then begin
Result := True;
exit;
end;
if not GetCellTo(FocusedCellRow, FocusedCellCol, Dir, FocusedCellRow, FocusedCellCol, True) then begin
FocusedCellRow := -1;
FocusedCellCol := -1;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ClearFocus;
begin
ValidateFocused;
if (FocusedCellRow<>-1) then begin
Cells[FocusedCellRow,FocusedCellCol].ClearFocus;
FocusedCellRow := -1;
FocusedCellCol := -1;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CellIsChosen: Boolean;
begin
Result := False;
ValidateChosen;
if ChosenCellRow=-1 then
exit;
Result := Cells[ChosenCellRow,ChosenCellCol].SelectionExists(False,True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.GetCellPosition(Cell: TRVTableCellData; var Row,
Col: Integer);
var r: Integer;
begin
Row := -1;
Col := -1;
for r := 0 to Rows.Count-1 do begin
Col := Rows[r].IndexOf(Cell);
if Col<>-1 then begin
Row := r;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.AdjustFocus(Row, Col: Integer;
TopLevelRVData: TPersistent; TopLevelItemNo: Integer);
begin
FocusedCellRow := Row;
FocusedCellCol := Col;
TCustomRVFormattedData(FRows.FMainRVData).AdjustFocus(GetMyItemNo,TopLevelRVData,TopLevelItemNo);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.AdjustFocusToControl(Control: TControl;
var TopLevelRVData: TPersistent; var TopLevelItemNo: Integer): Boolean;
var r,c,ItemNo: Integer;
item: TCustomRVItemInfo;
begin
Result := GetCellWhichOwnsControl(Control, r, c, ItemNo);
if Result then begin
FocusedCellRow := r;
FocusedCellCol := c;
Cells[r,c].FocusedItemNo := ItemNo;
item := TCustomRVItemInfo(Cells[r,c].Items.Objects[ItemNo]);
item.AdjustFocusToControl(Control,TopLevelRVData,TopLevelItemNo);
if item.GetBoolValue(rvbpImmediateControlOwner) then begin
TopLevelItemNo := ItemNo;
TopLevelRVData := Cells[r,c];
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.UndoEnabled: Boolean;
begin
Result := (rvtsInserted in FState) and
(Rows.FMainRVData.GetRootData is TRVEditRVData) and
(TCustomRichViewEdit(TRVEditRVData(Rows.FMainRVData.GetRootData).RichView).UndoLimit<>0);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.MarkStylesInUse(Data: TRVDeleteUnusedStylesData);
var r,c: Integer;
begin
inherited MarkStylesInUse(Data);
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then
Cells[r,c].GetRVData.DoMarkStylesInUse(Data);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UpdateStyles(Data: TRVDeleteUnusedStylesData);
var r,c: Integer;
begin
inherited UpdateStyles(Data);
for r := 0 to Rows.Count-1 do
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then
Cells[r,c].GetRVData.DoUpdateStyles(Data);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CompletelySelected: Boolean;
var SN,EN,SO,EO,No: Integer;
begin
Result := Rows.FMainRVData is TCustomRVFormattedData;
if not Result then
exit;
if rvstCompletelySelected in Rows.FMainRVData.State then
exit;
TCustomRVFormattedData(Rows.FMainRVData).GetSelectionBounds(SN,SO,EN,EO,True);
Result := SN<>-1;
if not Result then
exit;
No := GetMyItemNo;
Result := ((No>SN) or ((No=SN) and (SO=0))) and
((No<EN) or ((No=EN) and (EO=1)));
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSubRVDataAt(X, Y: Integer): TPersistent;
var Row, Col: Integer;
begin
if GetCellAt(X, Y, Row, Col) then
Result := Cells[Row,Col].GetRVData
else
Result := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UnAssignActiveCell;
begin
ValidateChosen;
if (ChosenCellRow<>-1) and (ChosenCellCol<>-1) and
(Rows.FMainRVData is TCustomRVFormattedData) then
TCustomRVFormattedData(Rows.FMainRVData).UnassignChosenRVData(Cells[ChosenCellRow,ChosenCellCol]);
ChosenCellRow := -1;
ChosenCellCol := -1;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.CleanUpChosen;
begin
ValidateChosen;
if ChosenCellRow<>-1 then
TCustomRVFormattedData(Cells[ChosenCellRow,ChosenCellCol].GetRVData).Deselect(nil,False);
ChosenCellRow := -1;
ChosenCellCol := -1;
DestroyInplace(True);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSubRVData(var StoreState: TRVStoreSubRVData;
Position: TRVSubRVDataPos): TPersistent;
var r,c,cs,rs: Integer;
Dir: TRVCellDirection;
begin
Result := nil;
case Position of
rvdFirst:
begin
StoreState := TRVTableStoreSubRVData.Create(0,0);
Result := Cells[0,0];
end;
rvdLast:
begin
r := Rows.Count-1;
c := Rows[r].Count-1;
StoreState := TRVTableStoreSubRVData.Create(r,c);
Result := FRows.GetMainCell(r,c,r,c);
end;
rvdChosenUp,rvdChosenDown:
begin
StoreState := nil;
if GetNormalizedSelectionBounds(True,r,c,cs,rs) then begin
if Position=rvdChosenUp then begin
inc(r,rs-1);
inc(c,cs-1);
end;
Result := FRows.GetMainCell(r,c,r,c);
StoreState := TRVTableStoreSubRVData.Create(r,c);
end
else begin
ValidateChosen;
if ChosenCellRow<>-1 then begin
StoreState := TRVTableStoreSubRVData.Create(ChosenCellRow,ChosenCellCol);
Result := Cells[ChosenCellRow,ChosenCellCol];
end;
end;
end;
rvdNext, rvdPrev:
begin
if Position=rvdNext then
Dir := rvcdNext
else
Dir := rvcdPrev;
r := TRVTableStoreSubRVData(StoreState).Row;
c := TRVTableStoreSubRVData(StoreState).Col;
if GetCellTo(r,c, Dir, r, c, True) then begin
TRVTableStoreSubRVData(StoreState).Row := r;
TRVTableStoreSubRVData(StoreState).Col := c;
Result := Cells[r,c];
end;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ChooseSubRVData_(r, c: Integer);
var no, no1,no2,off1,off2: Integer;
begin
if (ChosenCellRow=r) and (ChosenCellCol=c) then
exit;
TCustomRVFormattedData(Cells[r,c].GetRVData).GetSelectionBounds(no1,off1,no2,off2,False);
no := GetMyItemNo;
TCustomRVFormattedData(FRows.FMainRVData).SetSelectionBounds(no,1,no,1);
(FRows.FMainRVData as TCustomRVFormattedData).AssignChosenRVData(Cells[r,c], Self);
ChosenCellRow := r;
ChosenCellCol := c;
if (rvtsEditMode in FState) and (rvtsInserted in FState) then
EditCell(ChosenCellRow,ChosenCellCol);
TCustomRVFormattedData(Cells[r,c].GetRVData).SetSelectionBounds(no1,off1,no2,off2);
TCustomRVFormattedData(Cells[r,c].GetRVData).Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ChooseSubRVData(StoreState: TRVStoreSubRVData);
begin
ChooseSubRVData_(TRVTableStoreSubRVData(StoreState).Row,
TRVTableStoreSubRVData(StoreState).Col);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ResetSubCoords;
begin
if FRows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(FRows.FMainRVData).GetItemClientCoords(GetMyItemNo,
MyClientLeft, MyClientTop);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSoftPageBreakDY(Data: Integer): Integer;
begin
if Data>=Fmt.RowStarts.Count then
Result := Fmt.FHeight
else
Result := Fmt.RowStarts[Data];
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetInplaceBounds(Left, Top, Width,
Height: Integer);
begin
TRVTableInplaceEdit(FInplaceEditor).NormalScrolling := Height>10000;
TRVTableInplaceEdit(FInplaceEditor).FullRedraw := TRVTableInplaceEdit(FInplaceEditor).NormalScrolling;
if Height>10000 then
Height := 10000;
FInplaceEditor.SetBounds(Left, Top, Width, Height);
if rvtsFormatInplace in FState then begin
FInplaceEditor.RVData.TextWidth := -1;
FInplaceEditor.RVData.DocumentWidth := -1;
FInplaceEditor.RVData.Format_(True,False,True,0,FInplaceEditor.Canvas,
False,False,False);
end;
if (FInplaceEditor.RVData.DocumentHeight>0) and
(Height<FInplaceEditor.RVData.DocumentHeight) then
TRVTableInplaceEdit(FInplaceEditor).NormalScrolling := True;
Exclude(FState, rvtsFormatInplace);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.CanUseHeadingRowCount: Boolean;
var c,hrc, mr, mc: Integer;
cell: TRVTableCellData;
begin
Result := False;
hrc := HeadingRowCount;
if hrc>Rows.Count then
hrc := Rows.Count;
if hrc=0 then
exit;
for c := 0 to Rows[hrc-1].Count-1 do begin
cell := Rows.GetMainCell(hrc-1,c,mr,mc);
if mr+cell.RowSpan>hrc then
exit;
end;
Result := True;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetBackgroundImage: TGraphic;
begin
if FBackground<>nil then
Result := FBackground.Image
else
Result := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetBackgroundImage_(const Value: TGraphic; Copy: Boolean);
begin
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, Rows.FMainRVData, Copy);
if FBackground.Empty then begin
FBackground.Free;
FBackground := nil;
end
end;
if FInplaceEditor<>nil then
FInplaceEditor.Invalidate;
{$IFNDEF RVDONOTUSEANIMATION}
if Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetBackgroundImage(const Value: TGraphic);
var ui: TRVUndoModifyBackgroundImage;
begin
if Value=BackgroundImage then
exit;
if (rvtsInserted in FState) and IsInEditor then begin
MergeInplaceUndo(False);
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVUndoModifyBackgroundImage(
AddTableUndoInfo(TRVEditRVData(FRows.FMainRVData), TRVUndoModifyBackgroundImage,
GetMyItemNo, False, False));
if ui<>nil then begin
ui.Row := -1;
ui.Col := -1;
ui.Image := GetBackgroundImage;
SetBackgroundImage_(nil, False);
end;
end;
SetBackgroundImage_(Value, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetVisibleBorders(const Value: TRVBooleanRect);
begin
FVisibleBorders.Assign(Value);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.StoreVisibleBorders: Boolean;
begin
Result := not FVisibleBorders.IsAllEqual(True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCellBackgroundImage(Value: TGraphic; Row,Col: Integer);
var ui: TRVUndoModifyBackgroundImage;
Cell: TRVTableCellData;
begin
Cell := Cells[Row,Col];
if Value=Cell.BackgroundImage then
exit;
if (rvtsInserted in FState) and IsInEditor then begin
MergeInplaceUndo(False);
TRVEditRVData(FRows.FMainRVData).BeginUndoSequence(rvutModifyItem, True);
ui := TRVUndoModifyBackgroundImage(
AddTableUndoInfo(TRVEditRVData(FRows.FMainRVData), TRVUndoModifyBackgroundImage,
GetMyItemNo, False, False));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.Image := Cell.GetBackgroundImage;
Cell.SetBackgroundImage_(nil, False);
end;
end;
Cell.SetBackgroundImage_(Value, True);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetBackgroundStyle: TRVItemBackgroundStyle;
begin
if FBackground<>nil then
Result := FBackground.ItemBackStyle
else
Result := rvbsColor;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetBackgroundStyle(
const Value: TRVItemBackgroundStyle);
begin
if Value=BackgroundStyle then
exit;
if rvtsInserted in FState then begin
SetProperty('BackgroundStyle', ord(Value), False, False);
exit;
end;
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;
if FInplaceEditor<>nil then
FInplaceEditor.Invalidate;
{$IFNDEF RVDONOTUSEANIMATION}
if Rows.FMainRVData is TCustomRVFormattedData then
TCustomRVFormattedData(Rows.FMainRVData).ResetAniBackground;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetRVFExtraPropertyCount: Integer;
begin
Result := inherited GetRVFExtraPropertyCount;
if BackgroundImageFileName<>'' then
inc(Result);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SaveRVFExtraProperties(Stream: TStream);
begin
inherited SaveRVFExtraProperties(Stream);
if BackgroundImageFileName<>'' then
WriteRVFExtraStrPropertyStr(Stream, rvespImageFileName,
BackgroundImageFileName);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetExtraStrProperty(
Prop: TRVExtraItemStrProperty; var Value: String): Boolean;
begin
case Prop of
rvespImageFileName:
begin
Value := BackgroundImageFileName;
Result := True;
end;
else
Result := inherited GetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.SetExtraStrProperty(
Prop: TRVExtraItemStrProperty; const Value: String): Boolean;
begin
case Prop of
rvespImageFileName:
begin
BackgroundImageFileName := Value;
Result := True;
end;
else
Result := inherited SetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetItemNoInRootDocument: Integer;
var RVData: TCustomRVData;
Location: TRVStoreSubRVData;
ParentItemNo: Integer;
begin
RVData := Rows.FMainRVData;
ParentItemNo := GetMyItemNo;
Result := ParentItemNo;
repeat
RVData.GetParentInfo(ParentItemNo, Location);
Location.Free;
if ParentItemNo>=0 then begin
Result := ParentItemNo;
RVData := RVData.GetAbsoluteParentData;
end;
until ParentItemNo<0;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.AssignProperties(Source: TRVTableItemInfo);
begin
Options := Source.Options;
PrintOptions := Source.PrintOptions;
BestWidth := Source.BestWidth;
Color := Source.Color;
BackgroundImage := Source.BackgroundImage;
BackgroundStyle := Source.BackgroundStyle;
BackgroundImageFileName := Source.BackgroundImageFileName;
HeadingRowCount := Source.HeadingRowCount;
TextRowSeparator := Source.TextRowSeparator;
TextColSeparator := Source.TextColSeparator;
BorderWidth := Source.BorderWidth;
BorderColor := Source.BorderColor;
BorderLightColor := Source.BorderLightColor;
BorderStyle := Source.BorderStyle;
BorderVSpacing := Source.BorderVSpacing;
BorderHSpacing := Source.BorderHSpacing;
CellBorderWidth := Source.CellBorderWidth;
CellBorderColor := Source.CellBorderColor;
CellBorderLightColor := Source.CellBorderLightColor;
CellPadding := Source.CellPadding;
CellBorderStyle := Source.CellBorderStyle;
VRuleWidth := Source.VRuleWidth;
VRuleColor := Source.VRuleColor;
HRuleWidth := Source.HRuleWidth;
HRuleColor := Source.HRuleColor;
CellVSpacing := Source.CellVSpacing;
CellHSpacing := Source.CellHSpacing;
VOutermostRule := Source.VOutermostRule;
HOutermostRule := Source.HOutermostRule;
end;
procedure TRVTableItemInfo.ResetLiveSpell;
begin
{$IFNDEF RVDONOTUSELIVESPELL}
if GetMyItemNo>=0 then
TCustomRichView(Rows.FMainRVData.GetAbsoluteRootData.GetParentControl).
LaterSetBackLiveSpellingTo(Rows.FMainRVData.GetSourceRVData, GetMyItemNo, 0);
{$ENDIF}
end;
initialization
RegisterRichViewItemClass(rvsTable, TRVTableItemInfo);
end.