qrexcelf1.pas

一个报表控件TRepoEdit

unit QRExcelF1;


//NOt use, if  you have professional version of quickReport
//If not have Professional, then comment this and use this file ,
//where need definition of class TQRexcelFilter
//- BV

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,QuickRpt
  ,QRCtrls, QR3Const,QRPrntr,qrexport;

 resourcestring

  SqrQuSoft = 'QuSoft AS';
  SqrAbstractFilterDescription = 'Abstract non-working export filter';
  SqrAbstractFilterName = 'Abstract filter';
  SqrQRFile = 'QuickReport file';

type

TCellType = (CellBlank, CellInteger, CellDouble, CellLabel, CellBoolean);

TQRXLSFilter = class(TQRAbstractExportFilter)
  protected
    function GetFilterName : string; override;
    function GetDescription : string; override;
    function GetExtension : string; override;
    function GetStreaming : boolean; override;
    procedure CreateStream(Filename : string); override;
    procedure CloseStream; override;
    procedure WriteRecordHeader(RecType, Size : integer);
    procedure WriteData(CellType : TCellType; ARow, ACol: Integer; Cell : string); virtual;
  public
    procedure StorePage; override;
  end;


  TQRExcelFilter = class(TComponent)
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;



procedure Register;

const
   cQRName = 'QuickReport 3.0.1'; { This string should not be resourced }
   cQRVersion = 301;
   cQRPDefaultExt = 'QRP';      { Default extesion for QRP files }
   cQRDefaultExt = 'QR';        { Default extesion for QR files }

//QRExportFilterLibrary:TQRExportFilterLibrary;

implementation

{ TQRExportFilter }



function TQRXLSFilter.GetFilterName : string;
begin
  Result := SqrExcel;
end;

function TQRXLSFilter.GetDescription : string;
begin
  Result := SqrExcelFile;
end;

function TQRXLSFilter.GetExtension : string;
begin
  Result := 'XLS'; // Do not translate
end;

function TQRXLSFilter.GetStreaming : boolean;
begin
  Result := true;
end;

const
  BOF       = $0009;
  BIT_BIFF5 = $0800;
  BOF_BIFF5 = BOF or BIT_BIFF5;
  BIFF_EOF = $000a;
  DIMENSIONS = $0200;
  DOCTYPE_XLS = $0010;
  LEN_RECORDHEADER = 4;

procedure TQRXLSFilter.CreateStream(Filename : string);
var
  Buffer : array[0..4] of word;
begin
  inherited CreateStream(Filename);
  Buffer[0] := 0;
  Buffer[1] := DOCTYPE_XLS;
  Buffer[2] := 0;
  WriteRecordHeader(BOF_BIFF5, 6);
  Stream.Write(Buffer, 6);
  Buffer[0] := 0;
  Buffer[1] := LineCount;
  Buffer[2] := 0;
  Buffer[3] := ColCount;
  Buffer[4] := 0;
  WriteRecordHeader(Dimensions, 10);
  Stream.Write(Buffer, 10);
end;

procedure TQRXLSFilter.CloseStream;
begin
  WriteRecordHeader(BIFF_EOF, 0);
  inherited CloseStream;
end;

procedure TQRXLSFilter.StorePage;
var
  I, J : integer;
  Cell : string;
  Font : TFont;
begin
  for I := 0 to LineCount - 1 do
    for J := 0 to ColCount - 1 do
    begin
      Cell := GetText(J + 1, I + 1, Font);
      if Cell <> '' then
      begin
        WriteData(CellLabel, I, J, Cell);
      end;
    end;
end;

procedure TQRXLSFilter.WriteRecordHeader(RecType, Size : integer);
var
  Buffer : array[0..1] of word;
begin
  Buffer[0] := RecType;
  Buffer[1] := Size;
  Stream.Write(Buffer, SizeOf(Buffer));
end;

procedure TQRXLSFilter.WriteData(CellType : TCellType; ARow, ACol: Integer; Cell : string);
const
  Attribute: Array[0..2] Of Byte = (0, 0, 0); { 24 bit bitfield }
var
  Buffer : array[0..1] of word;
  RecType : word;
  Size : word;
  AString : ShortString;
begin
  Buffer[0] := ARow;
  Buffer[1] := ACol;
  AString := Cell;

  case CellType of
    CellLabel   : begin
                    RecType := 4;
                    Size := length(Cell) + 8;
                  end;
  else
    exit;
  end;
  WriteRecordHeader(RecType, Size);
  Stream.Write(Buffer, SizeOf(Buffer));
  Stream.Write(Attribute, SizeOf(Attribute));
  Stream.Write(AString, Length(AString) + 1);
end;



constructor TQRExcelFilter.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  QRExportFilterLibrary.AddFilter(TQRXLSFilter);
end;

destructor TQRExcelFilter.Destroy;
begin
  QRExportFilterLibrary.RemoveFilter(TQRXLSFilter);
  inherited Destroy;
end;


procedure Register;
begin
  RegisterComponents('QReport', [TQRExcelFilter]);
end;

end.