rvtable.pas

richview1.7 full.source

      procedure SetCellBestHeight(Value: Integer; Row,Col: Integer);
      procedure SetCellColor(Value: TColor; Row,Col: Integer);
      procedure SetCellVisibleBorders(Left, Top, Right, Bottom: Boolean; Row,Col: Integer);
      procedure SetCellBorderColor(Value: TColor; Row,Col: Integer);
      procedure SetCellBorderLightColor(Value: TColor; Row,Col: Integer);
      procedure SetCellVAlign(Value: TRVCellVAlign; Row,Col: Integer);
      procedure SetRowVAlign(Value: TRVCellVAlign; Row: Integer);
      function MoveFocus(GoForward: Boolean; var TopLevelRVData: TPersistent; var  TopLevelItemNo: Integer): Boolean; override;
      procedure ClearFocus; override;
      procedure GetCellPosition(Cell: TRVTableCellData; var Row, Col: Integer);
    published
      { Published properties }
      // Table:
      property Options: TRVTableOptions read FOptions write FOptions default RVTABLEDEFAULTOPTIONS;
      property PrintOptions: TRVTablePrintOptions read FPrintOptions write FPrintOptions default RVTABLEDEFAULTPRINTOPTIONS;
      property BestWidth: TRVHTMLLength read FBestWidth write SetBestWidth default 0;
      property Color: TColor read FColor write SetColor default clWindow;
      property HeadingRowCount: Integer read FHeadingRowCount write SetHeadingRowCount default 0;      
      property TextRowSeparator: String read FTextRowSeparator write FTextRowSeparator;
      property TextColSeparator: String read FTextColSeparator write FTextColSeparator;
      // Border around the table:
      property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
      property BorderColor: TColor read FBorderColor write SetBorderColor default clWindowText;
      property BorderLightColor: TColor read FBorderLightColor write SetBorderLightColor default clBtnHighlight;
      property BorderStyle: TRVTableBorderStyle read FBorderStyle write SetBorderStyle default rvtbRaised;
      property BorderVSpacing: Integer read FBorderVSpacing write SetBorderVSpacing default 2;
      property BorderHSpacing: Integer read FBorderHSpacing write SetBorderHSpacing default 2;
      // Cells:
      property CellBorderWidth: Integer read FCellBorderWidth write SetCellBorderWidth default 0;
      property CellBorderColor: TColor read FCellBorderColor write SetCellBorderColorProp default clWindowText;
      property CellBorderLightColor: TColor read FCellBorderLightColor write SetCellBorderLightColorProp default clBtnHighlight;
      property CellPadding: Integer read FCellPadding write SetCellPadding default 1;
      property CellBorderStyle: TRVTableBorderStyle read FCellBorderStyle write SetCellBorderStyle default rvtbLowered;
      // Between cells:
      property VRuleWidth: Integer read FVRuleWidth write SetVRuleWidth default 0;
      property VRuleColor: TColor read FVRuleColor write SetVRuleColor default clWindowText;
      property HRuleWidth: Integer read FHRuleWidth write SetHRuleWidth default 0;
      property HRuleColor: TColor  read FHRuleColor write SetHRuleColor default clWindowText;
      property CellVSpacing: Integer read FCellVSpacing write SetCellVSpacing default 2;
      property CellHSpacing: Integer read FCellHSpacing write SetCellHSpacing default 2;
      property VOutermostRule: Boolean read FVOutermostRule write SetVOutermostRule default False;
      property HOutermostRule: Boolean read FHOutermostRule write SetHOutermostRule default False;
      // Events
      property OnCellEditing: TRVCellEditingEvent read FOnCellEditing write FOnCellEditing;
      property OnDrawBorder: TRVTableDrawBorderEvent read FOnDrawBorder write FOnDrawBorder;

  end;

 TRVTableStoreSubRVData = class (TRVStoreSubRVData)
   public
     Row, Col: Integer;
     constructor Create(ARow, ACol: Integer);
     function Duplicate: TRVStoreSubRVData; override;
 end;

  ERVTableInplaceError = class (Exception);

const RichViewTableGridStyle: TPenStyle = psDot;

