Предложения по экспорту

Eugene LachinovEugene Lachinov Санкт-Петербург
отредактировано 06:27 Раздел: FastReport 3.0
- свойство FileName из всех фильтров перенести в базовый TfrxCustomExportFilter

и второе, наверное будет полезно тем кто экспортирует большие отчеты

{ frxExportMatrix.pas}

procedure TfrxIEMatrix.OrderByCells;

есть предлоложение, что FXPos, FYPos сортированные списки, и экспорт происходит существенно быстрее, если использовать быстрый поиск, например
function QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
var
  L, H, I: Integer;
  C: Extended;
begin
  Result := False;
  L := 0;
  H := aList.Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    C := TfrxIEMPos(aList[I]).Value - aPosition;
    if C < 0 then
      L := I + 1
    else begin
      H := I - 1;
      if C = 0 then begin
        Result := True;
        L := I
      end
    end
  end;
  Index := L
end;

цикл

for j := 0 to FXPos.Count - 1 do
 if TfrxIEMPos(FXPos[j]).Value >= Obj.Left then

заменяется на
    QuickFind(FXPos, Obj.Left, j);
    if j < FXPos.Count then
...
    for j := 0 to FYPos.Count - 1 do
      if TfrxIEMPos(FYPos[j]).Value >= Obj.Top then

заменяется на
    QuickFind(FYPos, Obj.Top, j);
    if j < FYPos.Count then

P.S. Скорее вопрос: в Fast Report Mail List на Yahoo посылался XLSExport c записью в BIFF-формат для Fast Report 2.5 от Евгения Тромболы (Fri, 16 Aug 2002 18:02:03 +0300)), экспорт адаптирован для Fast Report 3,
модули
BIFF8_Types.pas
XLSApp.pas
XLSTypes.pas
XLSWriters.pas
свободно распространяются или нет (может кто-нибудь знает) ?

Комментарии

  • SamuraySamuray Administrator
    отредактировано 06:27
    Спасибо! Учтем все предложения...
    Насчет BIFF8 - насколько я знаю, это коммерческая библиотека.
  • Eugene LachinovEugene Lachinov Санкт-Петербург
    отредактировано 06:27
    В любом случае, наверно не будет нарушением прав публикация кода с использованием этой библиотеки.

    Для задания параметров используется форма TfrxXMLExportDialog, на которую добавлен CheckBox включения экспорта на одну страницу и свойство FileName перенесено в базовый TfrxCustomExportFilter
    
{******************************************}
{                                          }
{             FastReport v3.0              }
{            BIFF Excel export             }
{                                          }
{******************************************}

unit frxExportBIFF;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, extctrls, Printers, ComObj, frxClass, frxExportMatrix, frxProgress
{$IFDEF Delphi6}, Variants {$ENDIF}, XLSApp;

type
  TfrxBIFFExport = class(TfrxCustomExportFilter)
  private
    FExportOneWorksheet: Boolean;
    FMatrix: TfrxIEMatrix;
    FOpenExcelAfterExport: Boolean;
    FProgress: TfrxProgress;
    FShowProgress: Boolean;
    FWysiwyg: Boolean;
    procedure ExportPage(aWriter: TXLSWorkbook);
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    function ShowModal: TModalResult; override;
    function Start: Boolean; override;
    procedure Finish; override;
    procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
    procedure ExportObject(Obj: TfrxComponent); override;
  published
    property OpenExcelAfterExport: Boolean read FOpenExcelAfterExport
      write FOpenExcelAfterExport default False;
    property ShowProgress: Boolean read FShowProgress write FShowProgress;
    property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
  end;


implementation

uses frxUtils, frxRes, frxExportXML, frxrcExports, XLSTypes;

const
  Xdivider = 34;
  Ydivider = 40;
  MargDiv = 25.4;
  XLMaxHeight = 409;

{ TfrxBIFFExport }

constructor TfrxBIFFExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowProgress := True;
  FWysiwyg := True;
end;

