copy a col (with content) right to a merged col

[j&b]

Hello,

I can copy a col (e.g. col 5) and insert right at col (e.g.) 1.
All oK.

Now I merge 2 cols (col 1 and col 2 -> all oK) and do the same. Now I get an error.
If I insert an empty col right from the merge cols and do same (copy a col with content and insert in the just bfefore inserted col all OK.

I think the reason are the merge cols. Perhaps colcount is wrong.

Why (Sergey) ?

Jürgen

Code: Select all

procedure TForm1.SpalteKopierenClick(Sender: TObject);
var r: integer;
begin
   if query1.state in [dsEdit, dsInsert] then query1.post;
   if not memo.GetCurrentItemEx(TRVTableItemInfo, rve, TCustomRVItemInfo(rveTable1)) then begin
      showMessage('Geht nicht !'+#10+'Tabelle muss den Fokus besitzen.');
      exit;
   end;
  if rveTable1.GetEditedCell(r,rveTspalte1)<>nil then begin
    rveTable1.SelectCols(rveTspalte1, 1);
    rveTspORzei:='Spalte';
  end else begin 
    showMessage('Fehler !'+#10+'Bei dieser Option dürfen keine Zellen markiert sein.'+#10);  
    rveTspORzei:='';
  end;  
end;


procedure TForm1.SpalteEinfuegenClick(Sender: TObject);
var item: TCustomRVItemInfo;
    yNc, r,c, rveTspalte2, itemNo, data: integer;
begin
  if rveTspORzei<>'Spalte' then begin
    ShowMessage('Geht nicht.'+#10+'Es trat bereits ein Fehler beim Kopieren auf (evtl. Zeile statt Spalte kopiert) !');
    exit;
  end;
  if (not memo.CanChange) or (not memo.GetCurrentItemEx(TRVTableItemInfo, rve, TCustomRVItemInfo(rveTable2))) then begin
    ShowMessage('Geht nicht !'+#10+'Tabelle muss den Fokus besitzen.'); 
    exit; 
  end;

  yNc:= MessageDlg('Soll der Spalten-Inhalt'+#10#10+
        '   in eine neue Spalte rechts der fokusierten Zeile einfügt        -->   JA'+#10+
        '   oder in die gerade fokusierte Spalte einfügt werden ?           -->   NEIN'+#10#10,
        mtConfirmation,[mbCancel,mbYes,mbNo],0);
  if yNc=2 then exit;          //2: cancel, 6: yes, 7: no
 
  if rveTable2.GetEditedCell(r,rveTspalte2)=NIL then exit;
    rveTable2.GetEditedCell(r,rveTSpalte2);

    if yNc=6 then begin          
      memo.GetCurrentItemEx(TRVTableItemInfo, rve, item);
      rveTable := TRVTableItemInfo(item);
      ItemNo := memo.GetItemNo(rveTable);   //code from Editor 1
      memo.BeginItemModify(ItemNo, Data);
      if Memo.SelectionExists=false then begin
        rve:=rveTable.GetEditedCell(r,c);
        rveTable.SelectCols(c,1);
      end;
      rveTable.InsertColsRight(1);
      memo.EndItemModify(ItemNo, Data);
      memo.Change;
    end;

    try
      if yNc=6 then                //Markierten Spalteninhalt in die eingefügte Spalte übergeben
        if rveTspalte1<rveTspalte2 then 
            CopyTableColumnEd(memo, rveTable1,rveTable2, rveTspalte1,rveTspalte2+1)
        else 
            CopyTableColumnEd(memo, rveTable1,rveTable2, rveTspalte1+1,rveTspalte2+1) 
      
      else  //of if yNc=6 then
          CopyTableColumnEd(memo, rveTable1,rveTable2, rveTspalte1,rveTspalte2); 

      rveTable2.SelectRows(rveTspalte2, 1);
    except
    end;  
end;

procedure TForm1.MergeSpaltenZeilenClick(Sender: TObject);
var item: TCustomRVItemInfo;
    itemNo,data,r,cs,rs : integer;
begin
  if query1.state in [dsEdit, dsInsert] then query1.post;
  if (not memo.CanChange) or (not memo.GetCurrentItemEx(TRVTableItemInfo, rve, TCustomRVItemInfo(rveTable))) then begin
     showMessage('Geht nicht !'+#10+'Tabelle muss den Fokus besitzen.');
     exit;
  end;
  if Memo.SelectionExists=false then begin 
    showMessage('Es wurde nichts markiert !'); exit; 
  end;
   try
     rveTable.GetNormalizedSelectionBounds(true, rveTzeile1,rveTspalte1,cs,rs);
     memo.GetCurrentItemEx(TRVTableItemInfo, rve, item);
     ItemNo := memo.GetItemNo(rveTable); 
     memo.BeginItemModify(ItemNo, Data);
     if (not memo.CanChange) then exit;

     lockWindowUpdate(Form1.handle);
     for r := rveTzeile1 to rveTzeile1+(rs-1) do begin
         rveTable.Select(r,rveTspalte1,0,cs-1); 
         rveTable.MergeSelectedCells(True);
     end;
   finally
     if rveTable<>nil then begin
       memo.EndItemModify(ItemNo, Data);
       memo.Change;
       lockWindowUpdate(0);
     end;  
   end;
end;

procedure TForm1.CopyTableColumnEd(rve: TCustomRichViewEdit; rveTable1,rveTable2: TRVTableItemInfo; SourceCol, DestCol: Integer); 
var r, ItemNo: Integer; 
    UnusedColor: TColor; 
    oldps, oldts:TRVFReaderStyleMode; 
    item: TCustomRVItemInfo;
    Stream1: TMemoryStream;
begin 
  UnusedColor := clNone; 
  oldps := rve.RVFParaStylesReadMode; 
  oldts := rve.RVFTextStylesReadMode; 
  rve.RVFParaStylesReadMode := rvf_sIgnore; 
  rve.RVFTextStylesReadMode := rvf_sIgnore; 
  SendMessage(memo.handle, WM_SETREDRAW, 0, 0);
  try 
    memo.GetCurrentItemEx(TRVTableItemInfo, rve, item);
    rveTable2 := TRVTableItemInfo(item);
    ItemNo:= memo.GetItemNo(rveTable2); 
    for r := 0 to min(rveTable1.Rows.Count,rveTable2.Rows.Count)-1 do 
      if (rveTable1.Cells[r, SourceCol]<>nil) and (rveTable2.Cells[r, DestCol]<>nil) then begin 
        Stream1:= TMemoryStream.Create;
        rveTable1.Cells[r, SourceCol].GetRVData.SaveRVFToStream(Stream1, False, UnusedColor, nil, nil); 
        Stream1.Position := 0; 
        rveTable2.Cells[r, DestCol].Edit; 
        rve.TopLevelEditor.SelectAll; 
        try
          rve.TopLevelEditor.InsertRVFFromStreamEd(Stream1); 
        except
           ShowMessage('StreamRead-Fehler in Spalte einfügen');
        end;
      end; 
  finally 
    Stream1.Free;
    rve.RVFParaStylesReadMode := oldps; 
    rve.RVFTextStylesReadMode := oldts; 
    SendMessage(memo.Handle, WM_SETREDRAW, 1, 0);  //rve.Handle
    while rve<>nil do begin 
      rve.Invalidate; 
      rve := TCustomRichViewEdit(rve.InplaceEditor); 
    end; 
  end; 
  if query1.state in [dsEdit, dsInsert] then query1.post;
end;

[Sergey Tkachenko]

Sorry, it's very hard to find error in this code. From the first look, it is ok, but I can miss something.
Can you create a project (as simple as possible) reproducing this problem and send it to me?

[j&b]

Hello Sergey,

do you have found something in my sample ?

Jürgen

[Sergey Tkachenko]

I received your project and I'll answer tomorrow.

[Sergey Tkachenko]

I found bugs in this code, see e-mail. The main reason is copying to the wrong column.

[j&b]

I found bugs in this code, see e-mail. The main reason is copying to the wrong column.

Thanks Sergey. Now it runs without error

About the exception: the error occurs when copying to column containing all
cells = nil.
In this case, variable Stream1 in TForm1.CopyTableColumnEd is not
initialized, and freeing it leads to error. The solution: add the line
Stream1 := nil at the beginning of this procedure.

But the main problem is copying to the wrong column. You get the column of
edited cell and copy to the next column. It is wrong, when ColSpan of this
cell > 1. The solution is simple (in TForm1.SpalteEinfuegenClick //jb):

after the line rveTable2.GetEditedCell(r,rveTSpalte2),
add the line:
inc(rveTSpalte2, rveTable2.Cells[r,rveTSpalte2].ColSpan-1);

Now, why column of all all-nil cell appear.

When you merge all cells with the column 0 and 1, cells from the column 0 cover the column 1, and all
cells in column 1 are nil. Such columns makes no sense,
so it's better to delete them.

Add rveTable.DeleteEmptyCols before "finally" (in TForm1.MergeSpaltenZeilenClick //jb)

Sergey Tkachenko




procedure TForm1.MergeSpaltenZeilenClick(Sender: TObject);
...
for r := rveTzeile1 to rveTzeile1+(rs-1) do begin
rveTable.Select(r,rveTspalte1,0,cs-1);
rveTable.MergeSelectedCells(True);
end;
rveTable.deleteEmptyCols; //<----------------------
finally
if rveTable<>nil then begin
...
end;


procedure TForm1.SpalteEinfuegenClick(Sender: TObject);
...
yNc:= MessageDlg('Soll der Spalten-Inhalt'+#10#10+
' in eine neue Spalte rechts der fokusierten Zeile einfügt --> JA'+#10+
' oder in die gerade fokusierte Spalte einfügt werden ? --> NEIN'+#10#10,
mtConfirmation,[mbCancel,mbYes,mbNo],0);
if yNc=2 then exit; //2: cancel, 6: yes, 7: no
if rveTable2.GetEditedCell(r,rveTspalte2)=NIL then exit;

rveTable2.GetEditedCell(r,rveTSpalte2);
inc(rveTSpalte2, rveTable2.cells[r, rveTSpalte2].colSpan-1); //<-------------------------
if yNc=6 then begin
...
end;