L'impression avec Delphi

implementation

{$R *.DFM}

var

Entete, Details, PiedPage: TRect; {pour connaître les limites des zones respectives}
 YCurr: integer; {La position en cours pour l'écriture d'une ligne}
 C: TCanvas; {Notre canvas pour imprimer}
 Li: integer; {nombre de lignes imprimées }
 Dx, Dy: integer; {Décalage par rapport aux marges}
 NPage: word = 0;  {Le numéro de page à incrémenter à chaque nouvelle page}
 TotalPages: word = 0;  {Le nombre de pages à imprimer. Pour afficher Page x / TotalPages }

{ TForm1 }

function Millimetres2PixelsX(Millims: integer): integer;
begin
 result := MulDiv(GetDeviceCaps(Printer.Handle, LOGPIXELSX), 10 * Millims, 254);
end;

function Millimetres2PixelsY(Millims: integer): integer;
begin
 result := MulDiv(GetDeviceCaps(Printer.Handle, LOGPIXELSY), 10 * Millims, 254);
end;

procedure DefFonte(F: TFont; Nom: string; Taille: integer; Styl: TFontStyles);
begin
 with F do begin
   Name := Nom;
   Size := Taille;
   Style := Styl;
  end;
end;

procedure TForm1.ImprimeEnTete;
var
 S: string;
