RichEdit

开发平台：

Delphi

RVTable.pas：源码内容

end
else begin
Cell.Clear;
Cell.AddNL('',0,0);
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnClearCells(CellsList: TList;RowList, ColList: TRVIntegerList);
var i: Integer;
ChosenCell: TCustomRVData;
begin
if (FMainRVData is TCustomRVFormattedData) and (TCustomRVFormattedData(FMainRVData).GetChosenRVData<>nil) then
ChosenCell := TCustomRVFormattedData(FMainRVData).GetChosenRVData.GetSourceRVData
else
ChosenCell := nil;
for i := 0 to RowList.Count-1 do begin
if ChosenCell=Items[RowList[i]][ColList[i]] then
TCustomRVFormattedData(FMainRVData).SilentReplaceChosenRVData(TRVTableCellData(CellsList.Items[i]));
Items[RowList[i]][ColList[i]].Free;
Items[RowList[i]][ColList[i]] := TRVTableCellData(CellsList.Items[i]);
TRVTableCellData(CellsList.Items[i]).MovingFromUndoList;
end;
CellsList.Clear;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.Do_BeforeMergeCells(ItemNo, Row, Col, ColSpan, RowSpan: Integer):TRVUndoInfo;
var ui: TRVUndoMerge;
r,c: Integer;
begin
ui := nil;
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoMerge(AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoMerge,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.OldColSpan := Items[Row][Col].ColSpan;
ui.OldRowSpan := Items[Row][Col].RowSpan;
ui.NewColSpan := ColSpan;
ui.NewRowSpan := RowSpan;
ui.OldBestWidth := Items[Row][Col].BestWidth;
ui.MergedItemsList := TRVList.Create;
for r := Row to Row+RowSpan-1 do
for c := Col to Col+ColSpan-1 do
if (Items[r][c]<>nil) and
(Items[r][c]<>Items[Row][Col]) then
ui.MergedItemsList.Add(TRVUndoMergeItem.Create(FTable,r,c,Row,Col));
end;
end;
Result := ui;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_MergeCells(ItemNo, Row, Col, ColSpan, RowSpan: Integer;
ui: TRVUndoInfo; ChangeBestWidth: Boolean);
var r,c: Integer;
Vampire, Victim: TRVTableCellData;
begin
Vampire := Items[Row][Col];
if ChangeBestWidth then
Vampire.FBestWidth := GetBestWidth(Row, Col, ColSpan, RowSpan);
for r := Row to Row+RowSpan-1 do
for c := Col to Col+ColSpan-1 do begin
Victim := Items[r].Items[c];
if (Victim<>Vampire) and (Victim<>nil) then begin
if Victim.HasData(False) then
Vampire.DrainFrom(Victim);
if ItemNo=-1 then
Victim.Free
else begin
Victim.MovingToUndoList(ui);
Victim.State := Victim.State - [rvstCompletelySelected];
end;
Items[r][c] := nil;
end;
end;
Vampire.FColSpan := ColSpan;
Vampire.FRowSpan := RowSpan;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UndoMergeCells(ItemNo, Row, Col, OldColSpan, OldRowSpan: Integer;
MergedItemsList: TRVList;
OldBestWidth: TRVHTMLLength);
var i,j,ItemIndex: Integer;
Vampire: TRVTableCellData;
UnmergeData: TRVUndoMergeItem;
begin
Vampire := Items[Row][Col];
Vampire.FBestWidth := OldBestWidth;
ItemIndex := Vampire.Items.Count;
for i := MergedItemsList.Count-1 downto 0 do begin
UnmergeData := TRVUndoMergeItem(MergedItemsList.Items[i]);
UnmergeData.Cell.MovingFromUndoList;
Items[UnmergeData.Row][UnmergeData.Col] := UnmergeData.Cell;
UnmergeData.Cell.FList := Items[UnmergeData.Row];
dec(ItemIndex,UnmergeData.ItemCount);
for j := ItemIndex to ItemIndex+UnmergeData.ItemCount-1 do
UnmergeData.Cell.AddItemAsIs(Vampire.Items[j], TCustomRVItemInfo(Vampire.Items.Objects[j]));
end;
while Vampire.Items.Count>ItemIndex do
Vampire.Items.Delete(Vampire.Items.Count-1);
Vampire.FColSpan := OldColSpan;
Vampire.FRowSpan := OldRowSpan;
MergedItemsList.Clear;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_BeforeUnmergeCell(ItemNo, Row, Col: Integer;
UnmergeRows, UnmergeCols: Boolean);
var ui: TRVUndoUnmerge;
begin
if (rvtsInserted in FTable.FState) and FTable.IsInEditor then begin
ui := TRVUndoUnmerge(AddTableUndoInfo(TRVEditRVData(FMainRVData), TRVUndoUnmerge,
ItemNo, True, True));
if ui<>nil then begin
ui.Row := Row;
ui.Col := Col;
ui.OldColSpan := Items[Row][Col].ColSpan;
ui.OldRowSpan := Items[Row][Col].RowSpan;
ui.UnmergeCols := UnmergeCols;
ui.UnmergeRows := UnmergeRows;
ui.OldBestWidth := Items[Row][Col].BestWidth;
ui.OldBestHeight := Items[Row][Col].BestHeight;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UnmergeCell(ItemNo, Row, Col: Integer;
UnmergeRows, UnmergeCols: Boolean);
var r,w,h, RowSpan: Integer;
MainCell: TRVTableCellData;
{.................................................}
procedure DoUnmergeCols(Row, RowSpan: Integer);
var c: Integer;
MainCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
for c := Col+1 to Col+MainCell.ColSpan-1 do begin
Items[Row][c] := TRVTableCellData.Create(Items[Row]);
Items[Row][c].BestWidth := w;
Items[Row][c].FRowSpan := RowSpan;
Items[Row][c].AssignAttributesFrom(MainCell,False,0,0);
end;
MainCell.FColSpan := 1;
MainCell.BestWidth := w;
end;
{.................................................}
begin
MainCell := Items[Row][Col];
if UnmergeCols then begin
w := MainCell.BestWidth div MainCell.ColSpan;
if w=0 then
if MainCell.BestWidth>0 then
w := 1
else if MainCell.BestWidth<0 then
w := -1;
end
else
w := MainCell.BestWidth;
if UnmergeRows then begin
h := MainCell.BestHeight div MainCell.RowSpan;
RowSpan := MainCell.RowSpan;
for r := Row+1 to Row+RowSpan-1 do begin
Items[r][Col] := TRVTableCellData.Create(Items[r]);
Items[r][Col].AssignAttributesFrom( MainCell,True,1,MainCell.RowSpan);
Items[r][Col].FColSpan := MainCell.ColSpan;
end;
MainCell.FRowSpan := 1;
MainCell.BestHeight := h;
if UnmergeCols then
for r := Row to Row+RowSpan-1 do
DoUnmergeCols(r, 1);
end
else if UnmergeCols then
DoUnmergeCols(Row, MainCell.RowSpan);
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.Do_UndoUnmergeCell(ItemNo, Row, Col: Integer;
OldColSpan, OldRowSpan: Integer;
OldBestWidth: TRVHTMLLength;
OldBestHeight: Integer);
var r,c: Integer;
MainCell: TRVTableCellData;
begin
MainCell := Items[Row][Col];
if OldRowSpan<>MainCell.RowSpan then
for r := Row+1 to Row+OldRowSpan-1 do
for c := Col to Col+OldColSpan-1 do begin
Items[r][c].Free;
Items[r][c] := nil;
end;
if OldColSpan<>MainCell.ColSpan then
for c := Col+1 to Col+OldColSpan-1 do begin
Items[Row][c].Free;
Items[Row][c] := nil;
end;
MainCell.FColSpan := OldColSpan;
MainCell.FRowSpan := OldRowSpan;
MainCell.FBestWidth := OldBestWidth;
MainCell.FBestHeight := OldBestHeight;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.InsertCols(Index, Count, CopyIndex: Integer;
DivideWidths: Boolean);
var r,c,mr,mc: Integer;
ItemNo: Integer;
cell: TRVTableCellData;
ForbiddenRows: TRVIntegerList;
begin
if (Index<0) or (Index>Items[0].Count) or
(CopyIndex<-1) or (CopyIndex>=Items[0].Count) then
raise ERichViewError.Create(errInvalidIndex);
ItemNo := FTable.GetEditorItemNoForUndo;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, True);
ForbiddenRows := TRVIntegerList.CreateEx(Self.Count,0);
try
if Index<>Items[0].Count then begin
r := Self.Count-1;
while r>=0 do begin
cell := GetMainCell(r,Index,mr,mc);
if (mc<Index) and (mc+cell.ColSpan-1>=Index) then begin
for c := mr to mr+cell.RowSpan-1 do
ForbiddenRows[c] := 1;
Do_SetSpan(ItemNo, mr, mc, cell.FColSpan+Count, True);
end;
r := mr-1;
end;
end;
r := 0;
while r<Self.Count do begin
if ForbiddenRows[r]=0 then begin
if CopyIndex<>-1 then
cell := Items[r][CopyIndex]
else
cell := nil;
if (cell<>nil) and DivideWidths then
FTable.SetCellBestWidth_(ItemNo, cell.BestWidth * cell.ColSpan div (cell.ColSpan+Count),r,CopyIndex);
for c := 0 to Count-1 do begin
Do_BeforeInsertCell(ItemNo,r,Index);
Items[r].Insert(Index);
if cell<>nil then begin
FTable.AssignCellAttributes(ItemNo, r, Index, cell, True, Cell.ColSpan,1);
Do_SetSpan(ItemNo, r, Index, cell.RowSpan, False);
end;
end;
if cell=nil then
inc(r)
else begin
Do_BeforeInsertEmptyCells(ItemNo,r+1,Index,Count,Cell.RowSpan-1);
Do_InsertEmptyCells(r+1,Index,Count,Cell.RowSpan-1);
inc(r,cell.RowSpan);
end;
end
else begin
Do_BeforeInsertEmptyCells(ItemNo,r,Index,Count,1);
Do_InsertEmptyCells(r,Index,Count,1);
inc(r);
end;
end;
finally
ForbiddenRows.Free;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.InsertRows(Index, Count, CopyIndex: Integer;
DivideHeights: Boolean);
var r,c,mr,mc: Integer;
cell: TRVTableCellData;
ForbiddenCols: TRVIntegerList;
ItemNo: Integer;
ColCount: Integer;
begin
if (Index<0) or (Index>Self.Count) or
(CopyIndex<-1) or (CopyIndex>=Self.Count) then
raise ERichViewError.Create(errInvalidIndex);
ItemNo := FTable.GetEditorItemNoForUndo;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, True);
ColCount := GetColCount;
ForbiddenCols := TRVIntegerList.CreateEx(ColCount,0);
try
if Index<>Self.Count then begin
c := ColCount-1;
while c>=0 do begin
cell := GetMainCell(Index,c, mr,mc);
if (mr<Index) and (mr+cell.RowSpan-1>=Index) then begin
for r := mc to mc+cell.ColSpan-1 do
ForbiddenCols[r] := 1;
Do_SetSpan(ItemNo, mr, mc, cell.FRowSpan+Count, False);
end;
c := mc-1;
end;
end;
if CopyIndex>=Index then
inc(CopyIndex,Count);
Do_BeforeInsertRows(ItemNo, Index,Count);
Do_InsertRows(Index,Count);
c := 0;
while c<ColCount do
if ForbiddenCols[c]=0 then begin
if CopyIndex<>-1 then
cell := Items[CopyIndex][c]
else
cell := nil;
if cell<>nil then begin
if DivideHeights then
FTable.SetCellBestHeight_(ItemNo, cell.BestHeight * cell.RowSpan div (cell.RowSpan+Count), CopyIndex,c);
for r := 0 to Count-1 do begin
FTable.AssignCellAttributes(ItemNo, Index+r, c, cell, True, 1, cell.RowSpan);
Do_BeforeSpreadOverEmptyCells(ItemNo, Index+r, c, cell.ColSpan);
Do_SpreadOverEmptyCells(Index+r, c, cell.ColSpan);
end;
inc(c,cell.ColSpan);
end
else
inc(c);
end
else begin
Do_BeforeFreeEmptyCells(ItemNo, Index, c, 1, Count);
Do_FreeEmptyCells(Index, c, 1, Count);
inc(c);
end;
finally
ForbiddenCols.Free;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.DeleteRows(Index, Count: Integer; DecreaseHeight: Boolean);
var c,mr,mc,span: Integer;
cell: TRVTableCellData;
ItemNo: Integer;
ui: TRVUndoInfo;
begin
if (Index<0) or (Index>=Self.Count) or (Count<=0) or
((Index=0) and (Count>Self.Count)) then
raise ERichViewError.Create(errInvalidIndex);
if Count+Index>Self.Count then
Count := Self.Count-Index;
ItemNo := FTable.GetEditorItemNoForUndo;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, True);
try
c := Items[0].Count-1;
while c>=0 do begin
cell := GetMainCell(Index+Count-1,c,mr,mc);
if mr+cell.RowSpan-1>Index+Count-1 then
if mr>=Index then begin
Do_BeforeSplitCellHorz(ItemNo,mr,mc,Index+Count,DecreaseHeight);
Do_SplitCellHorz(mr,mc,Index+Count,DecreaseHeight);
end;
c := mc-1;
end;
c := Items[0].Count-1;
while c>=0 do begin
cell := GetMainCell(Index,c,mr,mc);
if mr<Index then begin
if mr+cell.RowSpan-1<=Index+Count-1 then
span := (Index-mr)
else
span := cell.RowSpan-Count;
if DecreaseHeight then
FTable.SetCellBestHeight_(ItemNo, cell.BestHeight * span div cell.RowSpan, mr, mc);
Do_SetSpan(ItemNo,mr,mc,span,False);
end;
c := mc-1;
end;
ui := Do_BeforeDeleteRows(ItemNo,Index,Count);
Do_DeleteRows(ItemNo,Index,Count, ui);
finally
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableRows.DeleteCols(Index, Count: Integer; DecreaseWidth: Boolean);
var r,mr,mc,span: Integer;
cell: TRVTableCellData;
ItemNo: Integer;
ui: TRVUndoInfo;
begin
if (Index<0) or (Index>=Items[0].Count) or (Count<=0) or
((Index=0) and (Count>Items[0].Count)) then
raise ERichViewError.Create(errInvalidIndex);
if Count+Index>Items[0].Count then
Count := Items[0].Count-Index;
ItemNo := FTable.GetEditorItemNoForUndo;
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, True);
try
r := Self.Count-1;
while r>=0 do begin
cell := GetMainCell(r,Index+Count-1,mr,mc);
if mc+cell.ColSpan-1>Index+Count-1 then
if mc>=Index then begin
Do_BeforeSplitCellVert(ItemNo,mr,mc,Index+Count,DecreaseWidth);
Do_SplitCellVert(mr,mc,Index+Count,DecreaseWidth);
end;
r := mr-1;
end;
r := Self.Count-1;
while r>=0 do begin
cell := GetMainCell(r,Index,mr,mc);
if mc<Index then begin
if mc+cell.ColSpan-1<=Index+Count-1 then
span := (Index-mc)
else
span := cell.ColSpan-Count;
if DecreaseWidth then
FTable.SetCellBestWidth_(ItemNo, cell.BestWidth * span div cell.ColSpan, mr, mc);
Do_SetSpan(ItemNo,mr,mc,span,True);
end;
r := mr-1;
end;
ui := Do_BeforeDeleteCols(ItemNo,Index,Count);
Do_DeleteCols(ItemNo,Index,Count, ui);
finally
if ItemNo<>-1 then
TRVEditRVData(FMainRVData).Do_ItemModifyTerminator(ItemNo, False);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.SplitCellVertically(Row, Col, ColCount: Integer): Integer;
var OldColSpan, r, c,mr,mc,mr2,mc2,
NewColCount, NewColSpan: Integer;
MainCell,Cell: TRVTableCellData;
begin
Result := 0;
if ColCount<=1 then
exit;
MainCell := Items[Row][Col];
if MainCell=nil then
exit;
OldColSpan := MainCell.ColSpan;
if OldColSpan>1 then
UnmergeCell(Row,Col, False, True);
if OldColSpan<ColCount then begin
Result := ColCount-OldColSpan;
for c := Col+OldColSpan-1 downto Col do begin
if (ColCount=0) or (OldColSpan=0) then
exit;
NewColCount := ColCount div OldColSpan;
InsertCols(c, NewColCount-1,c, True);
r := Count-1;
while r>=0 do begin
GetMainCell(r,c,mr,mc);
if (mr<>Row) then begin
Cell := GetMainCell(mr,c+NewColCount-1,mr2,mc2);
inc(mc2,Cell.ColSpan);
MergeCells(mr,mc, mc2-mc,Cell.RowSpan, True, True);
end;
r := mr-1;
end;
dec(ColCount,NewColCount);
dec(OldColSpan);
end;
end
else if OldColSpan>ColCount then begin
c := Col+OldColSpan-1;
while c>=Col do begin
if (ColCount=0) or (OldColSpan=0) then
exit;
NewColSpan := OldColSpan div ColCount;
dec(c,NewColSpan-1);
MergeCells(Row, c, NewColSpan, Items[Row][c].RowSpan, True, True);
dec(OldColSpan, NewColSpan);
dec(ColCount);
dec(c);
end;
//Assert(ColCount=0);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.SplitCellHorizontally(Row, Col, RowCount: Integer): Integer;
var OldRowSpan, r, c,mr,mc,mr2,mc2,
NewRowCount, NewRowSpan: Integer;
MainCell,Cell: TRVTableCellData;
begin
Result := 0;
if RowCount<=1 then
exit;
MainCell := Items[Row][Col];
if MainCell=nil then
exit;
OldRowSpan := MainCell.RowSpan;
if OldRowSpan>1 then
UnmergeCell(Row,Col, True, False);
if OldRowSpan<RowCount then begin
Result := RowCount-OldRowSpan;
for r := Row+OldRowSpan-1 downto Row do begin
if (RowCount=0) or (OldRowSpan=0) then
exit;
NewRowCount := RowCount div OldRowSpan;
InsertRows(r, NewRowCount-1,r, True);
c := Items[0].Count-1;
while c>=0 do begin
GetMainCell(r,c,mr,mc);
if (mc<>Col) then begin
Cell := GetMainCell(r+NewRowCount-1,mc,mr2,mc2);
inc(mr2,Cell.RowSpan);
MergeCells(mr,mc, Cell.ColSpan,mr2-mr, True, True);
end;
c := mc-1;
end;
dec(RowCount,NewRowCount);
dec(OldRowSpan);
end;
end
else if OldRowSpan>RowCount then begin
r := Row+OldRowSpan-1;
while r>=Row do begin
if (RowCount=0) or (OldRowSpan=0) then
exit;
NewRowSpan := OldRowSpan div RowCount;
dec(r,NewRowSpan-1);
MergeCells(r, Col, Items[r][Col].ColSpan, NewRowSpan,True, True);
dec(OldRowSpan, NewRowSpan);
dec(RowCount);
dec(r);
end;
//Assert(RowCount=0);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.SplitCellsHorizontally(TopRow, LeftCol, ColSpan,
RowSpan, RowCount: Integer): Integer;
var r,c,r2,rowadded,Span: Integer;
begin
Result := 0;
for r := TopRow+RowSpan-1 downto TopRow do begin
rowadded := 0;
for c := LeftCol to LeftCol+ColSpan-1 do
if Items[r][c]<>nil then begin
if rowadded>0 then begin
Span := 0;
for r2 := r+1 to r+rowadded do
if Items[r2][c]<>nil then
inc(Span);
if (Span>0) then begin
MergeCells(r,c, Items[r][c].ColSpan,Items[r][c].RowSpan+Span,True,True);
end;
end;
inc(rowadded, SplitCellHorizontally(r,c,RowCount));
end;
inc(Result,rowadded);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableRows.SplitCellsVertically(TopRow, LeftCol, ColSpan,
RowSpan, ColCount: Integer): Integer;
var r,c,c2,coladded,Span: Integer;
begin
Result := 0;
for c := LeftCol+ColSpan-1 downto LeftCol do begin
coladded := 0;
for r := TopRow to TopRow+RowSpan-1 do
if Items[r][c]<>nil then begin
if coladded>0 then begin
Span := 0;
for c2 := c+1 to c+coladded do
if Items[r][c2]<>nil then
inc(Span);
if (Span>0) then begin
MergeCells(r,c, Items[r][c].ColSpan+Span,Items[r][c].RowSpan,True,True);
end;
end;
inc(coladded, SplitCellVertically(r,c,ColCount));
end;
inc(Result,coladded);
end;
end;
{========================= TRVTableItemFormattingInfo =========================}
constructor TRVTableItemFormattingInfo.Create(CreateRows:Boolean);
begin
inherited Create;
ColWidths := TRVIntegerList.Create;
ColStarts := TRVIntegerList.Create;
RowHeights := TRVIntegerList.Create;
RowStarts := TRVIntegerList.Create;
if CreateRows then
Rows := TRVList.Create;
end;
{------------------------------------------------------------------------------}
destructor TRVTableItemFormattingInfo.Destroy;
begin
ColWidths.Free;
ColStarts.Free;
RowHeights.Free;
RowStarts.Free;
Rows.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemFormattingInfo.Clear;
begin
ColWidths.Clear;
ColStarts.Clear;
RowHeights.Clear;
RowStarts.Clear;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemFormattingInfo.QuickClear;
begin
ColWidths.Count := 0;
ColStarts.Count := 0;
RowHeights.Count := 0;
RowStarts.Count := 0;
end;
{========================== TRVTableItemInfo ==================================}
constructor TRVTableItemInfo.Create(RVData: TPersistent);
begin
inherited Create(RVData);
Init(1,1, TCustomRVData(RVData));
Include(FState, rvtsJustCreated);
end;
{------------------------------------------------------------------------------}
constructor TRVTableItemInfo.CreateEx(nRows, nCols: Integer; AMainRVData: TCustomRVData);
begin
inherited Create(AMainRVData);
Init(nRows,nCols, AMainRVData);
Include(FState, rvtsJustCreated);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Init(nRows, nCols: Integer; AMainRVData: TCustomRVData);
begin
Fmt := TRVTableItemFormattingInfo.Create(False);
StyleNo := rvsTable;
FRows := TRVTableRows.Create(nRows, nCols, TCustomRVFormattedData(AMainRVData), Self);
FBorderWidth := 0;
FCellBorderWidth := 0;
FBorderStyle := rvtbRaised;
FCellBorderStyle := rvtbLowered;
FHRuleColor := clWindowText;
FVRuleColor := clWindowText;
FBorderColor := clWindowText;
FCellBorderColor := clWindowText;
FCellBorderLightColor := clBtnHighlight;
FBorderLightColor := clBtnHighlight;
FCellVSpacing := 2;
FCellHSpacing := 2;
FBorderVSpacing := 2;
FBorderHSpacing := 2;
FCellPadding := 1;
FHRuleWidth := 0;
FVRuleWidth := 0;
FColor := clWindow;
FSelStartCol := -1;
FSelStartRow := -1;
FSelColOffs := 0;
FSelRowOffs := 0;
FOptions := RVTABLEDEFAULTOPTIONS;
FPrintOptions := RVTABLEDEFAULTPRINTOPTIONS;
Screen.Cursors[crRVSelectCol] := LoadCursor(hInstance, 'RV_SELECTCOL_CURSOR');
Screen.Cursors[crRVSelectRow] := LoadCursor(hInstance, 'RV_SELECTROW_CURSOR');
TextRowSeparator := #13#10;
TextColSeparator := #13#10;
FocusedCellRow := -1;
FocusedCellCol := -1;
ChosenCellRow := -1;
ChosenCellCol := -1;
FVisibleBorders := TRVBooleanRect.Create(True);
end;
{------------------------------------------------------------------------------}
destructor TRVTableItemInfo.Destroy;
begin
ClearTemporal;
FRows.Free;
Fmt.Free;
FBackground.Free;
FVisibleBorders.Free;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ClearTemporal;
begin
if FRows.FMainRVData<>nil then begin
DestroyInplace(False);
if FRows.FMainRVData is TCustomRVFormattedData then
with TCustomRVFormattedData(FRows.FMainRVData) do begin
UnAssignXorDrawing(Self.XorDrawing);
ReleaseMouseCapture(Self);
end;
end;
Fmt.Clear;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetHeight: Integer;
begin
Result := Fmt.FHeight;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetWidth: Integer;
begin
Result := Fmt.FWidth;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCells(Row, Col: Integer): TRVTableCellData;
begin
Result := FRows.Items[Row].Items[Col];
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SetCells(Row, Col: Integer;
const Value: TRVTableCellData);
begin
if FRows.Items[Row].Items[Col]<>nil then
FRows.Items[Row].Items[Col].Assign(Value);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.PaintFullWidth(Left, Right, Top: Integer;
Canvas: TCanvas; State: TRVItemDrawStates; Style: TRVStyle; const ClipRect: TRect;
dli: TRVDrawLineInfo);
begin
PaintTo(Left, Right, Top, 0, Rows.Count, Canvas, State, Style, Fmt, False,
ClipRect, rvcmColor, nil)
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.PaintTo(Left, Right, Top, FromRow, RowCount: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; Fmt: TRVTableItemFormattingInfo;
UseHeadingRowCount: Boolean; const ClipRect: TRect; ColorMode: TRVColorMode;
RVData: TCustomPrintableRVData);
var r,c,l,t,h: Integer;
VRules, HRules, Editing: Boolean;
DH, DV, DHHalf, DVHalf: Integer;
CBOffs,ROffs: Integer;
SelColor: TColor;
{...............................................}
procedure DrawVLine(X,Y1,Y2,Width: Integer);
begin
dec(X, Width div 2);
while Width>0 do begin
Canvas.MoveTo(X,Y1);
Canvas.LineTo(X,Y2);
inc(X);
dec(Width);
end;
end;
{...............................................}
procedure DrawVLine2(X,Y1,Y2,Width: Integer);
begin
if Y1<ClipRect.Top-1 then
Y1 := ClipRect.Top-1;
if Y2>ClipRect.Bottom+1 then
Y2 := ClipRect.Bottom+1;
dec(X, Width div 2);
while Width>0 do begin
Canvas.MoveTo(X,Y1);
Canvas.LineTo(X,Y2);
inc(X);
dec(Width);
end;
end;
{...............................................}
procedure DrawHLine(Y,X1,X2,Width: Integer);
begin
dec(Y, Width div 2);
while Width>0 do begin
Canvas.MoveTo(X1,Y);
Canvas.LineTo(X2,Y);
inc(Y);
dec(Width);
end;
end;
{...............................................}
function GetExtraPrnVOffs(CellHeight,RowHeight: Integer; VAlign: TRVCellVAlign): Integer;
begin
case VAlign of
rvcMiddle:
Result := (RowHeight-CellHeight) div 2;
rvcBottom:
Result := (RowHeight-CellHeight);
else
Result := 0;
end;
end;
{...............................................}
procedure DrawCell(r,c,h, DV, DH, l,t: Integer;
Canvas: TCanvas;
const ClipRect, BorderRect: TRect);
var cw,ch, i,idx: Integer;
Cell: TRVTableCellData;
CanDrawBitmappedBack,WasSelected: Boolean;
CellColor: TColor;
CPD: TCellPtblRVData;
BColor, BLColor: TColor;
CellRect, CellRect2: TRect;
{$IFNDEF RICHVIEWCBDEF3}
pt: TPoint;
{$ENDIF}
rgn: HRGN;
rgnres: Integer;
begin
rgnres := 0;
rgn := 0;
Cell := Cells[r,c];
if Fmt.Rows=nil then begin
idx := 0;
ch := Cell.FHeight;
cw := Cell.FWidth;
end
else begin
idx := r*Rows[0].Count+c;
if Fmt.Rows[idx]<>nil then begin
ch := TCellPtblRVData(Fmt.Rows[idx]).Height+GetDevY(CellPadding*2);
cw := TCellPtblRVData(Fmt.Rows[idx]).Width+GetDevX(CellPadding*2);
end
else begin
ch := h + GetDevY(CellPadding*2);
for i := 1 to Cell.RowSpan-1 do
inc(ch, Fmt.RowHeights[r+i]+DV);
cw := Fmt.ColWidths[c] + GetDevX(CellPadding*2);
for i := 1 to Cell.ColSpan-1 do
inc(cw, Fmt.ColWidths[c+i]+DH);
end;
end;
CellColor := clNone;
if rvidsSelected in State then begin
WasSelected := rvstCompletelySelected in Cells[r,c].State;
CellColor := SelColor;
Include(Cells[r,c].State, rvstCompletelySelected);
CanDrawBitmappedBack := False;
end
else begin
CanDrawBitmappedBack := not ((Fmt.Rows=nil) and IsCellSelected(r,c));
if not CanDrawBitmappedBack then
CellColor := SelColor;
WasSelected := True;
end;
if not CanDrawBitmappedBack then
CanDrawBitmappedBack := SelColor=clNone;
if CellColor=clNone then
CellColor := Cells[r,c].Color;
if (Fmt.Rows=nil) and (CellColor=clNone) and (FInplaceEditor<>nil) and
(TRVTableInplaceEdit(FInplaceEditor).FCell=Cell) and
TRVTableInplaceEdit(FInplaceEditor).NormalScrolling then
CellColor := clWindow;
if (CellColor<>clNone) or (Cell.FBackground<>nil) then begin
if (Fmt.Rows<>nil) and (rvtoWhiteBackground in PrintOptions) then
CellColor := clWhite;
CellColor := RV_GetBackColor(CellColor, ColorMode);
Canvas.Brush.Color := CellColor;
Canvas.Pen.Color := CellColor;
CellRect := Bounds(l, t, cw, ch);
if rvtoCellBelowBorders in Options then
InflateRect(CellRect,GetDevX(CellBorderWidth),GetDevY(CellBorderWidth));
if (Fmt.Rows=nil) and (FInplaceEditor<>nil) and
(TRVTableInplaceEdit(FInplaceEditor).FCell=Cell) and
TRVTableInplaceEdit(FInplaceEditor).NormalScrolling then begin
SetBkColor(Canvas.Handle, ColorToRGB(CellColor));
Canvas.Brush.Style := bsFDiagonal;
Canvas.Brush.Color := CellBorderColor;
SetBrushOrgEx(Canvas.Handle, l,t,
{$IFNDEF RICHVIEWCBDEF3}pt{$ELSE}nil{$ENDIF});
SetBkMode(Canvas.Handle, OPAQUE);
SetBkColor(Canvas.Handle, ColorToRGB(CellColor));
CanDrawBitmappedBack := False;
end;
if CanDrawBitmappedBack and (Cell.FBackground<>nil) then begin
if Fmt.Rows=nil then
Cell.FBackground.Draw(Canvas, CellRect, 0, 0, CellRect.Left, CellRect.Top,
CellRect.Right-CellRect.Left, CellRect.Bottom-CellRect.Top, CellColor, True)
else begin
CellRect2 := CellRect;
OffsetRect(CellRect2,-CellRect2.Left,-CellRect2.Top);
OffsetRect(CellRect2,BorderRect.Left,BorderRect.Top);
Cell.FBackground.Print(Canvas, CellRect, CellRect2, cursad^, CellColor,
rvidsPreview in State, FRows.FMainRVData.GetRVLogPalette, RVData, 1);
end;
end
else if CellColor<>clNone then
Canvas.FillRect(CellRect);
Canvas.Brush.Style := bsSolid;
end;
if Fmt.Rows=nil then begin
if (rvtoIgnoreContentWidth in Options) or
(rvtoIgnoreContentHeight in Options) then begin
rgn := CreateRectRgn(0,0,1,1);
rgnres := GetClipRgn(Canvas.Handle, rgn);
IntersectClipRect(Canvas.Handle, l, t, l+cw, t+ch);
end;
try
Cell.PaintTo(Canvas, ClipRect);
finally
if (rvtoIgnoreContentWidth in Options) or
(rvtoIgnoreContentHeight in Options) then begin
if rgnres=1 then
SelectClipRgn(Canvas.Handle, rgn)
else
SelectClipRgn(Canvas.Handle, 0);
DeleteObject(rgn);
end;
end;
{$IFDEF RVDEBUGTABLE}
if Cell.BestWidth>0 then begin
Canvas.Pen.Color := clRed;
Canvas.MoveTo(l+CellPadding,t);
Canvas.LineTo(l+CellPadding+Cell.BestWidth,t);
end;
if Cell.BestHeight>0 then begin
Canvas.Pen.Color := clGreen;
Canvas.MoveTo(l,t+CellPadding);
Canvas.LineTo(l,t+CellPadding+Cell.BestHeight);
end;
Canvas.Font.Color := clBlack;
Canvas.Font.Name := 'Small Fonts';
Canvas.Font.Size := 6;
Canvas.TextOut(l,t, IntToStr(Cells[r,c].BestWidth)+','+IntToStr(Cells[r,c].BestHeight));
{$ENDIF}
end
else begin
if Fmt.Rows[idx]<>nil then begin
CPD := TCellPtblRVData(Fmt.Rows[idx]);
CPD.Left := Left;
CPD.Top := Top+GetExtraPrnVOffs(CPD.DocumentHeight, CPD.Height, Cells[r,c].GetRealVAlign);
FPrintCell := Cell;
if (rvtoIgnoreContentWidth in Options) or
(rvtoIgnoreContentHeight in Options) then begin
rgn := CreateRectRgn(0,0,1,1);
rgnres := GetClipRgn(Canvas.Handle, rgn);
IntersectClipRect(Canvas.Handle, l, t, l+cw, t+ch);
end;
try
FPrintCellRect := Bounds(l,t,cw,ch);
OffsetRect(FPrintCellRect,-BorderRect.Left,-BorderRect.Top);
RV_RectToScreen(FPrintCellRect, cursad^);
CPD.AssignItemsFrom(Cells[r,c].GetRVData);
if (FInplaceEditor<>nil) and (TRVTableInplaceEdit(FInplaceEditor).FCell=Cells[r,c]) then begin
CPD.FSourceDataForPrinting := TRVTableInplaceEdit(FInplaceEditor).FCell;
CPD.DrawPage(1, Canvas, rvidsPreview in State, rvidsPreviewCorrection in State);
CPD.FSourceDataForPrinting := Cells[r,c];
end
else begin
CPD.DrawPage(1, Canvas, rvidsPreview in State, rvidsPreviewCorrection in State);
end;
FPrintCell := nil;
finally
if (rvtoIgnoreContentWidth in Options) or
(rvtoIgnoreContentHeight in Options) then begin
if rgnres=1 then
SelectClipRgn(Canvas.Handle, rgn)
else
SelectClipRgn(Canvas.Handle, 0);
DeleteObject(rgn);
end;
end;
end;
end;
if Cell.BorderColor <> clNone then
BColor := Cell.BorderColor
else
BColor := CellBorderColor;
if Cell.BorderLightColor <> clNone then
BLColor := Cell.BorderLightColor
else
BLColor := CellBorderLightColor;
DrawBorder(Canvas, l-CBOffs,t-CBOffs,l+cw+CBOffs,t+ch+CBOffs,
FCellBorderWidth, BLColor, BColor, Color, CellBorderStyle,
not (rvtoHideGridLines in Options), Editing,
rvidsPrinting in State, ClipRect, Cell.VisibleBorders, r, c, ColorMode);
if not WasSelected then
Exclude(Cell.State, rvstCompletelySelected);
end;
{...............................................}
var StartRow, LastRow, StartCol,RuleWidth:Integer;
mr,mc, hrc: Integer;
Clr: TColor;
BorderRect, BorderRect2: TRect;
begin
if TRVScroller(Rows.FMainRVData.GetRootData.GetParentControl).FocusedEx then
SelColor := Rows.FMainRVData.GetRVStyle.SelColor
else
SelColor := Rows.FMainRVData.GetRVStyle.InactiveSelColor;
Editing := rvtsEditMode in FState;
if Editing then
Editing := (FRows.FMainRVData is TRVEditRVData) and
not TCustomRichViewEdit(TRVEditRVData(FRows.FMainRVData).RichView).ReadOnly;
MyClientLeft := Left;
MyClientTop := Top;
VRules := (FVRuleWidth<>0) and (FVRuleColor<>clNone);
HRules := (FHRuleWidth<>0) and (FHRuleColor<>clNone);
DH := GetDevX(CellPadding+CellHSpacing+CellPadding+FCellBorderWidth*2);
DV := GetDevY(CellPadding+CellVSpacing+CellPadding+FCellBorderWidth*2);
CBOffs := GetDevY(FCellBorderWidth);
if Fmt.Rows=nil then begin
StartRow := GetCrossed(ClipRect.Top-Top-GetDevY(BorderWidth),Fmt.RowStarts);
LastRow := Rows.Count-1;
BorderRect := Bounds(Left,Top,Fmt.FWidth,Fmt.FHeight);
hrc := 0;
end
else begin
if UseHeadingRowCount then begin
hrc := HeadingRowCount;
if hrc>FromRow then
hrc := FromRow;
end
else
hrc := 0;
StartRow := FromRow;
LastRow := FromRow+RowCount-1;
BorderRect := Bounds(Left,Top,Fmt.FWidth,
Fmt.RowStarts[0]+Fmt.FHeight-Fmt.RowStarts[Rows.Count-1]-Fmt.RowHeights[Rows.Count-1]);
if LastRow>=StartRow then
inc(BorderRect.Bottom, Fmt.RowStarts[LastRow]+Fmt.RowHeights[LastRow]-Fmt.RowStarts[StartRow]);
if hrc>0 then begin
inc(BorderRect.Bottom, Fmt.RowStarts[hrc-1]+Fmt.RowHeights[hrc-1]-Fmt.RowStarts[0]);
if LastRow>=FromRow then
inc(BorderRect.Bottom, Fmt.RowStarts[hrc]-(Fmt.RowStarts[hrc-1]+Fmt.RowHeights[hrc-1]));
end;
//dec(Top, Fmt.RowStarts[FromRow]-Fmt.RowStarts[0]);
end;
if FBackground<>nil then begin
if FColor=clNone then
Clr := clNone
else if (Fmt.Rows<>nil) and (rvtoWhiteBackground in PrintOptions) then
Clr := clWhite
else
Clr := RV_GetBackColor(FColor, ColorMode);
IntersectRect(BorderRect2, BorderRect, ClipRect);
if Fmt.Rows=nil then
FBackground.Draw(Canvas, BorderRect2, 0, 0, Left, Top, Fmt.FWidth, Fmt.FHeight, Clr, True)
else
FBackground.Print(Canvas, BorderRect2, BorderRect, cursad^, Clr, rvidsPreview in State,
FRows.FMainRVData.GetRVLogPalette, RVData, 0);
end
else if FColor<>clNone then begin
if (Fmt.Rows<>nil) and (rvtoWhiteBackground in PrintOptions) then
Canvas.Brush.Color := clWhite
else
Canvas.Brush.Color := RV_GetBackColor(FColor, ColorMode);
IntersectRect(BorderRect2, BorderRect, ClipRect);
Canvas.FillRect(BorderRect2);
end;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
if VRules then begin
RuleWidth := GetDevX(FVRuleWidth);
DHHalf := (GetDevX(CellHSpacing+FCellBorderWidth*2)+1) div 2;
StartCol := GetCrossed(ClipRect.Left-Left-GetDevX(BorderWidth+CellHSpacing+BorderHSpacing),Fmt.ColStarts);
if HRules and FHOutermostRule then
ROffs := GetDevX(BorderWidth+(BorderVSpacing{-FHRuleWidth}) div 2)
else
ROffs := 0;
Canvas.Pen.Color := FVRuleColor;
if FVOutermostRule and (StartCol=0) then begin
l := Left+GetDevX(BorderWidth+BorderHSpacing div 2);
DrawVLine2(l, BorderRect.Top+ROffs, BorderRect.Bottom-ROffs, RuleWidth);
end;
for c := StartCol to Rows[0].Count-2 do begin
l := Left+Fmt.ColStarts[c+1]-DHHalf;
if l-RuleWidth>ClipRect.Right then
break;
DrawVLine2(l, BorderRect.Top+ROffs, BorderRect.Bottom-ROffs, RuleWidth);
end;
if FVOutermostRule then begin
l := Left+Fmt.FWidth-GetDevX(BorderWidth+BorderHSpacing div 2)-1;
if GetDevX(FVRuleWidth) mod 2 = 0 then
inc(l);
DrawVLine2(l, BorderRect.Top+ROffs, BorderRect.Bottom-ROffs, RuleWidth);
end;
end;
if HRules then begin
RuleWidth := GetDevY(FHRuleWidth);
DVHalf := (GetDevY(CellVSpacing+FCellBorderWidth*2)+1) div 2;
if VRules and FVOutermostRule then
ROffs := GetDevY(BorderWidth+(BorderHSpacing{-FVRuleWidth}) div 2)
else
ROffs := 0;
Canvas.Pen.Color := FHRuleColor;
if FHOutermostRule and ((StartRow<2) or (Fmt.Rows<>nil)) then begin
t := BorderRect.Top+GetDevY(BorderWidth+BorderVSpacing div 2);
DrawHLine(t, Left+ROffs, Left+Fmt.FWidth-ROffs, RuleWidth);
end;
if hrc>0 then
for r := 0 to hrc-2 do begin
t := Top+Fmt.RowStarts[r+1]-DVHalf;
if t-RuleWidth>ClipRect.Bottom then
break;
DrawHLine(t, Left+ROffs, Left+Fmt.FWidth-ROffs, RuleWidth);
end;
if LastRow>=StartRow then begin
if Fmt.Rows<>nil then
dec(Top, Fmt.RowStarts[FromRow]-Fmt.RowStarts[hrc]);
StartCol := StartRow-1;
if StartCol<0 then
StartCol := 0;
for r := StartCol to LastRow-1 do begin
t := Top+Fmt.RowStarts[r+1]-DVHalf;
if t-RuleWidth>ClipRect.Bottom then
break;
DrawHLine(t, Left+ROffs, Left+Fmt.FWidth-ROffs, RuleWidth);
end;
if Fmt.Rows<>nil then
inc(Top, Fmt.RowStarts[FromRow]-Fmt.RowStarts[hrc]);
end;
if FHOutermostRule then begin
t := BorderRect.Bottom-GetDevY(BorderWidth+BorderVSpacing div 2)-1;
if GetDevY(FHRuleWidth) mod 2 = 0 then
inc(t);
DrawHLine(t, Left+ROffs, Left+Fmt.FWidth-ROffs, RuleWidth);
end;
end;
DrawBorder(Canvas, BorderRect.Left,BorderRect.Top,
BorderRect.Right,BorderRect.Bottom, BorderWidth, BorderLightColor, BorderColor,
TCustomRVFormattedData(Rows.FMainRVData).GetColor, BorderStyle,
not (rvtoHideGridLines in Options), Editing,
rvidsPrinting in State, ClipRect, VisibleBorders, -1, -1, ColorMode);
if (StartRow>0) and (StartRow<Rows.Count) then begin
c := Rows[StartRow].Count-1;
while c>=0 do begin
Rows.GetMainCell(StartRow,c,mr,mc);
if mr<StartRow then
DrawCell(mr, mc, Fmt.RowHeights[mr], DV, DH,
Fmt.ColStarts[mc]+Left,Fmt.RowStarts[mr]+Top,
Canvas, ClipRect, BorderRect);
c := mc-1;
end;
end;
if hrc>0 then
for r := 0 to hrc-1 do begin
t := Fmt.RowStarts[r]+Top;
if t-CBOffs>ClipRect.Bottom then
break;
h := Fmt.RowHeights[r];
for c := 0 to Rows[r].Count-1 do begin
l := Fmt.ColStarts[c]+Left;
if l-CBOffs>ClipRect.Right then break;
if Cells[r,c]<>nil then
DrawCell(r,c,h, DV, DH, l,t, Canvas, ClipRect, BorderRect);
end;
end;
if LastRow>=StartRow then begin
if Fmt.Rows<>nil then
dec(Top, Fmt.RowStarts[FromRow]-Fmt.RowStarts[hrc]);
for r := StartRow to LastRow do begin
t := Fmt.RowStarts[r]+Top;
if t-CBOffs>ClipRect.Bottom then
break;
h := Fmt.RowHeights[r];
for c := 0 to Rows[r].Count-1 do begin
l := Fmt.ColStarts[c]+Left;
if l-CBOffs>ClipRect.Right then break;
if Cells[r,c]<>nil then
DrawCell(r,c,h, DV, DH, l,t, Canvas, ClipRect, BorderRect);
end;
end;
end;
Canvas.Pen.Width := 1;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DrawBackgroundUnderCell(Canvas: TCanvas;
Cell: TRVTableCellData; const Rect: TRect);
var r: TRect;
Clr: TColor;
begin
Clr := GetTableColor(False);
if FBackground<>nil then
FBackground.Draw(Canvas, Rect, 0, 0,
-Cell.Left, -Cell.Top-Cell.GetExtraVOffs, Width, Height, Clr, False)
else if Clr<>clNone then begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Clr;
r := Rect;
OffsetRect(r, -r.Left, -r.Top);
Canvas.FillRect(r);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.IsSemiTransparentBackground: Boolean;
begin
Result := (FColor=clNone) and (FBackground<>nil) and FBackground.IsSemitransparent;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetHorzExtra: Integer;
begin
Result := GetDevX(((BorderWidth+BorderHSpacing)*2+(CellHSpacing*(Rows[0].Count-1)))+
Rows[0].Count*CellBorderWidth*2);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas; RVData: TPersistent): Integer;
var ColWidths: TRVIntegerList;
MinColsWidth: Integer;
{.................................................}
procedure CalcMinWidths;
var c,w,w2: Integer;
begin
MinColsWidth := 0;
for c := 0 to Rows[0].Count-1 do begin
if rvtoIgnoreContentWidth in Options then
w := 0
else
w := Rows.GetMinColWidth(c,sad,Canvas);
if BestWidth=0 then begin
w2 := GetDevX(Rows.GetPixelColWidth(c));
if w2>w then
w := w2;
end;
inc(MinColsWidth, w);
ColWidths.Add(w);
end;
end;
{.................................................}
procedure ExpandCols(Row,Col, Width, Depth: Integer);
var c, oldw, neww, savedw, pureoldw, DH, UnsizedCount: Integer;
Cell: TRVTableCellData;
AddProportionally: Boolean;
const MAXDEPTH = 30;
begin
if Width<=0 then
exit;
AddProportionally := Depth>MAXDEPTH;
savedw := Width;
inc(Width, GetDevX(CellPadding*2));
Cell := Cells[Row,Col];
DH := GetDevX(CellPadding+CellHSpacing+CellPadding+FCellBorderWidth*2);
oldw := GetDevX(-CellHSpacing-FCellBorderWidth*2);
pureoldw := 0;
UnsizedCount := 0;
for c := Col to Col+Cell.ColSpan-1 do begin
inc(oldw, ColWidths[c]+DH);
if AddProportionally and (ColWidths[c]+GetDevX(CellPadding*2)=0) then
inc(pureoldw, 1)
else
inc(pureoldw, ColWidths[c]+GetDevX(CellPadding*2));
inc(UnsizedCount);
end;
if AddProportionally then begin
for c := Col to Col+Cell.ColSpan-1 do begin
oldw := ColWidths[c]+GetDevX(CellPadding*2);
if oldw=0 then
inc(oldw);
Width := MulDiv(oldw,DH,pureoldw);
ColWidths[c] := Width-GetDevX(CellPadding*2);
dec(pureoldw, oldw);
dec(DH,Width);
inc(MinColsWidth, Width-oldw);
end;
exit;
end;
if (oldw<Width) and (UnsizedCount<>0) then begin
DH := Width-oldw;
inc(DH, pureoldw);
for c := Col to Col+Cell.ColSpan-1 do begin
if (UnsizedCount=0) or (DH<=0) then
break;
oldw := ColWidths[c]+GetDevX(CellPadding*2);
neww := Round(DH/UnsizedCount);
if oldw>=neww then begin
dec(DH, oldw);
dec(UnsizedCount);
end;
end;
for c := Col to Col+Cell.ColSpan-1 do begin
if (UnsizedCount=0) or (DH<=0) then
break;
oldw := ColWidths[c]+GetDevX(CellPadding*2);
neww := Round(DH/UnsizedCount);
if oldw<neww then begin
ColWidths[c] := neww-GetDevX(CellPadding*2);
inc(MinColsWidth, neww-oldw);
dec(DH, neww);
dec(UnsizedCount);
end;
end;
ExpandCols(Row,Col, savedw, Depth+1);
end;
end;
{.................................................}
procedure CalcMinWidthsSpan;
var r,c,w,w2: Integer;
begin
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if (Items[c]<>nil) and (Items[c].ColSpan>1) then begin
if rvtoIgnoreContentWidth in Options then
w := 0
else
w := Items[c].GetMinWidth(sad,Canvas);
if BestWidth=0 then begin
w2 := GetDevX(Items[c].BestWidth);
if w2>w then
w := w2;
end;
ExpandCols(r,c, w, 0);
end;
end;
{.................................................}
var oldsad: PRVScreenAndDevice;
begin
oldsad := cursad;
cursad := sad;
try
if Rows.Empty then begin
Result := GetDevX((BorderWidth+BorderHSpacing)*2);
cursad := oldsad;
exit;
end;
Result := GetHorzExtra+GetDevX(CellPadding*Rows[0].Count*2);
MinColsWidth := 0;
ColWidths := TRVIntegerList.Create;
try
CalcMinWidths;
CalcMinWidthsSpan;
finally
ColWidths.Free;
end;
inc(Result, MinColsWidth);
if GetDevX(BestWidth)>Result then
Result := GetDevX(BestWidth);
finally
cursad := oldsad;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.IsFixedWidthTable: Boolean;
var r,c,mr,mc: Integer;
cell: TRVTableCellData;
definedwidth: Boolean;
begin
Result := False;
if Rows.IsEmptyRows(0,0,Rows[0].Count,Rows.Count,0,0) then
exit;
for c := 0 to Rows[0].Count-1 do begin
definedwidth := False;
for r := 0 to Rows.Count-1 do begin
cell := Rows.GetMainCell(r,c,mr,mc);
if cell.BestWidth<0 then
exit;
if (mc+cell.ColSpan-1=c) and (cell.BestWidth>0) then
definedwidth := True;
end;
if not definedwidth then
exit;
end;
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.OnDocWidthChange(DocWidth: Integer; dli: TRVDrawLineInfo;
Printing: Boolean; Canvas: TCanvas; RVData: TPersistent; sad: PRVScreenAndDevice;
var HShift, Desc: Integer; NoCaching, Reformatting: Boolean);
begin
HShift := 0;
Desc := 0;
if not Printing then begin
if (rvtsModified in FState) then begin
Exclude(FState, rvtsModified);
Fmt.FWidth := 0;
end;
InternalOnDocWidthChange(DocWidth, Fmt, Canvas, NoCaching, Reformatting)
end
else
try
cursad := @(TRVTablePrintInfo(dli).sad);
InternalOnDocWidthChange(DocWidth, (dli as TRVTablePrintInfo).Fmt, Canvas, False, False);
dli.Width := TRVTablePrintInfo(dli).Fmt.FWidth;
dli.Height := TRVTablePrintInfo(dli).Fmt.FHeight;
finally
cursad := nil;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InternalOnDocWidthChange(DocWidth: Integer;
Fmt: TRVTableItemFormattingInfo;
Canvas: TCanvas;
NoCaching, Reformatting: Boolean);
var r,c,w,w2,w3, PureWidth, SumColWidth, MinColsWidth, ExtraWidth: Integer;
ColsWithAssignedWidths: TRVIntegerList;
FixedWidthCount,AssignedCount: Integer;
FixedWidth: Boolean;
{.................................................}
procedure CalcMinWidths;
var c,w: Integer;
begin
MinColsWidth := 0;
for c := 0 to Rows[0].Count-1 do begin
if (rvtoIgnoreContentWidth in Options) then
w := 0
else
w := Rows.GetMinColWidth(c,cursad,Canvas);
inc(MinColsWidth, w);
Fmt.ColWidths.Add(w);
end;
end;
{.................................................}
procedure ExpandCols(Row,Col, Width, CWALim: Integer; ChangeMins: Boolean;
Depth: Integer);
var c, oldw, pureoldw, DH, UnsizedCount, neww, savedw: Integer;
Cell: TRVTableCellData;
Lim: Integer;
AddProportionally: Boolean;
const MAXDEPTH = 30;
begin
if Width=0 then
exit;
AddProportionally := not ChangeMins or (Depth>MAXDEPTH);
savedw := Width;
inc(Width, GetDevX(CellPadding*2));
Cell := Cells[Row,Col];
DH := GetDevX(CellPadding+CellHSpacing+CellPadding+FCellBorderWidth*2);
Lim := 0;
repeat
oldw := GetDevX(-CellHSpacing-FCellBorderWidth*2);
UnsizedCount := 0;
pureoldw := 0;
for c := Col to Col+Cell.ColSpan-1 do begin
inc(oldw, Fmt.ColWidths[c]+DH);
if ChangeMins or (ColsWithAssignedWidths[c]<=Lim) then begin
if AddProportionally and (Fmt.ColWidths[c]+GetDevX(CellPadding*2)=0) then
inc(pureoldw, 1)
else
inc(pureoldw, Fmt.ColWidths[c]+GetDevX(CellPadding*2));
inc(UnsizedCount);
end;
end;
inc(Lim);
until ChangeMins or (Lim>CWALim) or (UnsizedCount>0);
dec(Lim);
if (oldw<Width) and (UnsizedCount<>0) then begin
DH := Width-oldw;
if not ChangeMins and not FixedWidth then begin
if DH>ExtraWidth then
DH := ExtraWidth;
if AddProportionally then
dec(ExtraWidth, DH);
end;
inc(DH, pureoldw);
if AddProportionally then begin
for c := Col to Col+Cell.ColSpan-1 do
if ChangeMins or (ColsWithAssignedWidths[c]<=Lim) then begin
oldw := Fmt.ColWidths[c]+GetDevX(CellPadding*2);
if oldw=0 then
inc(oldw);
Width := MulDiv(oldw,DH,pureoldw);
Fmt.ColWidths[c] := Width-GetDevX(CellPadding*2);
dec(pureoldw, oldw);
dec(DH,Width);
if ChangeMins then begin
inc(MinColsWidth, Width-oldw);
end;
end;
end
else begin
for c := Col to Col+Cell.ColSpan-1 do begin
if (UnsizedCount=0) or (DH<=0) then
break;
if ChangeMins or (ColsWithAssignedWidths[c]<=Lim) then begin
oldw := Fmt.ColWidths[c]+GetDevX(CellPadding*2);
neww := Round(DH/UnsizedCount);
if oldw>=neww then begin
dec(DH, oldw);
dec(UnsizedCount);
end;
end;
end;
for c := Col to Col+Cell.ColSpan-1 do begin
if (UnsizedCount=0) or (DH<=0) then
break;
if ChangeMins or (ColsWithAssignedWidths[c]<=Lim) then begin
oldw := Fmt.ColWidths[c]+GetDevX(CellPadding*2);
neww := Round(DH/UnsizedCount);
if oldw<neww then begin
Fmt.ColWidths[c] := neww-GetDevX(CellPadding*2);
if ChangeMins then
inc(MinColsWidth, neww-oldw);
dec(DH, neww);
if not ChangeMins and not FixedWidth then
dec(ExtraWidth, neww-oldw);
dec(UnsizedCount);
end;
end;
end;
if ChangeMins or FixedWidth or (ExtraWidth>0) then
ExpandCols(Row,Col, savedw, CWALim, ChangeMins, Depth+1);
end;
end;
end;
{.................................................}
procedure CalcMinWidthsSpan;
var r,c: Integer;
begin
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if (Items[c]<>nil) and (Items[c].ColSpan>1) then
ExpandCols(r,c, Items[c].GetMinWidth(cursad,Canvas), 2,True,0);
end;
{.................................................}
procedure CalcPercentWidths;
var c,w,pw,NonDistribWidth: Integer;
Widths: TRVIntegerList;
begin
ExtraWidth := PureWidth-MinColsWidth;
NonDistribWidth := 0;
Widths := TRVIntegerList.CreateEx(Rows[0].Count,0);
try
pw := 0;
for c := 0 to Rows[0].Count-1 do begin
w := Rows.GetPercentColWidth(c, SumColWidth)-GetDevX(CellPadding*2);
if w<0 then
w := 0;
Widths[c] := w;
if w>Fmt.ColWidths[c] then begin
inc(pw,w);
inc(NonDistribWidth, Fmt.ColWidths[c]);
inc(ExtraWidth, Fmt.ColWidths[c]);
end;
end;
if pw=0 then
exit;
if pw<ExtraWidth then
pw := ExtraWidth;
for c := 0 to Rows[0].Count-1 do begin
if Widths[c]=0 then
continue;
if Widths[c]<=Fmt.ColWidths[c] then begin
ColsWithAssignedWidths[c] := 2;
inc(AssignedCount);
continue;
end;
dec(NonDistribWidth, Fmt.ColWidths[c]);
w := MulDiv(Widths[c], ExtraWidth,pw);
dec(pw, Widths[c]);
if w>0 then begin
ColsWithAssignedWidths[c] := 2;
inc(AssignedCount);
end;
if w>ExtraWidth-NonDistribWidth then
w := ExtraWidth-NonDistribWidth;
if w>Fmt.ColWidths[c] then
Fmt.ColWidths[c] := w;
dec(ExtraWidth, Fmt.ColWidths[c]);
if (ExtraWidth=0) and (NonDistribWidth=0) then
break;
end;
finally
Widths.Free;
end;
{
ExtraWidth := PureWidth-MinColsWidth;
for c := 0 to Rows[0].Count-1 do begin
w := Rows.GetPercentColWidth(c, SumColWidth)-GetDevX(CellPadding*2);
if w>0 then begin
ColsWithAssignedWidths[c] := 2;
inc(AssignedCount);
end;
if w>Fmt.ColWidths[c] then begin
inc(ExtraWidth, Fmt.ColWidths[c]);
if w>ExtraWidth then
w := ExtraWidth;
Fmt.ColWidths[c] := w;
dec(ExtraWidth,w);
if ExtraWidth=0 then break;
end;
end;
}
end;
{.................................................}
procedure CalcPercentWidthsSpan;
var r,c,w,i: Integer;
begin
if ExtraWidth<=0 then exit;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if (Items[c]<>nil) and (Items[c].ColSpan>1) and
(Items[c].BestWidth<0) then begin
w := MulDiv(-Items[c].BestWidth, SumColWidth, 100)-GetDevX(CellPadding*2);
ExpandCols(r,c,w, 2, False, 0);
end;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if (Items[c]<>nil) and (Items[c].ColSpan>1) and
(Items[c].BestWidth<0) then begin
for i := 0 to Items[c].ColSpan-1 do
if ColsWithAssignedWidths[c+i]=0 then begin
ColsWithAssignedWidths[c+i] := 2;
inc(AssignedCount);
end;
end;
end;
{.................................................}
{ Calculates widths of pixel-width columns in tables having
width=sum of column widths }
procedure CalcFixedWidths;
var c,w: Integer;
begin
if not FixedWidth then
exit;
for c := 0 to Rows[0].Count-1 do
if ColsWithAssignedWidths[c]=0 then begin
w := GetDevX(Rows.GetPixelColWidth(c));
if w>0 then begin
ColsWithAssignedWidths[c] := 1;
inc(AssignedCount);
inc(FixedWidthCount);
end;
if w>Fmt.ColWidths[c] then
Fmt.ColWidths[c] := w;
end;
end;
{.................................................}
{ Calculates widths of pixel-width columns in tables having
width<>sum of column widths. This function does not distribute extra width
larger than necessary. If extra width is less than necessary, it distributes
lack of width between affected columns proportionally }
procedure CalcFixedWidths2;
var c,w, aw, fw: Integer;
Widths: TRVIntegerList;
begin
if FixedWidth or (ExtraWidth<=0) then
exit;
Widths := TRVIntegerList.CreateEx(Rows[0].Count,0);
try
aw := 0;
for c := 0 to Rows[0].Count-1 do
if ColsWithAssignedWidths[c]=0 then begin
w := GetDevX(Rows.GetPixelColWidth(c));
if w>0 then begin
ColsWithAssignedWidths[c] := 1;
inc(AssignedCount);
inc(FixedWidthCount);
end;
if w>Fmt.ColWidths[c] then begin
Widths[c] := w;
inc(aw, w);
inc(ExtraWidth, Fmt.ColWidths[c]);
end;
end;
fw := aw;
if aw>ExtraWidth then
aw := ExtraWidth;
if fw>0 then
for c := 0 to Rows[0].Count-1 do
if (ColsWithAssignedWidths[c]=1) and (Widths[c]>0) then begin
w := MulDiv(Widths[c], aw, fw);
if w>ExtraWidth then
w := ExtraWidth;
if w<Fmt.ColWidths[c] then
w := Fmt.ColWidths[c];
dec(ExtraWidth,w);
Fmt.ColWidths[c] := w;
dec(fw, Widths[c]);
dec(aw, w);
end;
finally
Widths.Free;
end;
end;
{.................................................}
procedure CalcFixedWidthsSpan;
var r,c,w,i: Integer;
begin
if not FixedWidth and (ExtraWidth<=0) then exit;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if //(ColsWithAssignedWidths[c]<>2) and
(Items[c]<>nil) and (Items[c].ColSpan>1) and
(Items[c].BestWidth>0) then begin
w := GetDevX(Items[c].BestWidth);
ExpandCols(r,c,w, 1, False, 0);
end;
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Rows[r].Count-1 do
if (Items[c]<>nil) and (Items[c].ColSpan>1) and
(Items[c].BestWidth>0) then begin
for i := 0 to Items[c].ColSpan-1 do
if ColsWithAssignedWidths[c+i]=0 then begin
ColsWithAssignedWidths[c+i] := 1;
inc(AssignedCount);
inc(FixedWidthCount);
end;
end;
end;
{.................................................}
procedure ExpandRows(Row,Col: Integer);
var r,h,h2,oldh, pureoldh, pureoldh2, DV: Integer;
EmptyRows: Boolean;
Cell: TRVTableCellData;
begin
Cell := Cells[Row,Col];
DV := GetDevY(CellPadding+CellVSpacing+CellPadding+FCellBorderWidth*2);
if Fmt.Rows=nil then
h := GetDevY(Cell.GetCellHeight(rvtoIgnoreContentHeight in Options)+CellPadding*2)
else begin
h := GetDevY(Cell.BestHeight);
if ((h=0) or not (rvtoIgnoreContentHeight in Options)) and
(Fmt.Rows[Row*Rows[0].Count+Col]<>nil) then begin
h2 := TCellPtblRVData(Fmt.Rows[Row*Rows[0].Count+Col]).DocumentHeight;
if h2>h then
h := h2;
end;
inc(h, GetDevY(CellPadding*2));
end;
oldh := GetDevY(-CellVSpacing-FCellBorderWidth*2);
pureoldh := 0;
pureoldh2 := 0;
EmptyRows := False;
for r := Row to Row+Cell.RowSpan-1 do begin
inc(oldh, Fmt.RowHeights[r]+DV);
inc(pureoldh, Fmt.RowHeights[r]);
if not Rows[r].HasCellsInRange(r, Row, Cell.RowSpan) then begin
inc(pureoldh2, Fmt.RowHeights[r]);
EmptyRows := True;
end;
end;
if EmptyRows then
pureoldh := pureoldh2;
if oldh<h then begin
DV := h-oldh;
inc(Fmt.FHeight, DV);
for r := Row to Row+Cell.RowSpan-1 do
if not (EmptyRows and Rows[r].HasCellsInRange(r, Row, Cell.RowSpan)) then begin
oldh := Fmt.RowHeights[r];
h := MulDiv(oldh,DV,pureoldh);
Fmt.RowHeights[r] := Integer(Fmt.RowHeights.Items[r])+h;
dec(pureoldh, oldh);
dec(DV,h);
end;
end;
end;
{.................................................}
var NewWidth, HorExtra: Integer;
begin
if Rows.Empty then begin
Fmt.FWidth := GetDevX((BorderWidth+BorderHSpacing)*2);
Fmt.FHeight := GetDevY((BorderWidth+BorderVSpacing)*2);
exit;
end;
HorExtra := GetHorzExtra;
FixedWidth := False;
if BestWidth>0 then
NewWidth := GetDevX(BestWidth)
else if BestWidth<0 then
NewWidth := -BestWidth*DocWidth div 100
else begin
FixedWidth := IsFixedWidthTable;
if not FixedWidth then begin // temporary
NewWidth := GetMinWidth(cursad, Canvas, nil);
if DocWidth>NewWidth then
NewWidth := DocWidth;
end
else
NewWidth := 0; //CalcPixelWidth;
//inc(NewWidth, HorExtra+GetDevX(CellPadding*Rows[0].Count*2));
end;
if (NewWidth<>0) and (NewWidth=Fmt.FWidth) and not NoCaching then
exit;
Fmt.FWidth := NewWidth;
if Rows.Empty then
exit;
ColsWithAssignedWidths := nil;
if not FixedWidth then begin
SumColWidth := Fmt.FWidth - HorExtra;
PureWidth := SumColWidth - GetDevX(CellPadding*Rows[0].Count*2);
end
else begin
SumColWidth := 0;
PureWidth := 0;
ExtraWidth := 0;
end;
Fmt.QuickClear;
// Calculating minimal widths
CalcMinWidths;
if not (rvtoIgnoreContentWidth in Options) then
CalcMinWidthsSpan;
if not FixedWidth and (MinColsWidth>=PureWidth) then begin
// Table is too narrow. Setting all width to minimums
Fmt.FWidth := Fmt.FWidth-PureWidth+MinColsWidth;
end
else begin
ColsWithAssignedWidths := TRVIntegerList.Create;
try
AssignedCount := 0;
FixedWidthCount := 0;
ColsWithAssignedWidths.Capacity := Fmt.ColWidths.Count;
for c := 0 to Fmt.ColWidths.Count-1 do
ColsWithAssignedWidths.Add(0);
// Setting widths for autosizing cols...
if not FixedWidth then begin
CalcPercentWidths;
CalcPercentWidthsSpan;
end;
// Setting widths for fixed cols...
CalcFixedWidths;
CalcFixedWidths2;
CalcFixedWidthsSpan;
if FixedWidth then begin
Fmt.FWidth := HorExtra+GetDevX(CellPadding*Rows[0].Count*2);
for c := 0 to Rows[0].Count-1 do
inc(Fmt.FWidth, Fmt.ColWidths[c]);
end
else if ExtraWidth>0 then
if AssignedCount<ColsWithAssignedWidths.Count then begin
// Setting widths for other cols...
for c := 0 to Rows[0].Count-1 do
if ColsWithAssignedWidths[c]=0 then begin
w := ExtraWidth div (ColsWithAssignedWidths.Count-AssignedCount);
Fmt.ColWidths[c] := Fmt.ColWidths[c]+w;
dec(ExtraWidth,w);
inc(AssignedCount);
if ExtraWidth<=0 then break;
end;
end
else if FixedWidthCount>0 then begin
// Expanding fixed width cols.
w2 := 0;
for c := 0 to Rows[0].Count-1 do
if not Rows.IsPercentWidthColumn(c) then begin
w := Rows.GetPixelColWidth(c);
if w=0 then
w := 1;
ColsWithAssignedWidths[c] := w;
inc(w2,w);
end
else
ColsWithAssignedWidths[c] := 0;
for c := 0 to Rows[0].Count-1 do begin
w3 := ColsWithAssignedWidths[c];
if w3<>0 then begin
w := MulDiv(ExtraWidth, w3, w2);
Fmt.ColWidths[c] := Fmt.ColWidths[c]+w;
dec(ExtraWidth,w);
dec(w2, w3);
if ExtraWidth<=0 then break;
end;
end
end
else begin
// Expanding all cols
w2 := 0;
for c := 0 to Rows[0].Count-1 do
if Rows.IsPercentWidthColumn(c) then begin
w := Rows.GetPercentColWidth(c, SumColWidth)-GetDevX(CellPadding*2);
if w<=0 then
w := 1;
ColsWithAssignedWidths[c] := w;
inc(w2,w);
end;
for c := 0 to Rows[0].Count-1 do begin
if Rows.IsPercentWidthColumn(c) then begin
w3 := ColsWithAssignedWidths[c];
w := MulDiv(ExtraWidth, w3, w2);
if w>ExtraWidth then
w := ExtraWidth;
Fmt.ColWidths[c] := Fmt.ColWidths[c]+w;
dec(ExtraWidth,w);
dec(w2, w3);
if ExtraWidth<=0 then break;
end;
end;
end;
finally
ColsWithAssignedWidths.Free;
end;
end;
// Note: for table with undefined width algorithm must be completely different...
UpdateCellXCoords(Fmt, NoCaching, Reformatting);
Fmt.FHeight := GetDevY((CellPadding*Rows.Count+BorderWidth+BorderVSpacing)*2+(CellVSpacing*(Rows.Count-1))+
Rows.Count*CellBorderWidth*2);
Fmt.RowHeights.Capacity := Rows.Count;
Fmt.RowStarts.Count := Rows.Count;
// pass 1...
if Fmt.Rows=nil then
for r := 0 to Rows.Count-1 do begin
w := GetDevY(Rows[r].GetHeight(rvtoIgnoreContentHeight in Options));
Fmt.RowHeights.Add(w);
inc(Fmt.FHeight, w);
end
else
for r := 0 to Rows.Count-1 do begin
with Rows[r] do begin
w := GetDevY(GetBestHeight);
if (w=0) or not (rvtoIgnoreContentHeight in Options) then
for c := 0 to Count-1 do
if (Items[c]<>nil) and (Items[c].RowSpan=1) and
((Items[c].BestHeight=0) or
not (rvtoIgnoreContentHeight in Options)) then begin
if Fmt.Rows[r*Count+c]<>nil then
w2 := TCellPtblRVData(Fmt.Rows[r*Count+c]).DocumentHeight
else begin
w2 := GetDevY(Items[c].DocumentHeight);
if w2=0 then begin
if (Items[c].GetRVData.ItemCount>0) and (Items[c].GetRVData.GetItemStyle(0)>=0) then begin
FRows.FMainRVData.GetRVStyle.ApplyStyle(Canvas, Items[c].GetRVData.GetItemStyle(0),
rvbdUnspecified, False);
w2 := Canvas.TextHeight(' ');
with FRows.FMainRVData.GetRVStyle.ParaStyles[Items[c].GetRVData.GetItemPara(0)] do
inc(w2, GetDevY(SpaceBefore+SpaceAfter));
end;
end;
end;
if w2>w then
w := w2;
end;
end;
if w=0 then
w := 10; // temporal
Fmt.RowHeights.Add(w);
inc(Fmt.FHeight, w);
end;
// pass 2...
for r := 0 to Rows.Count-1 do
with Rows[r] do
for c := 0 to Count-1 do
if (Items[c]<>nil) and (Items[c].RowSpan>1) then
ExpandRows(r,c);
UpdateCellYCoords(Fmt);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DrawBorder(Canvas: TCanvas;
Left,Top,Right,Bottom, Width: Integer; LightColor, Color, BackgroundColor: TColor;
Style: TRVTableBorderStyle; DrawEvenEmptyBorder, Editing, Printing: Boolean;
const ClipRect: TRect; VisibleBorders: TRVBooleanRect;
r,c: Integer; ColorMode: TRVColorMode);
var i,y1,y2,incr: Integer;
par: array [0..2] of TPoint;
DrawGridLines: Boolean;
{..........................................}
procedure ClipY(var y1,y2: Integer; const ClipRect: TRect);
begin
if y1<ClipRect.Top-1 then
y1 := ClipRect.Top-1;
if y2>ClipRect.Bottom+1 then
y2 := ClipRect.Bottom+1;
end;
{..........................................}
function HasTopLine: Boolean;
var r2,c2: Integer;
begin
if r<0 then
Result := False
else if r=0 then
Result := (BorderVSpacing<0) and (BorderWidth>0) and VisibleBorders.Top
else
Result := (CellVSpacing<0) and Rows.GetMainCell(r-1,c,r2,c2).VisibleBorders.Bottom;
end;
{..........................................}
function HasBottomLine: Boolean;
var r2,c2: Integer;
begin
if r<0 then
Result := False
else begin
r2 := r+Cells[r,c].RowSpan-1;
if r2=Rows.Count-1 then
Result := (BorderVSpacing<0) and (BorderWidth>0) and VisibleBorders.Bottom
else
Result := (CellVSpacing<0) and Rows.GetMainCell(r2+1,c,r2,c2).VisibleBorders.Top;
end;
end;
{..........................................}
function HasLeftLine: Boolean;
var r2,c2: Integer;
begin
if c<0 then
Result := False
else if c=0 then
Result := (BorderHSpacing<0) and (BorderWidth>0) and VisibleBorders.Left
else
Result := (CellHSpacing<0) and Rows.GetMainCell(r,c-1,r2,c2).VisibleBorders.Right;
end;
{..........................................}
function HasRightLine: Boolean;
var r2,c2: Integer;
begin
if c<0 then
Result := False
else begin
c2 := c+Cells[r,c].ColSpan-1;
if c2=Rows[r].Count-1 then
Result := (BorderHSpacing<0) and (BorderWidth>0) and VisibleBorders.Right
else
Result := (CellHSpacing<0) and Rows.GetMainCell(r,c2+1,r2,c2).VisibleBorders.Left;
end;
end;
{..........................................}
var DoDefault: Boolean;
GridStyle: TPenStyle;
begin
if (ClipRect.Left>Right) or
(ClipRect.Right<Left) or
(ClipRect.Top>Bottom) or
(ClipRect.Bottom<Top) then
exit;
if Assigned(FOnDrawBorder) then begin
DoDefault := True;
FOnDrawBorder(Self, Canvas, Left, Top, Right, Bottom, Width, LightColor, Color,
BackgroundColor, Style, Printing, VisibleBorders, r, c, DoDefault);
if not DoDefault then
exit;
end;
if Editing then
GridStyle := RichViewTableGridStyle
else
GridStyle := RichViewTableGridStyle2;
DrawGridLines := DrawEvenEmptyBorder and not Printing and (GridStyle<>psClear);
if Width=0 then begin
if not DrawGridLines then
exit;
Canvas.Pen.Width := 1;
Canvas.Brush.Color := clNone;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := GridStyle;
Canvas.Pen.Color := RichViewTableGridColor;
Canvas.Rectangle(Left,Top,Right,Bottom);
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := psSolid;
exit;
end;
if DrawGridLines and (VisibleBorders<>nil) and not VisibleBorders.IsAllEqual(True) then begin
Canvas.Pen.Width := 1;
Canvas.Brush.Color := clNone;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := GridStyle;
Canvas.Pen.Color := RichViewTableGridColor;
if not VisibleBorders.Top and not HasTopLine then begin
Canvas.MoveTo(Left,Top);
Canvas.LineTo(Right,Top);
end;
if not VisibleBorders.Bottom and not HasBottomLine then begin
Canvas.MoveTo(Left,Bottom);
Canvas.LineTo(Right,Bottom);
end;
if not VisibleBorders.Left and not HasLeftLine then begin
y1 := Top;
y2 := Bottom;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(Left,y1);
Canvas.LineTo(Left,y2);
end;
if not VisibleBorders.Right and not HasRightLine then begin
y1 := Top;
y2 := Bottom;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(Right,y1);
Canvas.LineTo(Right,y2);
end;
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := psSolid;
end;
Canvas.Brush.Style := bsClear;
if Style in [rvtbRaised, rvtbLowered, rvtbRaisedColor, rvtbLoweredColor] then begin
dec(Right);
dec(Bottom);
Width := GetDevY(Width);
// 3d frame
case Style of
rvtbRaised:
begin
if ColorToRGB(BackgroundColor)=ColorToRGB(clBtnHighlight) then
Canvas.Pen.Color := RV_GetColor(clBtnFace, ColorMode)
else
Canvas.Pen.Color := RV_GetColor(clBtnHighlight, ColorMode)
end;
rvtbRaisedColor:
Canvas.Pen.Color := RV_GetColor(LightColor, ColorMode);
rvtbLoweredColor:
Canvas.Pen.Color := RV_GetColor(Color, ColorMode);
else {rvtbLowered}
Canvas.Pen.Color := RV_GetColor(clBtnShadow, ColorMode);
end;
if Printing and (rvtoHalftoneBorders in PrintOptions) then begin
if (cursad<>nil) and (cursad.ppiyScreen<cursad.ppiyDevice) then begin
Canvas.Pen.Width := Width+1;
dec(Left);
dec(Top);
end;
Canvas.Pen.Style := psInsideFrame;
Width := Width div 2;
inc(Left,Width);
inc(Top,Width);
dec(Right,Width);
dec(Bottom,Width);
Width := 1;
incr := 0;
end
else begin
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
incr := 1;
end;
with par[0] do begin x := Left; y := Bottom; end;
with par[1] do begin x := Left; y := Top; end;
with par[2] do begin x := Right; y := Top; end;
for i := 0 to Width-1 do begin
//Canvas.Polyline(par); <- does not work for looooong tables
if (VisibleBorders=nil) or (VisibleBorders.Top) then begin
with par[1] do Canvas.MoveTo(x,y);
with par[2] do Canvas.LineTo(x+incr,y);
end;
if (VisibleBorders=nil) or (VisibleBorders.Left) then begin
y1 := par[1].y;
y2 := par[0].y;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(par[1].x,y1);
Canvas.LineTo(par[0].x,y2+incr);
end;
with par[0] do begin inc(x); dec(y); end;
with par[1] do begin inc(x); inc(y); end;
with par[2] do begin dec(x); inc(y); end;
end;
case Style of
rvtbRaised:
Canvas.Pen.Color := RV_GetColor(clBtnShadow, ColorMode);
rvtbRaisedColor:
Canvas.Pen.Color := RV_GetColor(Color, ColorMode);
rvtbLoweredColor:
Canvas.Pen.Color := RV_GetColor(LightColor, ColorMode);
else {rvtbLowered}
begin
if ColorToRGB(BackgroundColor)=ColorToRGB(clBtnHighlight) then
Canvas.Pen.Color := RV_GetColor(clBtnFace, ColorMode)
else
Canvas.Pen.Color := RV_GetColor(clBtnHighlight, ColorMode);
end;
end;
with par[0] do begin x := Right; y := Top; end;
with par[1] do begin x := Right; y := Bottom; end;
with par[2] do begin x := Left; y := Bottom; end;
for i := 0 to Width-1 do begin
//Canvas.Polyline(par); <- does not work for looooong tables
if (VisibleBorders=nil) or (VisibleBorders.Bottom) then begin
with par[2] do Canvas.MoveTo(x,y);
with par[1] do Canvas.LineTo(x+incr,y);
end;
if (VisibleBorders=nil) or (VisibleBorders.Right) then begin
y1 := par[0].y;
y2 := par[1].y;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(par[0].x,y1);
Canvas.LineTo(par[1].x,y2+incr);
end;
with par[0] do begin dec(x); inc(y); end;
with par[1] do begin dec(x); dec(y); end;
with par[2] do begin inc(x); dec(y); end;
end;
end
else begin
// Single frame
if Color=clNone then exit;
Canvas.Pen.Color := RV_GetColor(Color, ColorMode);
if (RVNT or (Bottom-Top<32000)) and
((VisibleBorders=nil) or
(VisibleBorders.Left and VisibleBorders.Right and
VisibleBorders.Top and VisibleBorders.Bottom)) then begin
Canvas.Pen.Width := GetDevY(Width);
if Printing and (cursad<>nil) and (cursad.ppiyScreen<cursad.ppiyDevice) then begin
Canvas.Pen.Width := Canvas.Pen.Width+1;
dec(Left);
dec(Top);
end;
Canvas.Pen.Style := psInsideFrame;
Canvas.Rectangle(Left, Top, Right, Bottom);
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
end
else begin
Width := GetDevY(Width);
if Printing and (cursad<>nil) and (cursad.ppiyScreen<cursad.ppiyDevice) then begin
inc(Width);
dec(Top);
dec(Left);
end;
if Printing and (rvtoHalftoneBorders in PrintOptions) then begin
Canvas.Pen.Width := Width;
Canvas.Pen.Style := psInsideFrame;
Width := Width div 2;
inc(Left,Width);
inc(Top,Width);
dec(Right,Width);
dec(Bottom,Width);
Width := 1;
end
else begin
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
end;
dec(Right);
dec(Bottom);
if rvtoOverlappingCorners in Options then begin
for i := 0 to Width-1 do begin // idea of Harley Pebley
y1 := Top;
y2 := Bottom+1;
ClipY(y1,y2,ClipRect);
if (VisibleBorders=nil) or VisibleBorders.Left then begin
Canvas.MoveTo(Left+i,y1);
Canvas.LineTo(Left+i,y2);
end;
if (VisibleBorders=nil) or VisibleBorders.Right then begin
Canvas.MoveTo(Right-i,y1);
Canvas.LineTo(Right-i,y2);
end;
if (VisibleBorders=nil) or VisibleBorders.Top then begin
Canvas.MoveTo(Left,Top+i);
Canvas.LineTo(Right+1,Top+i);
end;
if (VisibleBorders=nil) or VisibleBorders.Bottom then begin
Canvas.MoveTo(Left,Bottom-i);
Canvas.LineTo(Right+1,Bottom-i);
end;
end
end
else
for i := 0 to Width-1 do begin
if (VisibleBorders=nil) or VisibleBorders.Left then begin
y1 := Top;
y2 := Bottom+1;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(Left,y1);
Canvas.LineTo(Left,y2);
end;
if (VisibleBorders=nil) or VisibleBorders.Right then begin
y1 := Top;
y2 := Bottom+1;
ClipY(y1,y2,ClipRect);
Canvas.MoveTo(Right,y1);
Canvas.LineTo(Right,y2);
end;
if (VisibleBorders=nil) or VisibleBorders.Top then begin
Canvas.MoveTo(Left,Top);
Canvas.LineTo(Right+1,Top);
end;
if (VisibleBorders=nil) or VisibleBorders.Bottom then begin
Canvas.MoveTo(Left,Bottom);
Canvas.LineTo(Right+1,Bottom);
end;
inc(Left);
inc(Top);
dec(Right);
dec(Bottom);
end;
end;
end;
Canvas.Pen.Style := psSolid;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetVerticalRuleNo(X: Integer; var MinX, ZeroChangeX: Integer): Integer;
var i, DH,l: Integer;
{..................................}
function InEps(v, delta: Integer): Boolean;
begin
delta := delta div 2;
if delta<2 then delta := 2;
Result := abs(v-X)<=delta;
end;
{..................................}
begin
Result := -1;
if (X<0) or (X>Fmt.FWidth) then exit;
DH := CellHSpacing+FCellBorderWidth*2;
l := BorderWidth+BorderHSpacing+CellBorderWidth;
if InEps(l div 2, l) then begin
Result := 0;
MinX := -1;
ZeroChangeX := l div 2;
exit;
end;
if InEps(Fmt.FWidth - l div 2, l) then begin
Result := Rows[0].Count;
MinX := Fmt.ColStarts[Result-1];
ZeroChangeX := Fmt.FWidth - l div 2;
exit;
end;
for i := 0 to Rows[0].Count-2 do begin
l := Fmt.ColStarts[i+1];
if InEps(l-DH div 2, DH) then begin
Result := i+1;
MinX := Fmt.ColStarts[Result-1];
ZeroChangeX := l-(DH+1) div 2;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetHorizontalRuleNo(Y: Integer; var MinY, ZeroChangeY: Integer): Integer;
var i, DV,t: Integer;
{..................................}
function InEps(v, delta: Integer): Boolean;
begin
delta := delta div 2;
if delta<2 then delta := 2;
Result := abs(v-Y)<=delta;
end;
{..................................}
begin
Result := -1;
if (Y<0) or (Y>Fmt.FHeight) then exit;
DV := CellVSpacing+FCellBorderWidth*2;
t := BorderWidth+BorderVSpacing+CellBorderWidth;
if InEps(t div 2, t) then begin
Result := 0;
MinY := -1;
ZeroChangeY := t div 2;
exit;
end;
if InEps(Fmt.FHeight - t div 2, t) then begin
Result := Rows.Count;
MinY := Fmt.RowStarts[Result-1];
ZeroChangeY := Fmt.FHeight - t div 2;
exit;
end;
for i := 0 to Rows.Count-2 do begin
t := Fmt.RowStarts[i+1];
if InEps(t-DV div 2, DV) then begin
Result := i+1;
MinY := Fmt.RowStarts[Result-1];
ZeroChangeY := t-(DV+1) div 2;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetColNo(X: Integer): Integer;
var c:Integer;
begin
Result := -1;
for c := 0 to Rows[0].Count-1 do begin
if X<Fmt.ColStarts[c] then
exit;
if X<=Fmt.ColStarts[c]+Fmt.ColWidths[c] then begin
Result := c;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetRowNo(Y: Integer): Integer;
var r:Integer;
begin
Result := -1;
for r := 0 to Rows.Count-1 do begin
if Y<Fmt.RowStarts[r] then
exit;
if Y<=Fmt.RowStarts[r]+Fmt.RowHeights[r] then begin
Result := r;
exit;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCrossed(Coord: Integer;List: TRVIntegerList): Integer;
var a,b:Integer;
begin
if List.Count<2 then begin
Result := 0;
exit;
end;
if Coord>=List[List.Count-1] then begin
Result := List.Count-1;
exit;
end;
a := 0;
b := List.Count-1;
while b-a>1 do begin
Result := (b+a) div 2;
if List[Result]<Coord then
a := Result
else
b := Result;
end;
Result := a;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.MouseMove(Shift: TShiftState; X, Y,ItemNo: Integer; RVData: TObject): Boolean;
var Row,Col, RuleNo,a,b: Integer;
NewSelColOffs, NewSelRowOffs: Integer;
Redraw: Boolean;
begin
if Rows.Empty or TCustomRVFormattedData(Rows.FMainRVData).UsingThisXorDrawing(XORDrawing) then begin
Result := False;
exit;
end;
MyClientTop := 0;
MyClientLeft := 0;
Result := True;
if BusyCount>0 then exit;
if GetCellAt(X, Y, Row, Col) then begin
if FMakingSelection and (ssLeft in Shift) then begin
NewSelColOffs := Col-FSelStartCol;
NewSelRowOffs := Row-FSelStartRow;
Redraw := (FSelColOffs<>NewSelColOffs) or
(FSelRowOffs<>NewSelRowOffs);
FSelColOffs := NewSelColOffs;
FSelRowOffs := NewSelRowOffs;
if (FSelColOffs<>0) or (FSelRowOffs<>0) then
Include(FState, rvtsSelExists)
else
Exclude(FState, rvtsSelExists);
if Redraw then begin
UpdateCellSel;
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
if FInplaceEditor<>nil then
TRVTableInplaceEdit(FInplaceEditor).SelectCompletely(rvtsSelExists in FState);
end;
end;
if not FMakingSelection or not (rvtsSelExists in FState) then
with Cells[Row,Col] do begin
if RV_PointInRect(X, Y, Left+CellPadding, Top+CellPadding,
Width-CellPadding*2, Height-CellPadding*2) then begin
MouseMove(Shift, X{-Left-CellPadding}, Y{-Top-CellPadding});
Result := True;
exit;
end;
end
end
else begin
RuleNo := GetVerticalRuleNo(X,a,b);
if (rvtoRowSelect in Options) and (RuleNo=0) and
(rvoAllowSelection in TCustomRVFormattedData(RVData).Options) then begin
TCustomRVFormattedData(RVData).SetCursor(crRVSelectRow);
exit;
end;
if CanChange and (rvtoColSizing in Options) and (RuleNo>0) then begin
TCustomRVFormattedData(RVData).SetCursor(crHSplit);
exit;
end;
RuleNo := GetHorizontalRuleNo(Y,a,b);
if (rvtoColSelect in Options) and (RuleNo=0) and
(rvoAllowSelection in TCustomRVFormattedData(RVData).Options) then begin
TCustomRVFormattedData(RVData).SetCursor(crRVSelectCol);
exit;
end;
if CanChange and (rvtoRowSizing in Options) and (RuleNo>0) then begin
TCustomRVFormattedData(RVData).SetCursor(crVSplit);
exit;
end;
end;
TCustomRVFormattedData(RVData).SetCursor(crArrow);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.XorDrawing(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var Offs: Integer;
Canvas: TCanvas;
begin
Offs := 0;
Canvas := TCustomRVFormattedData(Sender).GetCanvas;
with Canvas do begin
Pen.Mode := pmNot;
Pen.Width := 1;
Brush.Style := bsClear;
Pen.Style := psSolid;
if not (rvtsVerticalDraggedRule in FState) then begin
if (DRMin<>-1) or (DRMax<>-1) then
Offs := MyTop-TCustomRVFormattedData(Rows.FMainRVData).GetVOffs;
if (DRMin<>-1) and (Y<DRMin+Offs) then
Y := DRMin+Offs;
if (DRMax<>-1) and (Y<DRMax+Offs) then
Y := DRMax+Offs;
DrawFancyHLine(Canvas, 0, TCustomRVFormattedData(Sender).GetWidth, Y);
end
else begin
if (DRMin<>-1) or (DRMax<>-1) then
Offs := MyLeft-TCustomRVFormattedData(Rows.FMainRVData).GetHOffs;
if (DRMin<>-1) and (X<DRMin+Offs) then
X := DRMin+Offs;
if (DRMax<>-1) and (X<DRMax+Offs) then
X := DRMax+Offs;
DrawFancyVLine(Canvas, X, 0, TCustomRVFormattedData(Sender).GetHeight);
end;
Pen.Mode := pmCopy;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.DoOnCellEditing(Row,Col: Integer; Automatic: Boolean): Boolean;
begin
Result := True;
if Assigned(FOnCellEditing) then
FOnCellEditing(Self, Row, Col, Automatic, Result);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.CreateInplace(ItemNo, Row, Col: Integer;
BuildJumps, CaretAtStart, CaretAtEnd, SetTime,
Unquestioning: Boolean);
var RVData: TCustomRVFormattedData;
tie: TRVTableInplaceEdit;
Idx, Offs: Integer;
begin
if not (rvtsInserted in FState) or not IsInEditor or
(not Unquestioning and not DoOnCellEditing(Row,Col, False)) then
exit;
if ItemNo=-1 then
ItemNo := GetMyItemNo;
DestroyInplace(True);
DeselectPartial;
TCustomRVFormattedData(FRows.FMainRVData).PartialSelectedItem := nil;
TCustomRVFormattedData(FRows.FMainRVData).FActiveItem := nil;
TCustomRVFormattedData(FRows.FMainRVData).RestoreSelBounds(ItemNo, ItemNo, 1, 1);
TCustomRVFormattedData(FRows.FMainRVData).DoOnSelection(False);
Deselect;
RVData := TCustomRVFormattedData(FRows.FMainRVData);
if IsInEditor and TCustomRichViewEdit(TRichViewRVData(RVData).RichView).ReadOnly then
BuildJumps := True;
FMinWidthPlus := RVData.CalculateMinItemWidthPlusEx(ItemNo);
tie := TRVTableInplaceEdit.Create(nil);
FInplaceEditor := tie;
tie.Options := TRichViewRVData(RVData).GetOptions;
tie.OnChangeEx := InplaceEditorChange;
tie.OnCaretGetOut := InplaceEditorCaretGetout;
if RVData is TRichViewRVData then begin
tie.BiDiMode := TCustomRichView(TRichViewRVData(RVData).RichView).BiDiMode;
tie.Cursor := TCustomRichView(TRichViewRVData(RVData).RichView).Cursor;
tie.Delimiters := TCustomRichView(TRichViewRVData(RVData).RichView).Delimiters;
tie.AssignEvents(TCustomRichView(TRichViewRVData(RVData).RichView));
tie.RVFTextStylesReadMode := TCustomRichView(TRichViewRVData(RVData).RichView).RVFTextStylesReadMode;
tie.RVFParaStylesReadMode := TCustomRichView(TRichViewRVData(RVData).RichView).RVFParaStylesReadMode;
tie.OnRVMouseDown := InplaceEditorMouseDown;
tie.OnRVMouseUp := InplaceEditorMouseUp;
tie.OnControlAction := InplaceEditorControlAction;
tie.OnMouseMove := InplaceEditorMouseMove;
tie.OnDragOver := InplaceEditorDragOver;
tie.OnDragDrop := InplaceEditorDragDrop;
if RVData is TRVEditRVData then
with TCustomRichViewEdit(TRVEditRVData(RVData).RichView) do begin
tie.EditorOptions := EditorOptions + [rvoWantTabs];
if UndoLimit<>0 then
tie.UndoLimit := -1 // temporal solution
else
tie.UndoLimit := 0;
end;
end;
tie.Color := GetCellColor(Cells[Row,Col]);
tie.Transparent := CanSeeBackgroundThroughCell(Cells[Row,Col]);
tie.Parent := TCustomRVData(RVData).GetParentControl;
tie.VScrollVisible := False;
tie.HScrollVisible := False;
RVData.GetItemClientCoords(ItemNo, MyLeft, MyTop);
with Cells[Row,Col] do
SetInplaceBounds(MyLeft+Left, MyTop+Top+GetExtraVOffs, Width, Height-GetExtraVOffs);
tie.SetParentRVData(RVData);
tie.FCell := Cells[Row,Col];
tie.RVData.DrainFrom(Cells[Row,Col]);
tie.SetCell(Row,Col,Self,CellPadding);
tie.Format;
if tie.ClientHeight<tie.RVData.DocumentHeight then
tie.NormalScrolling := True;
if SetTime then
tie.FClickTime := GetMessageTime;
//tie.FirstJumpNo := Cells[Row,Col].FirstJumpNo;
if BuildJumps then
TRVTableInplaceRVData(tie.RVData).BuildJumpsCoords(True);
tie.Visible := True;
RVData.AssignChosenRVData(Cells[Row,Col], Self);
ChosenCellRow := Row;
ChosenCellCol := Col;
FInplaceMinWidthPlus := tie.RVData.CalculateMinDocWidthPlus(nil,nil);
if CaretAtEnd then begin
Idx := tie.ItemCount-1;
Offs := tie.GetOffsAfterItem(Idx);
tie.SetSelectionBounds(Idx,Offs,Idx,Offs);
end;
if CaretAtStart then begin
Idx := 0;
Offs := tie.GetOffsBeforeItem(Idx);
tie.SetSelectionBounds(Idx,Offs,Idx,Offs);
end;
tie.CurTextStyleChange;
tie.CurParaStyleChange;
RVData.GetAbsoluteRootData.State := RVData.GetAbsoluteRootData.State+[rvstNoKillFocusEvents];
try
tie.SetFocusSilent;
finally
RVData.GetAbsoluteRootData.State := RVData.GetAbsoluteRootData.State-[rvstNoKillFocusEvents];
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y,ItemNo: Integer; RVData: TObject): Boolean;
var Row,Col, ERow, ECol: Integer;
VDRNo,HDRNo:Integer;
begin
Result := False;
if Rows.Empty then
exit;
if (BusyCount>0) or
(rvstIgnoreNextMouseDown in TCustomRVFormattedData(Rows.FMainRVData).State) then exit;
if (Button in [mbLeft, mbRight]) and
CanChange and (rvtoEditing in Options) and
GetCellAt(X, Y, Row, Col) then begin
if (Button=mbRight) and (IsCellSelected(Row,Col) or CompletelySelected) then
exit;
CreateInplace(ItemNo, Row, Col, ssCtrl in Shift, False, False, Button=mbLeft, False);
if (GetEditedCell(ERow,ECol)<>nil) and (ERow=Row) and (ECol=Col) then begin
SetCaptureControl(FInplaceEditor);
with Cells[Row,Col] do
FInplaceEditor.MouseDown(Button, Shift, X-Left, Y-Top-GetExtraVOffs);
exit;
end;
end;
MyClientTop := 0;
MyClientLeft := 0;
if GetCellAt(X, Y, Row, Col) then begin
DestroyInplace(True);
if Rows.FMainRVData is TRVEditRVData then
Rows.FMainRVData.GetParentControl.SetFocus;
if Button=mbLeft then begin
{
TCustomRVFormattedData(Rows.FMainRVData).State := TCustomRVFormattedData(Rows.FMainRVData).State+[rvstNoScroll];
try
TCustomRVFormattedData(Rows.FMainRVData).SetSelectionBounds(ItemNo, 1, ItemNo, 1);
finally
TCustomRVFormattedData(Rows.FMainRVData).State := TCustomRVFormattedData(Rows.FMainRVData).State-[rvstNoScroll];
end;
}
MyClientTop := 0;
MyClientLeft := 0;
end;
if Button in [mbLeft, mbRight] then begin
TCustomRVFormattedData(Rows.FMainRVData).AssignChosenRVData(Cells[Row,Col], Self);
ChosenCellRow := Row;
ChosenCellCol := Col;
end;
with Cells[Row,Col] do begin
if RV_PointInRect(X, Y, Left+CellPadding, Top+CellPadding,
Width-CellPadding*2, Height-CellPadding*2) then begin
MouseDown(Button, Shift, X, Y);
end;
if (Button=mbLeft) and not (rvstStartingDragDrop in Rows.FMainRVData.GetAbsoluteRootData.State) and
StartSelecting(Row,Col) then begin
TCustomRVFormattedData(RVData).SetMouseCapture(Self,MyLeft,MyTop);
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
end;
exit;
end;
end;
if (Button<>mbLeft) or
not ((rvtoRowSizing in Options) or (rvtoColSizing in Options) or
(rvtoColSelect in Options) or (rvtoRowSelect in Options)) then begin
DestroyInplace(True);
Rows.FMainRVData.GetParentControl.SetFocus;
exit;
end;
if (CanChange and (rvtoColSizing in Options)) or (rvtoRowSelect in Options) then begin
VDRNo := GetVerticalRuleNo(X, DRMin, DRDelta);
DRCoord := X;
end
else
VDRNo := -1;
if (VDRNo>0) and CanChange and (rvtoColSizing in Options) then begin
DRNo := VDRNo;
dec(DRDelta,X);
TCustomRVFormattedData(RVData).AssignXorDrawing(XorDrawing);
TCustomRVFormattedData(RVData).SetMouseCapture(Self,MyLeft,MyTop);
DRMax := -1;
if ssShift in Shift then
Include(FState, rvtsDRChangeTableWidth)
else
Exclude(FState, rvtsDRChangeTableWidth);
Include(FState, rvtsVerticalDraggedRule);
SaveInplace;
end
else begin
if (CanChange and (rvtoRowSizing in Options)) or (rvtoColSelect in Options) then begin
HDRNo := GetHorizontalRuleNo(Y,DRMin,DRDelta);
DRCoord := Y;
end
else
HDRNo := -1;
if (HDRNo>0) and CanChange and (rvtoRowSizing in Options) then begin
DRNo := HDRNo;
dec(DRDelta,Y);
TCustomRVFormattedData(RVData).AssignXorDrawing(XorDrawing);
TCustomRVFormattedData(RVData).SetMouseCapture(Self,MyLeft,MyTop);
DRMax := -1;
Exclude(FState, rvtsVerticalDraggedRule);
SaveInplace;
end
else if (HDRNo=0) and (rvtoColSelect in Options) then begin
Col := GetColNo(X);
if Col>=0 then begin
SelectCols(Col,1);
TCustomRVFormattedData(RVData).SetMouseCapture(Self,MyLeft,MyTop);
end;
end
else if (VDRNo=0) and (rvtoRowSelect in Options) then begin
Row := GetRowNo(Y);
if Row>=0 then begin
SelectRows(Row,1);
TCustomRVFormattedData(RVData).SetMouseCapture(Self,MyLeft,MyTop);
end;
end
// else
// DestroyInplace(True);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ResizeRow(Index, Height: Integer);
{...........................................}
procedure SetHeight(r,h,y: Integer);
var c,a,b,a1,b1: Integer;
Changed: Boolean;
Cell: TRVTableCellData;
begin
a := h;
dec(h, CellPadding*2);
if r<Rows.Count-1 then
dec(h, CellVSpacing div 2 + CellBorderWidth)
else
dec(h, (BorderWidth+BorderVSpacing+CellBorderWidth+1) div 2);
inc(y, h-a);
if h<0 then h := 0;
Changed := False;
with Rows[r] do begin
for c := 0 to Count-1 do
if (Items[c]<>nil) and (Items[c].RowSpan=1) then begin
SetCellBestHeight(h,r,c);
Changed := True;
end;
for c := 0 to Count-1 do
if (Items[c]=nil) then begin
Cell := Rows.GetMainCell(r,c,a,b);
if a=r then continue;
if (r=Rows.Count-1) or
(Cells[r+1,c]<>nil) or
(Cell<>Rows.GetMainCell(r+1,c,a1,b1)) then begin
if Changed then
h := 0
else begin
h := y-Cell.Top;
if h<0 then
h := 0;
end;
SetCellBestHeight(h,a,b);
end;
end;
end;
end;
{........................................}
begin
InitUndo;
try
SetHeight(Index, Height, Fmt.RowStarts[Index]+Height);
finally
DoneUndo;
end;
Fmt.FWidth := 0;
if (Rows.FMainRVData is TRVEditRVData) then begin
TRVEditRVData(Rows.FMainRVData).Reformat(False, False, False, GetMyItemNo, False);
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
Change;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.ResizeCol(Index, Width: Integer; Shift: Boolean);
{...........................................}
procedure SetWidth(c,w,x: Integer; Decrement: Boolean);
var r,a,b,a1,b1,oldw: Integer;
Changed: Boolean;
Cell: TRVTableCellData;
begin
oldw := w-CellPadding*2;
if Decrement then begin
if c<Rows[0].Count-1 then
x := Fmt.ColStarts[c+1] - (CellBorderWidth+(CellHSpacing+1) div 2)
else
x := Fmt.FWidth-(BorderWidth+BorderHSpacing+CellBorderWidth{+1}) div 2;
x := x + (Fmt.ColStarts[c]-Fmt.ColStarts[c-1] - (CellHSpacing+1) div 2)-w-CellBorderWidth;
w := x - Fmt.ColStarts[c];
end;
a := w;
dec(w, CellPadding*2);
if c<Rows[0].Count-1 then begin
dec(w,CellBorderWidth);
dec(w, CellHSpacing div 2);
end
else
dec(w, (BorderWidth+BorderHSpacing+CellBorderWidth+1) div 2);
//inc(x, w-a);
if w<=0 then w := 1;
Changed := False;
for r := 0 to Rows.Count-1 do
if (Cells[r,c]<>nil) and (Cells[r,c].ColSpan=1) then begin
SetCellBestWidth(w,r,c);
Changed := True;
end;
for r := 0 to Rows.Count-1 do
if (Cells[r,c]=nil) then begin
Cell := Rows.GetMainCell(r,c,a,b);
if (b=c) or Decrement then continue;
if (c=Rows[r].Count-1) or
(Cells[r,c+1]<>nil) or
(Cell<>Rows.GetMainCell(r,c+1,a1,b1)) then begin
if Changed then
w := 0
else begin
// w := x-Cell.Left;
w := Cell.Width - Fmt.ColWidths[c]+oldw;
if w<=0 then
w := 1;
end;
SetCellBestWidth(w,a,b)
end;
end;
end;
{...........................................}
procedure SetPercentWidth(c,w,x: Integer; Decrement: Boolean);
var r,a,b,a1,b1, he: Integer;
Changed: Boolean;
Cell: TRVTableCellData;
begin
he := GetHorzExtra;
a := w;
if c<Rows[0].Count-1 then begin
dec(w,CellBorderWidth);
dec(w, CellHSpacing div 2);
end
else
dec(w, (BorderWidth+BorderHSpacing+CellBorderWidth) div 2);
inc(x, w-a);
w := - w*100 div (Fmt.FWidth-he);
if w>=0 then w := -1;
Changed := False;
for r := 0 to Rows.Count-1 do
if (Cells[r,c]<>nil) and (Cells[r,c].ColSpan=1) then begin
SetCellBestWidth(w,r,c);
Changed := True;
end;
for r := 0 to Rows.Count-1 do
if (Cells[r,c]=nil) then begin
Cell := Rows.GetMainCell(r,c,a,b);
if b=c then continue;
if (c=Rows[r].Count-1) or
(Cells[r,c+1]<>nil) or
(Cell<>Rows.GetMainCell(r,c+1,a1,b1)) then begin
if Changed then
w := 0
else begin
w := -(x-Cell.Left)*100 div (Fmt.FWidth-he);
if w>=0 then
w := -1;
end;
SetCellBestWidth(w,a,b);
end;
end;
end;
{...........................................}
var pc: Boolean;
data: Integer;
begin
data := BeginModify(GetMyItemNo);
pc := Rows.IsPercentWidthColumn(Index);
InitUndo;
try
if pc then begin
SetPercentWidth(Index, Width, Fmt.ColStarts[Index]+Width, False);
end
else begin
SetWidth(Index, Width, Fmt.ColStarts[Index]+Width, False);
if not Shift and (Index+1<>Rows[0].Count) and
not Rows.IsPercentWidthColumn(Index+1) then
SetWidth(Index+1, Width, Fmt.ColStarts[Index]+Width, True);
end;
finally
DoneUndo;
end;
Fmt.FWidth := 0;
EndModify(GetMyItemNo, Data);
Change;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y,ItemNo: Integer; RVData: TObject): Boolean;
var Row,Col: Integer;
begin
Result := False;
if Rows.Empty then
exit;
if BusyCount>0 then exit;
MyClientTop := 0;
MyClientLeft := 0;
if (Button=mbLeft) then begin
if TCustomRVFormattedData(RVData).UsingThisXorDrawing(XORDrawing) then begin
TCustomRVFormattedData(RVData).UnAssignXorDrawing(XorDrawing);
if BeforeChange then
if rvtsVerticalDraggedRule in FState then begin
if DRCoord<>X then
ResizeCol(DRNo-1, X-DRMin+DRDelta, rvtsDRChangeTableWidth in FState);
end
else begin
if DRCoord<>Y then
ResizeRow(DRNo-1, Y-DRMin+DRDelta);
end;
TCustomRVFormattedData(RVData).ReleaseMouseCapture(Self);
RestoreInplace;
exit;
end;
//TCustomRVFormattedData(RVData).GetItemClientCoords(ItemNo, MyClientTop,MyC
MyClientTop := 0;
MyClientLeft := 0;
if FMakingSelection then begin
if FInplaceEditor=nil then begin
with Cells[FSelStartRow,FSelStartCol] do begin
MouseUp(Button, Shift, X, Y);
end;
if (TCustomRVFormattedData(FRows.FMainRVData).GetChosenRVData<>nil) and
(rvstCompletelySelected in TCustomRVFormattedData(FRows.FMainRVData).GetChosenRVData.State) then
TCustomRVFormattedData(FRows.FMainRVData).UnassignChosenRVData(TCustomRVFormattedData(FRows.FMainRVData).GetChosenRVData);
end
end
else
if FInplaceEditor=nil then begin
if GetCellAt(X, Y, Row, Col) then
with Cells[Row,Col] do
if RV_PointInRect(X, Y, Left+CellPadding, Top+CellPadding,
Width-CellPadding*2, Height-CellPadding*2) then
MouseUp(Button, Shift, X, Y);
end;
TCustomRVFormattedData(RVData).ReleaseMouseCapture(Self);
FMakingSelection := False;
end
else if FInplaceEditor=nil then begin
if GetCellAt(X, Y, Row, Col) then begin
with Cells[Row,Col] do
if RV_PointInRect(X, Y, Left+CellPadding, Top+CellPadding,
Width-CellPadding*2, Height-CellPadding*2) then begin
MouseUp(Button, Shift, X, Y);
if (Button=mbRight) and (rvoRClickDeselects in Rows.FMainRVData.Options) and
not IsCellSelected(Row,Col) and not CompletelySelected
and not ((ChosenCellRow=Row) and (ChosenCellCol=Col) and CellIsChosen)
then begin
TCustomRVFormattedData(Rows.FMainRVData).SetSelectionBounds(ItemNo, 1, ItemNo, 1);
end;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UpdateCellXCoords(Fmt: TRVTableItemFormattingInfo;
NoCaching, Reformatting: Boolean);
var r,c,l,w,i, cw: Integer;
AllDH, StartAllDH, CurDH, CP, Cnt, iew: Integer;
begin
Cnt := Rows[0].Count;
Fmt.ColStarts.Count := Cnt;
AllDH := GetDevX((CellHSpacing+(CellPadding+FCellBorderWidth)*2)*Cnt);
StartAllDH := AllDH;
l := GetDevX(BorderWidth+BorderHSpacing+CellBorderWidth);
CP := GetDevX(CellPadding);
for c := 0 to Rows[0].Count-1 do begin
Fmt.ColStarts[c] := l;
CurDH := AllDH div Cnt;
dec(AllDH,CurDH);
inc(l, Fmt.ColWidths[c]+CurDH);
dec(Cnt);
end;
for r := 0 to Rows.Count-1 do begin
for c := 0 to Rows[r].Count-1 do begin
l := Fmt.ColStarts[c];
w := Fmt.ColWidths[c];
if Cells[r,c]<>nil then begin
cw := w + GetDevX(CellPadding*2);
for i := 1 to Cells[r,c].ColSpan-1 do
inc(cw, Fmt.ColWidths[c+i]);
inc(cw, MulDiv(StartAllDH,Cells[r,c].ColSpan-1,Rows[r].Count));
if Fmt.Rows=nil then
with Cells[r,c] do begin
FLeft := l;
FWidth := cw;
end
else
if Fmt.Rows[r*Rows[0].Count+c]<>nil then
with TCellPtblRVData(Fmt.Rows[r*Rows[0].Count+c]) do begin
DX := l+CP;
Width := cw-CP*2;
end;
end;
end;
end;
if Fmt.Rows=nil then 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
Items[c].State := Items[c].State+[rvstDoNotMoveChildren];
try
Items[c].Format(NoCaching);
finally
Items[c].State := Items[c].State-[rvstDoNotMoveChildren];
end;
end;
if (FInplaceEditor<>nil) and
(TRVTableInplaceEdit(FInplaceEditor).FCell<>nil) then begin
iew := FInplaceEditor.Width;
FInplaceEditor.Width := TRVTableInplaceEdit(FInplaceEditor).FCell.Width;
if (iew=FInplaceEditor.Width) and Reformatting then
FInplaceEditor.Reformat;
end;
end
else begin
for r := 0 to Fmt.Rows.Count-1 do
if Fmt.Rows[r]<>nil then
TCellPtblRVData(Fmt.Rows[r]).Format(NoCaching);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.UpdateCellYCoords(Fmt: TRVTableItemFormattingInfo);
var r,c,t,h, i, ch: Integer;
StartAllDV,AllDV,CurDV,CP,Cnt: Integer;
begin
AllDV := GetDevY((CellVSpacing+(CellPadding+FCellBorderWidth)*2)*Rows.Count);
StartAllDV := AllDV;
CP := GetDevY(CellPadding);
t := GetDevY(BorderWidth+BorderVSpacing+CellBorderWidth);
Cnt := Rows.Count;
for r := 0 to Rows.Count-1 do begin
h := Fmt.RowHeights[r];
Fmt.RowStarts[r] := t;
for c := 0 to Rows[r].Count-1 do begin
if Cells[r,c]<>nil then begin
ch := h + GetDevY(CellPadding*2);
for i := 1 to Cells[r,c].RowSpan-1 do
inc(ch, Fmt.RowHeights[r+i]);
inc(ch, MulDiv(StartAllDV,Cells[r,c].RowSpan-1,Rows.Count));
if Fmt.Rows=nil then
with Cells[r,c] do begin
FTop := t;
FHeight := ch;
end
else
if Fmt.Rows[r*Rows[0].Count+c]<>nil then
with TCellPtblRVData(Fmt.Rows[r*Rows[0].Count+c]) do begin
DY := t+CP;
Height := ch-CP*2;
end;
end;
end;
CurDV := AllDV div Cnt;
dec(AllDV,CurDV);
inc(t, h+CurDV);
dec(Cnt);
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCellAt_(X, Y: Integer; var Row,Col: Integer): Boolean;
var r,c,dx,dy: Integer;
begin
Result := False;
dx := Cells[0,0].Left;
dy := Cells[0,0].Top;
if not RV_PointInRect(X,Y,dx+1,dy+1,Fmt.FWidth-dx*2-2,Fmt.FHeight-dy*2-2) then exit;
row := Rows.Count-1; // to change to bsearch !
for r := 0 to Rows.Count-2 do
if Fmt.RowStarts[r+1]>Y then begin
row := r;
break;
end;
with Rows[row] do begin
col := Count-1;
for c := 0 to Count-2 do // to change to bsearch !
if (Fmt.ColStarts[c+1]>X) then begin
col := c;
break;
end;
end;
Rows.GetMainCell(row, col, row, col);
with Cells[row,col] do
Result := RV_PointInRect(X,Y, Left+1,Top+1,Width-2,Height-2);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetCellAt(X, Y: Integer; var Row, Col: Integer): Boolean;
begin
if (MouseRow>=0) and (MouseRow<Rows.Count) and
(MouseCol>=0) and (MouseCol<Rows[0].Count) and
(Cells[MouseRow, MouseCol]<>nil) then
with Cells[MouseRow, MouseCol] do
if RV_PointInRect(X,Y, Left+1, Top+1, Width-2, Height-2) then begin
Row := MouseRow;
Col := MouseCol;
Result := True;
exit;
end;
Result := GetCellAt_(X,Y, Row, Col);
if Result then begin
MouseRow := Row;
MouseCol := Col;
end;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.IsCellSelected(Row, Col: Integer): Boolean;
var l,t,w,h: Integer;
Cell: TRVTableCellData;
begin
Result := False;
if not (rvtsSelExists in FState) then
exit;
Cell := FRows.GetMainCell(Row,Col,Row,Col);
GetNormalizedSelectionBounds(False, t,l,w,h);
if not (rvtsSelExists in FState) then
exit;
Result := (Col+Cell.ColSpan>l) and (Col<l+w) and
(Row+Cell.RowSpan>t) and (Row<t+h);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertCols(Index, Count, CopyIndex: Integer
{$IFDEF RICHVIEWDEF4};Select:Boolean=True{$ENDIF});
begin
if (Index<0) or (Index>Rows[0].Count) or
(CopyIndex<-1) or (CopyIndex>=Rows[0].Count) then
raise ERichViewError.Create(errInvalidIndex);
DestroyInplace(True);
InitUndo;
try
Rows.InsertCols(Index, Count, CopyIndex, False);
finally
DoneUndo;
end;
{$IFDEF RICHVIEWDEF4}
if Select then
SelectCols(Index, Count);
{$ENDIF}
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertRows(Index, Count, CopyIndex: Integer
{$IFDEF RICHVIEWDEF4};Select:Boolean=True{$ENDIF});
begin
if (Index<0) or (Index>Rows.Count) or
(CopyIndex<-1) or (CopyIndex>=Rows.Count) then
raise ERichViewError.Create(errInvalidIndex);
DestroyInplace(True);
InitUndo;
try
Rows.InsertRows(Index, Count, CopyIndex, False);
finally
DoneUndo;
end;
{$IFDEF RICHVIEWDEF4}
if Select then
SelectRows(Index, Count);
{$ENDIF}
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertColsLeft(Count: Integer);
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
InsertCols(c, Count, c);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertColsRight(Count: Integer);
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
InsertCols(c+cs, Count, c+cs-1);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertRowsAbove(Count: Integer);
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
InsertRows(r, Count, r);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.InsertRowsBelow(Count: Integer);
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
InsertRows(r+rs, Count, r+rs-1);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteRows(Index, Count: Integer;
DecreaseHeight: Boolean);
var er,ec,mr,mc: Integer;
begin
if Rows.Empty then
exit;
if (Index<0) or (Index>=Rows.Count) or (Count<=0) or
((Index=0) and (Count>Rows.Count)) then
raise ERichViewError.Create(errInvalidIndex);
if GetEditedCell(er,ec)<>nil then begin
if er>=Index+Count then
dec(er, Count)
end;
DestroyInplace(True);
Deselect;
InitUndo;
try
Rows.DeleteRows(Index,Count,DecreaseHeight);
finally
DoneUndo;
end;
if (Rows.Count>0) and (rvtoEditing in Options) then begin
if er<0 then begin
ec := 0;
er := Index;
end;
if er>=Rows.Count then
er := Rows.Count-1;
Rows.GetMainCell(er,ec,mr,mc);
CreateInplace(-1, mr,mc, False, True, False, False, False);
end;
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteCols(Index, Count: Integer; DecreaseWidth: Boolean);
var er,ec,mr,mc: Integer;
begin
if Rows.Empty then
exit;
if (Index<0) or (Index>=Rows[0].Count) or (Count<=0) or
((Index=0) and (Count>Rows[0].Count)) then
raise ERichViewError.Create(errInvalidIndex);
if GetEditedCell(er,ec)<>nil then begin
if ec>=Index+Count then
dec(ec, Count)
end;
DestroyInplace(True);
Deselect;
InitUndo;
try
Rows.DeleteCols(Index,Count,DecreaseWidth);
finally
DoneUndo;
end;
if (Rows.Count>0) and (Rows[0].Count>0) and CanChange and (rvtoEditing in Options) then begin
if er<0 then begin
er := 0;
ec := Index;
end;
if ec>=Rows[er].Count then
ec := Rows[er].Count-1;
Rows.GetMainCell(er,ec,mr,mc);
CreateInplace(-1, mr,mc, False, True, False, False, False);
end;
ResetLiveSpell;
Changed;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteSelectedRows;
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
DeleteRows(r, rs, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteSelectedCols;
var r,c,cs,rs: Integer;
begin
if not GetNormalizedSelectionBounds(True, r,c,cs,rs) then begin
Rows.FMainRVData.Beep;
exit;
end;
DeleteCols(c, cs, True);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteEmptyCols;
var r,c: Integer;
empty: Boolean;
begin
if Rows.Empty then
exit;
for c := Rows[0].Count-1 downto 0 do begin
empty := True;
for r := 0 to Rows.Count-1 do
if Cells[r,c]<>nil then begin
empty := False;
break;
end;
if empty then
DeleteCols(c,1,False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.DeleteEmptyRows;
var r,c: Integer;
empty: Boolean;
begin
for r := Rows.Count-1 downto 0 do begin
empty := True;
for c := 0 to Rows[r].Count-1 do
if Cells[r,c]<>nil then begin
empty := False;
break;
end;
if empty then
DeleteRows(r,1,False);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Deselect;
begin
{
if FInplaceEditor<>nil then begin
FInplaceEditor.Deselect;
FInplaceEditor.Invalidate;
exit;
end;
}
DestroyInplace(True);
Exclude(FState, rvtsSelExists);
FSelStartCol := -1;
FSelStartRow := -1;
FSelColOffs := 0;
FSelRowOffs := 0;
UpdateCellSel;
UnAssignActiveCell;
if Rows.FMainRVData is TCustomRVFormattedData then begin
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
TCustomRVFormattedData(Rows.FMainRVData).DoSelect;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.Select(StartRow, StartCol, RowOffs, ColOffs: Integer);
begin
if not (rvtsInserted in FState) then
exit;
DestroyInplace(True);
if not (Rows.FMainRVData is TCustomRVFormattedData) then
exit;
if not (rvoAllowSelection in Rows.FMainRVData.Options) then
exit;
TCustomRVFormattedData(Rows.FMainRVData).PartialSelectedItem := Self;
Include(FState, rvtsSelExists);
FSelStartCol := StartCol;
FSelStartRow := StartRow;
FSelColOffs := ColOffs;
FSelRowOffs := RowOffs;
UpdateCellSel;
if Rows.FMainRVData is TCustomRVFormattedData then begin
TCustomRVFormattedData(Rows.FMainRVData).Invalidate;
TCustomRVFormattedData(Rows.FMainRVData).DoSelect;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SelectCols(StartCol, Count: Integer);
begin
Select(0, StartCol, Rows.Count-1, Count-1);
end;
{------------------------------------------------------------------------------}
procedure TRVTableItemInfo.SelectRows(StartRow, Count: Integer);
begin
Select(StartRow, 0, Count-1, Rows[StartRow].Count-1);
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetSelectionBounds(var StartRow, StartCol,
RowOffs, ColOffs: Integer): Boolean;
begin
StartCol := FSelStartCol;
StartRow := FSelStartRow;
ColOffs := FSelColOffs;
RowOffs := FSelRowOffs;
Result := rvtsSelExists in FState;
end;
{------------------------------------------------------------------------------}
function TRVTableItemInfo.GetNormalizedSelectionBounds(IncludeEditedCell: Boolean;
var TopRow, LeftCol, ColSpan, RowSpan: Integer): Boolean;
var r,c: Integer;
Cell: TRVTableCellData;