class function TfrxBIFFExport.GetDescription: String;
begin
  Result := '-юъєьхэЄ Excel (BIFF)'
end;

procedure TfrxBIFFExport.ExportPage(aWriter: TXLSWorkbook);
var
  i, x, y, dx, dy, fx, fy, iStartY, Page: Integer;
  drow: Extended;
  obj: TfrxIEMObject;
  EStyle: TfrxIEMStyle;
  Range: TXLSRange;
  Worksheet: TXLSWorksheet;

  procedure WriteWorksheetBegin(aPageNo: Integer);
  var
    x : Integer;
    dcol: Extended;
  begin
    Worksheet := aWriter.AddSheet;
    Worksheet.Title := 'Лист' + IntToStr(aPageNo);
    with Worksheet.PageSetup do begin
      HeaderMargin := 0;
      FooterMargin := 0;
      LeftMargin   := FMatrix.GetPageLMargin(aPageNo-1) / 25.4;
      RightMargin  := FMatrix.GetPageRMargin(aPageNo-1) / 25.4;
      TopMargin    := 0{FMatrix.GetPageTMargin(aPageNo-1) / 25.4};
      BottomMargin := 0{FMatrix.GetPageBMargin(aPageNo-1) / 25.4};
      Orientation  := TXLSOrientationType(FMatrix.GetPageOrientation(aPageNo-1));
    end;
    for x := 1 to FMatrix.Width - 1 do begin
      dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1));
      Worksheet.Cols[x - 1].Width := Trunc(dcol * Xdivider);
    end
  end;

  procedure ConvertFrameType(aFrameTyp: TfrxFrameTypes; aBorders: TXLSBorders);
  begin
    if ftLeft in aFrameTyp then
      aBorders[xlEdgeLeft].LineStyle := lsThin;
    if ftRight in aFrameTyp then
      aBorders[xlEdgeRight].LineStyle := lsThin;
    if ftTop in aFrameTyp then
      aBorders[xlEdgeTop].LineStyle := lsThin;
    if ftBottom in aFrameTyp then
      aBorders[xlEdgeBottom].LineStyle := lsThin;
  end;

  function ConvertHAlign(aAlign: TfrxHAlign): TXLSHorizontalAlignmentType;
  begin
    case aAlign of
      haLeft: Result := xlHAlignLeft;
      haRight: Result := xlHAlignRight;
      haCenter: Result := xlHAlignCenter
    else { haBlock }
      Result := xlHAlignJustify
    end
  end;

  function ConvertVAlign(aAlign: TfrxVAlign): TXLSVerticalAlignmentType;
  begin
    case aAlign of
      vaTop: Result := xlVAlignTop;
      vaBottom: Result := xlVAlignBottom
    else
      Result := xlVAlignCenter
    end
  end;

begin
  if FShowProgress then
  begin
    FProgress := TfrxProgress.Create(nil);
    FProgress.Execute(FMatrix.PagesCount, 'Exporting pages', True, True);
  end;

  WriteWorksheetBegin(1);
  Page := 0; iStartY := 0;
  for y := 0 to FMatrix.Height - 2 do begin
    drow := (FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y));
    if FMatrix.PagesCount > Page then
      if FMatrix.GetYPosById(y) >= FMatrix.GetPageBreak(Page) then
      begin
        Inc(Page);
        if FExportOneWorksheet then
          Worksheet.SetStartRange
        else begin
          iStartY := y;
          WriteWorksheetBegin(Page + 1);
        end;
        if FShowProgress then begin
          FProgress.Tick;
          if FProgress.Terminated then
            break;
        end;
      end;
    Worksheet.Rows[y - iStartY].Height := Round(drow / 1.32);
    for x := 0 to FMatrix.Width - 1 do
    begin
      if FShowProgress then
        if FProgress.Terminated then
          break;
      i := FMatrix.GetCell(x, y);
      if (i <> -1) then
      begin
        Obj := FMatrix.GetObjectById(i);
        if Obj.Counter = 0 then
        begin
          Obj.Counter := 1;
          FMatrix.GetObjectPos(i, fx, fy, dx, dy);
          if Obj.IsText then begin
            Range := Worksheet.Ranges[x, y - iStartY, x + dx - 1, y - iStartY + dy - 1];
            if Obj.Rotation > 0 then
              Range.Rotation := Obj.Rotation;
            EStyle := FMatrix.GetStyleById(Obj.StyleIndex);
            if EStyle <> nil then begin
              Range.HorizontalAlignment := ConvertHAlign(EStyle.HAlign);
              Range.VerticalAlignment := ConvertVAlign(EStyle.VAlign);
              Range.WrapText := True;
              Range.Font.Assign(EStyle.Font);
              Range.FillPattern := fpSolid;
              Range.ForegroundFillPatternColor := EStyle.Color;
              Range.BackgroundFillPatternColor := EStyle.Color;
              ConvertFrameType(EStyle.FrameTyp, Range.Borders)
            end;
            Range.Value := TrimRight(Obj.Memo.Text)
          end
        end
      end
    end
  end;

  if FShowProgress then
    FProgress.Free;
