printer supportHi

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' ; [EMAIL PROTECTED] 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:[EMAIL PROTECTED]
    Sent: Wednesday, October 23, 2002 13:57
    To: [EMAIL PROTECTED] 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. 


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

Reply via email to