Глюки при экспорте в RTF

Комментарии

• Samuray Administrator

  February 2005 отредактировано 23:07

  Пришлите, пожалуйста, пример файла fp3 на адрес fediachov@fast-report.com
• alexghaash Йошкар-Ола

  February 2005 отредактировано 23:07

  Посылаю файл *.fp3 и rtf файл.
  
  Если silentmode у отчета выключить, на экспорте в RTF
  Access violation at adress... Read adress 0000000
  
  Сабж письма RTF_Error.
  
• Samuray Administrator

  February 2005 отредактировано February 2005

  Замените процедуру в файле frxExportRTF:
  

  procedure TfrxRTFExport.PrepareExport;
  var
    i, j, x, y, n, n1, fx: Integer;
    s, s0, s1, s2: String;
    Obj: TfrxIEMObject;
    RepPos: TStringList;
  begin
    for y := 0 to FMatrix.Height - 1 do
      for x := 0 to FMatrix.Width - 1 do
      begin
        i := FMatrix.GetCell(x, y);
        if (i <> -1) then
        begin
          Obj := FMatrix.GetObjectById(i);
          if Obj.Counter <> -1 then
          begin
            Obj.Counter := -1;
            GetRTFFontColor(GetRTFColor(Obj.Style.Color));
            GetRTFFontColor(GetRTFColor(Obj.Style.FrameColor));
            if Obj.IsRichText then
            begin
              RepPos := TStringList.Create;
              s := Obj.Memo.Text;
              fx := Pos('{\fonttbl', s);
              Delete(s, 1, fx + 8);
              i := 1;
              RepPos.Clear;
              while (i < Length(s)) and (s[i] <> '}') do
              begin
                while (i < Length(s)) and (s[i] <> '{') do
                  Inc(i);
                Inc(i);
                j := i;
                while (j < Length(s)) and (s[j] <> '}') do
                  Inc(j);
                Inc(j);
                s1 := Copy(s, i , j - i - 2);
                i := j;
                j := Pos(' ', s1);
                s2 := Copy(s1, j + 1, Length(s1) - j + 1);
                s0 := '\f' + GetRTFFontName(s2);
                j := Pos('\f', s1);
                n := j + 1;
                while (n < Length(s1)) and (s1[n] <> '\') and (s1[n] <> ' ') do
                  Inc(n);
                s2 := Copy(s1, j, n - j);
                j := Pos('}}', s);
                s1 := Copy(s, j + 2, Length(s) - j - 1);
                j := j + 2;
                n := 1;
                while n > 0 do
                begin
                  n := Pos(s2, s1);
                  if n > 0 then
                  begin
                    if RepPos.IndexOf(IntToStr(n + j - 1)) = -1 then
                    begin
                      RepPos.Add(IntToStr(n + j - 1));
                      Delete(s, n + j - 1, Length(s2));
                      Insert(s0, s, n + j - 1);
                    end;
                    j := j + n + Length(s2) - 1;
                    s1 := Copy(s, j, Length(s) - j + 1);
                  end;
                end;
              end;
              fx := Pos('}}', s);
              if fx > 0 then
                Delete(s, 1, fx + 1);
              fx := Pos('{\colortbl', s);
              if fx > 0 then
              begin
                Delete(s, 1, fx + 11);
                i := 1;
                n1 := 1;
                RepPos.Clear;
                while (i < Length(s)) and (s[i] <> '}') do
                begin
                  while (i < Length(s)) and (s[i] <> '\') do
                    Inc(i);
                  j := i;
                  while (j < Length(s)) and (s[j] <> ';') do
                    Inc(j);
                  Inc(j);
                  s1 := Copy(s, i , j - i);
                  i := j;
                  s0 := '\cf' + GetRTFFontColor(s1);
                  s2 := '\cf' + IntToStr(n1);
                  j := Pos(';}', s);
                  s1 := Copy(s, j + 2, Length(s) - j - 1);
                  j := j + 2;
                  n := 1;
                  while n > 0 do
                  begin
                    n := Pos(s2, s1);
                    if n > 0 then
                    begin
                      if RepPos.IndexOf(IntToStr(n + j - 1)) = -1 then
                      begin
                        RepPos.Add(IntToStr(n + j - 1));
                        Delete(s, n + j - 1, Length(s2));
                        Insert(s0, s, n + j - 1);
                      end;
                      j := j + n + Length(s2) - 1;
                      s1 := Copy(s, j, Length(s) - j + 1);
                    end;
                  end;
                  Inc(n1);
                end;
                fx := Pos(';}', s);
                if fx > 0 then
                  Delete(s, 1, fx + 1);
              end;
              fx := Pos('{\stylesheet', s);
              if fx > 0 then
              begin
                Delete(s, 1, fx + 12);
                fx := Pos('}}', s);
                if fx > 0 then
                  Delete(s, 1, fx + 1);
              end;
              s := StringReplace(s, '\pard', '', [rfReplaceAll]);
              Delete(s, Length(s) - 3, 3);
              Obj.Memo.Text := s;
              RepPos.Free;
            end else if Obj.IsText then
            begin
              GetRTFFontColor(GetRTFColor(Obj.Style.Font.Color));
              GetRTFFontName(Obj.Style.Font.Name);
            end;
          end;
        end;
      end;
  end;