Hi
 
Here you are:
The first section is an API call to show the standard printer dialog, the second section is an example from the Win32::NPRG module.
It detects your installed printers, you can select a printer, and it prints a little example to the selected printer.
Regards
Gabor
 
#!perl -w
use strict;
# Win32::API GDI printer test code
use ExtUtils::testlib;
use Win32::Wingraph;
use Win32::NPRG qw(drawmatrix);
use Win32::API;
 
my $PrintDialog = new Win32::API('comdlg32', 'PrintDlg', ['P'],  'N');
my $GlobalLock = new Win32::API('kernel32', 'GlobalLock', ['N'], 'N');
my $GlobalFree = new Win32::API('kernel32', 'GlobalFree', ['N'], 'N');
my $GetDeviceCaps = new Win32::API('gdi32', 'GetDeviceCaps', ['N','N'], 'N');
my $GetTextMetrics = new Win32::API('gdi32', 'GetTextMetrics',['N','P'], 'N');
my $StartDoc = new Win32::API('gdi32', 'StartDoc', ['N', 'P'] , 'N');
my $StartPage = new Win32::API('gdi32', 'StartPage', ['N'], 'N');
my $TextOut = new Win32::API('gdi32', 'TextOut',['N','I','I','P','I'], 'N');
my $EndPage = new Win32::API('gdi32', 'EndPage', ['N'], 'N');
my $EndDoc = new Win32::API('gdi32', 'EndDoc', ['N'], 'N');
my $GetLastError =   new Win32::API('kernel32', 'GetLastError',   [],'N');
my $FormatMessage =  new Win32::API('kernel32', 'FormatMessage',['N','P','N','N','P','N','P'],'N');
 
sub ShowError {
   my $function = shift;
   my $message = " " x 1024;
   $FormatMessage->Call(0x1000, 0, $GetLastError->Call(), 0,$message, 1024, 0);
   $message =~ s/\s+$//;
   print "$function: $message\n";
   exit;
}
 
# user dialog to select printer
# page setup dialog selected since pages, selection and copies are not used here
# paper size and orientation shown instead
my $pd = pack("Lx16Lx42", 66, 0x140);
# pd_size, flags = RETURNDC | PRINTSETUP
$PrintDialog->Call($pd) or die "Cancelled\n";
# get device mode and device context
my ($devmode, $dc) = unpack("x8Lx4L", $pd);
 
# this part is just to print a notice line
# and to practice mucking with pointers in structures
# otherwise, examining devmode is not needed for GDI
# devmode is a handle to movable global memory
my $handle = $devmode;
# get actual memory pointer
unless ($devmode = $GlobalLock->Call($handle)) {ShowError('GlobalLock')};
# get perl to use long integer as a pointer
# and retrieve the printer relevant part of the devmode structure
$devmode = unpack('P104', pack('L', $devmode));
# release the global memory
unless ($GlobalFree->Call($handle) == 0) {ShowError('GlobalFree')};
# these strings are blank padded
my ($devicename, $orient, $duplex, $formname) = unpack('A32x12Sx16Sx6A32', $devmode);
$orient = ('Portrait', 'Landscape')[--$orient];
$duplex = ('', 'Duplex')[$duplex > 1];
print "Printing to $devicename on $formname paper, $orient $duplex\n";
 

my $dc = new Win32::Wingraph(device=>"$devicename",  desc=>'test', orientation=>'$orient') or die; #orientation=>'Landscape',
 
$dc->SetPen(3);
# "font, size, codepage" - the third argument is Windows font codepage
# if you don't supply this it'll be set to russian !!!,
# 0-westerneuropean, 238-polish, I don't know the hungarian ;(
$dc->SetFont("Times New Roman Bold, 12, 0");
$dc->TextOut(70, 180, "Blah blah blah");
$dc->MoveTo(70, 200);
$dc->LineTo(270, 200);
 
print "Start\n";
 
my $rp=new NPRG(dc=>$dc);
$rp->{'atbreak'} = sub {
         $rp->pushq({font=>'Times, 6, 0', opt=>'R', border=>'B',value=>'Very wisdom report about something '.$rp->pagenum(), width=>980});
                $rp->pushq({height=>20, value=>' ', width=>100});
                $rp->pushq({font=>'Arial italic, 16, 0', opt=>'-L',border=>'TBLR', value=>"Some header", width=>300, brush=>220},
                            {font=>'Courier Bold, 12, 0', opt=>'-C',border=>'TBLR', value=>"Another header", width=>250, brush=>220},
                            {value=>\&NPRG::drawmatrix, width=>400,
       matrix=>[
                                  [ {font=>'Arial Bold Italic, 12',value=>'Month', border=>'TBLR', opt=>'C'}],
                                  [
                                      {font=>'Times New Roman,8',value=>'I', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,8',value=>'II', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,8',value=>'III', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,8',value=>'IV', border=>'TBLR', opt=>'-C'},
                                  ],
                                  [
                                      {font=>'Times New Roman,7',value=>'I', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'II', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'III', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'IV', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'V', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'VI', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'VII', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'VIII', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'IX', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'X', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'XI', border=>'TBLR', opt=>'-C'},
                                      {font=>'Times New Roman,7',value=>'XII', border=>'TBLR', opt=>'-C'},
                                   ]
                                ],
                             }
                            );
                  $rp->pushq({width=>950, height=>3, brush=>0});
                  $rp->flushq();
                  print "Here\n";
               };
 
$rp->flushq();
print "End\n";
----- Original Message -----
From: Peter Eisengrein
To: 'Magnone, Angelo' ; Perl-Win32-Gui-Users@Lists. Sourceforge. Net (E-mail)
Sent: Wednesday, October 23, 2002 8:13 PM
Subject: RE: [perl-win32-gui-users] printer support

I've only seen it done with a system() call to rundll32.exe. Something like this:
 
# untested
$dll = "/Winnt/System32/mshtml.dll";        
system("rundll32.exe $dll,PrintHTML $file");
 
-----Original Message-----
From: Magnone, Angelo [mailto:angelo.magnone@rbc.com]
Sent: Wednesday, October 23, 2002 13:57
To: Perl-Win32-Gui-Users@Lists. Sourceforge. Net (E-mail)
Subject: [perl-win32-gui-users] printer support


Does win32 have any printer-type functions like "Select printer", "Printer Properties", "Page Size", etc...

Thanks :)





------------------------------------------------------------
This e-mail may be privileged and/or confidential, and the sender does not waive any related rights and obligations. Any distribution, use or copying of this e-mail or the information it contains by other than an intended recipient is unauthorized. If you received this e-mail in error, please advise me (by return e-mail or otherwise) immediately.

Ce courriel est confidentiel et protégé. L'expéditeur ne renonce pas aux droits et obligations qui s'y rapportent. Toute diffusion, utilisation ou copie de ce message ou des renseignements qu'il contient par une personne autre que le (les) destinataire(s) désigné(s) est interdite. Si vous recevez ce courriel par erreur, veuillez m'en aviser immédiatement, par retour de courriel ou par un autre moyen.


============================================================