View Issue Details

IDProjectCategoryView StatusLast Update
0030623LazarusLCLpublic2019-06-09 09:07
ReporterK155LA3Assigned ToJesus Reyes 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformOSWindowsOS Version7
Product Version1.7 (SVN)Product Buildrev. 52995 
Target Version2.0Fixed in Version2.1 (SVN) 
Summary0030623: TStringGrid copy/paste to/from MS Excel and OO Calc bug
DescriptionWhen copy cell with quote symbol procedure TCustomStringGrid.CopyCellRectToClipboard get string as " but after function QuoteText it will converted to """".
When paste from clipboard to StringGrid it set cell data to ".
When paste from clipboard to OO Calc it set cell data to "".

When copy cell with " from OO Calc clipboard contained this data: "# 13#10
When paste from clipboard to StringGrid it clear cell data (make empty cell).
When paste from clipboard to OO Calc it set cell data to ".

Symbol "1" in cell:
StringGrid -> clipboard = """1"""# 13# 10
OO Calc -> clipboard = "1"# 13# 10
MS Excel -> clipboard = "1"# 13# 10

StringGrid -> MS Excel = "1"
StringGrid -> OO Calc = ""1""

OO Calc -> MS Excel = "1"
MS Excel -> OO Calc = "1"

But...

When I copy "1"# 13# 10 to clipboard from text file:

clipboard -> StringGrid = 1
clipboard -> OO Calc = 1
clipboard -> MS Excel = 1

When I copy """1"""# 13# 10 to clipboard from text file:

clipboard -> StringGrid = "1"
clipboard -> OO Calc = ""1""
clipboard -> MS Excel = "1"

If fill 3x3 cells in Excel and Calc:
1 1 1
1 1 1
1 1 1

And fill 3x3 cells in StringGrid:
2 2 2
2 2
2

And copy it from StringGrid and paste for replace cells:
Excel:
2 2 2
2 2
2
Calc:
2 2 2
2 2 1
2 1 1

If copy 3x3 cells from Excel:
2 2 2
2 2
2
And paste it to Calc:
2 2 2
2 2
2
Steps To Reproduce1 Place StringGrid to form.
2 Set in Options goEditing.
3 Run programm.
4 Place symbol " in one cell
5 Try copy/paste to/from MS Excel or OO Calc.
6 Fill 3x3 cell as above.
7 Try copy/paste to/from MS Excel or OO Calc.
Additional InformationMS Excel and OO Calc when copy cells to clipboard set this clipboard flag:

CF_Text = True
CF_Bitmap = False
CF_Picture = True
CF_MetaFilePict = False
CF_Object = False
CF_Component = False
CF_HTML = True

If CF_HTML = True then, MS Excel and OO Calc ignore text data and parse HTML data from clipboard.

Fix (only copy cells from StringGrid to Excel/Calc):

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
- SelStr: String;
+ SelStr, SelHTMLStr: String;
+ rflags: TReplaceFlags;
  aRow,aCol,k: LongInt;
  function QuoteText(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(0000009, s)>0) or
       (pos(0000010, s)>0) or
       (pos(0000013, s)>0) or
       (pos('"', s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;
begin
  SelStr := '';
+ SelHTMLStr := '<table>';
  for aRow:=R.Top to R.Bottom do begin
+ SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol:=R.Left to R.Right do begin

      if Columns.Enabled and (aCol>=FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow=0) and (FixedRows>0) then
- SelStr := SelStr + QuoteText(Columns[k].Title.Caption)
+ begin
+ SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
+ SelHTMLStr := SelHTMLStr + '<td>' + Columns[k].Title.Caption + '</td>';
+ end
        else
+ begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
+ SelHTMLStr := SelHTMLStr + '<td>' + Cells[aCol,aRow] + '</td>';
+ end;

      end else
+ begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
+ SelHTMLStr := SelHTMLStr + '<td>' + Cells[aCol,aRow] + '</td>';
+ end;

      if aCol<>R.Right then
        SelStr := SelStr + 0000009;
    end;

    SelStr := SelStr + sLineBreak;
+ SelHTMLStr := SelHTMLStr + '</tr>';
  end;
+ rflags := [rfReplaceAll, rfIgnoreCase];
+ SelHTMLStr := StringReplace(SelHTMLStr, '"', '"', rflags) + '</table>';
- Clipboard.AsText := SelStr;
+ Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

P.S.: To fix paste cells from Excel/Calc to StringGrid I think that need to parse HTML clipboard content in procedure TCustomStringGrid.SelectionSetText(TheText: String) or remove function QuoteText from procedure TCustomStringGrid.CopyCellRectToClipboard and correct operations with quote symbol in procedure LoadFromCSVStream.
TagsNo tags attached.
Fixed in Revision54001, 59960
LazTarget2.0
Widgetset
Attached Files
  • grids.pas.diff (3,513 bytes)
    uses .., HTMLDefs,
    
    ....
    
    procedure TCustomStringGrid.SelectionSetHTMLNew(theHTML: string);
    var
      StartCol,StartRow, aCol, aRow: Integer;
      p, q, t, endRow: pchar;
      theStr: string;
      replCount: Integer;
    
      procedure NewRow;
      begin
        inc(aRow);
        aCol := startCol - 1;
      end;
    
      procedure NewCol;
      begin
        inc(aCol);
      end;
    
      function NextColRow(aTag:string): boolean;
      var
        a: pchar;
        isRow: boolean;
      begin
        q := nil;
        isRow := aTag='tr';
        a := strpos(p, pchar('<'+aTag));
        if a=nil then begin
          aTag := uppercase(aTag);
          a := strpos(p, pchar('<'+aTag));
        end;
        result := a<>nil;
        if result then begin
          inc(a);
          a := strscan(a, '>');
          result := a<>nil;
          if result then begin
            // found, advance to content
            p := a + 1;
            // now find end of element
            q := strpos(p, pchar('</'+aTag));
            result := q<>nil;
            // update col, row
            if isRow then begin
              NewRow;
              if result then begin
                endRow := q + 4;
                q^ := #0; // put limits for any columns on this row
              end;
            end else
              NewCol;
          end;
        end;
      end;
    
      function RemoveTag(st, aTag, repl:string; closingToo:boolean):string;
      var
        o,a,b: pchar;
      begin
        replCount := 0;
        while true do begin
          //DebugLn('Removing ',aTag,' from ', dbgstr(st));
          result := st;
          if st='' then break;
          o := @st[1];
          a := strpos(o, pchar('<'+aTag));
          if a=nil then
            a := strpos(o, pchar('<'+uppercase(atag)));
          if a=nil then break;
          b := strpos(a+1, '>');
          if b=nil then break;
          inc(b);
          delete(st, a-o+1, b-a);
          if repl<>'' then begin
            inc(replCount);
            insert(repl, st, a-o+1);
          end;
        end;
    
        if closingToo then
          result := RemoveTag(st, '/' + aTag, '', false);
      end;
    
      function ReplaceEntities(st: string): string;
      var
        o,a,b: pchar;
        aName: widestring;
        entity: WideChar;
      begin
        while true do begin
          result := st;
          if st='' then
            break;
          o := @st[1];
          a := strscan(o, '&');
          if a=nil then
            break;
          b := strscan(a+1, ';');
          if b=nil then
            break;
          aName := UTF8Decode(copy(st, a-o+2, b-a-1));
          entity := ' ';
          if ResolveHTMLEntityReference(aName, entity) then begin
            delete(st, a-o+1, b-a+1);
            insert(UTF8Encode(entity), st, a-o+1);
          end;
        end;
      end;
    
    begin
      StartCol := Selection.Left;
      StartRow := Selection.Top;
      aCol := startCol - 1;
      aRow := startRow - 1;
    
      p := @theHTML[1];
      t := p + Length(theHTML);
    
      // find next row
      if not NextColRow('tr') then begin
        NewRow;
        endRow := t;
      end;
    
      while p<>nil do begin
    
        // find all cells
        while p<>nil do begin
          if not NextColRow('td') then
            break;
    
          SetString(theStr, p, q-p);
          theStr := RemoveTag(theStr, 'br', #10, false);
          if replCount>0 then begin
            theStr := StringReplace(theStr, #13#10'    ','', [rfReplaceAll]);
            theStr := StringReplace(theStr, #13#10'  ', ' ', [rfReplaceAll]);
          end;
          theStr := RemoveTag(theStr, 'span', '', true);
          theStr := ReplaceEntities(theStr);
    
          Cells[aCol, aRow] := theStr;
        end;
    
        p := endRow;  // next row
    
        if not NextColRow('tr') then
          break;
      end;
    end;
    
    
    grids.pas.diff (3,513 bytes)
  • grids.pas.diff.v2 (6,927 bytes)
  • grids.pas.v2.1.diff (6,820 bytes)
    uses .., HTMLDefs,
    
    ....
    
      TCustomStringGrid = class(TCustomDrawGrid)
          ...
        protected
          ...
          procedure SelectionSetHTML(TheHTML: String);
    
    ....
    
    procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
    var
      SelStr, SelHTMLStr: String;
      aRow,aCol,k: LongInt;
    
      function PrepareToTXT(s: string): string;
      begin
        DoCellProcess(aCol, aRow, cpCopy, s);
        if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
           (pos(#10, s)>0) or
           (pos(#13, s)>0) or
           (pos('"', s)>0)
        then
          result := AnsiQuotedStr(s, '"')
        else
          result := s;
      end;
    
      function PrepareToHTML(s: string): string;
      var
        i1: Integer;
        s1: string;
      begin
        Result := '';
        for i1 := 1 to Length(s) do
        begin
          case s[i1] of
            #13: s1 := '<br>';
            #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
            '<': s1 := '&lt;';
            '>': s1 := '&gt;';
            '"': s1 := '&quot;';
            '&': s1 := '&amp;';
            else s1 := s[i1];
          end;
          Result := Result + s1;
        end;
      end;
    
    begin
      SelStr := '';
      SelHTMLStr := '<table>';
      for aRow := R.Top to R.Bottom do begin
    
        SelHTMLStr := SelHTMLStr + '<tr>';
    
        for aCol := R.Left to R.Right do begin
    
          if Columns.Enabled and (aCol >= FirstGridColumn) then begin
    
            k := ColumnIndexFromGridColumn(aCol);
            if not Columns[k].Visible then
              continue;
    
            if (aRow = 0) and (FixedRows > 0) then
            begin
              SelStr := SelStr + PrepareToTXT(Columns[k].Title.Caption);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
            end
            else
            begin
              SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          end else
            begin
              SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          if aCol <> R.Right then
            SelStr := SelStr + #9;
        end;
    
        SelStr := SelStr + sLineBreak;
        SelHTMLStr := SelHTMLStr + '</tr>';
      end;
      SelHTMLStr := SelHTMLStr + '</table>';
      Clipboard.SetAsHtml(SelHTMLStr, SelStr);
    end;
    
    procedure TCustomStringGrid.DoPasteFromClipboard;
    begin
      // Unpredictable results when a multiple selection is pasted back in.
      // Therefore we inhibit this here.
      if HasMultiSelection then
        exit;
    
      if EditingAllowed(Col) then
      begin
        if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
        if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True));
      end;
    end; 
    
    procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String);
    var
      StartCol,StartRow, aCol, aRow: Integer;
      p, q, t, endRow: pchar;
      theStr: string;
      replCount: Integer;
      SelRect: TRect;
    
      procedure NewRow;
      begin
        inc(aRow);
        aCol := startCol - 1;
      end;
    
      procedure NewCol;
      begin
        inc(aCol);
      end;
    
      function NextColRow(aTag:string): boolean;
      var
        a: pchar;
        isRow: boolean;
      begin
        q := nil;
        isRow := aTag = 'tr';
        a := strpos(p, pchar('<'+aTag));
        result := a<>nil;
        if result then
        begin
          // found, advance to content
          p := a + 4;
          // now find end of element
          q := strpos(p, pchar('</'+aTag));
          result := q<>nil;
          // update col, row
          if isRow then
          begin
            NewRow;
            if result then
            begin
              endRow := q + 4;
              q^ := #0; // put limits for any columns on this row
            end;
          end
          else NewCol;
        end;
      end;
    
      function PrepareHTMLTable(const aStr: string): string;
      var
        bTag: string;
        bStr, bEndStr: PChar;
      begin
        Result := '';
        if aStr <> '' then
        begin
          bStr := PChar(aStr);
          bEndStr := bStr + StrLen(bStr) - 4;
          while bStr < bEndStr do
          begin
            if bStr^ = '<' then
            begin
              bTag := '<';
              Inc(bStr);
              if UpCase(bStr^) = 'B' then
              begin
                Inc(bStr);
                if UpCase(bStr^) = 'R' then Result := Result + #10; //<br>
              end;
              if bStr^ = '/' then
              begin
                bTag := '</';
                Inc(bStr);
              end;
              if UpCase(bStr^) = 'T' then
              begin
                Inc(bStr);
                if UpCase(bStr^) = 'R' then Result := Result + bTag + 'tr>'; //<tr>
                if UpCase(bStr^) = 'D' then Result := Result + bTag + 'td>'; //<td>
              end;
              while bStr < bEndStr do
              begin
                Inc(bStr);
                if bStr^ = '>' then
                begin
                  Inc(bStr);
                  Break;
                end;
              end;
            end else
            begin
              if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) then Result := Result + bStr^;
              Inc(bStr);
            end;
          end;
        end;
      end;
    
      function ReplaceEntities(st: string): string;
      var
        o,a,b: pchar;
        aName: widestring;
        entity: WideChar;
      begin
        while true do begin
          result := st;
          if st='' then
            break;
          o := @st[1];
          a := strscan(o, '&');
          if a=nil then
            break;
          b := strscan(a+1, ';');
          if b=nil then
            break;
          aName := UTF8Decode(copy(st, a-o+2, b-a-1));
          entity := ' ';
          if ResolveHTMLEntityReference(aName, entity) then begin
            system.delete(st, a-o+1, b-a+1);
            system.insert(UTF8Encode(entity), st, a-o+1);
          end;
        end;
      end;
    
    begin
      SelRect := Selection;
      StartCol := Selection.Left;
      StartRow := Selection.Top;
      aCol := startCol - 1;
      aRow := startRow - 1;
    
      //replace tag <br> to #10
      //remove all tag, except <tr>, </tr>, <td>, </td>
      //remove CL, CF and TAB symbols.
      theHTML := PrepareHTMLTable(theHTML);
    
      p := @theHTML[1];
      t := p + Length(theHTML);
    
      // find next row
      if not NextColRow('tr') then begin
        NewRow;
        endRow := t;
      end;
    
      while p<>nil do begin
    
        // find all cells
        while p<>nil do begin
          if not NextColRow('td') then
            break;
    
          SetString(theStr, p, q-p);
          if (aCol < ColCount) and (aRow < RowCount) then Cells[aCol, aRow] := ReplaceEntities(theStr);
        end;
    
        p := endRow;  // next row
    
        if not NextColRow('tr') then
          break;
      end;
    
      //need to corect set selection.
      SelRect.Right := aCol;
      SelRect.Bottom := aRow;
      Selection := SelRect;
    end;
    grids.pas.v2.1.diff (6,820 bytes)
  • grids.pas.v2.2.diff (5,914 bytes)
    uses .., HTMLDefs,
    
    ....
    
      TCustomStringGrid = class(TCustomDrawGrid)
          ...
        protected
          ...
          procedure SelectionSetHTML(TheHTML: String);
    
    ....
    
    procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
    var
      SelStr, SelHTMLStr: String;
      aRow,aCol,k: LongInt;
    
      function PrepareToTXT(s: string): string;
      begin
        DoCellProcess(aCol, aRow, cpCopy, s);
        if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
           (pos(#10, s)>0) or
           (pos(#13, s)>0) or
           (pos('"', s)>0)
        then
          result := AnsiQuotedStr(s, '"')
        else
          result := s;
      end;
    
      function PrepareToHTML(s: string): string;
      var
        i1: Integer;
        s1: string;
      begin
        Result := '';
        for i1 := 1 to Length(s) do
        begin
          case s[i1] of
            #13: s1 := '<br>';
            #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
            '<': s1 := '&lt;';
            '>': s1 := '&gt;';
            '"': s1 := '&quot;';
            '&': s1 := '&amp;';
            else s1 := s[i1];
          end;
          Result := Result + s1;
        end;
      end;
    
    begin
      SelStr := '';
      SelHTMLStr := '<table>';
      for aRow := R.Top to R.Bottom do begin
    
        SelHTMLStr := SelHTMLStr + '<tr>';
    
        for aCol := R.Left to R.Right do begin
    
          if Columns.Enabled and (aCol >= FirstGridColumn) then begin
    
            k := ColumnIndexFromGridColumn(aCol);
            if not Columns[k].Visible then
              continue;
    
            if (aRow = 0) and (FixedRows > 0) then
            begin
              SelStr := SelStr + PrepareToTXT(Columns[k].Title.Caption);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
            end
            else
            begin
              SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          end else
            begin
              SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          if aCol <> R.Right then
            SelStr := SelStr + #9;
        end;
    
        SelStr := SelStr + sLineBreak;
        SelHTMLStr := SelHTMLStr + '</tr>';
      end;
      SelHTMLStr := SelHTMLStr + '</table>';
      Clipboard.SetAsHtml(SelHTMLStr, SelStr);
    end;
    
    procedure TCustomStringGrid.DoPasteFromClipboard;
    begin
      // Unpredictable results when a multiple selection is pasted back in.
      // Therefore we inhibit this here.
      if HasMultiSelection then
        exit;
    
      if EditingAllowed(Col) then
      begin
        if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
        if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True));
      end;
    end; 
    
    procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String);
    var
      bStartCol, bStartRow, bCol, bRow: Integer;
      bCellStr: string;
      bSelRect: TRect;
    
      bCellData, bTagEnd: Boolean;
      bStr, bEndStr: PChar;
    
      function ReplaceEntities(cSt: string): string;
      var
        o,a,b: pchar;
        dName: widestring;
        dEntity: WideChar;
      begin
        while true do begin
          result := cSt;
          if cSt = '' then
            break;
          o := @cSt[1];
          a := strscan(o, '&');
          if a = nil then
            break;
          b := strscan(a + 1, ';');
          if b = nil then
            break;
          dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
          dEntity := ' ';
          if ResolveHTMLEntityReference(dName, dEntity) then begin
            system.delete(cSt, a - o + 1, b - a + 1);
            system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
          end;
        end;
      end;
    
    begin
      if theHTML <> '' then
      begin
        bSelRect := Selection;
        bStartCol := Selection.Left;
        bStartRow := Selection.Top;
        bCol := bStartCol;
        bRow := bStartRow;
        bStr := PChar(theHTML);
        bEndStr := bStr + StrLen(bStr) - 4;
        bCellStr := '';
        bCellData := False;
    
        while bStr < bEndStr do
        begin
          if bStr^ = '<' then // tag start sign '<'
          begin
            bTagEnd := False;
            Inc(bStr);
    
            if UpCase(bStr^) = 'B' then
            begin
              Inc(bStr);
              if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
            end;
    
            if bStr^ = '/' then // close tag sign '/'
            begin
              bTagEnd := True;
              Inc(bStr);
            end;
    
            if UpCase(bStr^) = 'T' then
            begin
              Inc(bStr);
    
              if UpCase(bStr^) = 'R' then // table start row tag <tr>
              begin
                bCellData := False;
                if bTagEnd then // table end row tag  </tr>
                begin
                  bSelRect.Right := bCol;
                  bSelRect.Bottom := bRow;
                  Inc(bRow);
                  bCol := bStartCol;
                end;
              end;
    
              if UpCase(bStr^) = 'D' then // table start cell tag <td>
              begin
                bCellData := not bTagEnd;
                if bTagEnd then // table end cell tag </td>
                begin
                  if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
                  Inc(bCol);
                  bCellStr := '';
                end;
              end;
            end;
    
            while bStr < bEndStr do
            begin
              Inc(bStr);
              if bStr^ = '>' then // tag end sign '>'
              begin
                Inc(bStr);
                Break;
              end;
            end;
          end else
          begin
            if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
            Inc(bStr);
          end;
        end;
    
        Selection := bSelRect; // set correct selection
      end;
    end;
    grids.pas.v2.2.diff (5,914 bytes)
  • grids.pas.v2.3.diff (6,069 bytes)
    uses .., HTMLDefs,
    
    ....
    
      TCustomStringGrid = class(TCustomDrawGrid)
          ...
        protected
          ...
          procedure SelectionSetHTML(TheHTML, TheText: String);
    
    ....
    
    procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
    var
      SelStr, SelHTMLStr: String;
      aRow,aCol,k: LongInt;
    
      function QuoteText(s: string): string;
      begin
        DoCellProcess(aCol, aRow, cpCopy, s);
        if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
           (pos(#10, s)>0) or
           (pos(#13, s)>0)
        then
          result := AnsiQuotedStr(s, '"')
        else
          result := s;
      end;
    
      function PrepareToHTML(s: string): string;
      var
        i1: Integer;
        s1: string;
      begin
        Result := '';
        for i1 := 1 to Length(s) do
        begin
          case s[i1] of
            #13: s1 := '<br>';
            #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
            '<': s1 := '&lt;';
            '>': s1 := '&gt;';
            '"': s1 := '&quot;';
            '&': s1 := '&amp;';
            else s1 := s[i1];
          end;
          Result := Result + s1;
        end;
      end;
    
    begin
      SelStr := '';
      SelHTMLStr := '<table>';
      for aRow := R.Top to R.Bottom do begin
    
        SelHTMLStr := SelHTMLStr + '<tr>';
    
        for aCol := R.Left to R.Right do begin
    
          if Columns.Enabled and (aCol >= FirstGridColumn) then begin
    
            k := ColumnIndexFromGridColumn(aCol);
            if not Columns[k].Visible then
              continue;
    
            if (aRow = 0) and (FixedRows > 0) then
            begin
              SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
            end
            else
            begin
              SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          end else
            begin
              SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          if aCol <> R.Right then
            SelStr := SelStr + #9;
        end;
    
        SelStr := SelStr + sLineBreak;
        SelHTMLStr := SelHTMLStr + '</tr>';
      end;
      SelHTMLStr := SelHTMLStr + '</table>';
      Clipboard.SetAsHtml(SelHTMLStr, SelStr);
    end;
    
    procedure TCustomStringGrid.DoPasteFromClipboard;
    begin
      // Unpredictable results when a multiple selection is pasted back in.
      // Therefore we inhibit this here.
      if HasMultiSelection then
        exit;
    
      if EditingAllowed(Col) then
      begin
        if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
        if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
      end;
    end; 
    
    procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
    var
      bStartCol, bStartRow, bCol, bRow: Integer;
      bCellStr: string;
      bSelRect: TRect;
    
      bCellData, bTagEnd: Boolean;
      bStr, bEndStr: PChar;
    
      function ReplaceEntities(cSt: string): string;
      var
        o,a,b: pchar;
        dName: widestring;
        dEntity: WideChar;
      begin
        while true do begin
          result := cSt;
          if cSt = '' then
            break;
          o := @cSt[1];
          a := strscan(o, '&');
          if a = nil then
            break;
          b := strscan(a + 1, ';');
          if b = nil then
            break;
          dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
          dEntity := ' ';
          if ResolveHTMLEntityReference(dName, dEntity) then begin
            system.delete(cSt, a - o + 1, b - a + 1);
            system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
          end;
        end;
      end;
    
    begin
      if theHTML <> '' then
      begin
        bSelRect := Selection;
        bStartCol := Selection.Left;
        bStartRow := Selection.Top;
        bCol := bStartCol;
        bRow := bStartRow;
        bStr := PChar(theHTML);
        bEndStr := bStr + StrLen(bStr) - 4;
        bCellStr := '';
        bCellData := False;
    
        while bStr < bEndStr do
        begin
          if bStr^ = '<' then // tag start sign '<'
          begin
            bTagEnd := False;
            Inc(bStr);
    
            if UpCase(bStr^) = 'B' then
            begin
              Inc(bStr);
              if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
            end;
    
            if bStr^ = '/' then // close tag sign '/'
            begin
              bTagEnd := True;
              Inc(bStr);
            end;
    
            if UpCase(bStr^) = 'T' then
            begin
              Inc(bStr);
    
              if UpCase(bStr^) = 'R' then // table start row tag <tr>
              begin
                bCellData := False;
                if bTagEnd then // table end row tag  </tr>
                begin
                  bSelRect.Right := bCol;
                  bSelRect.Bottom := bRow;
                  Inc(bRow);
                  bCol := bStartCol;
                end;
              end;
    
              if UpCase(bStr^) = 'D' then // table start cell tag <td>
              begin
                bCellData := not bTagEnd;
                if bTagEnd then // table end cell tag </td>
                begin
                  if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
                  Inc(bCol);
                  bCellStr := '';
                end;
              end;
            end;
    
            while bStr < bEndStr do
            begin
              Inc(bStr);
              if bStr^ = '>' then // tag end sign '>'
              begin
                Inc(bStr);
                Break;
              end;
            end;
          end else
          begin
            if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
            Inc(bStr);
          end;
        end;
    
        if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
        Selection := bSelRect; // set correct selection
      end;
    end;
    grids.pas.v2.3.diff (6,069 bytes)
  • grids.pas.v2.3.1.diff (6,069 bytes)
    uses .., HTMLDefs,
    
    ....
    
      TCustomStringGrid = class(TCustomDrawGrid)
          ...
        protected
          ...
          procedure SelectionSetHTML(TheHTML, TheText: String);
    
    ....
    
    procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
    var
      SelStr, SelHTMLStr: String;
      aRow,aCol,k: LongInt;
    
      function QuoteText(s: string): string;
      begin
        DoCellProcess(aCol, aRow, cpCopy, s);
        if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
           (pos(#10, s)>0) or
           (pos(#13, s)>0)
        then
          result := AnsiQuotedStr(s, '"')
        else
          result := s;
      end;
    
      function PrepareToHTML(s: string): string;
      var
        i1: Integer;
        s1: string;
      begin
        Result := '';
        for i1 := 1 to Length(s) do
        begin
          case s[i1] of
            #13: s1 := '<br>';
            #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
            '<': s1 := '&lt;';
            '>': s1 := '&gt;';
            '"': s1 := '&quot;';
            '&': s1 := '&amp;';
            else s1 := s[i1];
          end;
          Result := Result + s1;
        end;
      end;
    
    begin
      SelStr := '';
      SelHTMLStr := '<table>';
      for aRow := R.Top to R.Bottom do begin
    
        SelHTMLStr := SelHTMLStr + '<tr>';
    
        for aCol := R.Left to R.Right do begin
    
          if Columns.Enabled and (aCol >= FirstGridColumn) then begin
    
            k := ColumnIndexFromGridColumn(aCol);
            if not Columns[k].Visible then
              continue;
    
            if (aRow = 0) and (FixedRows > 0) then
            begin
              SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
            end
            else
            begin
              SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          end else
            begin
              SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
              SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
            end;
    
          if aCol <> R.Right then
            SelStr := SelStr + #9;
        end;
    
        SelStr := SelStr + sLineBreak;
        SelHTMLStr := SelHTMLStr + '</tr>';
      end;
      SelHTMLStr := SelHTMLStr + '</table>';
      Clipboard.SetAsHtml(SelHTMLStr, SelStr);
    end;
    
    procedure TCustomStringGrid.DoPasteFromClipboard;
    begin
      // Unpredictable results when a multiple selection is pasted back in.
      // Therefore we inhibit this here.
      if HasMultiSelection then
        exit;
    
      if EditingAllowed(Col) then
      begin
        if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
        if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
      end;
    end; 
    
    procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
    var
      bStartCol, bStartRow, bCol, bRow: Integer;
      bCellStr: string;
      bSelRect: TRect;
    
      bCellData, bTagEnd: Boolean;
      bStr, bEndStr: PChar;
    
      function ReplaceEntities(cSt: string): string;
      var
        o,a,b: pchar;
        dName: widestring;
        dEntity: WideChar;
      begin
        while true do begin
          result := cSt;
          if cSt = '' then
            break;
          o := @cSt[1];
          a := strscan(o, '&');
          if a = nil then
            break;
          b := strscan(a + 1, ';');
          if b = nil then
            break;
          dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
          dEntity := ' ';
          if ResolveHTMLEntityReference(dName, dEntity) then begin
            system.delete(cSt, a - o + 1, b - a + 1);
            system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
          end;
        end;
      end;
    
    begin
      if theHTML <> '' then
      begin
        bSelRect := Selection;
        bStartCol := Selection.Left;
        bStartRow := Selection.Top;
        bCol := bStartCol;
        bRow := bStartRow;
        bStr := PChar(theHTML);
        bEndStr := bStr + StrLen(bStr) - 4;
        bCellStr := '';
        bCellData := False;
    
        while bStr < bEndStr do
        begin
          if bStr^ = '<' then // tag start sign '<'
          begin
            bTagEnd := False;
            Inc(bStr);
    
            if UpCase(bStr^) = 'B' then
            begin
              Inc(bStr);
              if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
            end;
    
            if bStr^ = '/' then // close tag sign '/'
            begin
              bTagEnd := True;
              Inc(bStr);
            end;
    
            if UpCase(bStr^) = 'T' then
            begin
              Inc(bStr);
    
              if UpCase(bStr^) = 'R' then // table start row tag <tr>
              begin
                bCellData := False;
                if bTagEnd then // table end row tag  </tr>
                begin
                  bSelRect.Bottom := bRow;
                  Inc(bRow);
                  bCol := bStartCol;
                end;
              end;
    
              if UpCase(bStr^) = 'D' then // table start cell tag <td>
              begin
                bCellData := not bTagEnd;
                if bTagEnd then // table end cell tag </td>
                begin
                  if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
                  bSelRect.Right := bCol;
                  Inc(bCol);
                  bCellStr := '';
                end;
              end;
            end;
    
            while bStr < bEndStr do
            begin
              Inc(bStr);
              if bStr^ = '>' then // tag end sign '>'
              begin
                Inc(bStr);
                Break;
              end;
            end;
          end else
          begin
            if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
            Inc(bStr);
          end;
        end;
    
        if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
        Selection := bSelRect; // set correct selection
      end;
    end;
    grids.pas.v2.3.1.diff (6,069 bytes)
  • pruebas2.xlsx (10,453 bytes)
  • project1.zip (128,983 bytes)
  • ClpbrdTest.png (16,878 bytes)
    ClpbrdTest.png (16,878 bytes)
  • ClipboardTest.zip (129,335 bytes)
  • TCustomStringGrid_SelectionSetHTML.txt (7,055 bytes)
    procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
    type
      tTblCellData = record
        CellText: String;
        Row: Integer;
        ColSpan: Integer;
        RowSpan: Integer;
      end;
    
    var
      bStartCol, bStartRow, bCol, bRow, bTblCellCount: Integer;
      bCellStr: string;
      bSelRect: TRect;
    
      bCellData, bTagEnd: Boolean;
      bStr, bEndStr, bTDStart, bTDEnd: PChar;
      bTblCellData: array of tTblCellData;
      bCellDataArr: array of tTblCellData;
      bTblCellPos, bCellPos, bCellCount, bCounter: Integer;
    
      function ReplaceEntities(cSt: string): string;
      var
        o,a,b: pchar;
        dName: widestring;
        dEntity: WideChar;
      begin
        while true do begin
          result := cSt;
          if cSt = '' then
            break;
          o := @cSt[1];
          a := strscan(o, '&');
          if a = nil then
            break;
          b := strscan(a + 1, ';');
          if b = nil then
            break;
          dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
          dEntity := ' ';
          if ResolveHTMLEntityReference(dName, dEntity) then begin
            system.delete(cSt, a - o + 1, b - a + 1);
            system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
          end;
        end;
      end;
    
      function GetParamVal(const cTDStart, cTDEnd: PChar; cParamName: String): Integer;
      var
        dDigitChar: set of char = ['0'..'9'];
        dTDParam: String;
        dSpanPos, dPos: Integer;
        dTDPos, dTDEnd: PChar;
      begin
        dTDParam := UpCase(Copy(cTDStart, 1, cTDEnd - cTDStart));
    
        Result := 1;
        dTDPos := cTDStart + Pos(UpCase(cParamName), dTDParam);
        if dTDPos > cTDStart then
        begin
          while (dTDPos <= cTDEnd) and not(dTDPos^ in dDigitChar) do Inc(dTDPos);
          dTDEnd := dTDPos;
          while (dTDEnd <= cTDEnd) and (dTDEnd^ in dDigitChar) do Inc(dTDEnd);
          if dTDEnd > dTDPos then Result := StrToInt(Copy(dTDPos, 1, dTDEnd - dTDPos));
        end;
      end;
    
    begin
      if theHTML <> '' then
      begin
        bSelRect := Selection;
        bStartCol := Selection.Left;
        bStartRow := Selection.Top;
        bCol := bStartCol;
        bRow := bStartRow;
        bStr := PChar(theHTML);
        bTDStart := bStr;
        bTDEnd := bStr;
        bEndStr := bStr + StrLen(bStr) - 4;
        bCellStr := '';
        bCellData := False;
        bTblCellCount := 0;
        SetLength(bTblCellData, 0);
        SetLength(bCellDataArr, 0);
    
        while bStr < bEndStr do
        begin
          if bStr^ = '<' then // tag start sign '<'
          begin
            bTagEnd := False;
            Inc(bStr);
    
            if UpCase(bStr^) = 'B' then
            begin
              Inc(bStr);
              if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
            end;
    
            if bStr^ = '/' then // close tag sign '/'
            begin
              bTagEnd := True;
              Inc(bStr);
            end;
    
            if UpCase(bStr^) = 'T' then
            begin
              Inc(bStr);
    
              if UpCase(bStr^) = 'R' then // table start row tag <tr>
              begin
                bCellData := False;
                if bTagEnd then // table end row tag  </tr>
                begin
                  bSelRect.Bottom := bRow;
                  Inc(bRow);
                  bCol := bStartCol;
                end;
              end;
    
              if UpCase(bStr^) = 'D' then // table start cell tag <td>
              begin
                bCellData := not bTagEnd;
                if bTagEnd then // table end cell tag </td>
                begin
                  SetLength(bTblCellData, bTblCellCount + 1);
                  bTblCellData[bTblCellCount].CellText := ReplaceEntities(bCellStr);
                  bTblCellData[bTblCellCount].Row := bRow;
                  bTblCellData[bTblCellCount].ColSpan := GetParamVal(bTDStart, bTDEnd, 'COLSPAN');
                  bTblCellData[bTblCellCount].RowSpan := GetParamVal(bTDStart, bTDEnd, 'ROWSPAN');
                  Inc(bTblCellCount);
                  Inc(bCol);
                  bCellStr := '';
                end else
                begin
                  bTDStart := bStr;
                end;
              end;
            end;
    
            while bStr < bEndStr do
            begin
              Inc(bStr);
              if bStr^ = '>' then // tag end sign '>'
              begin
                if bCellData then bTDEnd := bStr;
                Inc(bStr);
                Break;
              end;
            end;
          end else
          begin
            if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
            Inc(bStr);
          end;
        end;
    
        if (bStartCol = bCol) and (bStartRow = bRow) then
        begin
          Cells[bCol, bRow] := TheText;
        end else
        begin
          bTblCellPos := 0;
          bCellPos := 0;
          bRow := bStartRow;
          
          //It is trrible code but it working. Please make it better.
    
          while bTblCellData[bTblCellPos].Row = bRow do  //First row of StringGrid
          begin
            bCellCount := bCellPos + bTblCellData[bTblCellPos].ColSpan;
            SetLength(bCellDataArr, bCellCount);
            for bCounter := 1 to bTblCellData[bTblCellPos].ColSpan do
            begin
              bCellDataArr[bCellPos] := bTblCellData[bTblCellPos];
              if ((bStartCol + bCellPos) < ColCount) and (bRow < RowCount) and (bCounter = 1) then
              begin
                Cells[bStartCol + bCellPos, bRow] := bCellDataArr[bCellPos].CellText;
              end;
              Inc(bCellPos);
              if bCellPos = bCellCount then Break;
            end;
            Inc(bTblCellPos);
            if bTblCellPos = bTblCellCount then Break;
          end;
    
          while bTblCellPos < bTblCellCount do  //Second and other row of StringGrid
          begin
            Inc(bRow);
            bCellPos := 0;
            while bTblCellData[bTblCellPos].Row = bRow do
            begin
              if bCellPos = bCellCount then
              begin
                bCellCount := bCellPos + bTblCellData[bTblCellPos].ColSpan;
                SetLength(bCellDataArr, bCellCount);
              end;
    
              while bCellPos < bCellCount do
              begin
                while bCellDataArr[bCellPos].RowSpan > 1 do
                begin
                  Dec(bCellDataArr[bCellPos].RowSpan);
                  Inc(bCellPos);
                  if bCellPos = bCellCount then Break;
                end;
                
                if bCellPos = bCellCount then Break;
    
                for bCounter := 1 to bTblCellData[bTblCellPos].ColSpan do
                begin
                  bCellDataArr[bCellPos] := bTblCellData[bTblCellPos];
                  if ((bStartCol + bCellPos) < ColCount) and (bRow < RowCount) and (bCounter = 1) then
                  begin
                    Cells[bStartCol + bCellPos, bRow] := bCellDataArr[bCellPos].CellText;
                  end;
                  Inc(bCellPos);
                  if bCellPos = bCellCount then Break;
                end;
                Inc(bTblCellPos);
                if bTblCellPos = bTblCellCount then Break;
              end;
              if bTblCellPos = bTblCellCount then Break;
            end;
    
          end;
        end;
        bSelRect.Right := bSelRect.Left + bCellCount - 1;
        Selection := bSelRect; // set correct selection
      end;
    end;

Relationships

related to 0030454 resolvedJesus Reyes TStringGrid copy selection bug, when cell in last column in selected range is empty. 
related to 0033111 resolvedJesus Reyes StringGrid incorrect copy-paste parsing 
related to 0034789 assignedJesus Reyes Grid pasting of selection into Excel doesn't preserve text line endings and may generate merged cells. 

Activities

K155LA3

2016-09-20 23:25

reporter   ~0094746

Last edited: 2016-09-20 23:39

View 3 revisions

+ SelHTMLStr := StringReplace(SelHTMLStr, '"', '"', rflags) + '</table>';
must be SelHTMLStr := StringReplace(SelHTMLStr, '"', '& quot;', rflags) + '</table>';
with out white space in '& quot;'

P.S.: Tested on MS Excel 2002.
P.P.S.: As a bonus, this fix has made it possible to insert copied cells from StringGrid as table to MS Word.

wp

2016-09-21 00:18

developer   ~0094747

Last edited: 2016-09-21 00:34

View 7 revisions

In addition to your report above I see also in Excel: If a cell contains a quoted character '1', a cell-internal line-break and an unquoted '2' (i.e. '"1" + Alt-RETURN + '2') then the clipboard gets the string '"""1""# 13'2"'# 13# 10). The same with LibreOffice, except that they want CTRL-RETURN for a cell-internal linebreak (which also shows up as a # 13), and they replace the ASCII quotes by some typographical UTF8 characters, at least on my German machine.