implementation
uses RVTInplace;
const errMerge = 'Parameters for cell merging are not correct';
      errIso   = 'Cannot perform operation for isolated cell';
      errReadCells  = 'Wrong end of cells list';
      errInplaceBusy = 'Cannot destroy cell inplace editor at this time';
      errInvalidIndex = 'Invalid row or column index';
      errInternalError = 'Internal error';
{============================== TRVTablePrintInfo =============================}
type
  TRVTablePrintPart = class (TRVMultiDrawItemPart)
    public
      StartRow, RowCount: Integer;
      function GetSoftPageBreakInfo: Integer; override;
  end;

function TRVTablePrintPart.GetSoftPageBreakInfo: Integer;
begin
  Result := StartRow;
end;

type

  TRVTablePrintInfo = class (TRVMultiDrawItemInfo)
    private
      Fmt: TRVTableItemFormattingInfo;
      sad: TRVScreenAndDevice;
      FTable: TRVTableItemInfo;
      FUseHeadingRowCount: Boolean;
    public
      constructor Create(ATable: TRVTableItemInfo);
      procedure SetSize(AWidth, AHeight: Integer); override;
      destructor Destroy; override;
      function InitSplit: Boolean; override;
      function CanSplitFirst(Y: Integer): Boolean; override;
      function SplitAt(Y: Integer): Boolean; override;
  end;
{------------------------------------------------------------------------------}
constructor TRVTablePrintInfo.Create(ATable: TRVTableItemInfo);
begin
  inherited Create;
  FTable := ATable;
  Fmt := TRVTableItemFormattingInfo.Create(True);
  FUseHeadingRowCount := FTable.CanUseHeadingRowCount;  
end;
{------------------------------------------------------------------------------}
destructor TRVTablePrintInfo.Destroy;
begin
  Fmt.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.InitSplit: Boolean;
var part: TRVTablePrintPart;
begin
  if not  (rvtoRowsSplit in FTable.PrintOptions) then begin
    Result := False;
    exit;
  end;
  part := TRVTablePrintPart.Create;
  if FUseHeadingRowCount then begin
    part.StartRow := FTable.HeadingRowCount;
    if part.StartRow>Fmt.RowStarts.Count then
      part.StartRow := Fmt.RowStarts.Count;
    end
  else
    part.StartRow := 0;
  part.RowCount := Fmt.RowStarts.Count-part.StartRow;
  part.Height := Fmt.FHeight;
  PartsList.Add(part);
  Result := True;
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.CanSplitFirst(Y: Integer): Boolean;
var BorderHeight, CanSplitHere, hrc: Integer;
begin
  if FUseHeadingRowCount then begin
    hrc := FTable.HeadingRowCount;
    if hrc>FTable.Rows.Count then
      hrc := FTable.Rows.Count;
    if hrc=FTable.Rows.Count then begin
      Result := False;
      exit;
    end;
    end
  else
    hrc := 0;
  BorderHeight := Fmt.RowStarts[hrc]+
                  Fmt.FHeight-Fmt.RowStarts[Fmt.RowStarts.Count-1]-
                  Fmt.RowHeights[Fmt.RowStarts.Count-1];
  dec(y,BorderHeight);
  inc(y, Fmt.RowStarts[hrc]);
  CanSplitHere := FTable.GetSplitRowBelow(hrc);
  Result := y>Fmt.RowStarts[CanSplitHere]+Fmt.RowHeights[CanSplitHere];
end;
{------------------------------------------------------------------------------}
function TRVTablePrintInfo.SplitAt(Y: Integer): Boolean;
var BorderHeight, r,Count, CanSplitHere: Integer;
    part: TRVTablePrintPart;
