On m'a souvent demandé comment faire pour imprimer une StringGrid ou une DbGrid... Voiçi une unité d'exemple qui permet :

  • Prévisualisation/Impression d'un rapport depuis un TDataSet (TTable, TQuery, ...) via DataSetPreviewPrint, DataSetPreview, DataSetPrint
  • Prévisualisation/Impression d'un rapport depuis un TStringGrid via StringGridPreviewPrint.
  • Export des données d'une StringGrid en TXT, DB, DBF et HTML via StringGridExport
  • Le même export mais depuis un TDataSet via ExportDBToFile

Les procédures marquées en vert sont les procédures à appeler. Ce code a été testé sous Delphi 4, 5 et 6. Cependant, selon la version de QuickReport, vous aurez peut-être à changer la clause "Uses".

Bon amusement

 
Sélectionnez
unit uPrntDbGrid;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, QuickRpt, Qrctrls, printers, grids;

type
  TDndExportFormat = (dndexp_TXT, dndexp_DB, dndexp_HTML);

procedure DataSetPreviewPrint(AOwner : TComponent; MakePreview : boolean;
  ReportTitle : string; ADataSet : TDataset;
  PageOrientation : TPrinterOrientation);
procedure DataSetPreview(AOwner : TComponent; ReportTitle : string;
  ADataSet : TDataset; PageOrientation : TPrinterOrientation);
procedure DataSetPrint(AOwner : TComponent; ReportTitle : string;
  ADataSet : TDataset; PageOrientation : TPrinterOrientation);
procedure StringGridPreviewPrint(AOwner : TComponent; StringGrid : TStringGrid;
  Preview : boolean; ReportTitle : string;
  PageOrientation : TPrinterOrientation);
function StringGridExport(StringGrid : TStringGrid;
  FileFormat : TDndExportFormat; FileName : string) : boolean;
function ExportDBToFile(Tbl : TDataSet; FileFormat : TDndExportFormat;
  FileName : string; const Tous : boolean = false) : boolean;

const
  CountReportPreview : integer = 0;

type
  TPrntDataSet = class(TComponent)
  private
    FQuickRep : TQuickRep;
    FDataset: TDataSet;
    FLstFields : TList;
    FString: string;
    FOrientation: TPrinterOrientation;
    procedure CreerReport;
    procedure QuickRepNeedData(Sender: TObject; var MoreData: Boolean);
    procedure CreerChamps;
    procedure AjouterChamp(i : integer; var x : extended; mw, w : extended);
    procedure Prepare(Tbl: TDataSet);
    procedure QRepPreview(Sender: TObject);
  protected
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Preview(Tbl : TDataSet);
    procedure Print(Tbl : TDataSet);
  published
    property DataSet : TDataSet read FDataset write FDataSet;
    property Title : string read FString write FString;
    property Orientation : TPrinterOrientation read FOrientation write FOrientation;
  end;

implementation

uses dbclient, dbtables;

procedure AjouterUnChamp(Titre : string; Tbl : TClientDataSet;
  Largeur : integer);
const
  Numero : integer = 0;
var
  Fld : TStringField;
  Nom : string;
begin
  Fld := TStringField.Create(Tbl);
  Nom := 'Champ'+inttostr(Numero);
  with Fld do begin
    Size := 255;
    SetFieldType(ftString);
    Name := Nom;
    FieldName := Nom;
    Index := Numero;
    DisplayLabel := Titre;
    DisplayWidth := strtoint(formatfloat('0',Largeur));
    DataSet := Tbl;
  end;
  Numero := Numero + 1;
end;

procedure StringGridToCDS(StringGrid : TStringGrid; CDS : TClientDataSet);
var
  NumChamp, NumColonne, NumLigne : integer;
begin
  with CDS do begin
    for NumColonne := 0 to StringGrid.colcount-1 do begin
      if StringGrid.ColWidths[NumColonne]>2 then begin
        AjouterUnChamp(StringGrid.Cells[NumColonne,0], CDS,
          StringGrid.ColWidths[NumColonne]);
      end;
    end;
    CreateDataSet;
    open;
    for NumLigne := 1 to StringGrid.RowCount-1 do begin
      append;
      NumChamp := 0;
      for NumColonne := 0 to StringGrid.ColCount-1 do begin
        if StringGrid.ColWidths[NumColonne]>2 then begin
          fields[NumChamp].asstring := StringGrid.Cells[NumColonne,NumLigne];
          inc(numChamp);
        end;
      end;
      CheckBrowseMode;
    end;
  end;
end;

function ExportDBToFileDB(Tbl : TDataSet; FileName : string;
  const Tous : boolean = false) : boolean;
var
  Dst : TTable;
  NumChamp : integer;
