RE: [perl-win32-gui-users] printer support

[Darek Adamkiewicz]

----- Original Message -----
From: Peter Eisengrein <[EMAIL PROTECTED]>
Date: Wed, 23 Oct 2002 14:13:59 -0400
To: "''Magnone, Angelo''" <[EMAIL PROTECTED]>, "[EMAIL PROTECTED] Sourceforge. Net (E-mail)"
Subject: RE: [perl-win32-gui-users] printer support

The following code is a part of source code I found some times ago on the newsgroups

(it works for me)

 

Regards

Darek

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

#!perl -w
use strict;
# Win32::API GDI printer test code

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";

--

_______________________________________________
Sign-up for your own FREE Personalized E-mail at Mail.com