BðP

Impression avec Perl sous Win32


Une première impression est toujours la bonne, surtout quand elle est mauvaise.
Henri Jeanson

Sous Windows®, l'utilisation d'une imprimante nécessite l'accès aux fonctions du GDI (Graphics Device Interface).
Le GDI est le moteur graphique qui gère tous les graphiques à l'écran, sur les imprimantes et peut aussi générer des bitmaps.

Avec Perl, on peut accéder à un petit nombre de fonctions du GDI grâce au package (mal connu) Win32::NPRG.

Le package Win32::NPRG

Le package Win32::NPRG comprend deux modules : Son auteur, Ivan Frolcov, n'a laissé que peu de renseignements personnels sur le CPAN !
(voir : IFROL)

Installation

Vous pouvez télécharger les sources des modules sur votre serveur CPAN favori, ou bien ici : NPRG-0.31.zip.
L'installation est classique mais nécessite l'utilisation d'un compilateur C.

Vous pouvez plus simplement installer une version binaire avec PPM, sur mon "ppm repository" personnel.
(Ce binaire a été compilé avec Visual-C++ 6.0 Service Pack 5)
Pour cela, tapez dans une console DOS (ou faites un couper/coller) :
 ppm install http://www.bribes.org/perl/ppm/Win32-NPRG.ppd

Le module Alias est nécessaire. Installez-le si ce n'est déjà fait :
 ppm install Alias

Documentation

La documentation POD est incluse dans les sources des modules.
On trouvera ici une version HTML de cette documentation : Wingraph et NPRG.
J'ai rajouté à la fin de chacun de ces fichiers la notice de copyright qui figure dans le fichier readme.
On notera que cette documentation est incomplète : les méthodes Ellipse, Arc, SetArcDirection, PolyBezier ne sont pas décrites.

Scripts

Les scripts qui suivent ont été testés sur deux ordinateurs avec des imprimantes différentes. Un fichier pdf donne le résultat obtenu avec Acrobat PDFWriter, pour comparaison.
Le module n'ayant fait l'objet d'aucun test (puisque apparemment personne ne le connaît) n'hésitez pas à me signaler tout problème ou bug : j'essaierais d'y remédier, car ça ne va pas être facile de contacter l'auteur !

Les trois scripts dans un fichier Zip : printer.zip

Un premier script : hello.pl

Ce premier script permet de tester l'installation : il imprime juste une ligne en haut d'une page sur l'imprimante par défaut.
Si tout se passe bien, voilà ce que l'on doit obtenir : hello.pdf 
#!perl
use strict;
use Win32::Wingraph;

# La fonction GetCurrentPrinter retourne l'imprimante par défaut.
sub GetCurrentPrinter {
  my %RegHash;
  use Win32::TieRegistry ( TiedHash => \%RegHash );
  if ( Win32::IsWinNT() ) { # pour Win NT/2000/XP
    my $SKey=$RegHash{'\HKEY_CURRENT_USER\Software\Microsoft\Windows NT'.
                      '\CurrentVersion\Windows'} or return undef;
    return (split "," , $SKey->GetValue('Device'))[0];
  }
  else {                    # pour Win 9x
    my $SKey=$RegHash{'HKEY_CURRENT_CONFIG\System\CurrentControlSet'.
                      '\Control\Print\Printers'} or return undef;
    return $SKey->GetValue('Default');
  }
}

# programme principal
my $cp=GetCurrentPrinter() or die "Pas d'imprimante ??";
my $dc=new Win32::Wingraph( device=>"$cp",  desc=>'test')
   or die "Imprimante $cp inactive.";

print "Debut impression sur $cp\n";
$dc->SetFont("Times new roman italic,36,252");
$dc->TextOut(50,100, "Salut tout le monde !");
print "Fin d'impression\n";

Un script de test

Le script suivant teste quelques méthodes du modules Wingraph.
On notera la manière tortueuse de changer les attributs d'une police (j'ai mis un moment à comprendre la manière dont le module mémorisait une police... et je ne suis pas sûr d'avoir tout compris ;-)
Et voilà le résultat : test.pdf 
#!perl
use strict;
use Win32::Wingraph;

# La fonction GetCurrentPrinter retourne l'imprimante par défaut.
sub GetCurrentPrinter {
  my %RegHash;
  use Win32::TieRegistry ( TiedHash => \%RegHash );
  if ( Win32::IsWinNT() ) { # pour Win NT/2000/XP
    my $SKey=$RegHash{'\HKEY_CURRENT_USER\Software\Microsoft\Windows NT'.
                      '\CurrentVersion\Windows'} or return undef;
    return (split "," , $SKey->GetValue('Device'))[0];
  }
  else {                    # pour Win 9x
    my $SKey=$RegHash{'HKEY_CURRENT_CONFIG\System\CurrentControlSet'.
                      '\Control\Print\Printers'} or return undef;
    return $SKey->GetValue('Default');
  }
}

# programme principal

my $cp = GetCurrentPrinter() or die "Pas d'imprimante ??";
my $dc = new Win32::Wingraph(
  device => "$cp",
  desc   => 'test' ) or die "Imprimante $cp inactive.";

my $s = 'abcdef éèêëçàù ABCDEF ÉÈÊÎÏÇÀÙ';
my $y = 50;
$dc->SetFont("Times new roman , 12, 252");         # Tnr normal
$dc->TextOut( 100, $y, "Times (12 pts) : " . $s );
$y += 20;
$dc->SetFont("Times new roman , 16, 252");
$dc->TextOut( 100, $y, "Times (16 pts) : " . $s );
$y += 32;
$dc->SetFont("Times New roman Italic, 12, 252");   # TNr italique
$dc->TextOut( 100, $y, "Times italique (12 pts) : " . $s );
$y += 20;
$dc->SetFont("Times New roman Italic , 16, 252");
$dc->TextOut( 100, $y, "Times italique (16 pts) : " . $s );
$y += 32;
$dc->SetFont("Times New Roman bold, 12, 252");     # TNR bold
$dc->TextOut( 100, $y, "Times bold (12 pts) : " . $s );
$y += 20;
$dc->SetFont("Times New Roman bold, 16, 252");
$dc->TextOut( 100, $y, "Times bold (16 pts) : " . $s );
$y += 32;

