IdentifiantMot de passe
Mot de passe oublié ?Je m'inscris ! (gratuit)

Impression d'un composant grille : TStringGrid,TDbGrid…

L'auteur

L'article

Publié le - Mis à jour le 31 décembre 2019 

Version PDF Version hors-ligne

ePub, Azw et Mobi

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. À savoir▲

On m'a souvent demandé comment faire pour imprimer une StringGrid ou une DbGrid… Voici 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 StringGridPreviewPrint(AOwner : TComponent; StringGrid : TStringGrid;
  Preview : boolean; ReportTitle : string;
  PageOrientation : TPrinterOrientation);
var
  Tbl : TClientDataSet;
begin
  Tbl := TClientDataSet.Create(nil);
  StringGridToCDS(StringGrid, Tbl);
  DataSetPreviewPrint(AOwner, Preview, ReportTitle, Tbl, PageOrientation);
  Tbl.Close;
  Tbl.free;
end;

procedure DataSetPreviewPrint(AOwner : TComponent; MakePreview : boolean;
  ReportTitle : string; ADataSet : TDataset;
  PageOrientation : TPrinterOrientation);
begin
  with TPrntDataSet.create(AOwner) do begin
    Title:=ReportTitle;
    Orientation:=PageOrientation;
    FQuickRep.Page.Orientation:=PageOrientation;
    if MakePreview then begin
      Preview(ADataSet);
    end else begin
      Print(ADataSet);
    end;
    free;
  end;
end;

procedure DataSetPreview(AOwner : TComponent; ReportTitle : string;
  ADataSet : TDataset; PageOrientation : TPrinterOrientation);
begin
  DataSetPreviewPrint(AOwner, True, ReportTitle, ADataSet, PageOrientation);
end;

procedure DataSetPrint(AOwner : TComponent; ReportTitle : string;
  ADataSet : TDataset; PageOrientation : TPrinterOrientation);
begin
  DataSetPreviewPrint(AOwner, false, ReportTitle, ADataSet, PageOrientation);
end;

{ TPrntDataSet }
constructor TPrntDataSet.Create(AOwner: TComponent);
begin
  inherited;
  FQuickRep:=TQuickRep.Create(Application);
  FQuickRep.PrinterSettings.PrinterIndex := printer.printerindex;
  FQuickRep.visible := false;
  FQuickRep.name:='myquickrep'+inttostr(CountReportPreview);
  CountReportPreview:=CountReportPreview+1;
  FQuickRep.Parent:=(Aowner as TWinControl);
//  FQuickRep.OnPreview := QRepPreview;
end;

procedure TPrntDataSet.QRepPreview(Sender : TObject);
begin
  DataSet.First;
end;

procedure TPrntDataSet.CreerReport;
const
  hauteur = 15;
begin
  FQuickRep.OnNeedData:=QuickRepNeedData;
  FQuickRep.Bands.HasTitle:=true;
  FQuickRep.Bands.HasColumnHeader:=true;
  FQuickRep.Bands.HasDetail:=true;
  FQuickRep.Bands.HasSummary:=true;
  FQuickRep.Bands.ColumnHeaderBand.height:=hauteur;
  FQuickRep.Bands.DetailBand.height:=hauteur;
  FQuickRep.Bands.SummaryBand.height:=5;
  with TQRShape.Create(FQuickRep) do begin
    parent:=FQuickRep.Bands.ColumnHeaderBand;
    left:=0;
    Shape:=qrsHorLine;
    height:=1;
    top:=FQuickRep.Bands.ColumnHeaderBand.Height-1;
    Size.Width:=FQuickRep.Bands.ColumnHeaderBand.Size.Width;
    name:='shp1';
  end;
  with TQRShape.Create(FQuickRep) do begin
    parent:=FQuickRep.Bands.SummaryBand;
    left:=0;
    top:=0;
    Shape:=qrsHorLine;
    height:=1;
    Size.Width:=FQuickRep.Bands.ColumnHeaderBand.Size.Width;
    name:='shp2';
  end;
  with tqrlabel.Create(FquickRep) do begin
    parent:=FquickRep.Bands.TitleBand;
    AlignToBand:=true;
    Alignment:=taCenter;
    AutoSize:=true;
    Font.Name:='Arial';
    Font.Size:=14;
    caption:=Title;
    name:='title1';
  end;