begin
  if PartsList.Count=0 then
    raise ERichViewError.Create(errPrint);
  part := TRVTablePrintPart(PartsList[PartsList.Count-1]);
  if (part.RowCount=1) or (part.Height<=Y) then begin
    Result := False;
    exit;
  end;
  if FUseHeadingRowCount then begin
    r := FTable.HeadingRowCount;
    if r>Fmt.RowStarts.Count then
      r := Fmt.RowStarts.Count;
    if r=Fmt.RowStarts.Count then begin
      Result := False;
      exit;
    end;
    end
  else
    r := 0;
  BorderHeight := Fmt.RowStarts[r]+
                  Fmt.FHeight-Fmt.RowStarts[Fmt.RowStarts.Count-1]-
                  Fmt.RowHeights[Fmt.RowStarts.Count-1];
  dec(y,BorderHeight);
  inc(y, Fmt.RowStarts[part.StartRow]);
  r := part.StartRow+1;
  Count := 1;
  while y>Fmt.RowStarts[r]+Fmt.RowHeights[r] do begin
    inc(r);
    inc(Count);
  end;
  if Count>=part.RowCount then
    raise ERichViewError.Create(errPrint);
  CanSplitHere := FTable.GetSplitRowAbove(r);
  if CanSplitHere<=part.StartRow+1 then
    CanSplitHere := FTable.GetSplitRowBelow(part.StartRow)+1;
  inc(Count, CanSplitHere-r);
  r := CanSplitHere;
  if Count>part.RowCount then
    raise ERichViewError.Create(errPrint);
  if Count=part.RowCount then begin
    Result := False;
    exit;
  end;
  part.RowCount := Count;
  part.Height := BorderHeight+Fmt.RowStarts[r-1]+Fmt.RowHeights[r-1]-Fmt.RowStarts[part.StartRow];

  part := TRVTablePrintPart.Create;
  part.StartRow := r;
  part.RowCount := Fmt.RowStarts.Count-r;
  part.Height := BorderHeight+Fmt.RowStarts[Fmt.RowStarts.Count-1]+Fmt.RowHeights[Fmt.RowStarts.Count-1]-
                 Fmt.RowStarts[r];
  PartsList.Add(part);
  Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVTablePrintInfo.SetSize(AWidth, AHeight: Integer);
begin
  // do nothing
end;
{------------------------------------------------------------------------------}
type
  TCellPtblRVData = class (TRectPtblRVData)
    protected
      function GetRVStyle: TRVStyle; override;
  end;

  function TCellPtblRVData.GetRVStyle: TRVStyle;
  begin
    Result := FPrintingData.GetRVStyle;
  end;

type

  TRVUndoModifyCellIntProperty = class(TRVUndoModifyItemIntProperty)
    public
      Row, Col: Integer;
      procedure Undo(RVData: TRichViewRVData); override;
      procedure SetOppositeUndoInfoProps(UndoInfo: TRVUndoModifyItemProps); override;
  end;

  TRVUndoModifyCellVisibleBorders = class(TRVUndoModifyItemProps)
    public
      Row, Col: Integer;
      Left, Right, Top, Bottom: Boolean;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoModifyCellIntProperties = class(TRVUndoModifyItemIntProperties)
    public
       Row, Col: Integer;
      procedure Undo(RVData: TRichViewRVData); override;
      procedure SetOppositeUndoInfoProps(UndoInfo: TRVUndoModifyItemProps); override;
  end;

  TRVUndoRowVAlign = class(TRVUndoModifyItemProps)
    public
      Row: Integer;
      OldVAlign: TRVCellVAlign;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoInsertTableRows = class(TRVUndoModifyItemProps)
    public
      Row, Count: Integer;
      Flag: Boolean;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoInsertTableCell = class(TRVUndoModifyItemProps)
    public
      Row, Col: Integer;
      Flag: Boolean;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoSpreadOverEmptyCells = class(TRVUndoModifyItemProps)
    public
      Row, Col, ColSpan: Integer;
      Flag: Boolean;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoSpan = class(TRVUndoModifyItemProps)
    public
      IsColSpan: Boolean;
      Row, Col, OldSpan: Integer;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoFreeEmptyCell = class(TRVUndoModifyItemProps)
    public
      Flag: Boolean;
      Row, Col, ColSpan, RowSpan: Integer;
      procedure Undo(RVData: TRichViewRVData); override;
  end;

  TRVUndoInsertEmptyCell = class(TRVUndoModifyItemProps)
    public
      Flag: Boolean;
      Row, Col, ColCount, RowCount: Integer;
      procedure Undo(RVData: TRichViewRVData); override;
  end;