Therefore, I think that the cell should be quoted only if it contains (# 10 or # 13 or # 9) AND quote. The current code in CopyCellRectToClipboard.QuoteText, however, checks for # 10 or # 13 or # 9 OR quote.

I'd propose this modification:

  function QuoteText(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos('"', s)>0) and
       ((pos(# 9, s)>0) or (pos(# 10, s)>0) or (pos(# 13, s)>0)) // please remove the spaces after #
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

In case of the HTML copy, the code must also take care of '<', '>', '&' characters.

Copying HTML to the clipboard is ok, but I don't see much use of pasting HTML back into the stringgrid because there is not more information than using the text format. All the formatting - colors, alignment, fonts - cannot be applied by the stringgrid because it does not store this information and thus cannot use it. An advanced grid, such as the spreadsheetgrid of fpspreadsheet should be used if this feature is needed.

wp

2016-09-21 02:04

developer   ~0094748

Last edited: 2016-09-21 02:12

View 2 revisions

As for your observations with copying empty cells into OO: After copying the half-filled triange of 2's from the grid to the clipboard my clipboard viewer shows:

'2' TAB '2' TAB '2' CR LF '2' TAB '2' TAB CR LF '2' TAB TAB CR LF

This looks correct. Unfortunately Excel and LibreOffce behave differently when interpreting the blank cells: Excel pastes them as new empty cells, LO ignores them and keeps the original content. But I don't see how Lazarus could change the behavior of external programs...

If you want both programs to paste the blank cells as blank cells you must copy the stringgrid as HTML and paste it as such.

As for the copy/paste experiment from Excel to LibreOffice you must be aware that both programs copy several formats of the selection to the clipboard, and for pasting they select the one which transfers most information. My Excel 2007 for example copies the selection as an xlsx stream and as several xls (BIFF) streams (plus CSV, RTF, bmp, wmf, emf and several others which I can't identify). LibreOffice can understand both and imports the clipboard as one of them (probably xlsx because it most closely matches the original). In xlsx, a blank cell has a special meaning: it is empty. Therefore, the pasted empty cells overwrite the occupied cells in Calc and erase them.

If on the other hand you select "Paste special" in LibreOffice and select "unformatted text" from the menu then LibreOffice has the same behavior that you saw when pasting text from the stringgrid and keeps the original content of the destination cells.

So, in total, nothing is wrong with these observations.

K155LA3

2016-09-21 19:13

reporter   ~0094754

> If you want both programs to paste the blank cells as blank cells you must copy the stringgrid as HTML and paste it as such.

Yes, I suggested it in my solution of the problem: put to clipboard additional html data Excel style (unfortunately in the proposed variant is processed only quote symbol).

I think that it is necessary to copy and paste cell data via HTML as Excel and Calc. Also need to save to clipboard text data and paste text data as Excel, but if there is HTML data in clipboard must be use only them.

This will require some changes in procedures: TCustomStringGrid.CopyCellRectToClipboard(const R: TRect), TCustomStringGrid.DoPasteFromClipboard and TCustomStringGrid.SelectionSetText(TheText: String).

I'll try to do it.

wp

2016-09-21 19:44

developer   ~0094755

Last edited: 2016-09-21 19:45

View 2 revisions

> Also need to paste text data as Excel, but if there is HTML data in clipboard must be use only them.

No, I don't think so. The grid should not paste HTML from the clipboard. As I said above, it cannot use anything from the HTML stream but the text, but the text can be accessed much easier from the Text format. And reading HTML would squeeze the task of parsing html into the grid.

Maybe you are mislead because in your experiments the quotes were pasted better as HTML than as Text. But this is because there is a bug in the current CopyCellRectToClipboard routine - see my first post here.

K155LA3

2016-09-21 20:30

reporter   ~0094756

>But this is because there is a bug in the current CopyCellRectToClipboard routine - see my first post here.

It is not a bug, it is difference in the parsing of the text in different programs.

Symbol "1" in cell:
StringGrid -> clipboard = """1"""# 13# 10
OO Calc -> clipboard = "1"# 13# 10
MS Excel -> clipboard = "1"# 13# 10

StringGrid -> MS Excel = "1" - text to Excel
StringGrid -> OO Calc = ""1"" - text to Calc

OO Calc -> MS Excel = "1" - HTML to Excel
MS Excel -> OO Calc = "1" - HTML to Calc

But...

When I copy "1"# 13# 10 to clipboard from text file:

clipboard -> StringGrid = 1
clipboard -> OO Calc = 1
clipboard -> MS Excel = 1

When I copy """1"""# 13# 10 to clipboard from text file:

clipboard -> StringGrid = "1"
clipboard -> OO Calc = ""1""
clipboard -> MS Excel = "1"

Text data is inserted into and Excel Calc differently. For the correct insert identical data should be used HTML.

So I try to copy the cells of StringGrid in text format similar to Excel text format, but add functionality to copy/paste data as HTML.

K155LA3

2016-09-22 00:56

reporter   ~0094758

Last edited: 2016-09-22 23:42

View 7 revisions

This code correctly copy/paste from/to StringGrid to/from Excel and Calc via HTML (StringGrid to StringGrid copy process also use HTML), text data copy left in the current version and not changed:

--------------------------

  TCustomStringGrid = class(TCustomDrawGrid)
      ...
    protected
      ...
      procedure SelectionSetHTML(TheHTML: String);

--------------------------

procedure TCustomStringGrid.DoPasteFromClipboard;
begin
  // Unpredictable results when a multiple selection is pasted back in.
  // Therefore we inhibit this here.
  if HasMultiSelection then
    exit;

  if EditingAllowed(Col) then
  begin
    if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
    if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True));
  end;
end;

--------------------------

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
  SelStr, SelHTMLStr: String;
  aRow,aCol,k: LongInt;

  function PrepareToTXT(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(# 9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
       (pos(# 10, s)>0) or
       (pos(# 13, s)>0) or
       (pos('"', s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

  function PrepareToHTML(s: string): string;
  var
    i1: Integer;
    s1: string;
  begin
    Result := '';
    for i1 := 1 to Length(s) do
    begin
      case s[i1] of
        # 13: s1 := '< br>';
        # 10: if i1 > 1 then if s[i1 - 1] = # 13 then s1 := '' else s1 := '< br>';
        '<': s1 := '& lt;';
        '>': s1 := '& gt;';
        '"': s1 := '& quot;';
        '&': s1 := '& amp;';
        else s1 := s[i1];
      end;
      Result := Result + s1;
    end;
  end;

begin
  SelStr := '';
  SelHTMLStr := '<table>';
  for aRow:=R.Top to R.Bottom do begin

    SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol:=R.Left to R.Right do begin

      if Columns.Enabled and (aCol>=FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow=0) and (FixedRows>0) then
        begin
          SelStr := SelStr + PrepareToTXT(Columns[k].Title.Caption);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
        end
        else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      end else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      if aCol<>R.Right then
        SelStr := SelStr + # 9;
    end;

    SelStr := SelStr + sLineBreak;
    SelHTMLStr := SelHTMLStr + '</tr>';
  end;
  SelHTMLStr := SelHTMLStr + '</table>';
  Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

--------------------------

procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String);
var
  StartCol,StartRow, aCol, aRow: Integer;
  UCTheHTML: String;
  RowArray: array of String;
  TableRowCount, i1, i2, i3: Integer;

  function PrepareToCell(s: string): string;
  var
    i1, i2, SLen: Integer;
    s1: string;
    c1: Char;
  begin

    i1 := Pos('& NBSP;', upcase(s)); // delete ' '
    while i1 > 0 do
    begin
      Delete(s, i1, 6);
      Insert(' ', s, i1);
      i1 := Pos('& NBSP;', upcase(s));
    end;

    i1 := Pos('</ P>', upcase(s)); // Word use tag

instead

    while i1 > 0 do
    begin
      s[i1 + 1] := 'B';
      s[i1 + 2] := 'R';
      i1 := Pos('</ P>', upcase(s));
    end;

    i1 := Pos(# 13#10, upcase(s)); // after
Excel add Linebreak and some whitespace.
    while i1 > 0 do
    begin
      i2 := i1 + 2;
      while (s[i2] = ' ') and (i2 < Length(s)) do Inc(i2);
      Delete(s, i1, i2 - i1);
      i1 := Pos(# 13#10, upcase(s));
    end;

    i1 := Pos('< !', s); //delete <!...> ...</!...> tags
    while i1 > 0 do
    begin
      i2 := i1 + 2;
      while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
      Delete(s, i1, i2 - i1 + 1);
      i1 := Pos('< !', upcase(s));
    end;

    i1 := Pos('</ !', s); //delete <!...> ...</!...> tags
    while i1 > 0 do
    begin
      i2 := i1 + 3;
      while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
      Delete(s, i1, i2 - i1 + 1);
      i1 := Pos('</ !', upcase(s));
    end;

    i1 := Pos('< SPAN', upcase(s)); // if after Linebreak in Excel cell have some whitespace it set in tag <span ...>...</span>
    while i1 > 0 do
    begin
      i2 := i1 + 5;
      while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
      Delete(s, i1, i2 - i1 + 1);
      i1 := Pos('< SPAN', upcase(s));
    end;

    i1 := Pos('</ SPAN', upcase(s));
    while i1 > 0 do
    begin
      i2 := i1 + 6;
      while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
      Delete(s, i1, i2 - i1 + 1);
      i1 := Pos('</ SPAN', upcase(s));
    end;

    i1 := Pos('< BR>', upcase(s));
    while i1 > 0 do
    begin
      Delete(s, i1, 4);
      Insert(# 13#10, s, i1); //!!!!
      i1 := Pos('< BR>', upcase(s));
    end;

    i1 := Pos('& LT;', upcase(s));
    while i1 > 0 do
    begin
      Delete(s, i1, 4);
      Insert('<', s, i1);
      i1 := Pos('& LT;', upcase(s));
    end;

    i1 := Pos('& GT;', upcase(s));
    while i1 > 0 do
    begin
      Delete(s, i1, 4);
      Insert('>', s, i1);
      i1 := Pos('& GT;', upcase(s));
    end;

    i1 := Pos('& QUOT;', upcase(s));
    while i1 > 0 do
    begin
      Delete(s, i1, 6);
      Insert('"', s, i1);
      i1 := Pos('& QUOT;', upcase(s));
    end;

    i1 := Pos('& AMP;', upcase(s));
    while i1 > 0 do
    begin
      Delete(s, i1, 5);
      Insert('&', s, i1);
      i1 := Pos('& AMP;', upcase(s));
    end;

    for c1 := 'A' to 'Z' do
    begin
      s1 := '<' + c1;
      i1 := Pos(s1, upcase(s));
      while i1 > 0 do
      begin
        i2 := i1 + 2;
        while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
        Delete(s, i1, i2 - i1 + 1);
        i1 := Pos(s1, upcase(s));
      end;
      s1 := '</' + c1;
      i1 := Pos(s1, upcase(s));
      while i1 > 0 do
      begin
        i2 := i1 + 3;
        while (s[i2] <> '>') and (i2 < Length(s)) do Inc(i2);
        Delete(s, i1, i2 - i1 + 1);
        i1 := Pos(s1, upcase(s));
      end;
    end;

    Result := s;
  end;

begin
  StartCol := Selection.Left;
  StartRow := Selection.Top;
  TableRowCount := 0;
  UCTheHTML := upcase(TheHTML); //Used upcase() because Excel create HTML lowercase table tag, Calc - upcase table tag.
  i1 := Pos('<TR', UCTheHTML); //Function pos - case sensitivity.
  if i1 = 0 then i1 := 1;
  while i1 > 0 do
  begin
    Inc(TableRowCount);
    SetLength(RowArray, TableRowCount);
    i2 := Pos('</TR', UCTheHTML);
    if i2 <= 0 then i2 := Length(TheHTML);
    RowArray[TableRowCount - 1] := Copy(TheHTML, i1, i2 - i1 + 4);
    Delete(TheHTML, 1, i2 + 4);
    Delete(UCTheHTML, 1, i2 + 4);
    i1 := Pos('<TR', UCTheHTML);
  end;
  if (StartCol < ColCount) and (StartRow < RowCount) then
  begin
    aRow := StartRow;
    for i1 := 0 to TableRowCount - 1 do
    begin
      if aRow >= RowCount then Break;
      aCol := StartCol;
      while aCol < ColCount do
      begin
        i2 := Pos('<TD', upcase(RowArray[i1]));
        if i2 = 0 then Break;
        Delete(RowArray[i1], 1, i2);
        i2 := Pos('>', RowArray[i1]);
        Delete(RowArray[i1], 1, i2); // delete tag <td .... >
        i2 := Pos('</TD', upcase(RowArray[i1]));
        Cells[aCol, aRow] := PrepareToCell(Copy(RowArray[i1], 1, i2 - 1));
        Inc(aCol);
      end;
      Inc(aRow);
    end;
  end;
end;

wp

2016-09-22 03:14

developer   ~0094759

Last edited: 2016-09-22 03:15

View 2 revisions

Copy to clipboard as HTML is ok.

But I don't like the pasting part, I said it several times. We should fix the CopyCellRectToClipboard and SelectionSetTexts procedures first to accept an additional case that keeps the quotes of an entirely quoted cell (BTW, my fix of the CopyCelLRectToClipboard above is not correct) before diving into the adventure of HTML pasting.

Did you consider that the clipboard may contain text in non-table tags (e.g. pasting from Word)?
Did you consider that the cell text inside the < td> tags may be arranged at several levels of hierarchy (< spsn>, < p>, < div>)? You don't know what the sending program does...
Did you consider that the cell text could contain other html tags such as < b>, < i>?
Will this work in Linux? Some programs want a full html structure, some are happy with the <table> fragment only.

And this is only what comes to my mind now.

K155LA3

2016-09-22 23:09

reporter   ~0094778

>Did you consider that the clipboard may contain text in non-table tags (e.g. pasting from Word)?
I did not achieve compatibility with MS Word. I sought compatibility with MS Excel and OO Calc.
Try to copy the data from MS Excel and OO Calc containing quote and single qoute, in text format, they will be different. Inserting data in text format is also perceived differently MS Excel and OO Calc.
Try to place in MS Excel, MS Word and OO Calc cell '1' + Alt-RETURN + "2". ' - single quote symbol. And try to copy cell.
Clipboard text data will contain:
MS Excel: 22 31 27 0A 22 22 32 22 22 22 0D 0A
MS Word: 27 31 27 0D 0A 22 32 22 0D 0A
OO Calc: 27 31 27 0D 0A 22 32 22 0D 0A
OO Writer: 27 31 27 0D 0A 22 32 22 0D 0A

And if you paste text data to StringGrid you need to determine which program is copying to the clipboard.

MS Excel and OO Calc is a spreadsheet processors, unlike MS Word, which is the word processor. Paste to MS Word it is bonus, there was no problem providing the copy of the table from MS Word to StringGrid.

>Did you consider that the cell text inside the < td> tags may be arranged at several levels of hierarchy (< spsn>, < p>, < div>)?
As you can see in the previous message if after Line Break in Excel cell have some whitespace it set whitespace in tag <span ...> </ span>. Text inside the < td> duplicated after < td> tag (but may be some problem with single quote symbol).

>Did you consider that the cell text could contain other html tags such as < b>, < i>, < u>?
html tags such as < b>, < i>, < u> and other stringgrid not used and should be ignored.
HTML tags such as < b>, < i>, < u> used OO Calc, unlike MS Excel, which used "style" in <td> tag.

>Will this work in Linux? Some programs want a full html structure, some are happy with the <table> fragment only.
After execute Clipboard.SetAsHtml('<table><tr><td>1</td></tr></table>', '1'), Clipboard.GetAsHtml(False) return: <html><body><!--StartFragment--><table><tr><td>1</td></tr></table><!--EndFragment--></body></html>
Normal HTML data with <html><body> </body></html> tags.

P.S.: fix function PreprareToCell, see comment http://bugs.freepascal.org/view.php?id=30623#c94758 . Now it delete all tags exept < tr>, < td>, < span>, and now can insert tables from Word and Writer.

jamie philbrook

2016-09-22 23:51

reporter   ~0094779

I find it ironic K155LA3 has all the answers in code and refuses to simply use it for his needs! Instead, an attempt is being made to turn a TStringGrid into
something it is not!

 Can we please come to our senses and stop this out of control bloatware practice.
  If K1555LA3 fells he really needs this functionality then what happen to the
idea of making custom controls to your needs using the base controls to start
with? At least the rest of us that don't want it won't need to deal with the
extra lard that is doing nothing in their apps.

 P.S.
  Also, please include a property to disable this function! even at its basic
state.

K155LA3

2016-09-23 01:08

reporter   ~0094780

>I find it ironic K155LA3 has all the answers in code and refuses to simply use it for his needs!

TStringGrid have copy/paste functional (and have it long time ago). And this functional corectly working only with TStringGrid, If you try use copy/paste with TStringGrid and some other application you can some confused by corrupted data.
'1' + Alt-RETURN + "2" in cell, after copy to clipboard in text data format you have next:
TStringGrid: 22 27 31 27 0D 0A 22 32 22 22 0D 0A
MS Excel: 22 31 27 0A 22 22 32 22 22 22 0D 0A
MS Word: 27 31 27 0D 0A 22 32 22 0D 0A
OO Calc: 27 31 27 0D 0A 22 32 22 0D 0A
OO Writer: 27 31 27 0D 0A 22 32 22 0D 0A

My proposal is not the ultimate truth. If you can offer a more elegant solution, I had to accept without any objections.

In principle, any additional functionality to TStringGrid, such as for example undo / redo easily added to the runtime without creating additional custom components.

wp

2016-09-23 01:35

developer   ~0094781

A last time before I leave this discussion, Jesus will have to decide: Yes, this is a bug report, and it is a valid one. The issue is that the grid does not correctly handle quotes when copying to and pasting from the clipboard. But this is a very local issue and can be fixed within the corresponding routines. After this fix, there will still be some rare differences in how the grid and other applications interact with the clipboard. But I bet: More than 99% of all clipboard operations will be correct, almost nobody has quotes within the cells, and even you did not notice that grid cells can contain embedded line-breaks. And therefore there is no reason to bloat the StringGrid by adding some half-hearted html support. As Jamie said: If this is an issue for your application you still can add your html code to your specialized app.

jamie philbrook

2016-09-23 01:50

reporter   ~0094782

Last edited: 2016-09-23 01:53

View 2 revisions

My offer is to stop this nonsense of making bloatware.

 If I felt the erg to wrap code around a Tstringgrid BASE control to implement
a process of functionality like you are inflating, I can surely do so with
the way the Tstringgrid is now. And this inflated code would only be in my app, note everyone else's that has no need for it or have it get in the way of what they want to do with the TStringGrid BASE control.

 So instead of me offering up a path to complete your conquest of making a mess
out of the TStringGrid BASE control, why not build a TEnhancedStringGrid based
from the TSTringGrid/TCustomStrigGrid control with all the lard and bloat you want in it. Offer that up to the community and see how that plays out.

  At least the rest of us that dread having that code in there wouldn't have to
worry about it so much.

jamie philbrook

2016-09-23 04:21

reporter   ~0094783

TO wp Thank you ;)

K155LA3

2016-09-23 19:07

reporter   ~0094793

Last edited: 2016-09-23 20:21

View 2 revisions

>TStringGrid BASE control.

Well, then why STringGrid code in its current version as overblown?
Why you dose not stop on BASE functionlity?

>why not build a TEnhancedStringGrid based from the TSTringGrid/TCustomStrigGrid control with all the lard and bloat you want in it.

If functionality is declared, then why is it not working correctly?
And...
Empty form (x64 application): 2839552 byte
Application with Stringrid:
Current functional: 3309056 bytes (TStringrid control add 469504 byte to application)
With HTML copy to clipboard finctional: 3317760 bytes (+8704 byte to half of megabyte)
With HTML copy/paste to/from clipboard finctional: 3330048 bytes (+20992 byte to half of megabyte)
Its funny to heared about "lard and bloat" control.

P.S.: Probably really worth to divide the current version TStringGrid in TStringGrid (as in Delphi) and TStringGridEx (with extended functionality), but it will break lots of applications written for the current functionality TStringGrid.

Jesus Reyes

2017-01-25 16:35

developer   ~0097694

Removed the case when the copied text has a quote.

It is clear that it would be very difficult to make this feature to work perfectly in every possible scenario.

Copy and Paste functionality support for grids definitively belongs to the string grid but it has to be limited to the most frequent use. I mean, the cases where a standard grid is edited. A bit more than that is the support for multiline text and I think it is just in the limit of what the string grid should do. More advanced usage should require a more advanced grid or external dedicated support.

For this reason, if you find that the limited copy and paste support do not met the expected 'simple' functionality please continue submitting bug reports about it.

Jesus Reyes

2018-03-15 06:45

developer   ~0107121

From 0033111 is evident than r54001 broke the grid's self support of copy&paste when the selection has quotes.

I already concluded that is very difficult achieve perfect integration of copy&paste operation between spreadsheets and the grid by using the normal tab delimited text clipboard format and on this days I confirmed that conclusion because you can always craft a test that will break it, :(.

The solution is to implement some clipboard format that both office suites support and that works fine in at least Windows and Linux. On inspecting the clipboards formats and excluding the text format and the "LO/OO and MS office" specific fornats which would require fpspreadsheet dependency, that left us only with the sylk, dif and html formats.

The SYLK format is simple to produce and consume, especially the version that OO/LO produces, the problem is that it doesn't support uft8 out of *nix systems, and although we can tweak the format in such way that it would be ideal for native stringgrid support, it does't work for sharing with other programs. So it's then discarded. There are similar problems with the.dif format (although I have not tried that one).

About the html option I first though of it as too much for generic grid usage, now I think it is the only real solution. It seems to works fine for sharing between OO/LO and MS offices. And the best is that K155LA3 already provided an implementation.

I found some minor things (no real errors though) that I don't like too much in his implementation as for example the usage of input data is doubled with an upper cased version (or triple if one counts the row arrays), the limited html entities handled, etc.

Things that in my opinion could be improved, but i have not made tests for actually checking it, so I will attach my version and if somebody can do the checks it will be appreciated.

So basically I think we should give the html format a try, any idea or suggestion about it?

Jesus Reyes

2018-03-15 07:09

developer  

grids.pas.diff (3,513 bytes)
uses .., HTMLDefs,

....

procedure TCustomStringGrid.SelectionSetHTMLNew(theHTML: string);
var
  StartCol,StartRow, aCol, aRow: Integer;
  p, q, t, endRow: pchar;
  theStr: string;
  replCount: Integer;

  procedure NewRow;
  begin
    inc(aRow);
    aCol := startCol - 1;
  end;

  procedure NewCol;
  begin
    inc(aCol);
  end;

  function NextColRow(aTag:string): boolean;
  var
    a: pchar;
    isRow: boolean;
  begin
    q := nil;
    isRow := aTag='tr';
    a := strpos(p, pchar('<'+aTag));
    if a=nil then begin
      aTag := uppercase(aTag);
      a := strpos(p, pchar('<'+aTag));
    end;
    result := a<>nil;
    if result then begin
      inc(a);
      a := strscan(a, '>');
      result := a<>nil;
      if result then begin
        // found, advance to content
        p := a + 1;
        // now find end of element
        q := strpos(p, pchar('</'+aTag));
        result := q<>nil;
        // update col, row
        if isRow then begin
          NewRow;
          if result then begin
            endRow := q + 4;
            q^ := #0; // put limits for any columns on this row
          end;
        end else
          NewCol;
      end;
    end;
  end;

  function RemoveTag(st, aTag, repl:string; closingToo:boolean):string;
  var
    o,a,b: pchar;
  begin
    replCount := 0;
    while true do begin
      //DebugLn('Removing ',aTag,' from ', dbgstr(st));
      result := st;
      if st='' then break;
      o := @st[1];
      a := strpos(o, pchar('<'+aTag));
      if a=nil then
        a := strpos(o, pchar('<'+uppercase(atag)));
      if a=nil then break;
      b := strpos(a+1, '>');
      if b=nil then break;
      inc(b);
      delete(st, a-o+1, b-a);
      if repl<>'' then begin
        inc(replCount);
        insert(repl, st, a-o+1);
      end;
    end;

    if closingToo then
      result := RemoveTag(st, '/' + aTag, '', false);
  end;

  function ReplaceEntities(st: string): string;
  var
    o,a,b: pchar;
    aName: widestring;
    entity: WideChar;
  begin
    while true do begin
      result := st;
      if st='' then
        break;
      o := @st[1];
      a := strscan(o, '&');
      if a=nil then
        break;
      b := strscan(a+1, ';');
      if b=nil then
        break;
      aName := UTF8Decode(copy(st, a-o+2, b-a-1));
      entity := ' ';
      if ResolveHTMLEntityReference(aName, entity) then begin
        delete(st, a-o+1, b-a+1);
        insert(UTF8Encode(entity), st, a-o+1);
      end;
    end;
  end;

begin
  StartCol := Selection.Left;
  StartRow := Selection.Top;
  aCol := startCol - 1;
  aRow := startRow - 1;

  p := @theHTML[1];
  t := p + Length(theHTML);

  // find next row
  if not NextColRow('tr') then begin
    NewRow;
    endRow := t;
  end;

  while p<>nil do begin

    // find all cells
    while p<>nil do begin
      if not NextColRow('td') then
        break;

      SetString(theStr, p, q-p);
      theStr := RemoveTag(theStr, 'br', #10, false);
      if replCount>0 then begin
        theStr := StringReplace(theStr, #13#10'    ','', [rfReplaceAll]);
        theStr := StringReplace(theStr, #13#10'  ', ' ', [rfReplaceAll]);
      end;
      theStr := RemoveTag(theStr, 'span', '', true);
      theStr := ReplaceEntities(theStr);

      Cells[aCol, aRow] := theStr;
    end;

    p := endRow;  // next row

    if not NextColRow('tr') then
      break;
  end;
end;

grids.pas.diff (3,513 bytes)

K155LA3

2018-06-07 19:36

reporter  

grids.pas.diff.v2 (6,927 bytes)

K155LA3

2018-06-07 19:38

reporter   ~0108740

Last edited: 2018-06-08 00:42

View 2 revisions

Found two problem in SelectionSetHTMLNew:

1. Cells[aCol, aRow] := theStr;
   must be
   if (aCol < ColCount) and (aRow < RowCount) then Cells[aCol, aRow] := theStr;
   otherwise an overflow error occurs when the rows or columns in the clipboard are larger than in TStringGrid.

2. Other tag in <td></td> tag is not removed. For example <TD HEIGHT=20 ALIGN=LEFT><FONT FACE="Courier New" SIZE=3>«2»</FONT></TD> pasted in cell as <FONT FACE="Courier New" SIZE=3>«2»</FONT>.

I do some changes in SelectionSetHTMLNew:

1. function RemoveTag(st, aTag, repl:string; closingToo:boolean):string;
   replaced to
   function PrepareHTMLTable(const aStr: string): string;

2. Remove from function NextColRow(aTag:string)

    if a=nil then begin
      aTag := uppercase(aTag);
      a := strpos(p, pchar('<'+aTag));
    end;

    because PrepareHTMLTable set tag <tr>, </tr>, <td>, </td> in lowercase.

3. Some changes in SelectionSetHTMLNew function.

Please see grids.pas.v2.1.diff.

Upd: the correct version is grids.pas.v2.1.diff

K155LA3

2018-06-08 00:38

reporter  

grids.pas.v2.1.diff (6,820 bytes)
uses .., HTMLDefs,

....

  TCustomStringGrid = class(TCustomDrawGrid)
      ...
    protected
      ...
      procedure SelectionSetHTML(TheHTML: String);

....

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
  SelStr, SelHTMLStr: String;
  aRow,aCol,k: LongInt;

  function PrepareToTXT(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
       (pos(#10, s)>0) or
       (pos(#13, s)>0) or
       (pos('"', s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

  function PrepareToHTML(s: string): string;
  var
    i1: Integer;
    s1: string;
  begin
    Result := '';
    for i1 := 1 to Length(s) do
    begin
      case s[i1] of
        #13: s1 := '<br>';
        #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
        '<': s1 := '&lt;';
        '>': s1 := '&gt;';
        '"': s1 := '&quot;';
        '&': s1 := '&amp;';
        else s1 := s[i1];
      end;
      Result := Result + s1;
    end;
  end;

begin
  SelStr := '';
  SelHTMLStr := '<table>';
  for aRow := R.Top to R.Bottom do begin

    SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol := R.Left to R.Right do begin

      if Columns.Enabled and (aCol >= FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow = 0) and (FixedRows > 0) then
        begin
          SelStr := SelStr + PrepareToTXT(Columns[k].Title.Caption);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
        end
        else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      end else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      if aCol <> R.Right then
        SelStr := SelStr + #9;
    end;

    SelStr := SelStr + sLineBreak;
    SelHTMLStr := SelHTMLStr + '</tr>';
  end;
  SelHTMLStr := SelHTMLStr + '</table>';
  Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

procedure TCustomStringGrid.DoPasteFromClipboard;
begin
  // Unpredictable results when a multiple selection is pasted back in.
  // Therefore we inhibit this here.
  if HasMultiSelection then
    exit;

  if EditingAllowed(Col) then
  begin
    if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
    if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True));
  end;
end; 

procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String);
var
  StartCol,StartRow, aCol, aRow: Integer;
  p, q, t, endRow: pchar;
  theStr: string;
  replCount: Integer;
  SelRect: TRect;

  procedure NewRow;
  begin
    inc(aRow);
    aCol := startCol - 1;
  end;

  procedure NewCol;
  begin
    inc(aCol);
  end;

  function NextColRow(aTag:string): boolean;
  var
    a: pchar;
    isRow: boolean;
  begin
    q := nil;
    isRow := aTag = 'tr';
    a := strpos(p, pchar('<'+aTag));
    result := a<>nil;
    if result then
    begin
      // found, advance to content
      p := a + 4;
      // now find end of element
      q := strpos(p, pchar('</'+aTag));
      result := q<>nil;
      // update col, row
      if isRow then
      begin
        NewRow;
        if result then
        begin
          endRow := q + 4;
          q^ := #0; // put limits for any columns on this row
        end;
      end
      else NewCol;
    end;
  end;

  function PrepareHTMLTable(const aStr: string): string;
  var
    bTag: string;
    bStr, bEndStr: PChar;
  begin
    Result := '';
    if aStr <> '' then
    begin
      bStr := PChar(aStr);
      bEndStr := bStr + StrLen(bStr) - 4;
      while bStr < bEndStr do
      begin
        if bStr^ = '<' then
        begin
          bTag := '<';
          Inc(bStr);
          if UpCase(bStr^) = 'B' then
          begin
            Inc(bStr);
            if UpCase(bStr^) = 'R' then Result := Result + #10; //<br>
          end;
          if bStr^ = '/' then
          begin
            bTag := '</';
            Inc(bStr);
          end;
          if UpCase(bStr^) = 'T' then
          begin
            Inc(bStr);
            if UpCase(bStr^) = 'R' then Result := Result + bTag + 'tr>'; //<tr>
            if UpCase(bStr^) = 'D' then Result := Result + bTag + 'td>'; //<td>
          end;
          while bStr < bEndStr do
          begin
            Inc(bStr);
            if bStr^ = '>' then
            begin
              Inc(bStr);
              Break;
            end;
          end;
        end else
        begin
          if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) then Result := Result + bStr^;
          Inc(bStr);
        end;
      end;
    end;
  end;

  function ReplaceEntities(st: string): string;
  var
    o,a,b: pchar;
    aName: widestring;
    entity: WideChar;
  begin
    while true do begin
      result := st;
      if st='' then
        break;
      o := @st[1];
      a := strscan(o, '&');
      if a=nil then
        break;
      b := strscan(a+1, ';');
      if b=nil then
        break;
      aName := UTF8Decode(copy(st, a-o+2, b-a-1));
      entity := ' ';
      if ResolveHTMLEntityReference(aName, entity) then begin
        system.delete(st, a-o+1, b-a+1);
        system.insert(UTF8Encode(entity), st, a-o+1);
      end;
    end;
  end;

begin
  SelRect := Selection;
  StartCol := Selection.Left;
  StartRow := Selection.Top;
  aCol := startCol - 1;
  aRow := startRow - 1;

  //replace tag <br> to #10
  //remove all tag, except <tr>, </tr>, <td>, </td>
  //remove CL, CF and TAB symbols.
  theHTML := PrepareHTMLTable(theHTML);

  p := @theHTML[1];
  t := p + Length(theHTML);

  // find next row
  if not NextColRow('tr') then begin
    NewRow;
    endRow := t;
  end;

  while p<>nil do begin

    // find all cells
    while p<>nil do begin
      if not NextColRow('td') then
        break;

      SetString(theStr, p, q-p);
      if (aCol < ColCount) and (aRow < RowCount) then Cells[aCol, aRow] := ReplaceEntities(theStr);
    end;

    p := endRow;  // next row

    if not NextColRow('tr') then
      break;
  end;

  //need to corect set selection.
  SelRect.Right := aCol;
  SelRect.Bottom := aRow;
  Selection := SelRect;
end;
grids.pas.v2.1.diff (6,820 bytes)

K155LA3

2018-06-09 20:21

reporter  

grids.pas.v2.2.diff (5,914 bytes)
uses .., HTMLDefs,

....

  TCustomStringGrid = class(TCustomDrawGrid)
      ...
    protected
      ...
      procedure SelectionSetHTML(TheHTML: String);

....

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
  SelStr, SelHTMLStr: String;
  aRow,aCol,k: LongInt;

  function PrepareToTXT(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
       (pos(#10, s)>0) or
       (pos(#13, s)>0) or
       (pos('"', s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

  function PrepareToHTML(s: string): string;
  var
    i1: Integer;
    s1: string;
  begin
    Result := '';
    for i1 := 1 to Length(s) do
    begin
      case s[i1] of
        #13: s1 := '<br>';
        #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
        '<': s1 := '&lt;';
        '>': s1 := '&gt;';
        '"': s1 := '&quot;';
        '&': s1 := '&amp;';
        else s1 := s[i1];
      end;
      Result := Result + s1;
    end;
  end;

begin
  SelStr := '';
  SelHTMLStr := '<table>';
  for aRow := R.Top to R.Bottom do begin

    SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol := R.Left to R.Right do begin

      if Columns.Enabled and (aCol >= FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow = 0) and (FixedRows > 0) then
        begin
          SelStr := SelStr + PrepareToTXT(Columns[k].Title.Caption);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
        end
        else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      end else
        begin
          SelStr := SelStr + PrepareToTXT(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      if aCol <> R.Right then
        SelStr := SelStr + #9;
    end;

    SelStr := SelStr + sLineBreak;
    SelHTMLStr := SelHTMLStr + '</tr>';
  end;
  SelHTMLStr := SelHTMLStr + '</table>';
  Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

procedure TCustomStringGrid.DoPasteFromClipboard;
begin
  // Unpredictable results when a multiple selection is pasted back in.
  // Therefore we inhibit this here.
  if HasMultiSelection then
    exit;

  if EditingAllowed(Col) then
  begin
    if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
    if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True));
  end;
end; 

procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String);
var
  bStartCol, bStartRow, bCol, bRow: Integer;
  bCellStr: string;
  bSelRect: TRect;

  bCellData, bTagEnd: Boolean;
  bStr, bEndStr: PChar;

  function ReplaceEntities(cSt: string): string;
  var
    o,a,b: pchar;
    dName: widestring;
    dEntity: WideChar;
  begin
    while true do begin
      result := cSt;
      if cSt = '' then
        break;
      o := @cSt[1];
      a := strscan(o, '&');
      if a = nil then
        break;
      b := strscan(a + 1, ';');
      if b = nil then
        break;
      dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
      dEntity := ' ';
      if ResolveHTMLEntityReference(dName, dEntity) then begin
        system.delete(cSt, a - o + 1, b - a + 1);
        system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
      end;
    end;
  end;

begin
  if theHTML <> '' then
  begin
    bSelRect := Selection;
    bStartCol := Selection.Left;
    bStartRow := Selection.Top;
    bCol := bStartCol;
    bRow := bStartRow;
    bStr := PChar(theHTML);
    bEndStr := bStr + StrLen(bStr) - 4;
    bCellStr := '';
    bCellData := False;

    while bStr < bEndStr do
    begin
      if bStr^ = '<' then // tag start sign '<'
      begin
        bTagEnd := False;
        Inc(bStr);

        if UpCase(bStr^) = 'B' then
        begin
          Inc(bStr);
          if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
        end;

        if bStr^ = '/' then // close tag sign '/'
        begin
          bTagEnd := True;
          Inc(bStr);
        end;

        if UpCase(bStr^) = 'T' then
        begin
          Inc(bStr);

          if UpCase(bStr^) = 'R' then // table start row tag <tr>
          begin
            bCellData := False;
            if bTagEnd then // table end row tag  </tr>
            begin
              bSelRect.Right := bCol;
              bSelRect.Bottom := bRow;
              Inc(bRow);
              bCol := bStartCol;
            end;
          end;

          if UpCase(bStr^) = 'D' then // table start cell tag <td>
          begin
            bCellData := not bTagEnd;
            if bTagEnd then // table end cell tag </td>
            begin
              if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
              Inc(bCol);
              bCellStr := '';
            end;
          end;
        end;

        while bStr < bEndStr do
        begin
          Inc(bStr);
          if bStr^ = '>' then // tag end sign '>'
          begin
            Inc(bStr);
            Break;
          end;
        end;
      end else
      begin
        if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
        Inc(bStr);
      end;
    end;

    Selection := bSelRect; // set correct selection
  end;
end;
grids.pas.v2.2.diff (5,914 bytes)

K155LA3

2018-06-09 20:40

reporter   ~0108798

grids.pas.v2.2.diff - simplified procedure TCustomStringGrid.SelectionSetHTML(TheHTML: String):
1. removed subfunctions:
- procedure NewRow;
- procedure NewCol;
- function NextColRow(aTag:string): boolean;
- function PrepareHTMLTable(const aStr: string): string;
2. Parsing HTML tables occur in a single pass (except for the replacement of HTML entities).

K155LA3

2018-08-11 21:12

reporter  

grids.pas.v2.3.diff (6,069 bytes)
uses .., HTMLDefs,

....

  TCustomStringGrid = class(TCustomDrawGrid)
      ...
    protected
      ...
      procedure SelectionSetHTML(TheHTML, TheText: String);

....

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
  SelStr, SelHTMLStr: String;
  aRow,aCol,k: LongInt;

  function QuoteText(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
       (pos(#10, s)>0) or
       (pos(#13, s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

  function PrepareToHTML(s: string): string;
  var
    i1: Integer;
    s1: string;
  begin
    Result := '';
    for i1 := 1 to Length(s) do
    begin
      case s[i1] of
        #13: s1 := '<br>';
        #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
        '<': s1 := '&lt;';
        '>': s1 := '&gt;';
        '"': s1 := '&quot;';
        '&': s1 := '&amp;';
        else s1 := s[i1];
      end;
      Result := Result + s1;
    end;
  end;

begin
  SelStr := '';
  SelHTMLStr := '<table>';
  for aRow := R.Top to R.Bottom do begin

    SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol := R.Left to R.Right do begin

      if Columns.Enabled and (aCol >= FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow = 0) and (FixedRows > 0) then
        begin
          SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
        end
        else
        begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      end else
        begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      if aCol <> R.Right then
        SelStr := SelStr + #9;
    end;

    SelStr := SelStr + sLineBreak;
    SelHTMLStr := SelHTMLStr + '</tr>';
  end;
  SelHTMLStr := SelHTMLStr + '</table>';
  Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

procedure TCustomStringGrid.DoPasteFromClipboard;
begin
  // Unpredictable results when a multiple selection is pasted back in.
  // Therefore we inhibit this here.
  if HasMultiSelection then
    exit;

  if EditingAllowed(Col) then
  begin
    if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
    if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
  end;
end; 

procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
var
  bStartCol, bStartRow, bCol, bRow: Integer;
  bCellStr: string;
  bSelRect: TRect;

  bCellData, bTagEnd: Boolean;
  bStr, bEndStr: PChar;

  function ReplaceEntities(cSt: string): string;
  var
    o,a,b: pchar;
    dName: widestring;
    dEntity: WideChar;
  begin
    while true do begin
      result := cSt;
      if cSt = '' then
        break;
      o := @cSt[1];
      a := strscan(o, '&');
      if a = nil then
        break;
      b := strscan(a + 1, ';');
      if b = nil then
        break;
      dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
      dEntity := ' ';
      if ResolveHTMLEntityReference(dName, dEntity) then begin
        system.delete(cSt, a - o + 1, b - a + 1);
        system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
      end;
    end;
  end;

begin
  if theHTML <> '' then
  begin
    bSelRect := Selection;
    bStartCol := Selection.Left;
    bStartRow := Selection.Top;
    bCol := bStartCol;
    bRow := bStartRow;
    bStr := PChar(theHTML);
    bEndStr := bStr + StrLen(bStr) - 4;
    bCellStr := '';
    bCellData := False;

    while bStr < bEndStr do
    begin
      if bStr^ = '<' then // tag start sign '<'
      begin
        bTagEnd := False;
        Inc(bStr);

        if UpCase(bStr^) = 'B' then
        begin
          Inc(bStr);
          if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
        end;

        if bStr^ = '/' then // close tag sign '/'
        begin
          bTagEnd := True;
          Inc(bStr);
        end;

        if UpCase(bStr^) = 'T' then
        begin
          Inc(bStr);

          if UpCase(bStr^) = 'R' then // table start row tag <tr>
          begin
            bCellData := False;
            if bTagEnd then // table end row tag  </tr>
            begin
              bSelRect.Right := bCol;
              bSelRect.Bottom := bRow;
              Inc(bRow);
              bCol := bStartCol;
            end;
          end;

          if UpCase(bStr^) = 'D' then // table start cell tag <td>
          begin
            bCellData := not bTagEnd;
            if bTagEnd then // table end cell tag </td>
            begin
              if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
              Inc(bCol);
              bCellStr := '';
            end;
          end;
        end;

        while bStr < bEndStr do
        begin
          Inc(bStr);
          if bStr^ = '>' then // tag end sign '>'
          begin
            Inc(bStr);
            Break;
          end;
        end;
      end else
      begin
        if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
        Inc(bStr);
      end;
    end;

    if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
    Selection := bSelRect; // set correct selection
  end;
end;
grids.pas.v2.3.diff (6,069 bytes)

K155LA3

2018-08-11 21:22

reporter   ~0109982

Last edited: 2018-08-11 21:31

View 2 revisions

grids.pas.v2.3.1.diff
Main changes:
1. Added parameter TheText in procedure SelectionSetHTML(TheHTML, TheText: String).
2. At the end of the procedure, a check was added for the presence of a table in HTML data, and set text in cell if clipboard has CF_HTML fomat, but havent HTML table:
if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText;

upd: v2.3.1 - fix selection in SelectionSetHTML, selection is set correctly.

K155LA3

2018-08-11 21:29

reporter  

grids.pas.v2.3.1.diff (6,069 bytes)
uses .., HTMLDefs,

....

  TCustomStringGrid = class(TCustomDrawGrid)
      ...
    protected
      ...
      procedure SelectionSetHTML(TheHTML, TheText: String);

....

procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
  SelStr, SelHTMLStr: String;
  aRow,aCol,k: LongInt;

  function QuoteText(s: string): string;
  begin
    DoCellProcess(aCol, aRow, cpCopy, s);
    if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
       (pos(#10, s)>0) or
       (pos(#13, s)>0)
    then
      result := AnsiQuotedStr(s, '"')
    else
      result := s;
  end;

  function PrepareToHTML(s: string): string;
  var
    i1: Integer;
    s1: string;
  begin
    Result := '';
    for i1 := 1 to Length(s) do
    begin
      case s[i1] of
        #13: s1 := '<br>';
        #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
        '<': s1 := '&lt;';
        '>': s1 := '&gt;';
        '"': s1 := '&quot;';
        '&': s1 := '&amp;';
        else s1 := s[i1];
      end;
      Result := Result + s1;
    end;
  end;

begin
  SelStr := '';
  SelHTMLStr := '<table>';
  for aRow := R.Top to R.Bottom do begin

    SelHTMLStr := SelHTMLStr + '<tr>';

    for aCol := R.Left to R.Right do begin

      if Columns.Enabled and (aCol >= FirstGridColumn) then begin

        k := ColumnIndexFromGridColumn(aCol);
        if not Columns[k].Visible then
          continue;

        if (aRow = 0) and (FixedRows > 0) then
        begin
          SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>';
        end
        else
        begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      end else
        begin
          SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
          SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>';
        end;

      if aCol <> R.Right then
        SelStr := SelStr + #9;
    end;

    SelStr := SelStr + sLineBreak;
    SelHTMLStr := SelHTMLStr + '</tr>';
  end;
  SelHTMLStr := SelHTMLStr + '</table>';
  Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;

procedure TCustomStringGrid.DoPasteFromClipboard;
begin
  // Unpredictable results when a multiple selection is pasted back in.
  // Therefore we inhibit this here.
  if HasMultiSelection then
    exit;

  if EditingAllowed(Col) then
  begin
    if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
    if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
  end;
end; 

procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
var
  bStartCol, bStartRow, bCol, bRow: Integer;
  bCellStr: string;
  bSelRect: TRect;

  bCellData, bTagEnd: Boolean;
  bStr, bEndStr: PChar;

  function ReplaceEntities(cSt: string): string;
  var
    o,a,b: pchar;
    dName: widestring;
    dEntity: WideChar;
  begin
    while true do begin
      result := cSt;
      if cSt = '' then
        break;
      o := @cSt[1];
      a := strscan(o, '&');
      if a = nil then
        break;
      b := strscan(a + 1, ';');
      if b = nil then
        break;
      dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
      dEntity := ' ';
      if ResolveHTMLEntityReference(dName, dEntity) then begin
        system.delete(cSt, a - o + 1, b - a + 1);
        system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
      end;
    end;
  end;

begin
  if theHTML <> '' then
  begin
    bSelRect := Selection;
    bStartCol := Selection.Left;
    bStartRow := Selection.Top;
    bCol := bStartCol;
    bRow := bStartRow;
    bStr := PChar(theHTML);
    bEndStr := bStr + StrLen(bStr) - 4;
    bCellStr := '';
    bCellData := False;

    while bStr < bEndStr do
    begin
      if bStr^ = '<' then // tag start sign '<'
      begin
        bTagEnd := False;
        Inc(bStr);

        if UpCase(bStr^) = 'B' then
        begin
          Inc(bStr);
          if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
        end;

        if bStr^ = '/' then // close tag sign '/'
        begin
          bTagEnd := True;
          Inc(bStr);
        end;

        if UpCase(bStr^) = 'T' then
        begin
          Inc(bStr);

          if UpCase(bStr^) = 'R' then // table start row tag <tr>
          begin
            bCellData := False;
            if bTagEnd then // table end row tag  </tr>
            begin
              bSelRect.Bottom := bRow;
              Inc(bRow);
              bCol := bStartCol;
            end;
          end;

          if UpCase(bStr^) = 'D' then // table start cell tag <td>
          begin
            bCellData := not bTagEnd;
            if bTagEnd then // table end cell tag </td>
            begin
              if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
              bSelRect.Right := bCol;
              Inc(bCol);
              bCellStr := '';
            end;
          end;
        end;

        while bStr < bEndStr do
        begin
          Inc(bStr);
          if bStr^ = '>' then // tag end sign '>'
          begin
            Inc(bStr);
            Break;
          end;
        end;
      end else
      begin
        if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
        Inc(bStr);
      end;
    end;

    if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
    Selection := bSelRect; // set correct selection
  end;
end;
grids.pas.v2.3.1.diff (6,069 bytes)

Jesus Reyes

2018-12-15 03:47

developer  

pruebas2.xlsx (10,453 bytes)

Jesus Reyes

2018-12-15 05:31

developer   ~0112576

Last edited: 2018-12-15 05:33

View 2 revisions

Please open the attached prueba2.xlsx in excel
* Click the Test1 sheet, select the C8:F11 range, copy the selection
* Paste the selection in a grid setup with appropriated number of cols and rows of editable cells and compiled with your v2.3.1.

The paste will succeed, because some excel cells are multilined and in a normal grid the pasted content of such cells appears as single line which is ok. In the grid, copy the selection and do the following tests:

a) Paste it into an excel sheet: F15 and G16 are not pasted right, multilined cells are now splited.
b) paste it into the same grid: Some ?? symbols appear.

K155LA3

2018-12-16 10:26

reporter   ~0112594

I'm have not ?? symbols, but localized symbol was converted to english symbol.
And I think I found a problem. The text is corrupted only in HTML format, but everything looks fine in TEXT format.
The HTML text is corrupted in the procedure TClipboard.SetAsHtml(Html: String; const PlainText: String); in clipbrd.inc at string:

Stream := TStringStream.Create(InsertClipHeader(Html));

I'm chnaged procedure TClipboard.SetAsHtml to this:

procedure TClipboard.SetAsHtml(Html: String; const PlainText: String);
var
  Stream: TStream;
  IsValid: Boolean;
  TmpHTML: string;
begin
  if CF_HTML = 0 then
    exit;
  //If the HTML does not have correct <html><body> and closing </body></html> insert them
  MaybeInsertHtmlAndBodyTags(HTML, IsValid);
  if not IsValid then
    exit;

  Stream := TStringStream.Create;
  {$IFDEF WINDOWS}
  TmpHTML := InsertClipHeader(Html);
  {$ELSE}
  TmpHTML := Html;
  {$ENDIF}
  try
    Stream.Position := 0;
    if (TmpHTML <> '') then
    begin
      Stream.Size := 0;
      Stream.Position := 0;
      Stream.WriteBuffer(Pointer(TmpHTML)^, Length(TmpHTML)+1);
      Stream.Position := 0;
      Clipboard.AddFormat(CF_HTML, Stream);
    end;

    if (PlainText <> '') then
    begin
      Stream.Size := 0;
      Stream.Position := 0;
      Stream.WriteBuffer(Pointer(PlainText)^, Length(PlainText)+1); //Also write terminating zero
      Stream.Position := 0;
      ClipBoard.AddFormat(CF_TEXT, Stream);
    end;

  finally
    Stream.Free;
  end;
end;

It fix problem. Please check it.

P.S.: This change only fixes TClipboard.SetAsHtml, but I think that the main problem is in TStringStream. If, for example, AnyString contains localized characters, then TStringStream.Create(AnyString) corrupt them.

wp

2018-12-16 11:53

developer   ~0112595

Last edited: 2018-12-16 11:55

View 2 revisions

> I think that the main problem is in TStringStream. If, for example, AnyString
> contains localized characters, then TStringStream.Create(AnyString) corrupt
> them.

I cannot confirm this statement: create a form with a memo and a button, and the button has the following click procedure:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
  stream: TStringStream;
begin
  s := 'äöü';
  stream := TStringStream.Create(s);
  try
    Memo1.Lines.LoadFromStream(stream);
  finally
    stream.Free;
  end;
end;

When I click the button the string 'äöü' is displayed in the memo correctly.

Bart Broersma

2018-12-16 15:37

developer   ~0112601

Last edited: 2018-12-16 15:38

View 2 revisions

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
begin
  ClipBoard.SetAsHtml('Графические библиотеки','Plain');
  s:=ClipBoard.GetAsHtml(True);
  Memo1.Text:=s;
end;

The example text is outside my current codepage.
It works as expected: I get the correct text in the memo.

K155LA3

2018-12-16 16:38

reporter  

project1.zip (128,983 bytes)

K155LA3

2018-12-16 16:38

reporter  

ClpbrdTest.png (16,878 bytes)
ClpbrdTest.png (16,878 bytes)

K155LA3

2018-12-16 16:39

reporter   ~0112608

I make test programm (see project1.zip in attach), and have this result (see ClpbrdTest.png in attach).
System Win10 x64, Lazarus 2.1 svn r59293.

Jesus Reyes

2018-12-18 00:50

developer   ~0112655

Thanks for the test, I can reproduce the problem, when using fpc trunk. I fixed the problem in r59842.

With this patch my encoding test are now fixed.
The splitting problem remains.

I repeat the test here:

*In excel select range C8:F11
*paste it in the grid.
*In the grid, press CTRL+C to copy the current selection
*paste in excel in new sheet at cell A1

Notes:

The cell A2 is splitted into A2 and A3, curiously B2 (which originally was D9) is merged into B2:B3, the same with C2 which is merged into C2:C3. D2 which as B2 wwre multiline is now splitted into D2 and D3.

Bart Broersma

2018-12-18 19:01

developer   ~0112669

The HTML we paste shoud have a ColSPan or RowSpan in it I guess.
Why do we even try to paste that into in TStringGrid.
I would just simply disallow that.

K155LA3

2018-12-18 20:37

reporter  

ClipboardTest.zip (129,335 bytes)

Jesus Reyes

2018-12-18 20:58

developer   ~0112671

The grid can be configured to show multi-line text, in that case you want to preserve the text layout. Because multiline text is an option in the grid, one would think an option could be added to the grid in order to correctly handle that situation, I'm afraid such option would be always ON because it's required by those using it but it really doesn't matter for those who don't. So I think it's better that it's supported by default.

K155LA3

2018-12-18 21:00

reporter   ~0112672

TStringGrid as was and remains a TStringGrid. The HTML table is created dynamically only when copied to the clipboard.
If we get rid of this functionality, we will return to the problem two years ago - the appearance of extra quotes when copying from TStringGrid to MS Excel or OO Calc. Similarly, when inserting into TStringGrid from MS Excel or OO Calc, extra quotes appear. Because they interpret text data from the clipboard in their own way.
To check who and what data puts to the clipboard, I made a test application ClipboardTest (see ClipboardTest.zip in attach), it shows the contents of the clipboard.
Text data is different for MS Excel and OO Calc, but they both create tables in HTML format and read them in priority order.

When parsing the HTML table, I suggest splitting the combined cells into single ones and writing the value to the top left cell.

Bart Broersma

2018-12-18 21:24

developer   ~0112674

Last edited: 2018-12-18 21:25

View 2 revisions

I fail to see how disallowing ColSpan/RowSpan in the string returned by ClipBoard.GetAsHtml(), when pasting into a TStringGrid will re-introduce the problems with quotes.

K155LA3

2018-12-19 00:22

reporter   ~0112675

I apologize, maybe I did not understand correctly.
If, when detecting ColSpan/RowSpan, only parse Text, and not the HTML table, then the rows and columns will be separated correctly and value of merged cell will set to the top left cell, but then the problem of extra quotes arises.
I think it's worth trying to split the cells containing ColSpan/RowSpan, or build the table structure by text field, and take values from HTML table.

Jesus Reyes

2018-12-19 01:42

developer   ~0112677

For the time being, we only have to deal with cells with multiline text, later when the grid support merged cells we can improve html support for merged ranges. So any implementation that preserve the source merge content onto the grid would be ok.

Bart Broersma

2018-12-19 10:18

developer   ~0112695

My suggestion was to, if ColSpan or RowSpan is detected, to reject the pasting into TStringGrid and possibly show a message that this is NOT supported (yet).

@Jesus: you plan to support merging of cells?
In TStringGrid, all Grids?
If in TStringGrid wouldn't it be better to derive a new class from TStringGrid and implement it there?

Jesus Reyes

2018-12-19 22:07

developer   ~0112714

Last edited: 2018-12-19 22:16

View 2 revisions

The grid has already the needed infrastructure, it seems it can be all the grids, only a small amount of code will be needed in order to wire the functionality, or that is what I remember.

About the colspan/rowspan, in reality nothing prevents to somebody doing crazy copying of complex spreadsheets and trying to paste it into the grid. Throwing an error doesn't feel right to me. The only think is required is copying the grid and pasting into a spreadsheet and into the same grid and then copying back that selection. That should be the limit, if something can be rescued from a complex spreadsheet is OK but is not required. In that sense, only basic html support should be implemented and prepare it to fail graceful. IMO.

K155LA3

2018-12-22 21:30

reporter  

TCustomStringGrid_SelectionSetHTML.txt (7,055 bytes)
procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
type
  tTblCellData = record
    CellText: String;
    Row: Integer;
    ColSpan: Integer;
    RowSpan: Integer;
  end;

var
  bStartCol, bStartRow, bCol, bRow, bTblCellCount: Integer;
  bCellStr: string;
  bSelRect: TRect;

  bCellData, bTagEnd: Boolean;
  bStr, bEndStr, bTDStart, bTDEnd: PChar;
  bTblCellData: array of tTblCellData;
  bCellDataArr: array of tTblCellData;
  bTblCellPos, bCellPos, bCellCount, bCounter: Integer;

  function ReplaceEntities(cSt: string): string;
  var
    o,a,b: pchar;
    dName: widestring;
    dEntity: WideChar;
  begin
    while true do begin
      result := cSt;
      if cSt = '' then
        break;
      o := @cSt[1];
      a := strscan(o, '&');
      if a = nil then
        break;
      b := strscan(a + 1, ';');
      if b = nil then
        break;
      dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
      dEntity := ' ';
      if ResolveHTMLEntityReference(dName, dEntity) then begin
        system.delete(cSt, a - o + 1, b - a + 1);
        system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
      end;
    end;
  end;

  function GetParamVal(const cTDStart, cTDEnd: PChar; cParamName: String): Integer;
  var
    dDigitChar: set of char = ['0'..'9'];
    dTDParam: String;
    dSpanPos, dPos: Integer;
    dTDPos, dTDEnd: PChar;
  begin
    dTDParam := UpCase(Copy(cTDStart, 1, cTDEnd - cTDStart));

    Result := 1;
    dTDPos := cTDStart + Pos(UpCase(cParamName), dTDParam);
    if dTDPos > cTDStart then
    begin
      while (dTDPos <= cTDEnd) and not(dTDPos^ in dDigitChar) do Inc(dTDPos);
      dTDEnd := dTDPos;
      while (dTDEnd <= cTDEnd) and (dTDEnd^ in dDigitChar) do Inc(dTDEnd);
      if dTDEnd > dTDPos then Result := StrToInt(Copy(dTDPos, 1, dTDEnd - dTDPos));
    end;
  end;

begin
  if theHTML <> '' then
  begin
    bSelRect := Selection;
    bStartCol := Selection.Left;
    bStartRow := Selection.Top;
    bCol := bStartCol;
    bRow := bStartRow;
    bStr := PChar(theHTML);
    bTDStart := bStr;
    bTDEnd := bStr;
    bEndStr := bStr + StrLen(bStr) - 4;
    bCellStr := '';
    bCellData := False;
    bTblCellCount := 0;
    SetLength(bTblCellData, 0);
    SetLength(bCellDataArr, 0);

    while bStr < bEndStr do
    begin
      if bStr^ = '<' then // tag start sign '<'
      begin
        bTagEnd := False;
        Inc(bStr);

        if UpCase(bStr^) = 'B' then
        begin
          Inc(bStr);
          if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
        end;

        if bStr^ = '/' then // close tag sign '/'
        begin
          bTagEnd := True;
          Inc(bStr);
        end;

        if UpCase(bStr^) = 'T' then
        begin
          Inc(bStr);

          if UpCase(bStr^) = 'R' then // table start row tag <tr>
          begin
            bCellData := False;
            if bTagEnd then // table end row tag  </tr>
            begin
              bSelRect.Bottom := bRow;
              Inc(bRow);
              bCol := bStartCol;
            end;
          end;

          if UpCase(bStr^) = 'D' then // table start cell tag <td>
          begin
            bCellData := not bTagEnd;
            if bTagEnd then // table end cell tag </td>
            begin
              SetLength(bTblCellData, bTblCellCount + 1);
              bTblCellData[bTblCellCount].CellText := ReplaceEntities(bCellStr);
              bTblCellData[bTblCellCount].Row := bRow;
              bTblCellData[bTblCellCount].ColSpan := GetParamVal(bTDStart, bTDEnd, 'COLSPAN');
              bTblCellData[bTblCellCount].RowSpan := GetParamVal(bTDStart, bTDEnd, 'ROWSPAN');
              Inc(bTblCellCount);
              Inc(bCol);
              bCellStr := '';
            end else
            begin
              bTDStart := bStr;
            end;
          end;
        end;

        while bStr < bEndStr do
        begin
          Inc(bStr);
          if bStr^ = '>' then // tag end sign '>'
          begin
            if bCellData then bTDEnd := bStr;
            Inc(bStr);
            Break;
          end;
        end;
      end else
      begin
        if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
        Inc(bStr);
      end;
    end;

    if (bStartCol = bCol) and (bStartRow = bRow) then
    begin
      Cells[bCol, bRow] := TheText;
    end else
    begin
      bTblCellPos := 0;
      bCellPos := 0;
      bRow := bStartRow;
      
      //It is trrible code but it working. Please make it better.

      while bTblCellData[bTblCellPos].Row = bRow do  //First row of StringGrid
      begin
        bCellCount := bCellPos + bTblCellData[bTblCellPos].ColSpan;
        SetLength(bCellDataArr, bCellCount);
        for bCounter := 1 to bTblCellData[bTblCellPos].ColSpan do
        begin
          bCellDataArr[bCellPos] := bTblCellData[bTblCellPos];
          if ((bStartCol + bCellPos) < ColCount) and (bRow < RowCount) and (bCounter = 1) then
          begin
            Cells[bStartCol + bCellPos, bRow] := bCellDataArr[bCellPos].CellText;
          end;
          Inc(bCellPos);
          if bCellPos = bCellCount then Break;
        end;
        Inc(bTblCellPos);
        if bTblCellPos = bTblCellCount then Break;
      end;

      while bTblCellPos < bTblCellCount do  //Second and other row of StringGrid
      begin
        Inc(bRow);
        bCellPos := 0;
        while bTblCellData[bTblCellPos].Row = bRow do
        begin
          if bCellPos = bCellCount then
          begin
            bCellCount := bCellPos + bTblCellData[bTblCellPos].ColSpan;
            SetLength(bCellDataArr, bCellCount);
          end;

          while bCellPos < bCellCount do
          begin
            while bCellDataArr[bCellPos].RowSpan > 1 do
            begin
              Dec(bCellDataArr[bCellPos].RowSpan);
              Inc(bCellPos);
              if bCellPos = bCellCount then Break;
            end;
            
            if bCellPos = bCellCount then Break;

            for bCounter := 1 to bTblCellData[bTblCellPos].ColSpan do
            begin
              bCellDataArr[bCellPos] := bTblCellData[bTblCellPos];
              if ((bStartCol + bCellPos) < ColCount) and (bRow < RowCount) and (bCounter = 1) then
              begin
                Cells[bStartCol + bCellPos, bRow] := bCellDataArr[bCellPos].CellText;
              end;
              Inc(bCellPos);
              if bCellPos = bCellCount then Break;
            end;
            Inc(bTblCellPos);
            if bTblCellPos = bTblCellCount then Break;
          end;
          if bTblCellPos = bTblCellCount then Break;
        end;

      end;
    end;
    bSelRect.Right := bSelRect.Left + bCellCount - 1;
    Selection := bSelRect; // set correct selection
  end;
end;

K155LA3

2018-12-22 21:42

reporter   ~0112821

Im make some terrible code, but it working. HTML table parsed to bTblCellData with colspan/rowspan data, and then it is converted to a TStrinGrid cells. The data is placed only in the upper left corner of the "merged" cells, the remaining cells remain empty.

Jesus Reyes

2018-12-23 04:43

developer   ~0112822

ahem.. wasn't the opposite problem what was remaining?, I mean the copy of the grid selection and then pasting into the excel sheet where the multilines were split (A2->A2+A3 and D2->D2+D3) and the incorrect merging of the other cells (B2+B3 and C2+C3)? IIRC pasting from excel into the grid was fine. The col/row span in my opinion could wait until the grid supports merged cells.

K155LA3

2018-12-24 20:12

reporter   ~0112863

May be I don't understand problem. When I paste from StringGrind (for example two rows with four cols) into Excel (Office 2002) or Calc sheet where merged cell (for example A1+A2 and D1+D2) in A1, I get divided merged cells, and no other cells merge.
But if I try paste from Excel or Calc randomly merged cells (for example A1+A2 and B2+B3 for A1-B3 range) I have incorrect StringGrind cells filing. I solve this problem through separate merged cell (taken from Clipboard) to cell grid.

Jesus Reyes

2018-12-31 18:08

developer   ~0113047

Applied the grids.pas.v2.3.1.diff patch.

A new bug report will be opened for tracking the remaining problems of preserving line endings and probably related to this the merging of cells mentioned in my notes. Those problems are considered not critical because they require a grid configured in special way.

Thank you.

K155LA3

2019-01-19 15:45

reporter   ~0113477

Last edited: 2019-01-19 15:49

View 3 revisions

2 Jesus Reyes

The procedure TCustomStringGrid.SelectionSetHTML after

    while bStr < bEndStr do
    begin

must be supplemented with the following code:

      if (bStr^ = # 13) or (bStr^ = # 10) then // delete cl/rf symbol and delete tab/space symbol after cl/cr.
      begin
        while bStr < (bEndStr - 1) do
        begin
          Inc(bStr);
          if (bStr^ <> # 09) and (bStr^ <> # 10) and (bStr^ <> ' ') then Break;
        end;
      end;

Otherwise, if there are cl/rf in HTML data between < td> </ td> tags, extra spaces and tabs will be added to the cell.
For example copy multiline cell from OO Calc and MS Excel to StringGrid cell. MS Excel add cl, rf and some space after < br> tag.

Bart Broersma

2019-01-19 16:35

developer   ~0113483

@K155LA3: if you believe the bug is not fixed (properly) then re-open the issue.
Just ading a note to an issue that has status "resolved" most likely will not be picked up by the person to whom this issue was assigned.

jamie philbrook

2019-01-19 18:17

reporter   ~0113490

The grid is not a Spread Sheet nor is it a Microsoft Browser interface .

Why must this continue.
@K155LA3 you openly admit that you don't understand the problem YOU are having
not others, so why is it you think it's so important and life threatening that
you must make a basket case out of the StringGrid ?
 
  Personally I don't want your HTML code in my app, it's obvious useless cause
you don't understand the problem and I have already had to hack around myself,
but I didn't come here demanding the stringgrid to be changed on my behalf.


 I would like to take a VOTE on this and force the issue of separating this
code into a super class that is for HTML and stop with the antics.

 I think it was @Wp had the correct idea, put in a clipboard interceptor set of
events so that anyone can condition the text as they see fit and have them built there own class based from the StringGrid which is what you should be doing anyways.

 And if you come up with a good working THTMLStringGrid calss then maybe it can be installed in Lazarus but until then please stop and lets think about removing some lard!.

K155LA3

2019-01-19 19:34

reporter   ~0113491

Once again, it is enough for me that the functionality that provides data transmission through the text. I do not need to copy/paste multi-line cells. I do not need to insert StringGrid cell data into OO Calc. And the problem of extra quotes did not concern me at all. But the difference in StringGrid behavior with different applications categorically fails me.

The functionality of HTML that is necessary and sufficient for data exchange is incredibly lean and coming from the HTML data barbarously cut out everything that does not belong to the table.
Herewith, StringGrid as it was and remains StringGrid and HTML data appears and disappears only when performing a copy/paste operation.

And as far as I understand, there is a desire to develop the further development of the StringGrid in terms of combining cells. So, without structured data in the clipboard, providing cell colspan and rowspan parameters, copying/pasting even from a StringGrid to a StringGrid will turn out to be an very difficult task. And then either reinvent the wheel, or use already prepared in the form of the notorious HTML or other markup language. But HTML is already used in other data transfer applications.

jamie philbrook

2019-01-19 20:25

reporter   ~0113492

I think for what ever reason you have lost sight or maybe didn't understand it
in the first place, the controls that come with the LCL for the most part are
to provide basic functionality and if additional action needs to be taken
for your app, not for everyone else, you are to subclass it to something where
you can override, add to etc. to get what you need.

 For me, If I wanted to implement HTML for the grid, which I did in Delphi
I did not butcher the String grid. I simply created another control based from
the stringgrid and intercepted the copy and paste messages to condition the
strings coming and going via the clipboard.

 Please consider making your own class for this based from the grid if you must
but you are polluting everyone else's apps with code that ether hiccups or gets in the way of proper operation.
 The stringGrid is exactly what it states, its a grid of strings, it is not a
HTML, Microsoft companion tool.
  
  Also, with all the various browsers and spread sheets out there, they all do not behave the same so you simply trying to lard the control with useless code.

 If the Grid had some serious issue that prevents you from extending it for your own code then I can see a fix would be needed, but this isn't the case here.
  if you need help in resolving your issues there are a lot of talented coders
in the forums that are more than willing to help you work out code that would work as a subclass.

K155LA3

2019-01-19 23:45

reporter   ~0113499

StringGrid in Lazarus has long outgrown its ancestor from Delphi. And copy/paste functionality has long been built into a StringGrid.

HTML is just a container for transferring data through the clipboard, it is not used anywhere else in the StringGrid. If you do not like HTML - think of another way to ensure copying/pasting compatibility with other applications. Without "out-of-box" compatibility with other commonly used applications (excluding any exotics) the StringGrid copy/paste functionality will be almost useless.

At the time of opening this case, there were no problems with copying/pasting data from MS Excel. There was a problem of empty cells and extra quotes, but this problem was with Open Office Calc, which has nothing to do with Microsoft. Re-read the problem description at the top of this page.

If I need additional runtime functionality (for example, undo/redo or the reaction to the shortcut keys such as Ctrl+A or deleting the entire selected fragment and not just one cell), I will do a lot easier than creating a new component and having to recompile Lazarus when adding it.

Jesus Reyes

2019-02-03 02:43

developer   ~0113810

I don't understand why this bug has been reopened. The provided patch seems to be a fix for multilines which are the main reason of the related bug report (so it should be handled there). If I'm wrong then please say so, other way there is no reason for keeping this report opened.

To jamie et al: I will be glad to remove the html usage of this patch for interchange with other apps (and the grid itself) if you or somebody else provide a patch that:

1. Preserve the current functionality without loses and ...
2. It should be a brain dead solution that just will require either:
  a) (preferable) Adding a unit (that will, with the help of some automatism, plug in the desired functionality).
  b) call some function that hooks the desired functionality at some documented grid event.
  c) Some other thing, be creative...

I'm sure everybody (and me the first) will be happy of lightening the grid by removing features, while at the same time being able to say "we removed that but you can fix your code this or that way".

So all is reduced to give the users of this (or any) feature a path to fix their code.

K155LA3

2019-02-03 16:06

reporter   ~0113828

Last edited: 2019-02-03 16:07

View 2 revisions

When copying multi-line cells, Excel after the < BR> tag puts the line break and carriage return characters, a new line starts with a few spaces. They must be removed, otherwise this spaces will be added to the cell at the beginning of the second line in the cell. In the rev. 60312, these spaces are not removed. In addition to Excel, there may be other applications that, after the < BR> tag, put line breaks, carriage returns, and spaces with tabs.
The solution here: https://bugs.freepascal.org/view.php?id=30623#c113477

wp

2019-02-03 17:34

developer   ~0113833

> I will be glad to remove the html usage of this patch for interchange with other
> apps (and the grid itself) if you or somebody else provide a patch that:
> [...]
> b) call some function that hooks the desired functionality at some documented
> grid event.
> c) Some other thing, be creative...[...]

I don't have the time ATM to provide a patch (maybe later), but the idea is this: Remove all HTML related stuff and return to one of the last working solutions based on CSV. Add an event OnCopyToClipboard which is fired in DoCopyToClipboard - this way the user can copy any format in addition to the CF_TEXT. And add an event OnPasteFromClipboard which is fired at the beginning of DoPasteFromClipboard - now the user can check the clipboard contents on his own and paste the format he wants. Without an event handler the clipboard will be accessed as standard CF_TEXT format via CSV. If CSV is not enough - no problem, he can try HTML coded by himself, or, with the aid of fpspreadsheet, he can even use the original clipboard formats of the spreadsheets (fpspreadsheet has its own grid derivative, though). Of course this means more programming, probably MUCH more programming, but it offers the greatest flexibility without stuffing anything into the grid beyond the standard CF_TEXT format, and is one step towards a slimmer TCustomGrid.

Jesus Reyes

2019-02-03 19:27

developer   ~0113838

K155LA3: that means that the patch had to do with multiline cells, but that is not a matter in this bug report anymore, we will take the patch from here and deal with it in the related report, it's ok, and if there is not yet, a note in the related report would be welcomed.

wp, if we restore the original tabbed text handling we will have a wrongly behaved grid (at least for some situations) with no trivial fix at hand, my estimate is that fixing it will take more code into the grid than the code using the html approach (which as already said, as a bonus, it brings in exchangeable support, but any way...).

It looks right to let the grid with just basic CF_TEXT support but this has to work right always. So this is the deal: extracting the html support from the grid would implicitly mean to fix the CF_TEXT base handling. No matter the method used for lightening the grid, it should fulfill that goal.

But anyway, if any action is taken, why this report should be kept opened? please notice that I don't know if just adding a note to a resolved report automatically will reopen it, at least it seems K155LA3's note didn't.

Issue History

Date Modified Username Field Change
2016-09-20 23:20 K155LA3 New Issue
2016-09-20 23:25 K155LA3 Note Added: 0094746
2016-09-20 23:28 K155LA3 Note Edited: 0094746 View Revisions
2016-09-20 23:39 K155LA3 Note Edited: 0094746 View Revisions
2016-09-21 00:18 wp Note Added: 0094747
2016-09-21 00:21 wp Note Edited: 0094747 View Revisions
2016-09-21 00:28 wp Note Edited: 0094747 View Revisions
2016-09-21 00:29 wp Note Edited: 0094747 View Revisions
2016-09-21 00:32 wp Note Edited: 0094747 View Revisions
2016-09-21 00:32 wp Note Edited: 0094747 View Revisions
2016-09-21 00:34 wp Note Edited: 0094747 View Revisions
2016-09-21 02:04 wp Note Added: 0094748
2016-09-21 02:12 wp Note Edited: 0094748 View Revisions
2016-09-21 19:13 K155LA3 Note Added: 0094754
2016-09-21 19:44 wp Note Added: 0094755
2016-09-21 19:45 wp Note Edited: 0094755 View Revisions
2016-09-21 20:30 K155LA3 Note Added: 0094756
2016-09-22 00:56 K155LA3 Note Added: 0094758
2016-09-22 00:58 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 00:59 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 01:00 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 03:14 wp Note Added: 0094759
2016-09-22 03:15 wp Note Edited: 0094759 View Revisions
2016-09-22 23:09 K155LA3 Note Added: 0094778
2016-09-22 23:11 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 23:16 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 23:42 K155LA3 Note Edited: 0094758 View Revisions
2016-09-22 23:51 jamie philbrook Note Added: 0094779
2016-09-23 01:08 K155LA3 Note Added: 0094780
2016-09-23 01:35 wp Note Added: 0094781
2016-09-23 01:50 jamie philbrook Note Added: 0094782
2016-09-23 01:53 jamie philbrook Note Edited: 0094782 View Revisions
2016-09-23 04:21 jamie philbrook Note Added: 0094783
2016-09-23 18:15 Jesus Reyes Assigned To => Jesus Reyes
2016-09-23 18:15 Jesus Reyes Status new => assigned
2016-09-23 19:07 K155LA3 Note Added: 0094793
2016-09-23 20:21 K155LA3 Note Edited: 0094793 View Revisions
2016-12-18 20:21 Jesus Reyes Relationship added related to 0030454
2017-01-25 16:35 Jesus Reyes Fixed in Revision => 54001
2017-01-25 16:35 Jesus Reyes LazTarget => 1.8
2017-01-25 16:35 Jesus Reyes Note Added: 0097694
2017-01-25 16:35 Jesus Reyes Status assigned => resolved
2017-01-25 16:35 Jesus Reyes Fixed in Version => 1.7 (SVN)
2017-01-25 16:35 Jesus Reyes Resolution open => fixed
2017-01-25 16:35 Jesus Reyes Target Version => 1.8
2018-02-01 13:08 wp Relationship added related to 0033111
2018-03-15 06:45 Jesus Reyes LazTarget 1.8 => 1.8.4
2018-03-15 06:45 Jesus Reyes Note Added: 0107121
2018-03-15 06:45 Jesus Reyes Status resolved => assigned
2018-03-15 06:45 Jesus Reyes Resolution fixed => reopened
2018-03-15 06:46 Jesus Reyes Target Version 1.8 => 1.8.4
2018-03-15 07:09 Jesus Reyes File Added: grids.pas.diff
2018-06-07 19:36 K155LA3 File Added: grids.pas.diff.v2
2018-06-07 19:38 K155LA3 Note Added: 0108740
2018-06-08 00:38 K155LA3 File Added: grids.pas.v2.1.diff
2018-06-08 00:42 K155LA3 Note Edited: 0108740 View Revisions
2018-06-09 20:21 K155LA3 File Added: grids.pas.v2.2.diff
2018-06-09 20:40 K155LA3 Note Added: 0108798
2018-08-11 21:12 K155LA3 File Added: grids.pas.v2.3.diff
2018-08-11 21:22 K155LA3 Note Added: 0109982
2018-08-11 21:29 K155LA3 File Added: grids.pas.v2.3.1.diff
2018-08-11 21:31 K155LA3 Note Edited: 0109982 View Revisions
2018-09-05 12:18 Juha Manninen LazTarget 1.8.4 => 1.10
2018-09-05 12:18 Juha Manninen Fixed in Version 1.7 (SVN) =>
2018-09-05 12:18 Juha Manninen Target Version 1.8.4 => 1.10
2018-09-05 12:18 Juha Manninen Additional Information Updated View Revisions
2018-12-15 03:47 Jesus Reyes File Added: pruebas2.xlsx
2018-12-15 05:31 Jesus Reyes Note Added: 0112576
2018-12-15 05:33 Jesus Reyes Note Edited: 0112576 View Revisions
2018-12-16 10:26 K155LA3 Note Added: 0112594
2018-12-16 11:53 wp Note Added: 0112595
2018-12-16 11:55 wp Note Edited: 0112595 View Revisions
2018-12-16 15:37 Bart Broersma Note Added: 0112601
2018-12-16 15:38 Bart Broersma Note Edited: 0112601 View Revisions
2018-12-16 16:38 K155LA3 File Added: project1.zip
2018-12-16 16:38 K155LA3 File Added: ClpbrdTest.png
2018-12-16 16:39 K155LA3 Note Added: 0112608
2018-12-18 00:50 Jesus Reyes Note Added: 0112655
2018-12-18 19:01 Bart Broersma Note Added: 0112669
2018-12-18 20:37 K155LA3 File Added: ClipboardTest.zip
2018-12-18 20:58 Jesus Reyes Note Added: 0112671
2018-12-18 21:00 K155LA3 Note Added: 0112672
2018-12-18 21:24 Bart Broersma Note Added: 0112674
2018-12-18 21:25 Bart Broersma Note Edited: 0112674 View Revisions
2018-12-19 00:22 K155LA3 Note Added: 0112675
2018-12-19 01:42 Jesus Reyes Note Added: 0112677
2018-12-19 10:18 Bart Broersma Note Added: 0112695
2018-12-19 22:07 Jesus Reyes Note Added: 0112714
2018-12-19 22:16 Jesus Reyes Note Edited: 0112714 View Revisions
2018-12-22 21:30 K155LA3 File Added: TCustomStringGrid_SelectionSetHTML.txt
2018-12-22 21:42 K155LA3 Note Added: 0112821
2018-12-23 04:43 Jesus Reyes Note Added: 0112822
2018-12-24 20:12 K155LA3 Note Added: 0112863
2018-12-31 18:08 Jesus Reyes Fixed in Revision 54001 => 54001, 59960
2018-12-31 18:08 Jesus Reyes LazTarget 1.10 => 2.0
2018-12-31 18:08 Jesus Reyes Note Added: 0113047
2018-12-31 18:08 Jesus Reyes Status assigned => resolved
2018-12-31 18:08 Jesus Reyes Fixed in Version => 2.1 (SVN)
2018-12-31 18:08 Jesus Reyes Resolution reopened => fixed
2018-12-31 18:08 Jesus Reyes Target Version 1.10 => 2.0
2018-12-31 18:16 Jesus Reyes Relationship added related to 0034789
2019-01-19 15:45 K155LA3 Note Added: 0113477
2019-01-19 15:46 K155LA3 Note Edited: 0113477 View Revisions
2019-01-19 15:49 K155LA3 Note Edited: 0113477 View Revisions
2019-01-19 16:35 Bart Broersma Note Added: 0113483
2019-01-19 16:35 Bart Broersma Status resolved => assigned
2019-01-19 16:35 Bart Broersma Resolution fixed => reopened
2019-01-19 18:17 jamie philbrook Note Added: 0113490
2019-01-19 19:34 K155LA3 Note Added: 0113491
2019-01-19 20:25 jamie philbrook Note Added: 0113492
2019-01-19 23:45 K155LA3 Note Added: 0113499
2019-02-03 02:43 Jesus Reyes Note Added: 0113810
2019-02-03 02:43 Jesus Reyes Status assigned => resolved
2019-02-03 02:43 Jesus Reyes Resolution reopened => fixed
2019-02-03 16:06 K155LA3 Note Added: 0113828
2019-02-03 16:07 K155LA3 Note Edited: 0113828 View Revisions
2019-02-03 17:34 wp Note Added: 0113833
2019-02-03 17:34 wp Status resolved => assigned
2019-02-03 17:34 wp Resolution fixed => reopened
2019-02-03 19:27 Jesus Reyes Note Added: 0113838
2019-03-20 07:14 Jesus Reyes Status assigned => resolved
2019-03-20 07:14 Jesus Reyes Resolution reopened => fixed