begin
 {On dessine l'entourage (si on le désire)}
 C.Rectangle(Entete);

 DefFonte(C.Font, 'Arial', 10, []);

{ Ecriture de la date en haut à gauche en n'oubliant pas les }
{ décalages par rapport aux marges }
{ Vous remarquerez que l'on aurait aussi pu utiliser DrawText avec DT_LEFT or DT_VTOP}
 C.TextOut(Entete.Left + Dx, Entete.top + Dy, DateToStr(now));
{Notre page en cours}
 S := format('Page %d / %d', [NPage, TotalPages]);
 C.TextOut(Entete.Right - C.TextWidth(S) - Dx, Entete.top + Dy, S);

{Enfin, centré au milieu de notre rectangle d'en-tète le nom de la table}
 DefFonte(C.Font, 'Times New Roman', 24, []);
 DrawText(C.handle,  PChar(Datas.TableName),  length(Datas.tablename),
            Entete,  DT_VCENTER or DT_SINGLELINE or DT_CENTER);
 {On dessine si on le désire un entourage autour de la zone Détails}
 C.Rectangle(Details);
end;

procedure TForm1.ImprimePiedPage;
var
 S: string;
begin
 C.Rectangle(PiedPage);
 DefFonte(C.Font, 'Arial', 10, []);
 S := format('%d lignes imprimées sur un total de %d', [Li, Datas.RecordCount]);
 DrawText(C.handle,  PChar(S),  length(S),  PiedPage,  DT_VCENTER or DT_SINGLELINE or DT_CENTER);
end;

procedure TForm1.NouvellePage(RealNewPage: boolean);
begin
 if RealNewPage then Printer.NewPage;
 Inc(NPage);
 ImprimeEnTete;
 YCurr := Details.Top + Dy;
end;

procedure TForm1.ImprimerClick(Sender: TObject);
var
 HM: integer;
 T: array of integer;
 S: string;
 Bm: TBookmark;
 Bl: boolean;
 LignesParPage: word;
begin

 Li := 0;  {initialisation du nombre de lignes imprimée}
 Dx := Millimetres2PixelsX(2); {Calcul en pixels d'un décalage haut et bas de 2 mm }
                               {en cas d'impression texte près des marges}
 Dy := Millimetres2PixelsY(2);

 with Printer do begin
  Orientation := poLandScape;
  BeginDoc;

  {Hauteur de l'en-tète = 10% de la hauteur totale}
   Entete := Rect(0, 0, PageWidth, muldiv(PageHeight, 10, 100));
  {Hauteur du pied de page = 5% de la hauteur totale}
   PiedPage := Rect(0, PageHeight - muldiv(PageHeight, 5, 100), PageWidth, PageHeight);
  end;

 with Details do
  begin
   Left := 0;
   Right := Printer.PageWidth;
   {Haut de la zone détails à 10 mm sous le bas de l'en-tète}
   Top := EnTete.bottom + Millimetres2PixelsY(10);
   {Bas de la zone détails à 5 mm au-dessus du haut du pied de page}
   Bottom := PiedPage.Top - Millimetres2PixelsY(5);
  end;

C := Printer.Canvas;  {Pour un code plus concis}

 //Calcul du nombre de ligne par page, et ainsi du nombre de page
 DefFonte(C.Font, 'Arial', 11, []);
 Hm := C.TextHeight('M');     {On calcule la hauteur d une ligne en pixels}
{On peut ainsi calculer le nombre de lignes que peut contenir la zone Details}
 LignesParPage := (Details.Bottom - Details.Top - Dy) div HM;
{Le nombre de pages sera calculé en divisant le nombre total de lignes par LignesParPage}
 TotalPages := Datas.RecordCount div LignesParPage;
{ATTENTION: on doit également vérifier si les pages seront complètes.}
{ Avec mod on peut voir s'il nous restera des lignes à imprimer en fin de document}
 Bl := (Datas.RecordCount mod LignesParPage) <> 0;
{Si on obtient un reste, il nout faut ajouter une page}
 if BL then inc(TotalPages);
{Prenons un exemple! Si la zone Details peut contenir 35 lignes et si nous avons }
{42 lignes à imprimer, nous aurons les valeurs suivantes: }
{TotalPages := 42 div 35; Donc  TotalPages  =  1 (1 page de 35 lignes)
{Bl := (42 mod 35) <> 0 ;  Donc  true puisque 42 mod 35 = 7.
{Ainsi, nous avons défini que nous aurons 1 page complète de 35 lignes et une page }
{incomplète de 7 lignes}
{Utilisons le nombre de colonnes de la DBGrid pour définir nos colonnes sur la sortie imprimée}
{Bien sur, cela n'est valable que si vous avez un nombre raisonnable de colonnes.}
{La table utilisée dans l'exemple s'y prète bien.
{Dans un autre cas, vous serez obligé de définir quelles colonnes vous voulez imprimer}
 SetLength(T, DBGrid1.columns.count);
 DefiniColonnes(T);

 NPage := 0;
{Le paramètre de NouvellePage est false, car la page est déjà créée par BeginDoc}
 NouvellePage(false);

 with Datas do begin
   Bm := GetBookmark;
   DisableControls;
   first;
   while not eof do
    begin
     {Utilisation d'une procédure pour construire la chaîne à utiliser avec TabbedTextOut}
     DefLigne(S);
     {à chaque ligne on incrémente le nombre de lignes imprimées (pour le bas de page)}
     Inc(Li);
     TabbedTextOut(C.handle, Dx, yCurr, PChar(S), length(S), high(T), T[0], 0);
     {après impression de la ligne en cours, on passe à la ligne suivante}
     next;
     {Ici, nous allons gérer la nécessité de changer de page. yCurr est notre position }
     {d'impression courante sur notre page.}
     { Puisque nous connaissons la hauteur d'une ligne, nous allons incrémenter yCurr }
     { de cette hauteur pour définir la valeur suivante en y}
     yCurr := yCurr + Hm;
     {Ici, nous devons vérifier si yCurr est toujours à l'intérieur de la zone Details,}
     { et surtout si la place est suffisante pour imprimer une ligne}
     if YCurr > (Details.bottom - Hm) then
      begin
       ImprimePiedPage;
       NouvellePage(true);
      end;

    end;
   {Enfin, si le nombre de lignes ne correspondait pas à des pages complètes,}
   { il faudrait imprimer le bas de page. On est obligé d'imprimer le pied de }
   { page seulement quand une page de détails a été créée pour connaitre le nombre }
   { de lignes déjà imprimées. Dans un autre cas, ImprimerPiedPage pourrait être }
   { ajouté à la procédure NouvellePage}
   if Bl then ImprimePiedPage;

   GotoBookmark(Bm);
   FreeBookmark(Bm);
   EnableControls;
  end;
 Printer.EndDoc;
end;

procedure TForm1.DefiniColonnes(var Tb: array of integer);
var
 I, J, L: integer;
 T: array of single;
begin
 L := Details.Right - Details.Left;
 SetLength(T, high(Tb));

 with DBGrid1 do  for I := low(T) to high(T) do T[I] := L * (Columns[I].Width / Width);

 Tb[0] := Details.Left;
 for I := low(Tb) + 1 to high(Tb) do Tb[I] := Tb[I - 1] + round(T[I - 1]);

end;

procedure TForm1.DefLigne(var S: string);
var
 I: integer;
begin
 S := '';
 with Datas do for I := 0 to Fields.Count - 1 do S := S + Fields[I].AsString + #9;
 SetLength(S, Length(S) - 1);  {Pour supprimer le dernier caractère de tabulation}
end;

end.