begin
  result := false;
  Dst := TTable.Create(application);
  with Dst do begin
    TableName := FileName;
    FieldDefs.Assign((Tbl as TClientDataSet).FieldDefs);
    IndexDefs.Assign((Tbl as TClientDataSet).IndexDefs);
    CreateTable;
    open;
    Tbl.First;
    While not Tbl.Eof do begin
      Append;
      for NumChamp := 0 to fields.count-1 do begin
        fields[NumChamp].Value := Tbl.Fields[NumChamp].value;
      end;
      Post;
      Tbl.Next;
    end;
    Dst.FlushBuffers;
    Dst.Close;
    Dst.Free;
  end;
end;

function ExportDBToFileHTML(Tbl : TDataSet; FileName : string;
  const Tous : boolean = false; const Separateur : string = ';') : boolean;
var
  Sl : TStringList;
  Chaine : string;
  NumChamp : integer;
begin
  result := false;
  sl := TStringList.Create;
  sl.add('<HTML><TITLE>');
  sl.add('</TITLE><BODY><TABLE BORDER="1">');
  try
    with Tbl do begin
      first;
      Chaine := '';
      sl.add('<TR>');
      for NumChamp := 0 to fields.count-1 do begin
        if (fields[NumChamp].Visible or Tous) then begin
          Chaine := Chaine + '<TD>' + Fields[NumChamp].DisplayName + '</TD>';
        end;
      end;
      sl.add('</TR>');
      sl.add(Chaine);
      while not eof do begin
        sl.add('<TR>');
        Chaine := '';
        for NumChamp := 0 to fields.count-1 do begin
          if (fields[NumChamp].Visible or Tous) then begin
            Chaine := Chaine + '<TD>'+Fields[NumChamp].asstring + '</TD>';
          end;
        end;
        sl.add(Chaine);
        next;
        sl.add('</TR>');
      end;
    end;
    sl.add('</TABLE></BODY></HTML>');
    sl.SaveToFile(FileName);
    result := True;
  finally
    sl.free;
  end;
end;

function ExportDBToFileTXT(Tbl : TDataSet; FileName : string;
  const Tous : boolean = false; const Separateur : string = ';') : boolean;
var
  Sl : TStringList;
  Chaine : string;
  NumChamp : integer;
begin
  result := false;
  sl := TStringList.Create;
  try
    with Tbl do begin
      first;
      Chaine := '';
      for NumChamp := 0 to fields.count-1 do begin
        if (fields[NumChamp].Visible or Tous) then begin
          Chaine := Chaine + Fields[NumChamp].DisplayName + ';';
        end;
      end;
      sl.add(Chaine);
      while not eof do begin
        Chaine := '';
        for NumChamp := 0 to fields.count-1 do begin
          if (fields[NumChamp].Visible or Tous) then begin
            Chaine := Chaine + Fields[NumChamp].asstring + ';';
          end;
        end;
        sl.add(Chaine);
        next;
      end;
    end;
    sl.SaveToFile(FileName);
    result := True;
  finally
    sl.free;
  end;
end;

function AskFileNameForExport : string;
begin
  with TOpenDialog.create(application) do begin
    DefaultExt:='txt';
    Filter:='Fichiers texte (*.txt)|*.txt';
    Options:=[ofOverwritePrompt, ofHideReadOnly, ofPathMustExist,
      ofNoReadOnlyReturn, ofEnableIncludeNotify, ofEnableSizing];
    {(ofReadOnly, ofOverwritePrompt, ofHideReadOnly, ofNoChangeDir, ofShowHelp,
    ofNoValidate, ofAllowMultiSelect, ofExtensionDifferent, ofPathMustExist,
    ofFileMustExist, ofCreatePrompt, ofShareAware, ofNoReadOnlyReturn,
    ofNoTestFileCreate, ofNoNetworkButton, ofNoLongNames, ofOldStyleDialog,
    ofNoDereferenceLinks, ofEnableIncludeNotify, ofEnableSizing);}
    if Execute then result := FileName;
    free;
  end;
end;

function ExportDBToFile(Tbl : TDataSet; FileFormat : TDndExportFormat;
  FileName : string; const Tous : boolean = false) : boolean;
begin
  result := false;
  FileName := Trim(FileName);
  if Length(FileName) = 0 then begin
    FileName := AskFileNameForExport;
  end;
  case FileFormat of
    dndexp_TXT : result := ExportDBToFileTXT(Tbl, FileName, Tous);
    dndexp_DB : result := ExportDBToFileDB(Tbl, FileName, Tous);
    dndexp_HTML : result := ExportDBToFileHTML(Tbl, FileName, Tous);
  end;
end;

function StringGridExport(StringGrid : TStringGrid;
  FileFormat : TDndExportFormat; FileName : string) : boolean;
var
  Tbl : TClientDataSet;
begin
  Tbl := TClientDataSet.Create(nil);
  StringGridToCDS(StringGrid, Tbl);
  result := ExportDBToFile(Tbl, FileFormat, FileName);
  Tbl.Close;
  Tbl.free;
end;

procedure