end;

function TfrxBIFFExport.ShowModal: TModalResult;
begin
  with TfrxXMLExportDialog.Create(nil) do
  begin
    cbOneWorkSheet.Checked := FExportOneWorksheet;
    WCB.Checked := FWysiwyg;
    OpenExcelCB.Checked := FOpenExcelAfterExport;
    Result := ShowModal;

    if Result = mrOk then
    begin
      PageNumbers := '';
      CurPage := False;
      if CurPageRB.Checked then
        CurPage := True
      else if PageNumbersRB.Checked then
        PageNumbers := PageNumbersE.Text;

      FExportOneWorksheet := cbOneWorkSheet.Checked;
      FWysiwyg := WCB.Checked;
      FOpenExcelAfterExport := OpenExcelCB.Checked;

      if SaveDialog1.Execute then
        FName := SaveDialog1.FileName
      else
        Result := mrCancel;
    end;
    Free;
  end;
end;

function TfrxBIFFExport.Start: Boolean;
begin
  if FName <> '' then begin
    FMatrix := TfrxIEMatrix.Create;
    FMatrix.ShowProgress := ShowProgress;
    FMatrix.MaxCellHeight := XLMaxHeight * Ydivider;
    if FWysiwyg then
      FMatrix.Inaccuracy := 0.5
    else
      FMatrix.Inaccuracy := 10;
    FMatrix.DeleteHTMLTags := True;
    Result := True
  end
  else
    Result := False;
end;

procedure TfrxBIFFExport.ExportObject(Obj: TfrxComponent);
begin
  if Obj is TfrxView then
    if TfrxView(Obj).Name <> '_pagebackground' then
      FMatrix.AddObject(TfrxView(Obj));
end;

procedure TfrxBIFFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
  FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
                  Page.TopMargin, Page.RightMargin, Page.BottomMargin)
end;

procedure TfrxBIFFExport.Finish;
var
  XLSWorkbook: TXLSWorkbook;
  Excel: Variant;
begin
  FMatrix.Prepare;
  XLSWorkbook := TXLSWorkbook.Create;
  try
    ExportPage(XLSWorkbook);
    XLSWorkbook.SaveAsXLSToFile(FileName);
  finally
    XLSWorkbook.Free
  end;
  try
    if FOpenExcelAfterExport then
    begin
      Excel := CreateOLEObject('Excel.Application');
      Excel.Visible := True;
      Excel.WorkBooks.Open(FileName)
    end;
  finally
    Excel := Unassigned
  end;
  FMatrix.Free
end;


end.
  • Eugene LachinovEugene Lachinov Санкт-Петербург
    отредактировано 06:27
    Samuray написал:
    Учтем все предложения...
    Спасибо за учет предложений ;)

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.

Начало • FastReport 3.0Комментировать как ...

© Vanilla Keystone Theme 2024