end;

destructor TPrntDataSet.Destroy;
begin
  FQuickRep.destroy;
  inherited;
end;

procedure TPrntDataSet.QuickRepNeedData(Sender: TObject; var MoreData: Boolean);
var
  i : integer;
  n : integer;
begin
  MoreData:=not Dataset.EOF;
  if not moredata then exit;
  // remplir les captions
  n:=0;
  for i:=0 to DataSet.Fields.count-1 do begin
    if DataSet.Fields[i].Visible then begin
      TQRLabel(FLstFields[n]).Caption:=dataset.fields[i].asstring;
      inc(n);
    end;
  end;
  //
  DataSet.next;
end;

procedure TPrntDataSet.Preview(Tbl: TDataSet);
begin
  FQuickRep.Page.Orientation:=Orientation;
  Prepare(Tbl);
  Tbl.first;
  FQuickRep.Preview;
  Tbl.first;
end;

procedure TPrntDataSet.Prepare(Tbl: TDataSet);
begin
  DataSet:=Tbl;
  DataSet.First;
  CreerReport;
  CreerChamps;
end;

procedure TPrntDataSet.CreerChamps;
var
  i : integer;
  x : extended;
  w, mw : extended;
  MaxDispWidth : integer;
begin
  FLstFields:=TList.create;
  x:=0;
  mw:=FQuickRep.Bands.DetailBand.Size.Width;
  MaxDispWidth:=0;
  for i:=0 to DataSet.Fields.count-1 do begin
    if DataSet.Fields[i].Visible then begin
      MaxDispWidth:=MaxDispWidth+DataSet.Fields[i].DisplayWidth;
    end;
  end;
  for i:=0 to DataSet.Fields.count-1 do begin
    if DataSet.Fields[i].Visible then begin
      w:=DataSet.Fields[i].DisplayWidth*(mw/MaxDispWidth);
      AjouterChamp(i,x,mw,w);
    end;
  end;
end;

procedure TPrntDataSet.AjouterChamp(i : integer; var x : extended; mw, w : extended);
const
  n : integer = 0;
var
  fld : TQRLabel;
  ox : extended;
begin
  ox:=x;
  fld:=tqrlabel.Create(FquickRep);
  with fld do begin
    parent:=FquickRep.Bands.DetailBand;
    size.Left:=x;
    top:=0;
    AutoSize:=false;
    size.width:=w;
    x:=x+w;//width+10;
    Transparent:=true;
    name:='myqrlabelspec'+inttostr(n);
    inc(n);
  end;
  FLstFields.Add(fld);
  with TQRLabel.create(FQuickRep) do begin
    parent:=FquickRep.Bands.ColumnHeaderBand;
    size.left:=ox;
    top:=0;
    AutoSize:=true;
    caption:=dataset.fields[i].DisplayName;
    Transparent:=true;
    name:='myqrlabelspec'+inttostr(n);
    inc(n);
  end;
end;

procedure TPrntDataSet.Print(Tbl: TDataSet);
begin
  FQuickRep.Page.Orientation:=Orientation;
  Prepare(Tbl);
  Tbl.first;
  FQuickRep.print;
  Tbl.first;
end;
end.

Je suis bien entendu ouvert à toute discussion sur cette unité, je vous la soumets afin de vous aider dans votre travail… Soyez indulgents !
www.dnd.be

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Ce document est issu de https://www.developpez.com et reste la propriété exclusive de son auteur. La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur.