Impression d'un composant grille : TStringGrid,TDbGrid…

Stéphane Vidouse

- Titre : Impression d'un composant grille : TStringGrid,TDbGrid…

- Auteur : Stéphane Vidouse

- Parution : 1 décembre 2011

- Mise à jour : 31 décembre 2019

- Licence : 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.

Sommaire

- I. À savoir

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

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