$dc->SetFont("Arial, 12, 252");                    # Arial normal
$dc->TextOut( 100, $y, "Arial (12 pts) : " . $s );
$y += 20;
$dc->SetFont("ARial italic, 16, 252");             # ARial italic
$dc->TextOut( 100, $y, "Arial italique (16 pts) : " . $s );
$y += 32;
$dc->SetFont("ARIal bold, 12, 252");               # ARIal bold
$dc->TextOut( 100, $y, "Arial bold (12 pts) : " . $s );
$y += 20;
$dc->SetFont("ARIAl bold italic, 12, 252");        # ARIAl bold italic
$dc->TextOut( 100, $y, "Arial bold italique (12 pts) : " . $s );

$y += 50;
foreach ( 2, 4, 8, 16, 32 ) {
    $dc->SetPen($_);
    $dc->MoveTo( 100, $y );
    $dc->LineTo( 750, $y );
    $y += 2 * $_;
}

$y -= 20;
my $x = 100;
foreach ( 0, 32, 64, 96, 128, 160 ) {
    $dc->SetBrush($_);
    $dc->FillRect( $x, $y, 100, 50 );
    $x += 120;
}

$y += 100;
$x = 100;
$dc->SetPen(8);
foreach ( 0, 32, 64, 96, 128, 160 ) {
    $dc->SetBrush($_);
    $dc->Ellipse( $x, $y, $x + 100, $y + 50 );
    $x += 120;
}

Un listeur

Ce script list.pl permet de lister une série de fichiers texte.
Il ne faut utiliser que des polices à chasse fixe dans ce script; on utilise la largeur de la lettre W pour déterminer le nombre de caractères par ligne et après on découpe les lignes trop longues à la hache : c'est un procédé trop rustique pour une police proportionnelle.
Si on l'applique à lui-même avec : > perl list.pl list.pl
on obtient le listing suivant : list.pdf 
#!perl
use strict;
use Win32::Wingraph;
use Text::Tabs;

# La fonction GetCurrentPrinter retourne l'imprimante par défaut.
sub GetCurrentPrinter {
  my %RegHash;
  use Win32::TieRegistry ( TiedHash => \%RegHash );
  if ( Win32::IsWinNT() ) { # pour Win NT/2000/XP
    my $SKey=$RegHash{'\HKEY_CURRENT_USER\Software\Microsoft\Windows NT'.
                      '\CurrentVersion\Windows'} or return undef;
    return (split "," , $SKey->GetValue('Device'))[0];
  }
  else {                    # pour Win 9x
    my $SKey=$RegHash{'HKEY_CURRENT_CONFIG\System\CurrentControlSet'.
                      '\Control\Print\Printers'} or return undef;
    return $SKey->GetValue('Default');
  }
}

# programme principal

if ( not @ARGV ) {
    print " Usage : perl list.pl file1.txt file2.txt ...\n";
    exit;
}

# ------ paramètres à personnaliser
my $format = 'A4';             # format du papier A4, A3, LETTER, LEGAL ...etc
my $police = 'Courier new';    # police non proport.
my $taille = 10;               # taille police en pt
my $haut   = 40;               # marge haut de page
my $gauche = 100;              # marge gauche
my $droite = 100;              # marge droite
my $bas    = 40;               # marge bas de page
$tabstop = 2;                  # nombre d'espaces pour une tabulation \t

# ------

my $cp = GetCurrentPrinter() or die "Pas d'imprimante ??";
my $dc = new Win32::Wingraph(
  device    => $cp,
  desc      => 'list',
  papersize => $format ) or die "Imprimante $cp inactive.";

$dc->SetFont("$police, $taille, 252");      # codepage WinLatin1 = 252
my ( $w, $h ) = $dc->TextSize('W');         # dim caractère
$w *= 1.06;                                 # pitch = 6% de $w
my $ncol = int( ( $dc->maxx - $droite - $gauche ) / $w );
my $decalg = int( 1.1 * $h );               # interligne = 10% de $h
my $nlig = int( ( $dc->maxy - $haut - $bas ) / $decalg );

print "Police = $police ($taille points) $nlig lignes de $ncol caracteres\n";
my $start = 1;

while ( my $fichier = shift ) {
    if ( open F, "<$fichier" ) {
        print "Impression de $fichier\n";
        if ($start) {
            $start = 0;
        }
        else {
            $dc->NextPage();
            $dc->SetFont("$police, $taille, 252");
        }
        my $vert = $haut;
        my $c    = 1;

        while (<F>) {
            $_ = expand($_);
            chop;
            if ( $_ eq '' ) { $_ = ' ' }    # ligne vide
            while ( my $r = substr( $_, 0, $ncol, '' ) ) {
                $dc->TextOut( $gauche, $vert, substr( $r, 0, $ncol ) );
                $vert += $decalg;
                $c++;

                if ( $c > $nlig ) {
                    $dc->NextPage();
                    $dc->SetFont("$police, $taille, 252");
                    $c    = 1;
                    $vert = $haut;
                }
            }
        }
        close F;
    }
    else {
        print "Erreur ouverture $fichier\n";
    }
}

À suivre ... :-)


BðP © 2001 J-L Morel - Contact : jl_morel@bribes.org [Validation HTML 4.0!]