#------------------------------------------------------------------------------#
# Win32::Printer #
# V 0.9.1 (2008-04-28) #
# Copyright (C) 2003-2005 Edgars Binans #
#------------------------------------------------------------------------------#
package Win32::Printer;
use 5.006;
use strict;
use warnings;
use Carp;
require Exporter;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $_debuglevel $_numcroaked );
$VERSION = '0.9.1';
@ISA = qw( Exporter );
@EXPORT = qw(
EB_EMF EB_25MATRIX EB_25INTER EB_25IND EB_25IATA EB_27 EB_39STD EB_39EXT
EB_39DUMB EB_93 EB_128SMART EB_128A EB_128B EB_128C EB_128SHFT EB_128EAN
EB_EAN13 EB_UPCA EB_EAN8 EB_UPCE EB_ISBN EB_ISBN2 EB_ISSN EB_AD2 EB_AD5
EB_CHK EB_TXT
LETTER LETTERSMALL TABLOID LEDGER LEGAL STATEMENT EXECUTIVE A3 A4
A4SMALL A5 B4 B5 FOLIO QUARTO IN_10X14 IN_11X17 NOTE ENV_9 ENV_10
ENV_11 ENV_12 ENV_14 CSHEET DSHEET ESHEET ENV_DL ENV_C5 ENV_C3 ENV_C4
ENV_C6 ENV_C65 ENV_B4 ENV_B5 ENV_B6 ENV_ITALY ENV_MONARCH ENV_PERSONAL
FANFOLD_US FANFOLD_STD_GERMAN FANFOLD_LGL_GERMAN ISO_B4
JAPANESE_POSTCARD IN_9X11 IN_10X11 IN_15X11 ENV_INVITE RESERVED_48
RESERVED_49 LETTER_EXTRA LEGAL_EXTRA TABLOID_EXTRA A4_EXTRA
LETTER_TRANSVERSE A4_TRANSVERSE LETTER_EXTRA_TRANSVERSE A_PLUS B_PLUS
LETTER_PLUS A4_PLUS A5_TRANSVERSE B5_TRANSVERSE A3_EXTRA A5_EXTRA
B5_EXTRA A2 A3_TRANSVERSE A3_EXTRA_TRANSVERSE
PORTRAIT LANDSCAPE VERTICAL HORIZONTAL
ALLPAGES SELECTION PAGENUMS NOSELECTION NOPAGENUMS PRINTTOFILE
PRINTSETUP NOWARNING DISABLEPRINTTOFILE HIDEPRINTTOFILE NONETWORKBUTTON
NOUPDATECP TOP LEFT UPDATECP RIGHT VCENTER BOTTOM WORDBREAK BASELINE
SINGLELINE EXPANDTABS NOCLIP EXTERNALLEADING CALCRECT INTERNAL
EDITCONTROL PATH_ELLIPSIS END_ELLIPSIS MODIFYSTRING RTLREADING
WORD_ELLIPSIS CENTER JUSTIFY UTF8
PS_SOLID PS_DASH PS_DOT PS_DASHDOT PS_DASHDOTDOT PS_NULL PS_INSIDEFRAME
PS_JOIN_ROUND PS_ENDCAP_ROUND PS_ENDCAP_SQUARE PS_ENDCAP_FLAT
PS_JOIN_BEVEL PS_JOIN_MITER
HS_HORIZONTAL HS_VERTICAL HS_FDIAGONAL HS_BDIAGONAL HS_CROSS
HS_DIAGCROSS
ALTERNATE WINDING
CR_OFF CR_AND CR_OR CR_XOR CR_DIFF CR_COPY
ANSI DEFAULT SYMBOL SHIFTJIS HANGEUL GB2312 CHINESEBIG5 OEM JOHAB HEBREW
ARABIC GREEK TURKISH VIETNAMESE THAI EASTEUROPE RUSSIAN MAC BALTIC
BIN_ONLYONE BIN_LOWER BIN_MIDDLE BIN_MANUAL BIN_ENVELOPE BIN_ENVMANUAL
BIN_AUTO BIN_TRACTOR BIN_SMALLFMT BIN_LARGEFMT BIN_LARGECAPACITY
BIN_CASSETTE BIN_FORMSOURCE
MONOCHROME COLOR
DRIVERVERSION HORZSIZE VERTSIZE HORZRES VERTRES BITSPIXEL PLANES
NUMBRUSHES NUMPENS NUMFONTS NUMCOLORS CURVECAPS LINECAPS POLYGONALCAPS
TEXTCAPS CLIPCAPS RASTERCAPS ASPECTX ASPECTY ASPECTXY LOGPIXELSX
LOGPIXELSY SIZEPALETTE NUMRESERVED COLORRES PHYSICALWIDTH
PHYSICALHEIGHT PHYSICALOFFSETX PHYSICALOFFSETY SCALINGFACTORX
SCALINGFACTORY
PSI_BEGINSTREAM PSI_PSADOBE PSI_PAGESATEND PSI_PAGES PSI_DOCNEEDEDRES
PSI_DOCSUPPLIEDRES PSI_PAGEORDER PSI_ORIENTATION PSI_BOUNDINGBOX
PSI_PROCESSCOLORS PSI_COMMENTS PSI_BEGINDEFAULTS PSI_ENDDEFAULTS
PSI_BEGINPROLOG PSI_ENDPROLOG PSI_BEGINSETUP PSI_ENDSETUP PSI_TRAILER
PSI_EOF PSI_ENDSTREAM PSI_PROCESSCOLORSATEND PSI_PAGENUMBER
PSI_BEGINPAGESETUP PSI_ENDPAGESETUP PSI_PAGETRAILER PSI_PLATECOLOR
PSI_SHOWPAGE PSI_PAGEBBOX PSI_ENDPAGECOMMENTS PSI_VMSAVE PSI_VMRESTORE
FIF_BMP FIF_ICO FIF_JPEG FIF_JNG FIF_KOALA FIF_LBM FIF_IFF FIF_MNG
FIF_PBM FIF_PBMRAW FIF_PCD FIF_PCX FIF_PGM FIF_PGMRAW FIF_PNG FIF_PPM
FIF_PPMRAW FIF_RAS FIF_TARGA FIF_TIFF FIF_WBMP FIF_PSD FIF_CUT FIF_XBM
FIF_XPM FIF_DDS FIF_GIF
BMP_DEFAULT BMP_SAVE_RLE JPEG_DEFAULT JPEG_QUALITYSUPERB
JPEG_QUALITYGOOD JPEG_QUALITYNORMAL JPEG_QUALITYAVERAGE JPEG_QUALITYBAD
PNM_DEFAULT PNM_SAVE_RAW PNM_SAVE_ASCII TIFF_DEFAULT TIFF_CMYK
TIFF_PACKBITS TIFF_DEFLATE TIFF_ADOBE_DEFLATE TIFF_NONE TIFF_CCITTFAX3
TIFF_CCITTFAX4TIFF_LZW
);
@EXPORT_OK = qw( );
require XSLoader;
XSLoader::load('Win32::Printer', $VERSION);
#------------------------------------------------------------------------------#
sub _carp {
if (!defined($_debuglevel)) { $_debuglevel = 0; }
my $arg = shift;
if ($_debuglevel == 1) {
croak $arg, "(Died on warning!)";
} else {
carp $arg;
}
}
sub _croak {
if (!defined($_debuglevel)) { $_debuglevel = 0; }
my $arg = shift;
if ($_debuglevel == 2) {
carp $arg, "(Warned on error!)";
} else {
croak $arg;
}
}
#------------------------------------------------------------------------------#
sub AUTOLOAD {
my $constname = $AUTOLOAD;
$constname =~ s/.*:://;
_croak "Unknown Win32::Printer macro $constname.\n";
return undef;
}
#------------------------------------------------------------------------------#
# "ebbl" modes
sub EB_25MATRIX { 0x00000001; }
sub EB_25INTER { 0x00000002; }
sub EB_25IND { 0x00000004; }
sub EB_25IATA { 0x00000008; }
sub EB_27 { 0x00000010; }
sub EB_39STD { 0x00000020; }
sub EB_39EXT { 0x00000040; }
sub EB_39DUMB { 0x00000080; }
sub EB_93 { 0x00000100; }
sub EB_128SMART { 0x00000200; }
sub EB_128A { 0x00000400; }
sub EB_128B { 0x00000800; }
sub EB_128C { 0x00001000; }
sub EB_128SHFT { 0x00002000; }
sub EB_128EAN { 0x00004000; }
sub EB_EAN13 { 0x00008000; }
sub EB_UPCA { 0x00010000; }
sub EB_EAN8 { 0x00020000; }
sub EB_UPCE { 0x00040000; }
sub EB_ISBN { 0x00080000; }
sub EB_ISBN2 { 0x00100000; }
sub EB_ISSN { 0x00200000; }
sub EB_AD2 { 0x00400000; }
sub EB_AD5 { 0x00800000; }
sub EB_CHK { 0x01000000; }
sub EB_TXT { 0x02000000; }
sub EB_EMF { 0x80000000; }
sub FIF_UNKNOWN { -1; }
sub FIF_BMP { 0; }
sub FIF_ICO { 1; }
sub FIF_JPEG { 2; }
sub FIF_JNG { 3; }
sub FIF_KOALA { 4; }
sub FIF_LBM { 5; }
sub FIF_IFF { FIF_LBM; }
sub FIF_MNG { 6; }
sub FIF_PBM { 7; }
sub FIF_PBMRAW { 8; }
sub FIF_PCD { 9; }
sub FIF_PCX { 10; }
sub FIF_PGM { 11; }
sub FIF_PGMRAW { 12; }
sub FIF_PNG { 13; }
sub FIF_PPM { 14; }
sub FIF_PPMRAW { 15; }
sub FIF_RAS { 16; }
sub FIF_TARGA { 17; }
sub FIF_TIFF { 18; }
sub FIF_WBMP { 19; }
sub FIF_PSD { 20; }
sub FIF_CUT { 21; }
sub FIF_XBM { 22; }
sub FIF_XPM { 23; }
sub FIF_DDS { 24; }
sub FIF_GIF { 25; }
sub BMP_DEFAULT { 0; }
sub BMP_SAVE_RLE { 1; }
sub CUT_DEFAULT { 0; }
sub DDS_DEFAULT { 0; }
sub GIF_DEFAULT { 0; }
sub ICO_DEFAULT { 0; }
sub ICO_MAKEALPHA { 1; }
sub IFF_DEFAULT { 0; }
sub JPEG_DEFAULT { 0; }
sub JPEG_FAST { 1; }
sub JPEG_ACCURATE { 2; }
sub JPEG_QUALITYSUPERB { 0x80; }
sub JPEG_QUALITYGOOD { 0x100; }
sub JPEG_QUALITYNORMAL { 0x200; }
sub JPEG_QUALITYAVERAGE { 0x400; }
sub JPEG_QUALITYBAD { 0x800; }
sub KOALA_DEFAULT { 0; }
sub LBM_DEFAULT { 0; }
sub MNG_DEFAULT { 0; }
sub PCD_DEFAULT { 0; }
sub PCD_BASE { 1; }
sub PCD_BASEDIV4 { 2; }
sub PCD_BASEDIV16 { 3; }
sub PCX_DEFAULT { 0; }
sub PNG_DEFAULT { 0; }
sub PNG_IGNOREGAMMA { 1; }
sub PNM_DEFAULT { 0; }
sub PNM_SAVE_RAW { 0; }
sub PNM_SAVE_ASCII { 1; }
sub PSD_DEFAULT { 0; }
sub RAS_DEFAULT { 0; }
sub TARGA_DEFAULT { 0; }
sub TARGA_LOAD_RGB888 { 1; }
sub TIFF_DEFAULT { 0; }
sub TIFF_CMYK { 0x0001; }
sub TIFF_PACKBITS { 0x0100; }
sub TIFF_DEFLATE { 0x0200; }
sub TIFF_ADOBE_DEFLATE { 0x0400; }
sub TIFF_NONE { 0x0800; }
sub TIFF_CCITTFAX3 { 0x1000; }
sub TIFF_CCITTFAX4 { 0x2000; }
sub TIFF_LZW { 0x4000; }
sub WBMP_DEFAULT { 0; }
sub XBM_DEFAULT { 0; }
sub XPM_DEFAULT { 0; }
# Print dialog
sub ALLPAGES { 0x00000000; }
sub SELECTION { 0x00000001; }
sub PAGENUMS { 0x00000002; }
sub NOSELECTION { 0x00000004; }
sub NOPAGENUMS { 0x00000008; }
sub COLLATE { 0x00000010; }
sub PRINTTOFILE { 0x00000020; }
sub PRINTSETUP { 0x00000040; }
sub NOWARNING { 0x00000080; }
sub RETURNDC { 0x00000100; }
sub RETURNIC { 0x00000200; }
sub RETURNDEFAULT { 0x00000400; }
sub SHOWHELP { 0x00000800; }
sub ENABLEPRINTHOOK { 0x00001000; }
sub ENABLESETUPHOOK { 0x00002000; }
sub ENABLEPRINTTEMPLATE { 0x00004000; }
sub ENABLESETUPTEMPLATE { 0x00008000; }
sub ENABLEPRINTTEMPLATEHANDLE { 0x00010000; }
sub ENABLESETUPTEMPLATEHANDLE { 0x00020000; }
sub USEDEVMODECOPIES { 0x00040000; }
sub USEDEVMODECOPIESANDCOLLATE { 0x00040000; }
sub DISABLEPRINTTOFILE { 0x00080000; }
sub HIDEPRINTTOFILE { 0x00100000; }
sub NONETWORKBUTTON { 0x00200000; }
# Paper source bin
sub BIN_ONLYONE { 1; }
sub BIN_LOWER { 2; }
sub BIN_MIDDLE { 3; }
sub BIN_MANUAL { 4; }
sub BIN_ENVELOPE { 5; }
sub BIN_ENVMANUAL { 6; }
sub BIN_AUTO { 7; }
sub BIN_TRACTOR { 8; }
sub BIN_SMALLFMT { 9; }
sub BIN_LARGEFMT { 10; }
sub BIN_LARGECAPACITY { 11; }
sub BIN_CASSETTE { 14; }
sub BIN_FORMSOURCE { 15; }
# Printer output color setting
sub MONOCHROME { 1; }
sub COLOR { 2; }
# Device caps
sub DRIVERVERSION { 0; }
sub TECHNOLOGY { 2; }
sub HORZSIZE { 4; }
sub VERTSIZE { 6; }
sub HORZRES { 8; }
sub VERTRES { 10; }
sub BITSPIXEL { 12; }
sub PLANES { 14; }
sub NUMBRUSHES { 16; }
sub NUMPENS { 18; }
sub NUMMARKERS { 20; }
sub NUMFONTS { 22; }
sub NUMCOLORS { 24; }
sub PDEVICESIZE { 26; }
sub CURVECAPS { 28; }
sub LINECAPS { 30; }
sub POLYGONALCAPS { 32; }
sub TEXTCAPS { 34; }
sub CLIPCAPS { 36; }
sub RASTERCAPS { 38; }
sub ASPECTX { 40; }
sub ASPECTY { 42; }
sub ASPECTXY { 44; }
sub LOGPIXELSX { 88; }
sub LOGPIXELSY { 90; }
sub SIZEPALETTE { 104; }
sub NUMRESERVED { 106; }
sub COLORRES { 108; }
sub PHYSICALWIDTH { 110; }
sub PHYSICALHEIGHT { 111; }
sub PHYSICALOFFSETX { 112; }
sub PHYSICALOFFSETY { 113; }
sub SCALINGFACTORX { 114; }
sub SCALINGFACTORY { 115; }
# Text output flags
sub NOUPDATECP { 0x00000000; } #
sub TOP { 0x00000000; } #
sub LEFT { 0x00000000; } #
sub UPDATECP { 0x00000001; } #
sub RIGHT { 0x00000002; } #
sub VCENTER { 0x00000004; }
sub BOTTOM { 0x00000008; } #
sub WORDBREAK { 0x00000010; }
sub BASELINE { 0x00000018; } #
sub SINGLELINE { 0x00000020; }
sub EXPANDTABS { 0x00000040; }
sub TABSTOP { 0x00000080; }
sub NOCLIP { 0x00000100; }
sub EXTERNALLEADING { 0x00000200; }
sub CALCRECT { 0x00000400; }
sub INTERNAL { 0x00001000; }
sub EDITCONTROL { 0x00002000; }
sub PATH_ELLIPSIS { 0x00004000; }
sub END_ELLIPSIS { 0x00008000; }
sub MODIFYSTRING { 0x00010000; }
sub RTLREADING { 0x00020000; } # Modify 1
sub WORD_ELLIPSIS { 0x00040000; }
sub CENTER { 0x00080000; } # Modify 2
sub UTF8 { 0x40000000; }
sub JUSTIFY { 0x80000000; }
# Pen styles
sub PS_DASH { 0x00000001; }
sub PS_DOT { 0x00000002; }
sub PS_DASHDOT { 0x00000003; }
sub PS_DASHDOTDOT { 0x00000004; }
sub PS_NULL { 0x00000005; }
sub PS_INSIDEFRAME { 0x00000006; }
sub PS_SOLID { 0x00010000; }
sub PS_JOIN_ROUND { 0x00010000; }
sub PS_ENDCAP_ROUND { 0x00010000; }
sub PS_ENDCAP_SQUARE { 0x00010100; }
sub PS_ENDCAP_FLAT { 0x00010200; }
sub PS_JOIN_BEVEL { 0x00011000; }
sub PS_JOIN_MITER { 0x00012000; }
# Brush styles
sub BS_SOLID { 0; }
sub BS_NULL { 1; }
sub BS_HOLLOW { 1; }
sub BS_HATCHED { 2; }
sub BS_PATTERN { 3; }
sub BS_DIBPATTERN { 5; }
sub BS_DIBPATTERNPT { 6; }
sub BS_PATTERN8X8 { 7; }
sub BS_DIBPATTERN8X8 { 8; }
# Brush hatches
sub HS_HORIZONTAL { 0; }
sub HS_VERTICAL { 1; }
sub HS_FDIAGONAL { 2; }
sub HS_BDIAGONAL { 3; }
sub HS_CROSS { 4; }
sub HS_DIAGCROSS { 5; }
# Path modes
sub CR_OFF { 0; }
sub CR_AND { 1; }
sub CR_OR { 2; }
sub CR_XOR { 3; }
sub CR_DIFF { 4; }
sub CR_COPY { 5; }
# Fill modes
sub ALTERNATE { 1; }
sub WINDING { 2; }
# Duplexing
sub SIMPLEX { 1; }
sub VERTICAL { 2; }
sub HORIZONTAL { 3; }
# Paper sizes
sub LETTER { 1; }
sub LETTERSMALL { 2; }
sub TABLOID { 3; }
sub LEDGER { 4; }
sub LEGAL { 5; }
sub STATEMENT { 6; }
sub EXECUTIVE { 7; }
sub A3 { 8; }
sub A4 { 9; }
sub A4SMALL { 10; }
sub A5 { 11; }
sub B4 { 12; }
sub B5 { 13; }
sub FOLIO { 14; }
sub QUARTO { 15; }
sub IN_10X14 { 16; }
sub IN_11X17 { 17; }
sub NOTE { 18; }
sub ENV_9 { 19; }
sub ENV_10 { 20; }
sub ENV_11 { 21; }
sub ENV_12 { 22; }
sub ENV_14 { 23; }
sub CSHEET { 24; }
sub DSHEET { 25; }
sub ESHEET { 26; }
sub ENV_DL { 27; }
sub ENV_C5 { 28; }
sub ENV_C3 { 29; }
sub ENV_C4 { 30; }
sub ENV_C6 { 31; }
sub ENV_C65 { 32; }
sub ENV_B4 { 33; }
sub ENV_B5 { 34; }
sub ENV_B6 { 35; }
sub ENV_ITALY { 36; }
sub ENV_MONARCH { 37; }
sub ENV_PERSONAL { 38; }
sub FANFOLD_US { 39; }
sub FANFOLD_STD_GERMAN { 40; }
sub FANFOLD_LGL_GERMAN { 41; }
sub ISO_B4 { 42; }
sub JAPANESE_POSTCARD { 43; }
sub IN_9X11 { 44; }
sub IN_10X11 { 45; }
sub IN_15X11 { 46; }
sub ENV_INVITE { 47; }
sub RESERVED_48 { 48; }
sub RESERVED_49 { 49; }
sub LETTER_EXTRA { 50; }
sub LEGAL_EXTRA { 51; }
sub TABLOID_EXTRA { 52; }
sub A4_EXTRA { 53; }
sub LETTER_TRANSVERSE { 54; }
sub A4_TRANSVERSE { 55; }
sub LETTER_EXTRA_TRANSVERSE { 56; }
sub A_PLUS { 57; }
sub B_PLUS { 58; }
sub LETTER_PLUS { 59; }
sub A4_PLUS { 60; }
sub A5_TRANSVERSE { 61; }
sub B5_TRANSVERSE { 62; }
sub A3_EXTRA { 63; }
sub A5_EXTRA { 64; }
sub B5_EXTRA { 65; }
sub A2 { 66; }
sub A3_TRANSVERSE { 67; }
sub A3_EXTRA_TRANSVERSE { 68; }
# Paper orientation
sub PORTRAIT { 1; }
sub LANDSCAPE { 2; }
# Character sets
sub ANSI { 0; }
sub DEFAULT { 1; }
sub SYMBOL { 2; }
sub SHIFTJIS { 128; }
sub HANGEUL { 129; }
sub GB2312 { 134; }
sub CHINESEBIG5 { 136; }
sub OEM { 255; }
sub JOHAB { 130; }
sub HEBREW { 177; }
sub ARABIC { 178; }
sub GREEK { 161; }
sub TURKISH { 162; }
sub VIETNAMESE { 163; }
sub THAI { 222; }
sub EASTEUROPE { 238; }
sub RUSSIAN { 204; }
sub MAC { 77; }
sub BALTIC { 186; }
sub FW_NORMAL { 400; }
sub FW_BOLD { 700; }
# Injection of PostScript
sub PSI_BEGINSTREAM { 1; }
sub PSI_PSADOBE { 2; }
sub PSI_PAGESATEND { 3; }
sub PSI_PAGES { 4; }
sub PSI_DOCNEEDEDRES { 5; }
sub PSI_DOCSUPPLIEDRES { 6; }
sub PSI_PAGEORDER { 7; }
sub PSI_ORIENTATION { 8; }
sub PSI_BOUNDINGBOX { 9; }
sub PSI_PROCESSCOLORS { 10; }
sub PSI_COMMENTS { 11; }
sub PSI_BEGINDEFAULTS { 12; }
sub PSI_ENDDEFAULTS { 13; }
sub PSI_BEGINPROLOG { 14; }
sub PSI_ENDPROLOG { 15; }
sub PSI_BEGINSETUP { 16; }
sub PSI_ENDSETUP { 17; }
sub PSI_TRAILER { 18; }
sub PSI_EOF { 19; }
sub PSI_ENDSTREAM { 20; }
sub PSI_PROCESSCOLORSATEND { 21; }
sub PSI_PAGENUMBER { 100; }
sub PSI_BEGINPAGESETUP { 101; }
sub PSI_ENDPAGESETUP { 102; }
sub PSI_PAGETRAILER { 103; }
sub PSI_PLATECOLOR { 104; }
sub PSI_SHOWPAGE { 105; }
sub PSI_PAGEBBOX { 106; }
sub PSI_ENDPAGECOMMENTS { 107; }
sub PSI_VMSAVE { 200; }
sub PSI_VMRESTORE { 201; }
#------------------------------------------------------------------------------#
sub new {
my $class = shift;
my $self = { };
bless($self, $class);
if ($self->_init(@_)) {
return $self;
} else {
_croak qq^ERROR: Cannot initialise object!\n^;
return undef;
}
}
#------------------------------------------------------------------------------#
sub _init {
my $self = shift;
(%{$self->{params}}) = @_;
for (keys %{$self->{params}}) {
if ($_ !~ /^debug$|^dc$|^printer$|^dialog$|^file$|^pdf$|^prompt$|^copies$|^collate$|^minp$|^maxp$|^orientation$|^papersize$|^duplex$|^description$|^unit$|^source$|^color$|^height$|^width$/) {
_carp qq^WARNING: Unknown attribute "$_"!\n^;
}
}
$_numcroaked = 0;
if ((!_num($self->{params}->{'debug'})) or ($self->{params}->{'debug'} > 2)) {
$_debuglevel = 0;
} else {
$_debuglevel = $self->{params}->{'debug'};
}
my $dialog;
if (_num($self->{params}->{'dialog'})) {
$dialog = 1;
} else {
$dialog = 0;
$self->{params}->{'dialog'} = 0;
}
if (defined($self->{params}->{'file'})) {
$self->{params}->{'file'} =~ s/\//\\/g;
my $file = $self->{params}->{'file'};
$file =~ s/(.*\\)//g;
my $dir = $1;
unless ($dir) { $dir = '.\\'; }
if (($file =~ /[\"\*\/\:\<\>\?\\\|]|[\x00-\x1f]/) or (!(-d $dir))) {
_croak "ERROR: Cannot create printer object! Invalid filename\n";
return undef;
}
}
unless (defined $self->{params}->{'printer'}) { $self->{params}->{'printer'} = ""; } else { $self->{params}->{'printer'} =~ s/\//\\/g; }
unless (_num($self->{params}->{'copies'})) { $self->{params}->{'copies'} = 1; }
unless (_num($self->{params}->{'collate'})) { $self->{params}->{'collate'} = 1; }
unless (_num($self->{params}->{'minp'})) { $self->{params}->{'minp'} = 0; }
unless (_num($self->{params}->{'maxp'})) { $self->{params}->{'maxp'} = 0; }
unless (_num($self->{params}->{'orientation'})) { $self->{params}->{'orientation'} = 0; }
unless (_num($self->{params}->{'papersize'})) { $self->{params}->{'papersize'} = 0; }
unless (_num($self->{params}->{'duplex'})) { $self->{params}->{'duplex'} = 0; }
unless (_num($self->{params}->{'source'})) { $self->{params}->{'source'} = 7; }
unless (_num($self->{params}->{'color'})) { $self->{params}->{'color'} = 2; }
unless (_num($self->{params}->{'height'})) { $self->{params}->{'height'} = 0; }
unless (_num($self->{params}->{'width'})) { $self->{params}->{'width'} = 0; }
unless (defined($self->{params}->{'unit'})) { $self->{params}->{'unit'} = 1; }
return undef if $_numcroaked;
if (($self->{params}->{'width'}) and (!$self->{params}->{'height'})) {
$self->{params}->{'width'} = 0;
_carp qq^WARNING: width attribute used without height attribute - IGNORED!\n^;
}
if ((!$self->{params}->{'width'}) and ($self->{params}->{'height'})) {
$self->{params}->{'height'} = 0;
_carp qq^WARNING: height attribute used without width attribute - IGNORED!\n^;
}
if (($self->{params}->{'width'} > 0) and ($self->{params}->{'height'} > 0)) {
if (defined($self->{params}->{'unit'})) {
if ($self->{params}->{'unit'} eq "mm") {
$self->{params}->{'width'} *= 10;
$self->{params}->{'height'} *= 10;
} elsif ($self->{params}->{'unit'} eq "cm") {
$self->{params}->{'width'} *= 100;
$self->{params}->{'height'} *= 100;
} elsif ($self->{params}->{'unit'} eq "pt") {
$self->{params}->{'width'} *= 254.09836 / 72;
$self->{params}->{'height'} *= 254.09836 / 72;
} elsif ($self->{params}->{'unit'} =~ /^\d+\.*\d*$/i) {
$self->{params}->{'width'} *= 254.09836 / $self->{params}->{'unit'};
$self->{params}->{'height'} *= 254.09836 / $self->{params}->{'unit'};
} else {
$self->{params}->{'width'} *= 254.09836;
$self->{params}->{'height'} *= 254.09836;
}
} else {
$self->{params}->{'width'} *= 254.09836;
$self->{params}->{'height'} *= 254.09836;
}
} elsif (($self->{params}->{'width'} < 0) or ($self->{params}->{'height'} < 0)) {
$self->{params}->{'width'} = 0;
$self->{params}->{'height'} = 0;
_carp qq^WARNING: height, width attributes may not have negative values - IGNORED!\n^;
}
if (($dialog) and ((defined($self->{params}->{'prompt'})) or (defined($self->{params}->{'file'})))) {
$self->{params}->{'dialog'} = $self->{params}->{'dialog'} | PRINTTOFILE;
undef $self->{params}->{'prompt'};
}
unless(_IsNT()) {
_carp qq^WARNING: Windows 95/98/ME detected!\n^;
_carp qq^WARNING: All "Space" tranformations will be ignored!\n^;
}
$self->{dc} = _CreatePrinter($self->{params}->{'printer'}, $dialog, $self->{params}->{'dialog'}, $self->{params}->{'copies'}, $self->{params}->{'collate'}, $self->{params}->{'minp'}, $self->{params}->{'maxp'}, $self->{params}->{'orientation'}, $self->{params}->{'papersize'}, $self->{params}->{'duplex'}, $self->{params}->{'source'}, $self->{params}->{'color'}, $self->{params}->{'height'}, $self->{params}->{'width'});
unless ($self->{dc}) {
_croak "ERROR: Cannot create printer object! ${\_GetLastError()}";
return undef;
}
$self->{odc} = $self->{dc};
unless (defined($self->Unit($self->{params}->{'unit'}))) {
_croak "ERROR: Cannot set default units!\n";
return undef;
}
$self->{xres} = $self->Caps(LOGPIXELSX);
$self->{yres} = $self->Caps(LOGPIXELSY);
$self->{xsize} = $self->_xp2un($self->Caps(PHYSICALWIDTH));
$self->{ysize} = $self->_yp2un($self->Caps(PHYSICALHEIGHT));
unless (($self->{xres} > 0) && ($self->{yres} > 0)) {
_croak "ERROR: Cannot get printer resolution! ${\_GetLastError()}";
return undef;
}
$self->{flags} = $self->{params}->{'dialog'};
if (($self->{flags} & PRINTTOFILE) || (defined($self->{params}->{'prompt'}))) {
my ($suggest, $indir) = ("", "");
if (defined($self->{params}->{'file'})) {
$suggest = $self->{params}->{'file'};
$suggest =~ s/(.*\\)//g;
$indir = $1 || "";
} elsif ((defined($self->{params}->{'description'})) and ($self->{params}->{'description'} ne "")) {
$suggest = $self->{params}->{'description'};
$suggest =~ s/[\"\*\/\:\<\>\?\\\|]|[\x00-\x1f]/-/g;
$suggest = reverse $suggest;
$suggest =~ s/^.*?\.//;
$suggest = reverse $suggest;
$suggest =~ s/\s\s//g;
} else {
$suggest = "Printer";
}
if (defined($self->{params}->{'pdf'})) {
my $ext = $self->{params}->{'file'} ? "" : ".pdf";
$self->{params}->{'file'} = _SaveAs(2, $suggest.$ext, $indir);
} else {
my $ext = $self->{params}->{'file'} ? "" : ".prn";
$self->{params}->{'file'} = _SaveAs(1, $suggest.$ext, $indir);
}
if ($self->{params}->{'file'} eq "") {
_croak "ERROR: Save to file failed! ${\_GetLastError()}";
return undef;
}
}
if ((defined($self->{params}->{'pdf'})) and (!defined($self->{params}->{'file'}))) {
delete $self->{params}->{'pdf'};
_carp qq^WARNING: pdf attribute used without file attribute - IGNORED!\n^;
}
$self->{copies} = $self->{params}->{'copies'};
$self->{collate} = $self->{params}->{'collate'};
$self->{minp} = $self->{params}->{'minp'};
$self->{maxp} = $self->{params}->{'maxp'};
if (!defined($self->{params}->{'dc'})) {
unless (defined($self->Start($self->{params}->{description}, $self->{params}->{'file'}))) {
_croak "ERROR: Cannot start default document!\n";
return undef;
}
}
unless (defined($self->Pen(1, 0, 0, 0))) {
_croak "ERROR: Cannot create default pen!\n";
return undef;
}
unless (defined($self->Color(0, 0, 0))) {
_croak "ERROR: Cannot set default color!\n";
return undef;
}
unless (defined($self->Brush(128, 128, 128))) {
_croak "ERROR: Cannot create default brush!\n";
return undef;
}
unless (defined($self->Font())) {
_croak "ERROR: Cannot create default font!\n";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub _num {
my $val = shift;
if (defined($val)) {
if ($val =~ /^\-*\d+\.*\d*$/) {
return 1;
} else {
$_numcroaked = 1;
_croak qq^ERROR: Argument "$val" isn't numeric!\n^;
return undef;
}
} else {
return 0;
}
}
#------------------------------------------------------------------------------#
sub _xun2p {
my $self = shift;
my $uval = shift;
return $uval if $self->{unit} == 0;
my $pval = $uval * $self->{xres} / $self->{unit};
return $pval;
}
sub _yun2p {
my $self = shift;
my $uval = shift;
return $uval if $self->{unit} == 0;
my $pval = $uval * $self->{yres} / $self->{unit};
return $pval;
}
sub _xp2un {
my $self = shift;
my $pval = shift;
return $pval if $self->{unit} == 0;
my $uval = ($self->{unit} * $pval) / $self->{xres};
return $uval;
}
sub _yp2un {
my $self = shift;
my $pval = shift;
return $pval if $self->{unit} == 0;
my $uval = ($self->{unit} * $pval) / $self->{yres};
return $uval;
}
sub _pts2p {
my $self = shift;
my $ptsval = shift;
return $ptsval if $self->{unit} == 0;
my $pval = ($ptsval * $self->{xres}) / 72;
return $pval;
}
sub _p2pts {
my $self = shift;
my $pval = shift;
return $pval if $self->{unit} == 0;
my $ptsval = (72 * $pval) / $self->{xres};
return $ptsval;
}
#------------------------------------------------------------------------------#
sub _pdf {
my $self = shift;
if ((defined($self->{params}->{'pdf'})) and (defined($self->{pdfend0}))) {
if ($self->{params}->{'pdf'} == 0) {
open OLDERR, ">&STDERR";
open STDERR, ">nul" or die;
}
if ($self->{params}->{'pdf'} == 1) {
open OLDERR, ">&STDERR" or die;
open STDERR, ">$self->{pdfend1}.log";
}
unless (Win32::Printer::_GhostPDF($self->{pdfend0}, $self->{pdfend1})) {
if (($self->{params}->{'pdf'} == 0) || ($self->{params}->{'pdf'} == 1)) {
close STDERR;
open STDERR, ">&OLDERR";
close OLDERR;
}
return 0;
}
if (($self->{params}->{'pdf'} == 0) || ($self->{params}->{'pdf'} == 1)) {
close STDERR;
open STDERR, ">&OLDERR";
close OLDERR;
}
unlink $self->{pdfend0};
undef $self->{pdfend0};
undef $self->{pdfend1};
}
return 1;
}
#------------------------------------------------------------------------------#
sub Unit {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
my $unit = shift;
if (defined($unit)) {
if ($unit eq "mm") {
$self->{unit} = 25.409836;
} elsif ($unit eq "cm") {
$self->{unit} = 2.5409836;
} elsif ($unit eq "in") {
$self->{unit} = 1;
} elsif ($unit eq "pt") {
$self->{unit} = 72;
} elsif ($unit =~ /^\d+\.*\d*$/i) {
$self->{unit} = $unit;
} else {
_carp "WARNING: Invalid unit \"$unit\"! Units set to \"in\".\n";
$self->{unit} = 1;
}
}
return $self->{unit};
}
#------------------------------------------------------------------------------#
sub Debug {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ == 0) {
$_numcroaked = 0;
_num($_[0]);
return undef if $_numcroaked;
if (($_[0] > -1) and ($_[0] < 3)) {
$_debuglevel = shift;
} else {
_croak "ERROR: Invalid argument!\n";
}
}
return $_debuglevel;
}
#------------------------------------------------------------------------------#
sub Next {
my $self = shift;
if ($self->{emfstate}) {
if ($#_ > -1) {
$self->{emfname} = shift;
$self->{emfw} = shift;
$self->{emfh} = shift;
}
return ($self->MetaEnd, $self->Meta($self->{emfname}, $self->{emfw}, $self->{emfh}));
} else {
if ($#_ > 1) { _carp "WARNING: Too many actual parameters!\n"; }
my $desc = shift;
my $file = shift;
my $ret = $self->End();
unless (defined($ret)) {
_croak "ERROR: Cannot end previous job!\n";
return undef;
}
unless (defined($self->Start($desc, $file))) {
_croak "ERROR: Cannot start next job!\n";
return undef;
}
return $ret;
}
}
#------------------------------------------------------------------------------#
sub Start {
my $self = shift;
if ($self->{emfstate}) {
_croak "ERROR: Starting document not allowed in EMF mode!\n";
return undef;
}
if ($#_ > 1) { _carp "WARNING: Too many actual parameters!\n"; }
my $desc = shift;
my $file = shift;
if ((!defined($file)) and (!defined($self->{params}->{'file'}))) {
$file = "";
} else {
if ((!defined($file)) and (defined($self->{params}->{'file'}))) {
$file = $self->{params}->{'file'};
}
while (-f $file) {
if ($file !~ s/(.*\\*)(.*)\((\d+)\)(.*)\./my $i = $3; $i++; "$1$2($i)."/e) {
$file =~ s/(.*\\*)(.*)\./$1$2(1)\./
}
$self->{params}->{'file'} = $file;
}
}
if (($file ne "") and (defined($self->{params}->{'pdf'}))) {
$self->{pdfend1} = $file;
my $tmp = Win32::Printer::_GetTempPath();
$file =~ s/.*\\//;
my $seed = join('', (0..9, 'A'..'Z', 'a'..'z')[rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62, rand 62]);
$file = $tmp.$file.".".$seed;
$self->{pdfend0} = $file;
}
unless (_StartDoc($self->{dc}, $desc || $self->{params}->{'description'} || 'Printer', $file) > 0) {
_croak "ERROR: Cannot start the document! ${\_GetLastError()}";
return undef;
}
unless (_StartPage($self->{dc}) > 0) {
_croak "ERROR: Cannot start the page! ${\_GetLastError()}";
return undef;
}
unless (defined($self->Space(1, 0, 0, 1, 0, 0))) {
_croak "ERROR: Cannot reset the document space!\n";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub End {
my $self = shift;
if ($self->{emfstate}) {
_croak "ERROR: Ending document not allowed in EMF mode!\n";
return undef;
}
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_EndPage($self->{dc}) > 0) {
_croak "ERROR: Cannot end the page! ${\_GetLastError()}";
return undef;
}
unless (_EndDoc($self->{dc})) {
_croak "ERROR: Cannot end the document! ${\_GetLastError()}";
return undef;
}
unless ($self->_pdf()) {
_croak "ERROR: Cannot create PDF document! ${\_GetLastError()}";
return undef;
}
if (defined($self->{params}->{'file'})) { return $self->{params}->{'file'}; }
return 1;
}
#------------------------------------------------------------------------------#
sub Abort {
my $self = shift;
if ($self->{emfstate}) {
_croak "ERROR: Aborting document not allowed in EMF mode!\n";
return undef;
}
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_AbortDoc($self->{dc})) {
_croak "ERROR: Cannot abort the document! ${\_GetLastError()}";
return undef;
}
if (defined($self->{params}->{'file'})) { return $self->{params}->{'file'}; }
return 1;
}
#------------------------------------------------------------------------------#
sub Page {
my $self = shift;
if ($self->{emfstate}) {
_croak "ERROR: Starting new page not allowed in EMF mode!\n";
return undef;
}
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_EndPage($self->{dc}) > 0) {
_croak "ERROR: Cannot end the page! ${\_GetLastError()}";
return undef;
}
unless (_StartPage($self->{dc}) > 0) {
_croak "ERROR: Cannot start the page! ${\_GetLastError()}";
return undef;
}
unless (defined($self->Space(1, 0, 0, 1, 0, 0))) {
_croak "ERROR: Cannot reset the page space!\n";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Space {
my $self = shift;
if (_IsNT()) {
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($m11, $m12, $m21, $m22, $dx, $dy) = @_;
my $xoff = $self->Caps(PHYSICALOFFSETX);
my $yoff = $self->Caps(PHYSICALOFFSETY);
unless (defined($xoff) && defined($yoff)) {
_croak "ERROR: Cannot get the physical offset!\n";
return undef;
}
if (_SetWorldTransform($self->{dc}, $m11, $m12, $m21, $m22, $self->_xun2p($dx) - $xoff, $self->_yun2p($dy) - $yoff) == 0) {
_croak "ERROR: Cannot transform space! ${\_GetLastError()}";
return undef;
}
}
return 1;
}
#------------------------------------------------------------------------------#
sub FontSpace {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
my $space = shift;
$_numcroaked = 0;
$space = 0 unless _num($space);
return undef if $_numcroaked;
my $return = _SetTextCharacterExtra($self->{dc}, $self->_pts2p($space));
if ($return == 0x80000000) {
_croak "ERROR: Cannot change font spacing! ${\_GetLastError()}";
return undef;
}
return $self->_p2pts($return);
}
#------------------------------------------------------------------------------#
sub Font {
my $self = shift;
if ($#_ > 3) { _carp "WARNING: Too many actual parameters!\n"; }
if (($#_ == 0) and _IsNo($_[0])) {
my $prefont;
unless ($prefont = _SelectObject($self->{dc}, $_[0])) {
_croak "ERROR: Cannot select font! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($_[0], $prefont) : $_[0];
} else {
my ($face, $size, $angle, $charset) = @_;
my ($escape, $orient);
if (defined $angle) {
if ($angle =~ /^ARRAY/) {
$escape = $$angle[0];
$orient = $$angle[1];
} else {
$escape = $angle;
$orient = $angle;
}
}
$_numcroaked = 0;
$face = '' if !defined $face;
$size = 10 unless _num($size);
$escape = 0 unless _num($escape);
$orient = 0 unless _num($orient);
$charset = 1 unless _num($charset);
return undef if $_numcroaked;
my $fontid = "$face\_$size\_$escape\_$orient\_$charset";
if (!$self->{obj}->{$fontid}) {
$escape *= 10;
$orient *= 10;
my ($opt1, $opt2, $opt3, $opt4) = (FW_NORMAL, 0, 0, 0);
if ($face =~ s/ bold//i ) {
$opt1 = FW_BOLD;
}
if ( $face =~ s/ italic//i ){
$opt2 = 1;
}
if ( $face =~ s/ underline//i ){
$opt3 = 1;
}
if ( $face =~ s/ strike//i ){
$opt4 = 1;
}
$face =~ s/^\s*//;
$face =~ s/\s*$//;
$self->{obj}->{$fontid} = _CreateFont($self->_pts2p($size), $escape, $orient, $opt1, $opt2, $opt3,
$opt4, $charset, $face);
if ($self->{obj}->{$fontid}) {
my $prefont;
unless ($prefont = _SelectObject($self->{dc}, $self->{obj}->{$fontid})) {
_croak "ERROR: Cannot select font! ${\_GetLastError()}";
return undef;
}
my $realface = _GetTextFace($self->{dc});
if (($face) && ($realface !~ /^$face$/)) {
_carp "WARNING: Cannot select desired font face - \"$realface\" selected!\n";
}
return wantarray ? ($self->{obj}->{$fontid}, $prefont) : $self->{obj}->{$fontid};
} else {
_croak "ERROR: Cannot create font! ${\_GetLastError()}";
return undef;
}
} else { # Fix by Sandor Patocs;
my $prefont;
unless ($prefont = _SelectObject($self->{dc}, $self->{obj}->{$fontid})) {
_croak "ERROR: Cannot select font! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($self->{obj}->{$fontid}, $prefont) : $self->{obj}->{$fontid};
}
}
}
#------------------------------------------------------------------------------#
sub FontEnum {
my $self = shift;
if ($#_ > 1) { _carp "WARNING: Too many actual parameters!\n"; }
my ($face, $charset) = @_;
$face = '' if !defined $face;
$charset = 1 unless _num($charset);
my $return = _FontEnum($self->{dc}, $face, $charset);
if (wantarray) {
my @return;
my @lines = split(/\n/, $return);
for my $i (0..$#lines) {
(
$return[$i]{Face},
$return[$i]{Charset},
$return[$i]{Style},
$return[$i]{Type}
) = split(/\t/, $lines[$i]);
}
return @return;
} else {
return $return;
}
}
#------------------------------------------------------------------------------#
sub Fit {
my $self = shift;
if ($#_ > 2) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 0) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
my $string = shift;
my $ext = shift;
my $vers = shift;
$_numcroaked = 0;
_num($ext);
$vers = 0 unless _num($vers);
return undef if $_numcroaked;
if ($vers & 0x40000000) {
$vers = 1;
}
$ext = $self->_xun2p($ext);
my ($fit, $cx, $cy) = (0, 0, 0);
unless (_GetTextExtentPoint($vers, $self->{dc}, $string, $ext, $fit, $cx, $cy)) {
_croak "ERROR: Cannot get text extent! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($fit, $self->_xp2un($cx), $self->_yp2un($cy)) : $fit;
}
#------------------------------------------------------------------------------#
sub Write {
my $self = shift;
if ($#_ > 6) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 2) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
if (!defined($_[0]) || ($_[0] eq '')) {
return wantarray ? (0, 0, 0, '') : 0;
}
if ((($#_ > 1) and ($#_ < 4)) or (($_[3] & 0x80000000) and ($#_ == 4))) {
my ($string, $x, $y, $align) = @_;
unless (defined($string)) { $string = ''; }
$_numcroaked = 0;
for ($x, $y, $align) {
_num($_);
}
return undef if $_numcroaked;
unless ($align) { $align = LEFT; }
if ($align & 0x00020000) { $align = $align & ~0x00020000 | 0x00000100; }
if ($align & 0x00080000) { $align = $align & ~0x00080000 | 0x00000006; }
my $vers = 0;
if ($align & 0x40000000) {
$align &= ~0x40000000;
$vers = 1;
}
if ($align & 0x80000000) {
unless(_num($_[4])) {
_croak "ERROR: Cannot set text justification! Wrong justification width\n";
return undef;
}
my $width = $self->_xun2p($_[4]);
unless (_SetJustify($vers, $self->{dc}, $string, $width)) {
_croak "ERROR: Cannot set text justification! ${\_GetLastError()}";
return undef;
}
}
my ($retval, $retw, $reth);
unless ($retval = _TextOut($vers, $self->{dc}, $self->_xun2p($x), $self->_yun2p($y), $string, $align & ~0x80000000)) {
_croak "ERROR: Cannot write text! ${\_GetLastError()}";
return undef;
}
$retw = 0x0000FFFF & $retval;
$reth = (0xFFFF0000 & $retval) >> 16;
if ($align & 0x80000000) {
unless (_SetJustify($vers, $self->{dc}, "", -1)) {
_croak "ERROR: Cannot unset text justification! ${\_GetLastError()}";
return undef;
}
}
return wantarray ? ($self->_xp2un($retw), $self->_yp2un($reth)) : $self->_yp2un($reth);
} else {
my ($string, $x, $y, $w, $h, $f, $tab) = @_;
unless (defined($string)) { $string = ''; }
$_numcroaked = 0;
for ($x, $y, $w, $h, $f, $tab) {
_num($_);
}
$f = 0 unless _num($f);
$tab = 8 unless _num($tab);
return undef if $_numcroaked;
my $height;
my $len = 0;
my $width = $self->_xun2p($x + $w);
if ($f & 0x00080000) { $f = $f & ~0x00080000 | 0x00000001; }
my $vers = 0;
if ($f & 0x40000000) {
$f &= ~0x40000000;
$vers = 1;
}
$height = _DrawText($vers, $self->{dc}, $string,
$self->_xun2p($x), $self->_yun2p($y),
$width, $self->_yun2p($y + $h),
$f, $len, $tab);
unless ($height) {
_croak "ERROR: Cannot draw text! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($self->_xp2un($width), $self->_yp2un($height), $len, $string) : $self->_yp2un($height);
}
}
#------------------------------------------------------------------------------#
sub Write2 {
my $self = shift;
if ($#_ > 8) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 3) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
my $text = shift;
my ($x, $y, $w, $flags, $indento, $hspace, $vspace) = @_;
unless (defined($text)) { $text = ''; }
$_numcroaked = 0;
for ($x, $y, $w) {
_num($_);
}
$flags = 0 unless _num($flags);
$indento = 0 unless _num($indento);
$hspace = 0 unless _num($hspace);
$vspace = 0 unless _num($vspace);
return undef if $_numcroaked;
my @rows = split(/\n/, $text);
my ($lf, $proctext) = (0, '');
my ($vers, $len, $wi, $he) = (0, 0, 0, 0);
if ($flags & 0x40000000) {
$flags &= ~0x40000000;
$vers = 1;
}
unless (_GetTextExtentPoint($vers, $self->{dc}, 'W', 1, $len, $wi, $he)) {
_croak "ERROR: Cannot get text extent! ${\_GetLastError()}";
return undef;
}
my $return = _SetTextCharacterExtra($self->{dc}, $self->_pts2p($hspace));
if ($return == 0x80000000) {
_croak "ERROR: Cannot change font spacing! ${\_GetLastError()}";
return undef;
}
if ($flags & 0x00080000) {
$x += $w / 2;
$indento = 0;
} elsif ($flags & 0x00000002) {
$x += $w;
$indento = 0;
}
my $out_wi = 0;
for my $row (@rows) {
my $indent = $indento;
if ($row eq '') {
$lf += $he;
$proctext .= "\n";
next;
}
while (length($row)) {
unless (_GetTextExtentPoint($vers, $self->{dc}, $row, $self->_xun2p($w - $indent), $len, $wi, $he)) {
_croak "ERROR: Cannot get text extent! ${\_GetLastError()}";
return undef;
}
if ($out_wi < $wi) {
$out_wi = $wi;
}
my $corr = 0;
my $rowenta = substr($row, 0, $len);
if ($len < length($row)) {
$rowenta =~ s/\s$//;
$rowenta = reverse($rowenta);
$rowenta =~ s/^\S+?([\s\-])/defi($1, \$corr)/e;
$rowenta = reverse($rowenta);
if ($flags & 0x80000000) {
unless (_SetJustify($vers, $self->{dc}, $rowenta, $self->_xun2p($w))) {
_croak "ERROR: Cannot set text justification! ${\_GetLastError()}";
return undef;
}
}
}
unless (_TextOut($vers, $self->{dc}, $self->_xun2p($x + $indent), $self->_yun2p($y) + $lf, $rowenta, $flags & ~0x80000000)) {
_croak "ERROR: Cannot write text! ${\_GetLastError()}";
return undef;
}
$lf += $he + $self->_yun2p($vspace);
if ($flags & 0x80000000) {
unless (_SetJustify($vers, $self->{dc}, "", -1)) {
_croak "ERROR: Cannot unset text justification! ${\_GetLastError()}";
return undef;
}
$out_wi = $self->_xun2p($w);
}
$proctext .= $rowenta."\n";
$row = substr($row, length($rowenta) + $corr);
$indent = 0;
}
}
return wantarray ? ($self->_xp2un($out_wi), $self->_yp2un($lf), $proctext) : $self->_yp2un($lf);
#--------------------
sub defi {
if ($_[0] eq "-") {
${$_[1]} = 0;
return "-";
} else {
${$_[1]} = 1;
return "";
}
}
#--------------------
}
#------------------------------------------------------------------------------#
sub Pen {
my $self = shift;
if (($#_ == 0) and _IsNo($_[0])) {
my $handle = shift;
my $prepen = _SelectObject($self->{dc}, $handle);
unless ($prepen) {
_croak "ERROR: Cannot select pen! ${\_GetLastError()}";
return undef;
}
return $prepen;
} else {
my $penid = "pen";
if ($#_ == -1) {
if (!$self->{obj}->{$penid}) {
$self->{obj}->{$penid} = _CreatePen(PS_NULL, 0, 0, 0, 0);
unless ($self->{obj}->{$penid}) {
_croak "ERROR: Cannot create pen! ${\_GetLastError()}";
return undef;
}
}
} else {
if ($#_ > 4) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 3) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
my ($w, $r, $g, $b, $s) = @_;
$_numcroaked = 0;
for ($w, $r, $g, $b, $s) {
_num($_);
}
return undef if $_numcroaked;
if (!defined($s)) { $s = PS_SOLID; }
if (0x00010000 & $s) {
$w = $self->_pts2p($w);
} else {
$w = 1;
}
$penid = "$w\_$r\_$g\_$b\_$s";
if (!$self->{obj}->{$penid}) {
$self->{obj}->{$penid} = _CreatePen($s, $w, $r, $g, $b);
unless ($self->{obj}->{$penid}) {
_croak "ERROR: Cannot create pen! ${\_GetLastError()}";
return undef;
}
}
}
my $prepen = _SelectObject($self->{dc}, $self->{obj}->{$penid});
unless ($prepen) {
_croak "ERROR: Cannot select pen! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($self->{obj}->{$penid}, $prepen) : $self->{obj}->{$penid};
}
}
#------------------------------------------------------------------------------#
sub Color {
my $self = shift;
if (($#_ != 0) && ($#_ != 2)) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my $thecolor;
if ($#_ == 0) {
$thecolor = shift;
} else {
my ($r, $g, $b) = @_;
$thecolor = ((($b << 8) | $g) << 8) | $r;
}
my $coloref = _SetTextColor($self->{dc}, $thecolor);
if ($coloref =~ /-/) {
_croak "ERROR: Cannot select color! ${\_GetLastError()}";
return undef;
}
return $coloref;
}
#------------------------------------------------------------------------------#
sub Brush {
my $self = shift;
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
if (($#_ == 0) and _IsNo($_[0])) {
my $handle = shift;
my $prebrush = _SelectObject($self->{dc}, $handle);
unless ($prebrush) {
_croak "ERROR: Cannot select brush! ${\_GetLastError()}";
return undef;
}
return $prebrush;
} else {
my ($r, $g, $b, $hs) = @_;
my ($bs, $brushid);
$brushid = "brush";
if (!defined($r)) {
if (!$self->{obj}->{$brushid}) {
$self->{obj}->{$brushid} = _CreateBrushIndirect(BS_NULL, 0, 255, 255, 255);
unless ($self->{obj}->{$brushid}) {
_croak "ERROR: Cannot create brush! ${\_GetLastError()}";
return undef;
}
}
} else {
if ($#_ > 3) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 2) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
if (defined($hs)) {
$bs = BS_HATCHED;
} else {
$bs = BS_SOLID;
$hs = 0;
}
$brushid = "$r\_$g\_$b\_$hs";
if (!$self->{obj}->{$brushid}) {
$self->{obj}->{$brushid} = _CreateBrushIndirect($bs, $hs, $r, $g, $b);
unless ($self->{obj}->{$brushid}) {
_croak "ERROR: Cannot create brush! ${\_GetLastError()}";
return undef;
}
}
}
my $prebrush = _SelectObject($self->{dc}, $self->{obj}->{$brushid});
unless ($prebrush) {
_croak "ERROR: Cannot select brush! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($self->{obj}->{$brushid}, $prebrush) : $self->{obj}->{$brushid};
}
}
#------------------------------------------------------------------------------#
sub Fill {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 0) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
my $fmode = shift;
$_numcroaked = 0;
_num($fmode);
return undef if $_numcroaked;
unless (_SetPolyFillMode($self->{dc}, $fmode)) {
_croak "ERROR: Cannot select brush! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Rect {
my $self = shift;
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 3) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h, $ew, $eh) = @_;
if ($ew) {
if (!$eh) { $eh = $ew; }
unless (_RoundRect($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h),
$self->_xun2p($ew), $self->_yun2p($eh))) {
_croak "ERROR: Cannot draw rectangular! ${\_GetLastError()}";
return undef;
}
} else {
unless (_Rectangle($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h))) {
_croak "ERROR: Cannot draw rectangular! ${\_GetLastError()}";
return undef;
}
}
return 1;
}
#------------------------------------------------------------------------------#
sub Ellipse {
my $self = shift;
if ($#_ > 3) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 3) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h) = @_;
unless (_Ellipse($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h))) {
_croak "ERROR: Cannot draw ellipse! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Chord {
my $self = shift;
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h, $a1, $a2) = @_;
my $r1 = $w / 2;
my $r2 = $h / 2;
my $xc = $x + $r1;
my $yc = $y + $r2;
my $pi = 3.1415926535;
my $rm1 = sqrt(abs(($r1 * $r1 * $r2 * $r2) / ($r1 * $r1 * sin($a1 * $pi / 180) + $r2 * $r2 * cos($a1 * $pi / 180))));
my $rm2 = sqrt(abs(($r1 * $r1 * $r2 * $r2) / ($r1 * $r1 * sin($a2 * $pi / 180) + $r2 * $r2 * cos($a2 * $pi / 180))));
my $xr1 = $xc + cos($a1 * $pi / 180) * $rm1;
my $yr1 = $yc - sin($a1 * $pi / 180) * $rm1;
my $xr2 = $xc + cos($a2 * $pi / 180) * $rm2;
my $yr2 = $yc - sin($a2 * $pi / 180) * $rm2;
unless (_Chord($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h),
$self->_xun2p($xr1), $self->_yun2p($yr1),
$self->_xun2p($xr2), $self->_yun2p($yr2))) {
_croak "ERROR: Cannot draw chord! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Pie {
my $self = shift;
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h, $a1, $a2) = @_;
my $xc = $x + $w / 2;
my $yc = $y + $h / 2;
my $pi=3.1415926535;
my $xr1 = $xc + int(100 * cos($a1 * $pi / 180));
my $yr1 = $yc - int(100 * sin($a1 * $pi / 180));
my $xr2 = $xc + int(100 * cos($a2 * $pi / 180));
my $yr2 = $yc - int(100 * sin($a2 * $pi / 180));
unless (_Pie($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h),
$self->_xun2p($xr1), $self->_yun2p($yr1),
$self->_xun2p($xr2), $self->_yun2p($yr2))) {
_croak "ERROR: Cannot draw pie! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Move {
my $self = shift;
if ($#_ > 1) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 1) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y) = @_;
$x = $self->_xun2p($x);
$y = $self->_yun2p($y);
unless (_MoveTo($self->{dc}, $x, $y)) {
_croak "ERROR: Cannot Move! ${\_GetLastError()}";
return undef;
}
return ($self->_xp2un($x), $self->_yp2un($y));
}
#------------------------------------------------------------------------------#
sub Arc {
my $self = shift;
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h, $a1, $a2) = @_;
my $xc = $x + $w / 2;
my $yc = $y + $h / 2;
my $pi = 3.1415926535;
my $xr1 = $xc + int(100 * cos($a1 * $pi / 180));
my $yr1 = $yc - int(100 * sin($a1 * $pi / 180));
my $xr2 = $xc + int(100 * cos($a2 * $pi / 180));
my $yr2 = $yc - int(100 * sin($a2 * $pi / 180));
unless (_Arc($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h),
$self->_xun2p($xr1), $self->_yun2p($yr1),
$self->_xun2p($xr2), $self->_yun2p($yr2))) {
_croak "ERROR: Cannot draw arc! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub ArcTo {
my $self = shift;
if ($#_ > 5) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my ($x, $y, $w, $h, $a1, $a2) = @_;
my $xc = $x + $w / 2;
my $yc = $y + $h / 2;
my $pi=3.1415926535;
my $xr1 = $xc + int(100 * cos($a1*$pi/180));
my $yr1 = $yc - int(100 * sin($a1*$pi/180));
my $xr2 = $xc + int(100 * cos($a2*$pi/180));
my $yr2 = $yc - int(100 * sin($a2*$pi/180));
unless (_ArcTo($self->{dc}, $self->_xun2p($x), $self->_yun2p($y),
$self->_xun2p($x + $w), $self->_yun2p($y + $h),
$self->_xun2p($xr1), $self->_yun2p($yr1),
$self->_xun2p($xr2), $self->_yun2p($yr2))) {
_croak "ERROR: Cannot draw arc! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Line {
my $self = shift;
if ($#_ < 3) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my (@args) = @_;
my $cnt = 1;
@args = map { $cnt++%2 ? $self->_yun2p($_) : $self->_xun2p($_) } @args;
unless (_Polyline($self->{dc}, @args)) {
_croak "ERROR: Cannot draw line! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub LineTo {
my $self = shift;
if ($#_ < 1) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my (@args) = @_;
my ($cnt) = 1;
@args = map { $cnt++%2 ? $self->_yun2p($_) : $self->_xun2p($_) } @args;
unless (_PolylineTo($self->{dc}, @args)) {
_croak "ERROR: Cannot draw line! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Poly {
my $self = shift;
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my (@args) = @_;
my ($cnt) = 1;
@args = map { $cnt++%2 ? $self->_yun2p($_) : $self->_xun2p($_) } @args;
unless (_Polygon($self->{dc}, @args)) {
_croak "ERROR: Cannot draw polygon! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub Bezier {
my $self = shift;
if ($#_ < 7) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my (@args) = @_;
my ($cnt) = 1;
@args = map { $cnt++%2 ? $self->_yun2p($_) : $self->_xun2p($_) } @args;
unless (_PolyBezier($self->{dc}, @args)) {
_croak "ERROR: Cannot draw polybezier! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub BezierTo {
my $self = shift;
if ($#_ < 5) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
$_numcroaked = 0;
for (@_) { _num($_); }
return undef if $_numcroaked;
my (@args) = @_;
my ($cnt) = 1;
@args = map { $cnt++%2 ? $self->_yun2p($_) : $self->_xun2p($_) } @args;
unless (_PolyBezierTo($self->{dc}, @args)) {
_croak "ERROR: Cannot draw polybezier! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub PBegin {
my $self = shift;
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_BeginPath($self->{dc})) {
_croak "ERROR: Cannot begin path! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub PAbort {
my $self = shift;
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_AbortPath($self->{dc})) {
_croak "ERROR: Cannot abort path! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub PEnd {
my $self = shift;
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_EndPath($self->{dc})) {
_croak "ERROR: Cannot end path! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub PDraw {
my $self = shift;
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
unless (_StrokeAndFillPath($self->{dc})) {
_croak "ERROR: Cannot draw path! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub PClip {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ < 0) {
_croak "ERROR: Not enough actual parameters!\n";
}
my $mode = shift;
$_numcroaked = 0;
_num($mode);
return undef if $_numcroaked;
if ($mode == CR_OFF) {
unless (_DeleteClipPath($self->{dc})) {
_croak "ERROR: Cannot remove clip path! ${\_GetLastError()}";
return undef;
}
return 1;
}
unless (_SelectClipPath($self->{dc}, $mode)) {
_croak "ERROR: Cannot create clip path! ${\_GetLastError()}";
return undef;
}
return 1;
}
#------------------------------------------------------------------------------#
sub EBbl {
my $self = shift;
if ($#_ < 0) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
if ($#_ > 5) {
_carp "WARNING: Too many actual parameters!\n";
}
my ($string, $x, $y, $flags, $baw, $bah) = @_;
$_numcroaked = 0;
unless(_num($x)) { $x = 0; }
unless(_num($y)) { $y = 0; }
unless(_num($flags)) { $flags = EB_128SMART | EB_TXT; }
unless(_num($baw)) { $baw = 0.54; }
unless(_num($bah)) { $bah = 20; }
return undef if $_numcroaked;
my $emf = ($flags & EB_EMF) ? 1 : 0;
my $error = _EBbl($self->{dc}, $emf, $string, $self->_xun2p($x), $self->_yun2p($y), $flags & ~EB_EMF, $self->_pts2p($baw), $self->_pts2p($bah));
unless ($error == 0) {
my @errmessage;
$errmessage[1] = "Select barcode standard!\n";
$errmessage[2] = "Unsupported character in barcode string!\n";
$errmessage[4] = "Wrong barcode string size!\n";
$errmessage[8] = "GDI error!\n";
$errmessage[16] = "Memory allocation error!\n";
$errmessage[32] = "Unknown error!\n";
$errmessage[64] = "Could not load ebbl!\n";
_croak "ERROR: ".$errmessage[$error];
return undef;
}
if ($flags & EB_EMF) {
if ($emf == 0) {
_croak "ERROR: Cannot draw barcode! ${\_GetLastError()}";
return undef;
}
$self->{imager}->{$emf} = 0;
}
return $emf;
}
#------------------------------------------------------------------------------#
sub Image {
my $self = shift;
if (($#_ != 0) and ($#_ != 2) and ($#_ != 4)) {
_croak "ERROR: Wrong number of parameters!\n";
return undef;
}
my ($width, $height) = (0, 0);
if (($#_ == 2) or ($#_ == 4)) {
my ($fileorref, $x, $y, $w, $h) = @_;
if (!_IsNo($fileorref)) {
$fileorref = $self->Image($fileorref);
unless (defined($fileorref)) { return undef; }
}
_GetEnhSize($self->{dc}, $fileorref, $width, $height, $self->{unit});
$width = $self->_xp2un($width);
$height = $self->_yp2un($height);
if ((!defined($w)) or ($w == 0)) { $w = $width; }
if ((!defined($h)) or ($h == 0)) { $h = $height; }
unless (_PlayEnhMetaFile($self->{dc}, $fileorref, $self->_xun2p($x), $self->_yun2p($y), $self->_xun2p($x + $w), $self->_yun2p($y + $h))) {
_croak "ERROR: Cannot display metafile! ${\_GetLastError()}";
return undef;
}
return wantarray ? ($fileorref, $width, $height) : $fileorref;
} else {
my $file = shift;
if (_IsNo($file)) {
_GetEnhSize($self->{dc}, $file, $width, $height, $self->{unit});
$width = $self->_xp2un($width);
$height = $self->_yp2un($height);
return ($width, $height);
}
if (defined($self->{imagef}->{$file})) {
_GetEnhSize($self->{dc}, $self->{imagef}->{$file}, $width, $height, $self->{unit});
$width = $self->_xp2un($width);
$height = $self->_yp2un($height);
return wantarray ? ($self->{imagef}->{$file}, $width, $height) : $self->{imagef}->{$file};
}
my $fref;
if ($file =~ /.emf$/) {
$fref = _GetEnhMetaFile($file);
unless ($fref) {
_croak "ERROR: Cannot load metafile! ${\_GetLastError()}";
return undef;
}
} elsif ($file =~ /.wmf$/) {
$fref = _GetWinMetaFile($self->{dc}, $file);
unless ($fref) {
_croak "ERROR: Cannot load metafile! ${\_GetLastError()}";
return undef;
}
} else {
$fref = _LoadBitmap($self->{dc}, $file, -1, $self->{unit});
unless ($fref) {
_croak "ERROR: Cannot load bitmap! ${\_GetLastError()}";
return undef;
}
}
$self->{imager}->{$fref} = $file;
$self->{imagef}->{$file} = $fref;
_GetEnhSize($self->{dc}, $fref, $width, $height, $self->{unit});
$width = $self->_xp2un($width);
$height = $self->_yp2un($height);
return wantarray ? ($fref, $width, $height) : $fref;
}
}
#------------------------------------------------------------------------------#
sub Meta {
my $self = shift;
if ($#_ > 2) { _carp "WARNING: Too many actual parameters!\n"; }
if ($self->{emfstate}) {
_croak qq^ERROR: There is allready started EMF!\n^;
}
my $fname = shift;
my $width = shift;
my $height = shift;
if ($fname) {
my $prompt;
if ($fname =~ s/^FILE://i) { $prompt = 1; }
$fname =~ s/\//\\/g;
while (-f $fname) {
if ($fname !~ s/(.*\\*)(.*)\((\d+)\)(.*)\./my $i = $3; $i++; "$1$2($i)."/e) {
$fname =~ s/(.*\\*)(.*)\./$1$2(1)\./
}
}
my $file = $fname;
$file =~ s/(.*\\)//g;
my $dir = $1;
unless ($dir) { $dir = '.\\'; }
if ($prompt) {
$fname = _SaveAs(3, $file, $dir);
}
if (($file =~ /[\"\*\/\:\<\>\?\\\|]|[\x00-\x1f]/) or (!(-d $dir))) {
_croak "ERROR: Cannot create printer object! Invalid filename\n";
return undef;
}
} else {
$fname = "";
}
$_numcroaked = 0;
_num($width);
_num($height);
return undef if $_numcroaked;
if (!defined($width) or !defined($height)) {
$width = 0;
$height = 0;
} else {
$self->{emfw} = $width;
$self->{emfh} = $height;
}
if (($width > 0) and ($height > 0)) {
if (defined($self->{params}->{'unit'})) {
if ($self->{params}->{'unit'} eq "mm") {
$width *= 100;
$height *= 100;
} elsif ($self->{params}->{'unit'} eq "cm") {
$width *= 1000;
$height *= 1000;
} elsif ($self->{params}->{'unit'} eq "pt") {
$width *= 2540.9836 / 72;
$height *= 2540.9836 / 72;
} elsif ($self->{params}->{'unit'} =~ /^\d+\.*\d*$/i) {
$width *= 2540.9836 / $self->{params}->{'unit'};
$height *= 2540.9836 / $self->{params}->{'unit'};
} else {
$width *= 2540.9836;
$height *= 2540.9836;
}
} else {
$width *= 2540.9836;
$height *= 2540.9836;
}
} elsif (($width < 0) and ($height < 0)) {
_croak qq^ERROR: height, width must be positive values!\n^;
}
my $meta = _CreateMeta($self->{dc}, $fname, $width, $height);
if ($meta) {
$self->{emfstate} = 1;
$self->{dc} = $meta;
} else {
_croak "ERROR: Cannot begin EMF! ${\_GetLastError()}";
return undef;
}
if (_CopyTextColor($self->{odc}, $self->{dc}) =~ /-/) {
_croak "ERROR: Cannot set default color!\n";
return undef;
}
unless (_CopyObject($self->{odc}, $self->{dc}, 1)) {
_croak "ERROR: Cannot select pen!\n";
return undef;
}
unless (_CopyObject($self->{odc}, $self->{dc}, 2)) {
_croak "ERROR: Cannot select brush!\n";
return undef;
}
unless (_CopyObject($self->{odc}, $self->{dc}, 6)) {
_croak "ERROR: Cannot select font!\n";
return undef;
}
$self->{emfname} = $fname;
return $fname;
}
#------------------------------------------------------------------------------#
sub MetaEnd {
my $self = shift;
if ($#_ > -1) { _carp "WARNING: Too many actual parameters!\n"; }
if (!$self->{emfstate}) {
_croak qq^ERROR: There is no beginning of the EMF!\n^;
}
my $return = _CloseMeta($self->{dc});
if ($return) {
$self->{emfstate} = 0;
$self->{dc} = $self->{odc};
$self->{imager}->{$return} = 0;
my ($width, $height) = (0, 0);
_GetEnhSize($self->{dc}, $return, $width, $height, $self->{unit});
$width = $self->_xp2un($width);
$height = $self->_yp2un($height);
return wantarray ? ($return, $width, $height) : $return;
} else {
_croak "ERROR: Cannot end EMF! ${\_GetLastError()}";
return undef;
}
}
#------------------------------------------------------------------------------#
sub Caps {
my $self = shift;
if ($#_ < 0) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
if ($#_ > 0) {
_carp "WARNING: Too many actual parameters!\n";
return undef;
}
my $index = shift;
$_numcroaked = 0;
_num($index);
return undef if $_numcroaked;
return _GetDeviceCaps($self->{dc}, $index);
}
#------------------------------------------------------------------------------#
sub Close {
my $self = shift;
if ($#_ > 0) { _carp "WARNING: Too many actual parameters!\n"; }
if ($#_ == 0) {
if (_IsNo($_[0])) {
if (_DeleteEnhMetaFile($_[0])) {
delete $self->{imagef}->{$self->{imager}->{$_[0]}};
delete $self->{imager}->{$_[0]};
}
} else {
if (my $file = _DeleteEnhMetaFile($self->{imagef}->{$_[0]})) {
delete $self->{imagef}->{$_[0]};
delete $self->{imager}->{$file};
}
}
} else {
$self->MetaEnd() if $self->{emfstate};
for (keys %{$self->{obj}}) {
_DeleteObject($self->{obj}->{$_});
}
for (keys %{$self->{imager}}) {
_DeleteEnhMetaFile($_);
}
if ($self->{dc}) {
_EndPage($self->{dc});
if (_EndDoc($self->{dc}) > 0) {
unless($self->_pdf()) {
_croak "ERROR: Cannot create PDF document! ${\_GetLastError()}";
return undef;
}
}
_DeleteDC($self->{dc});
}
undef $self->{dc};
if (defined($self->{params}->{'file'})) { return $self->{params}->{'file'}; }
}
return 1;
}
#------------------------------------------------------------------------------#
sub Inject {
my $self = shift;
if ($#_ != 2) {
_croak "ERROR: Wrong number of parameters!\n";
return undef;
}
my ($point, $page, $data) = @_;
$_numcroaked = 0;
_num($point);
_num($page);
return undef if $_numcroaked;
_Inject($self->{dc}, $point, $page, $data);
return 1;
}
#------------------------------------------------------------------------------#
sub ImageSave {
my $self = shift;
if ($#_ < 1) {
_croak "ERROR: Not enough actual parameters!\n";
return undef;
}
if ($#_ > 6) {
_carp "WARNING: Too many actual parameters!\n";
return undef;
}
my ($handle, $fname, $bpp, $width, $height, $format, $flag) = @_;
$_numcroaked = 0;
_num($handle);
_num($format);
$bpp = 24 unless _num($bpp);
$flag= 0 unless _num($flag);
$format= -1 unless _num($format);
if (!_num($width) || !_num($height) || ($width <= 0) || ($height <= 0)) {
$width = 0;
$height = 0;
_GetEnhSize($self->{dc}, $handle, $width, $height, $self->{unit});
}
return undef if $_numcroaked;
my $prompt;
if ($fname =~ s/^FILE://i) { $prompt = 1; }
$fname =~ s/\//\\/g;
while (-f $fname) {
if ($fname !~ s/(.*\\*)(.*)\((\d+)\)(.*)\./my $i = $3; $i++; "$1$2($i)."/e) {
$fname =~ s/(.*\\*)(.*)\./$1$2(1)\./
}
}
my $file = $fname;
$file =~ s/(.*\\)//g;
my $dir = $1;
unless ($dir) { $dir = '.\\'; }
if ($prompt) {
$fname = _SaveAs(4, $file, $dir);
}
if (($file =~ /[\"\*\/\:\<\>\?\\\|]|[\x00-\x1f]/) or (!(-d $dir))) {
_croak "ERROR: Cannot create printer object! Invalid filename\n";
return undef;
}
my $rerr = _EmfH2BMP($self->{dc}, $handle, $fname, $width, $height, $format, $flag, $bpp);
if ($rerr == 1) {
return $fname;
} elsif ($rerr == 0) {
_croak "ERROR: Cannot save image! ${\_GetLastError()}";
} elsif ($rerr == -1) {
_croak "ERROR: Cannot save image! (Unable to guess filetype)\n";
} elsif ($rerr == -2) {
_croak "ERROR: Cannot save image! (Bits not supported)\n";
} elsif ($rerr == -3) {
_croak "ERROR: Cannot save image! (Image format not supported)\n";
}
return undef;
}
#------------------------------------------------------------------------------#
sub DESTROY {
my $self = shift;
if ($self->{dc}) {
_AbortDoc($self->{dc});
$self->Close();
}
return 1;
}
#------------------------------------------------------------------------------#
1;
__END__
=head1 NAME
Win32::Printer - Perl extension for Win32 printing
=head1 SYNOPSIS
use Win32::Printer;
my $dc = new Win32::Printer(
papersize => A4,
dialog => NOSELECTION,
description => 'Hello, Mars!',
unit => 'mm'
);
my $font = $dc->Font('Arial Bold', 24);
$dc->Font($font);
$dc->Color(0, 0, 255);
$dc->Write("Hello, Mars!", 10, 10);
$dc->Brush(128, 0, 0);
$dc->Pen(4, 0, 0, 128);
$dc->Ellipse(10, 25, 50, 50);
$dc->Close();
=head1 ABSTRACT
DISCONTINUED!!! Win32 GDI graphical printing
If You are desperate to find me You can try to to do it through CPAN!
=head1 INSTALLATION
=head2 Source installation
B<1.> Make sure you have a C/C++ compiler and you're running Win32.
B<2.> For VC++ 6.0 or VC++ .NET do the following (others not tested):
> perl Makefile.PL
> nmake
> nmake test
> nmake install
B<3.> For bitmap support, copy I<FreeImage.dll> somewhere in your system path.
You may get this library form I<http://sourceforge.net>.
B<4.> For PDF support, install I<Ghostscript> and set path to it's B<\bin>
directory. You may get this PostScript interpreter form
I<http://sourceforge.net>.
B<5.> For Barcode support, install B<I<ebbl>>. DISCONTINUED!!!
B<6.> Enjoy it ;)
=head1 DESCRIPTION
B<All symbolic constants are exported by default!!!>
=head2 new
new Win32::Printer ( [ parameter => value, ... ] );
The B<new> class method creates printer object, starts new document (a print
job), returns printer object and changes B<$dc-E<gt>{flags}> variable.
B<$dc-E<gt>{flags}> contains modified printer dialog flags. B<new> also sets
B<$dc-E<gt>{copies}>, B<$dc-E<gt>{collate}>, B<$dc-E<gt>{maxp}> and
B<$dc-E<gt>{minp}>, B<$dc-E<gt>{xres}>, B<$dc-E<gt>{yres}>, B<$dc-E<gt>{xsize}>,
B<$dc-E<gt>{ysize}> variables.
$dc->{xres}; # X resolution
$dc->{yres}; # Y resolution
$dc->{xsize}; # X size in chosen units
$dc->{ysize}; # Y size in chosen units
B<NOTE!> Print job is automatically aborted if print job is not ended by
B<L</End>> or B<L</Close>> methods or if an error occurs!
The B<new> class method sets the following optional printer object and document
parameters:
=head3 collate
Specifies whether collation should be used when printing multiple copies. This
member can be be one of the following values:
0 - Do not collate when printing multiple copies.
1 - Collate when printing multiple copies (default).
Using B<collate> provides faster, more efficient output for collation, since
the data is sent to the device driver just once, no matter how many copies are
required. The printer is told to simply print the page again. If this flag is
set to 1 and print dialog is used, the B<Collate> check box is initially
checked.
B<$dc-E<gt>{collate}> variable shows if collation was required. You may use it
after print dialog to check user input.
If B<$dc-E<gt>{collate}> is set to 0 - You need to handle multiple copies by
yourself.
See also L</copies>.
=head3 color*
Switches between color and monochrome on color printers. Following are the
possible values:
MONOCHROME = 1
COLOR = 2
=head3 copies
Initial number of document copies to print. Used by dialog and/or printer
driver. B<$dc-E<gt>{collate}> variable shows how many copies were required.
See also L</collate>.
=head3 dc
If B<dc> defined- returns only device context without starting the document and
new page.
=head3 debug*
Set to:
0 - default;
1 - die on warnings;
2 - warn on errors (not recomended);
If debug level set to 2- methods return undef value on error.
MAY INTERFERE WITH DIFFERENT PRINTER OBJECTS!
See also L</Debug>.
=head3 description
Document description. Default is "Printer". It is used as document name,
filename suggestion and/or PDF document title;
=head3 dialog
If both B<L</printer>> and B<dialog> attributes omitted- systems B<default
printer> is used.
Printer dialog settings. You may use the combination of the following flags
(B<$dc-E<gt>{flags}> contains modified printer dialog flags):
ALLPAGES = 0x000000
The default flag that indicates that the B<All> radio button is initially
selected. This flag is used as a placeholder to indicate that the PAGENUMS and
SELECTION flags are not specified.
SELECTION = 0x000001
If this flag is set, the B<Selection> radio button is selected.
If neither PAGENUMS nor SELECTION is set, the B<All> radio button is selected.
PAGENUMS = 0x000002
If this flag is set, the Pages radio button is selected.
If this flag is set when the B<new> method returns, the B<$dc-E<gt>{maxp}> and
B<$dc-E<gt>{minp}> variables indicate the starting and ending pages specified by
the user.
NOSELECTION = 0x000004
Disables the B<Selection> radio button.
NOPAGENUMS = 0x000008
Disables the B<Pages> radio button and the associated edit controls.
PRINTTOFILE = 0x000020
If this flag is set, the B<Print to File> check box is selected.
PRINTSETUP = 0x000040
Causes the system to display the B<Print Setup> dialog box rather than the
B<Print> dialog box.
NOWARNING = 0x000080
Prevents the warning message from being displayed when there is no default
printer.
DISABLEPRINTTOFILE = 0x080000
Disables the B<Print to File> check box.
HIDEPRINTTOFILE = 0x100000
Hides the B<Print to File> check box.
NONETWORKBUTTON = 0x200000
Hides and disables the B<Network> button.
=head3 duplex
Duplexing mode:
SIMPLEX = 1
VERTICAL = 2
HORIZONTAL = 3
=head3 file
Set B<file> attribute to save printer drivers output into the file specified by
value of attribute. B<Note:> Specified file will not be overwritten- it's name
will be changed to B<file_name(1)... file_name(n)> to avoid overwriting.
If the flag is set - End(), Abort() and Close() methods returns possibly
modified file name.
See also L</pdf>, L</prompt>, L</End>, L</Abort> and L</Close>.
It is used as suggestion if used with B<prompt> or B<dialog>'s PRINTTOFILE.
=head3 height
Set specific page height (must be greater than tenth of milimetre).
See also L</width>.
=head3 maxp
Major page number in printer dialog (maximal allowed value).
See also L</minp>.
=head3 minp
Minor page number in printer dialog (minimal allowed value).
See also L</maxp>.
=head3 orientation
Page orientation (portrait by default).
PORTRAIT = 1
LANDSCAPE = 2
=head3 papersize
Defined paper sizes:
LETTER = 1
LETTERSMALL = 2
TABLOID = 3
LEDGER = 4
LEGAL = 5
STATEMENT = 6
EXECUTIVE = 7
A3 = 8
A4 = 9
A4SMALL = 10
A5 = 11
B4 = 12
B5 = 13
FOLIO = 14
QUARTO = 15
IN_10X14 = 16
IN_11X17 = 17
NOTE = 18
ENV_9 = 19
ENV_10 = 20
ENV_11 = 21
ENV_12 = 22
ENV_14 = 23
CSHEET = 24
DSHEET = 25
ESHEET = 26
ENV_DL = 27
ENV_C5 = 28
ENV_C3 = 29
ENV_C4 = 30
ENV_C6 = 31
ENV_C65 = 32
ENV_B4 = 33
ENV_B5 = 34
ENV_B6 = 35
ENV_ITALY = 36
ENV_MONARCH = 37
ENV_PERSONAL = 38
FANFOLD_US = 39
FANFOLD_STD_GERMAN = 40
FANFOLD_LGL_GERMAN = 41
ISO_B4 = 42
JAPANESE_POSTCARD = 43
IN_9X11 = 44
IN_10X11 = 45
IN_15X11 = 46
ENV_INVITE = 47
RESERVED_48 = 48
RESERVED_49 = 49
LETTER_EXTRA = 50
LEGAL_EXTRA = 51
TABLOID_EXTRA = 52
A4_EXTRA = 53
LETTER_TRANSVERSE = 54
A4_TRANSVERSE = 55
LETTER_EXTRA_TRANSVERSE = 56
A_PLUS = 57
B_PLUS = 58
LETTER_PLUS = 59
A4_PLUS = 60
A5_TRANSVERSE = 61
B5_TRANSVERSE = 62
A3_EXTRA = 63
A5_EXTRA = 64
B5_EXTRA = 65
A2 = 66
A3_TRANSVERSE = 67
A3_EXTRA_TRANSVERSE = 68
=head3 pdf
Set this attribute if You want to convert PostScript printer drivers output to
PDF format. B<WARNING:> This feature needs installed I<Ghostscript> and atleast
one PostScript printer driver. Use this attribute with B<L</file>> or
B<L</prompt>> attributes.
Set attribute value to:
0 - ignore Ghostscript messages;
1 - redirect Ghostscript messages to log file;
other - redirect Ghostscript messages to STDERR;
Use B<L</file>> attribute "-" to generate pdf to STDOUT.
See also L</file>, L</prompt>.
=head3 printer
If both B<printer> and B<L</dialog>> attributes omitted- systems
B<default printer> is used. Value of attribute is also used for B<L</dialog>>
initialisation.
Set printer's "friendly" name e.g. "HP LaserJet 8500" or network printer's UNC
e.g. "\\\\server\\printer" or "//server/printer".
=head3 prompt
If prompt attribute defined- prompts for print output filename and sets
B<L</file>> attribute. Behaves like B<L</file>> attribute. Also sets
B<L</dialog>>'s PRINTTOFILE flag.
See also L</file>, L</pdf>.
=head3 source
Specifies the paper source.
BIN_ONLYONE = 1
BIN_LOWER = 2
BIN_MIDDLE = 3
BIN_MANUAL = 4
BIN_ENVELOPE = 5
BIN_ENVMANUAL = 6
BIN_AUTO = 7
BIN_TRACTOR = 8
BIN_SMALLFMT = 9
BIN_LARGEFMT = 10
BIN_LARGECAPACITY = 11
BIN_CASSETTE = 14
BIN_FORMSOURCE = 15
=head3 unit*
Document units (inches by default).
Specified unit is used for all coordinates and sizes, except for
L<font sizes|/Font> and L<pen widths|/Pen>.
You may use strings:
'in' - inches
'mm' - millimeters
'cm' - centimeters
'pt' - points (in/72)
Or unit ratio according to:
ratio = in / unit
Example: 2.5409836 cm = 1 in
B<Set units to 0 to use device units.>
See also L</Unit>.
=head3 width
Set specific page width (must be greater than tenth of milimetre).
See also L</height>.
=head2 Abort
$dc->Abort();
The B<Abort> method stops the current print job and erases everything drawn
since the last call to the B<L</Start>> method. Method returns possibly changed
file name if B<L</file>> attribute is set.
See also L</Start>, L</Next>, L</End> and L</file>.
=head2 Arc
$dc->Arc($x, $y, $width, $height, $start_angle, $end_angle2);
The B<Arc> method draws an elliptical arc.
B<$x, $y> sets the upper-left corner coordinates of bounding rectangle.
B<$width, $height> sets the width and height of bounding rectangle.
B<$start_angle, $end_angle2> sets the starting and ending angle of the arc
according to the center of bounding rectangle. The current point is not updated.
See also L</ArcTo>, L</Ellipse>, L</Chord> and L</Pie>.
=head2 ArcTo
$dc->ArcTo($x, $y, $width, $height, $start_angle, $end_angle2);
The B<ArcTo> method draws an elliptical arc.
B<$x, $y> sets the upper-left corner coordinates of bounding rectangle.
B<$width, $height> sets the width and height of bounding rectangle.
B<$start_angle, $end_angle2> sets the starting and ending angle of the arc
according to the center of bounding rectangle. The current point is updated.
See also L</Move>, L</Arc>, L</Ellipse>, L</Chord> and L</Pie>.
=head2 Bezier
$dc->Bezier(@points);
The B<Polybezier> method draws cubic Bézier curves by using the endpoints and
control points specified by the B<@points> array. The first curve is drawn from
the first point to the fourth point by using the second and third points as
control points. Each subsequent curve in the sequence needs exactly three more
points: the ending point of the previous curve is used as the starting point,
the next two points in the sequence are control points, and the third is the
ending point. The current point is not updated.
See also L</BezierTo>.
=head2 BezierTo
$dc->Bezier(@points);
The B<BezierTo> method draws one or more Bézier curves.
This method draws cubic Bézier curves by using the control points specified by
the B<@points> array. The first curve is drawn from the current position to the
third point by using the first two points as control points. For each subsequent
curve, the method needs exactly three more points, and uses the ending point
of the previous curve as the starting point for the next. The current point is
updated.
See also L</Bezier> and L</Move>.
=head2 Brush
$handle = $dc->Brush([$r, $g, $b, [$hatch]]);
($handle, $previous_handle) = $dc->Brush([$r, $g, $b, [$hatch]]);
$previous_handle = $dc->Brush($handle);
The B<Brush> method creates a logical brush that has the specified style
and optional hatch style.
If no parameters specified, creates transparent brush.
You may use the following brush hatch styles:
HS_HORIZONTAL = 0
Horizontal hatch.
HS_VERTICAL = 1
Vertical hatch.
HS_FDIAGONAL = 2
A 45-degree downward, left-to-right hatch.
HS_BDIAGONAL = 3
A 45-degree upward, left-to-right hatch.
HS_CROSS = 4
Horizontal and vertical cross-hatch
HS_DIAGCROSS = 5
45-degree crosshatch.
See also L</Pen> and L</EBbl>.
=head2 Caps
$dc->Caps($index);
The B<Caps> method retrieves device-specific information about a specified
device.
B<$index> specifies the item to return. This parameter can be one of the
following values:
DRIVERVERSION = 0
The device driver version.
HORZSIZE = 4
Width, in millimeters, of the physical screen.
VERTSIZE = 6
Height, in millimeters, of the physical screen.
HORZRES = 8
Width, in pixels, of the screen.
VERTRES = 10
Height, in raster lines, of the screen.
BITSPIXEL = 12
Number of adjacent color bits for each pixel.
PLANES = 14
Number of color planes.
NUMBRUSHES = 16
Number of device-specific brushes.
NUMPENS = 18
Number of device-specific pens.
NUMFONTS = 22
Number of device-specific fonts.
NUMCOLORS = 24
Number of entries in the device's color table, if the device has a color depth
of no more than 8 bits per pixel. For devices with greater color depths, -1 is
returned.
CURVECAPS = 28
Value that indicates the curve capabilities of the device, as shown in the
following table:
0 Device does not support curves.
1 Device can draw circles.
2 Device can draw pie wedges.
4 Device can draw chord arcs.
8 Device can draw ellipses.
16 Device can draw wide borders.
32 Device can draw styled borders.
64 Device can draw borders that are wide and styled.
128 Device can draw interiors.
256 Device can draw rounded rectangles.
-
LINECAPS = 30
Value that indicates the line capabilities of the device, as shown in the
following table:
0 Device does not support lines.
2 Device can draw a polyline.
4 Device can draw a marker.
8 Device can draw multiple markers.
16 Device can draw wide lines.
32 Device can draw styled lines.
64 Device can draw lines that are wide and styled.
128 Device can draw interiors.
_
POLYGONALCAPS = 32
Value that indicates the polygon capabilities of the device, as shown in the
following table:
0 Device does not support polygons.
1 Device can draw alternate-fill polygons.
2 Device can draw rectangles.
4 Device can draw winding-fill polygons.
8 Device can draw a single scanline.
16 Device can draw wide borders.
32 Device can draw styled borders.
64 Device can draw borders that are wide and styled.
128 Device can draw interiors.
-
TEXTCAPS = 34
Value that indicates the text capabilities of the device, as shown in the
following table:
0x0001 Device is capable of character output precision.
0x0002 Device is capable of stroke output precision.
0x0004 Device is capable of stroke clip precision.
0x0008 Device is capable of 90-degree character rotation.
0x0010 Device is capable of any character rotation.
0x0020 Device can scale independently in the x- and y-directions.
0x0040 Device is capable of doubled character for scaling.
0x0080 Device uses integer multiples only for character scaling.
0x0100 Device uses any multiples for exact character scaling.
0x0200 Device can draw double-weight characters.
0x0400 Device can italicize.
0x0800 Device can underline.
0x1000 Device can draw strikeouts.
0x2000 Device can draw raster fonts.
0x4000 Device can draw vector fonts.
_
CLIPCAPS = 36
Flag that indicates the clipping capabilities of the device. If the device can
clip to a rectangle, it is 1. Otherwise, it is 0.
RASTERCAPS = 38
Value that indicates the raster capabilities of the device, as shown in the
following table:
0x0001 Capable of transferring bitmaps.
0x0002 Requires banding support.
0x0004 Capable of scaling.
0x0008 Capable of supporting bitmaps larger than 64K.
0x0010 Capable of supporting features of 16-bit Windows 2.0.
0x0080 Capable of supporting the SetDIBits and GetDIBits functions
(Win API).
0x0100 Specifies a palette-based device.
0x0200 Capable of supporting the SetDIBitsToDevice function (Win API).
0x0800 Capable of performing the StretchBlt function (Win API).
0x1000 Capable of performing flood fills.
0x2000 Capable of performing the StretchDIBits function (Win API).
-
ASPECTX = 40
Relative width of a device pixel used for line drawing.
ASPECTY = 42
Relative height of a device pixel used for line drawing.
ASPECTXY = 44
Diagonal width of the device pixel used for line drawing.
LOGPIXELSX = 88
Number of pixels per logical inch along the screen width.
LOGPIXELSY = 90
Number of pixels per logical inch along the screen height.
SIZEPALETTE = 104
Number of entries in the system palette. This index is valid only if the device
driver sets the RC_PALETTE bit in the RASTERCAPS index and is available only if
the driver is compatible with 16-bit Windows.
NUMRESERVED = 106
Number of reserved entries in the system palette. This index is valid only if
the device driver sets the RC_PALETTE bit in the RASTERCAPS index and is
available only if the driver is compatible with 16-bit Windows.
COLORRES = 108
Actual color resolution of the device, in bits per pixel. This index is valid
only if the device driver sets the RC_PALETTE bit in the RASTERCAPS index and
is available only if the driver is compatible with 16-bit Windows.
PHYSICALWIDTH = 110
For printing devices: the width of the physical page, in device units. For
example, a printer set to print at 600 dpi on 8.5"x11" paper has a physical
width value of 5100 device units. Note that the physical page is almost always
greater than the printable area of the page, and never smaller.
PHYSICALHEIGHT = 111
For printing devices: the height of the physical page, in device units. For
example, a printer set to print at 600 dpi on 8.5"x11" paper has a physical
height value of 6600 device units. Note that the physical page is almost always
greater than the printable area of the page, and never smaller.
PHYSICALOFFSETX = 112
For printing devices: the distance from the left edge of the physical page to
the left edge of the printable area, in device units. For example, a printer
set to print at 600 dpi on 8.5"x11" paper, that cannot print on the leftmost
0.25" of paper, has a horizontal physical offset of 150 device units.
PHYSICALOFFSETY = 113
For printing devices: the distance from the top edge of the physical page to the
top edge of the printable area, in device units. For example, a printer set to
print at 600 dpi on 8.5"x11" paper, that cannot print on the topmost 0.5" of
paper, has a vertical physical offset of 300 device units.
SCALINGFACTORX = 114
Scaling factor for the x-axis of the printer.
SCALINGFACTORY = 115
Scaling factor for the y-axis of the printer.
See also L</new>.
=head2 Chord
$dc->Chord($x, $y, $width, $height, $start_angle, $end_angle2);
The B<Chord> method draws a chord (a region bounded by the intersection of an
ellipse and a line segment, called a "secant"). The chord is outlined by using
the current pen and filled by using the current brush.
B<$x, $y> sets the upper-left corner coordinates of bounding rectangle.
B<$width, $height> sets the width and height of bounding rectangle.
B<$start_angle, $end_angle2> sets the starting and ending angle of the chord
according to the center of bounding rectangle.
See also L</Ellipse>, L</Pie>, L</Arc> and L</ArcTo>.
=head2 Close
$dc->Close([$image_handle_or_path]);
The B<Close> method finishes current print job, closes all open handles and
frees memory. Method returns possibly changed file name if B<L</file>> attribute
is set.
If optional image handle or path is provided- closes only that image!
See also L</new>, L</Image>, L</MetaEnd>, L</EBbl> and L</file>.
=head2 Color
$previous_coloref = $dc->Color($b, $g, $b);
$previous_coloref = $dc->Color($coloref);
The B<Color> method sets the text to the specified color.
See also L</Write>, L</Font> and L</EBbl>.
=head2 Debug
$dc->Debug([$debuglevel]);
The B<Debug> method changes debug level from now on or gets current level.
Possible values:
0 - default;
1 - die on warnings;
2 - warn on errors (not recomended);
If debug level set to 2- methods return undef value on error.
MAY INTERFERE WITH DIFFERENT PRINTER OBJECTS!
See also L</debug*>.
=head2 EBbl
$dc->EBbl($string, $x, $y, $flags, $baw, $bah);
The B<EBbl> method draws barcode. Uses B<L</Brush>> to fill the bars,
current B<L</Font>> for the text and B<L</Color>> for the text color.
B<$string> string to encode, B<$x> drawing x origin, B<$y> drawing y origin,
B<$flags> barcode mode flags, B<$baw> narrowest bar width in pts, B<$bah> bar
height in pts.
Mode flags:
EB_25MATRIX - 2 of 5 Matrix
EB_25INTER - 2 of 5 Interleaved
EB_25IND - 2 of 5 Industrial
EB_25IATA - 2 of 5 IATA
EB_27 - 2 of 7 (aka CODABAR)
EB_39STD - 3 of 9
EB_39EXT - 3 of 9 extended
EB_39DUMB - 3 of 9 "dumb" (allows to pass asterixes *)
EB_93 - 9 of 3
EB_128SMART - Code 128 "Smart" (smallest possible with shifting and code changes)
EB_128A - Code 128 A
EB_128B - Code 128 B
EB_128C - Code 128 C
EB_128SHFT - Allow shifting (for 128A, 128B, 128C)
EB_128EAN - EAN fnc (for 128SMART, 128A, 128B, 128C)
EB_EAN13 - EAN-13
EB_UPCA - UPC-A
EB_EAN8 - EAN-8
EB_UPCE - UPC-E
EB_ISBN - ISBN
EB_ISBN2 - ISBN (reserved)
EB_ISSN - ISSN
EB_AD2 - 2 digit addon (for EAN13, EAN8, UPCA, UPCE, ISSN, ISBN, ISBN2 modes)
EB_AD5 - 5 digit addon (for EAN13, EAN8, UPCA, UPCE, ISSN, ISBN, ISBN2 modes)
EB_CHK - With optional check character (for 25, 39 modes)
EB_TXT - Draw text (for all codes)
See also L</Brush>, L</Font> and L</Color>.
=head2 Ellipse
$dc->Ellipse($x, $y, $width, $height);
The B<Ellipse> method draws an ellipse. The center of the ellipse is the
center of the specified bounding rectangle. The ellipse is outlined by using the
current pen and is filled by using the current brush. B<$x, $y> sets the
upper-left corner coordinates of bounding rectangle. B<$width, $height> sets the
width and height of bounding rectangle.
See also L</Pie>, L</Chord>, L</Arc> and L</ArcTo>.
=head2 End
$dc->End();
The B<End> method finishes a current print job. Method returns possibly changed
file name if B<L</file>> attribute is set.
Not allowed in B<L</Meta>> brackets!
See also L</Start>, L</Next>, L</Abort>, L</Page> and L</file>.
=head2 Fill
$dc->Fill($mode);
The B<Fill> method sets the polygon fill mode for methods that fill
polygons.
ALTERNATE = 1
Selects alternate mode (fills the area between odd-numbered and even-numbered
polygon sides on each scan line).
WINDING = 2
Selects winding mode (fills any region with a nonzero winding value).
See also L</PDraw> and L</Poly>.
=head2 Fit
$char_num = $dc->Fit($text, $maxwidth, [UTF8]);
($char_num, $width, $height) = $dc->Fit($text, $maxwidth, [UTF8]);
The B<Fit> method retrieves the number of characters (B<$char_num>) in a
specified string (B<$text>) that will fit within a specified space
(B<$maxwidth>) and in array context also returns B<$width, $height> of string.
Use B<UTF8> for UTF-8 encoded strings;
See also L</Write> and L</Write2>.
=head2 Font
$font_handle = $dc->Font([$face, [$size, [$angle, [$charset]]]]);
($font_handle, $previous_font) = $dc->Font([$face, [$size, [\[$escapement, [orientation]\], [$charset]]]]);
B<or>
$dc->Font($font_handle);
The B<Font> method creates and selects a logical font that has specific
characteristics and returns handle to it B<or> selects given font by it's
handle. Fontsize is set in pts. In array context also returns previously selecte
font handle.
B<For UTF-8 support see L</Write>.>
B<IMPORTANT!!!> First font (e.g. "Arial") that matches desired attributes is
selected if desired font is not found. Reason of that may be raster font, wrong
font name, character set unsupported by font etc. B<Warning is issued!>
If B<$angle> is array reference then function looks for B<($escapement,
[orientation])>
Example:
$fh = $dc->Font("Arial", 10, [-90, 0]); # Same as:
$fh = $dc->Font("Arial", 10, [-90]); # ...prints characters cascaded vertically
B<$escapement> - Specifies the angle in degrees, between the escapement vector
and the x-axis of the device. The escapement vector is parallel to the base
line of a row of text.
B<Windows NT/2k/XP/...>: You can specify the escapement angle of the string
independently of the orientation angle of the string's characters.
B<Windows 95/98/Me>: The B<$escapement> member specifies both the escapement and
orientation. You should set B<$escapement> and B<$orientation> to the same
value.
B<$orientation> - Specifies the angle, in degrees, between each character's base
line and the x-axis of the device.
Defaults to:
$face = ''; # First font (e.g. "Arial") that matches desired attributes
$size = 10; # fontsize
$angle = 0; # text direction angle in degrees
$charset = DEFAULT; # character set code
B<$face> may include any combination of the following attributes: B<bold italic
underline strike>.
Defined character set constants:
ANSI = 0
DEFAULT = 1
SYMBOL = 2
MAC = 77
SHIFTJIS = 128
HANGEUL = 129
JOHAB = 130
GB2312 = 134
CHINESEBIG5 = 136
GREEK = 161
TURKISH = 162
VIETNAMESE = 163
HEBREW = 177
ARABIC = 178
BALTIC = 186
RUSSIAN = 204
THAI = 222
EASTEUROPE = 238
OEM = 255
See also L</FontEnum>, L</Write>, L</Color> and L</EBbl>.
=head2 FontEnum
$font_table = $dc->FontEnum([$face, [$charset]]);
@font_array = $dc->FontEnum([$face, [$charset]]);
The B<FontEnum> method enumerates all fonts in the system available for printer
that match the font characteristics specified. It returns tab-delimited table of
values in scalar context or array of hashes in array context. B<$font> - font
face of interest, B<$charset> - character set of interest.
Follown hash keys available:
{Face} - enumerated font face
{Charset} - enumerated character set (character set codes - see Font method)
{Style} - enumerated font style ('bold' and/or 'italic')
{Type} - type of enumerated font face (Raster = 1, Device = 2, TrueType = 4);
See also L</Font>.
=head2 FontSpace
$old_space = $dc->FontSpace($space);
The B<FontSpace> function sets the intercharacter spacing (B<$space>) and
returns previous value. B<$space> is in pts. Intercharacter spacing is added to
each character, including break characters, when the system writes a line of
text.
See also L</Font> and L</Write2>.
=head2 Image
$image_handle = $dc->Image($filename);
($image_handle, $original_width, $original_height) = $dc->Image($filename);
B<or>
$image_handle = $dc->Image($filename, $x, $y, [$width, $height]);
($image_handle, $original_width, $original_height) = $dc->Image($filename, $x, $y, [$width, $height]);
$dc->Image($image_handle, $x, $y, [$width, $height]);
B<or>
($width, $height) = $dc->Image($image_handle);
The B<Image> method loads an image file into memory and returns a handle
to it or draws it by it's filename or handle. B<$x, $y> specifies coordinates of
the image upper-left corner. B<$width, $height> specifies the width and height
of image on the paper (default is set by image header). Once loaded by image
path- image is cached in to memory and it may be referenced by it's path.
In second case if signed integer is given- method assumes it's a handle!
In array context also returns original image width an d height
B<$original_width, $original_height>.
Natively it supports B<EMF> and B<WMF> format files.
B<BMP, CUT, DDS, ICO, JPEG, JNG, KOALA, LBM, IFF, MNG, PBM, PBMRAW, PCD, PCX,
PGM, PGMRAW, PNG, PPM, PPMRAW, PSD, RAS, TARGA, TIFF, WBMP, XBM, XPM> bitmap
formats are handled via L<FreeImage library|/INSTALLATION>.
Image file formats are recognized by their extensions. On failure- method tries
to recognize it by file content (bitmaps only).
B<WARNING!> Metafiles may have objects outside the bounding box specified by
metafile header. These objects will be visible unless you specify clipping
region (See B<L</PClip>>).
After usage, you should use B<L</Close>> to unload image from memory and destroy
a handle.
See also L</Close>, L</MetaEnd> and L</EBbl>.
=head2 ImageSave
$dc->ImageSave($handle, $filename, [$bpp, [$width, $height, [$format, [$flag]]]]);
The B<ImageSave> method saves image as bitmap by its B<$handle> aquired by
B<L</Image>>, B<L</MetaEnd>> or B<L</EBbl>> methods. B<$filename> represents the
file name and path string. B<$bpp> for setting target bit depth (currently only
24-bit & 8-bit images supported). B<$width, $height> target width of the image.
B<$format> is one of the following B<(Note, that not all formats are writable yet)>:
FIF_BMP = 0
Windows or OS/2 Bitmap File (*.BMP)
FIF_ICO = 1
Windows Icon (*.ICO)
FIF_JPEG = 2
Independent JPEG Group (*.JPG, *.JIF, *.JPEG, *.JPE)
FIF_JNG = 3
JPEG Network Graphics (*.JNG)
FIF_KOALA = 4
Commodore 64 Koala format (*.KOA)
FIF_IFF = 5
Amiga IFF (*.IFF, *.LBM)
FIF_MNG = 6
Multiple Network Graphics (*.MNG)
FIF_PBM = 7
Portable Bitmap (ASCII) (*.PBM)
FIF_PBMRAW = 8
Portable Bitmap (BINARY) (*.PBM)
FIF_PCD = 9
Kodak PhotoCD (*.PCD)
FIF_PCX = 10
Zsoft Paintbrush PCX bitmap format (*.PCX)
FIF_PGM = 11
Portable Graymap (ASCII) (*.PGM)
FIF_PGMRAW = 12
Portable Graymap (BINARY) (*.PGM)
FIF_PNG = 13
Portable Network Graphics (*.PNG)
FIF_PPM = 14
Portable Pixelmap (ASCII) (*.PPM)
FIF_PPMRAW = 15
Portable Pixelmap (BINARY) (*.PPM)
FIF_RAS = 16
Sun Rasterfile (*.RAS)
FIF_TARGA = 17
Truevision Targa files (*.TGA, *.TARGA)
FIF_TIFF = 18
Tagged Image File Format (*.TIF, *.TIFF)
FIF_WBMP = 19
Wireless Bitmap (*.WBMP)
FIF_PSD = 20
Adobe Photoshop (*.PSD)
FIF_CUT = 21
Dr. Halo (*.CUT)
FIF_XBM = 22
X11 Bitmap Format (*.XBM)
FIF_XPM = 23
X11 Pixmap Format (*.XPM)
FIF_DDS = 24
DirectDraw Surface (*.DDS)
FIF_GIF = 25
Graphics Interchange Format (*.GIF)
B<$flag> is one of the following:
B<BMP:>
BMP_DEFAULT = 0
Save without any compression
BMP_SAVE_RLE = 1
Compress the bitmap using RLE when saving
B<JPEG:>
JPEG_DEFAULT = 0
Saves with good quality (75:1)
JPEG_QUALITYSUPERB = 0x80
Saves with superb quality (100:1)
JPEG_QUALITYGOOD = 0x100
Saves with good quality (75:1)
JPEG_QUALITYNORMAL = 0x200
Saves with normal quality (50:1)
JPEG_QUALITYAVERAGE = 0x400
Saves with average quality (25:1)
JPEG_QUALITYBAD = 0x800
Saves with bad quality (10:1)
Integer x in [0..100]
Save with quality x:100
B<PBM, PGM, PPM:>
PNM_DEFAULT = 0
Saves the bitmap as a binary file
PNM_SAVE_RAW = 0
Saves the bitmap as a binary file
PNM_SAVE_ASCII = 1
Saves the bitmap as an ASCII file
B<TIFF:>
TIFF_DEFAULT = 0
Save using CCITTFAX4 compression for 1-bit bitmaps and LZW compression for any other bitmaps
TIFF_CMYK = 0x0001
Stores tags for separated CMYK (use | to combine with TIFF compression flags)
TIFF_PACKBITS = 0x0100
Save using PACKBITS compression.
TIFF_DEFLATE = 0x0200
Save using DEFLATE compression (also known as ZLIB compression)
TIFF_ADOBE_DEFLATE = 0x0400
Save using ADOBE DEFLATE compression
TIFF_NONE = 0x0800
Save without any compression
TIFF_CCITTFAX3 = 0x1000
Save using CCITT Group 3 fax encoding
TIFF_CCITTFAX4 = 0x2000
Save using CCITT Group 4 fax encoding
TIFF_LZW = 0x4000
Save using LZW compression
See also L</Image>, L</MetaEnd> and L</EBbl>.
=head2 Inject
$dc->Inject($point, $page, $data);
The B<Inject> method adds B<$data> to a specific B<$point> in specified B<$page>.
Where B<$point> specifies where to inject the raw data in the PostScript output.
This member can be one of the following values. B<$page> specifies the page
number (starting from 1) to which the injection data is applied. Specify zero to
apply the injection data to all pages. This member is meaningful only for page
level injection points starting from PSI_PAGENUMBER. For other injection points,
set PageNumber to zero.
The injection data for a specified injection point is cumulative. In other
words, B<Inject> method adds the new injection data to any injection data
previously specified for the same injection point.
If the job is in EMF data type, you must provide all injection data before
B<Start>.
If the job is in RAW data type, you must provide the following injection data
before the driver needs it:
1) Data for header sections (before first %%Page:) before calling the first
B<Page> method.
2) Data for page setup sections (when injecting data for one particular page)
before calling the B<Page> method for that particular page.
3) Data for page setup sections (when injecting data for all pages starting from
a certain page) before calling B<Page> for the starting page.
4) Data for page trailer sections before calling the next B<Page> method.
5) Data for document trailer sections before calling the B<Close> method.
B<The injection points are:>
PSI_BEGINSTREAM = 1
Before the first byte of job stream.
PSI_PSADOBE = 2
Before %!PS-Adobe.
PSI_PAGESATEND = 3
Replaces driver's B<%%Pages (atend)>.
PSI_PAGES = 4
Replaces driver's B<%%Pages nnn>.
PSI_DOCNEEDEDRES = 5
After B<%%DocumentNeededResources>.
PSI_DOCSUPPLIEDRES = 6
After B<%%DocumentSuppliedResources>.
PSI_PAGEORDER = 7
Replaces driver's B<%%PageOrder>.
PSI_ORIENTATION = 8
Replaces driver's B<%%Orientation>.
PSI_BOUNDINGBOX = 9
Replaces driver's B<%%BoundingBox>.
PSI_PROCESSCOLORS = 10
Replaces driver's B<%DocumentProcessColors <color>>.
PSI_COMMENTS = 11
Before B<%%EndComments>.
PSI_BEGINDEFAULTS = 12
After B<%%BeginDefaults>.
PSI_ENDDEFAULTS = 13
Before B<%%EndDefaults>.
PSI_BEGINPROLOG = 14
After B<%%BeginProlog>.
PSI_ENDPROLOG = 15
Before B<%%EndProlog>.
PSI_BEGINSETUP = 16
After B<%%BeginSetup>.
PSI_ENDSETUP = 17
Before B<%%EndSetup>.
PSI_TRAILER = 18
After B<%%Trailer>.
PSI_EOF = 19
After B<%%EOF>.
PSI_ENDSTREAM = 20
After the last byte of job stream.
PSI_PROCESSCOLORSATEND = 21
Replaces driver's B<%%DocumentProcessColors (atend)>.
B<Page level injection points>
PSI_PAGENUMBER = 100
Replaces driver's B<%%Page>.
PSI_BEGINPAGESETUP = 101
After B<%%BeginPageSetup>.
PSI_ENDPAGESETUP = 102
Before B<%%EndPageSetup>.
PSI_PAGETRAILER = 103
After B<%%PageTrailer>.
PSI_PLATECOLOR = 104
Replace driver's B<%%PlateColor: <color>>.
PSI_SHOWPAGE = 105
Before showpage operator.
PSI_PAGEBBOX = 106
Replaces driver's B<%%PageBoundingBox>.
PSI_ENDPAGECOMMENTS = 107
Before B<%%EndPageComments>.
PSI_VMSAVE = 200
Before save operator.
PSI_VMRESTORE = 201
After restore operator.
See also L</Start>, L</Page> and L</Close>.
=head2 Line
$dc->Line(@endpoints);
The B<Line> method draws a series of line segments by connecting the
points in the specified array. The current point is not updated.
See also L</LineTo>.
=head2 LineTo
$dc->LineTo(@endpoints);
The B<LineTo> method draws a series of line segments by connecting the
points in the specified array. The current point is updated.
See also L</Line>.
=head2 Meta
$filename2 = $dc->Meta([$filename1], [$width, $height]);
The B<Meta> method opens an EMF bracket. This means that everything until
B<L</MetaEnd>> will be drawn in to the EMF file. Device context is based on
current Printer object device context, but only default objects and their
default values are selected into it.
B<$filename2> - name of the EMF file to create (if omited or empty -
creates only memory EMF file). B<$width, $height> - width and height of the
EMF file.
Function returns possibly changed filename.
Use "FILE:" or "FILE:C:/suggest.emf" as a file name to invoke 'Save as' dialog.
Function will not overwrite existing files but will change names like
B<L</file>>, except if set by dialog (this is different from B<L</file>>).
You may not use nested brackets!
See also L</MetaEnd>.
=head2 MetaEnd
$image_handle = $dc->MetaEnd();
($image_handle, $width, $height) = $dc->MetaEnd();
The B<MetaEnd> method closes an EMF bracket and returns handle to a creted EMF
image and also B<$width, $height> in array context. After usage, you should use
B<L</Close>> to unload image from memory and destroy a handle.
See also L</Meta>, L</Image> and L</Close>.
=head2 Move
($old_x, $old_y) = $dc->Move($x, $y);
The B<Move> method updates the current position to the specified point.
See also L</ArcTo>, L</LineTo> and L</BezierTo>.
=head2 Next
$dc->Next([$description]);
The B<Next> method ends and starts new print job. Equivalent for:
$dc->End();
$dc->Start([$description]);
Default description - "Printer".
Method returns possibly changed file name if B<L</file>> attribute is set.
Inside B<L</Meta>> brackets:
($image_handle ,$filename2) = $dc->Next(([$filename1], [$width, $height]);
In this context - closes previous and opens new B<L</Meta>> brackets. If
arguments omited - uses arguments from previous brackets.
See also L</Start>, L</End>, L</Abort>, L</Page>, L</Meta> and L</MetaEnd>.
=head2 Page
$dc->Page();
The B<Page> method starts new page.
Not allowed in B<L</Meta>> brackets!
See also L</Start>, L</Next> and L</End>.
=head2 PAbort
$dc->PAbort();
The B<PAbort> method closes and discards any paths.
=head2 PBegin
$dc->PBegin();
The B<PBegin> method opens a path bracket.
See also L</PClip>, L</PDraw>, L</PEnd> and L</PAbort>.
=head2 PClip
$dc->PClip($mode);
The B<PClip> method selects the current path as a clipping region,
combining the new region with any existing clipping region by using the
specified mode.
Where B<$mode> is one of the following:
CR_OFF = 0
Remove clipping region.
CR_AND = 1
The new clipping region includes the intersection (overlapping areas) of the
current clipping region and the current path.
CR_OR = 2
The new clipping region includes the union (combined areas) of the current
clipping region and the current path.
CR_XOR = 3
The new clipping region includes the union of the current clipping region and
the current path but without the overlapping areas.
CR_DIFF = 4
The new clipping region includes the areas of the current clipping region with
those of the current path excluded.
CR_COPY = 5
The new clipping region is the current path.
See also L</PBegin>, L</PDraw>, L</PEnd> and L</PAbort>.
=head2 PDraw
$dc->PDraw();
The B<PDraw> method closes any open figures in a path, strokes the outline
of the path by using the current pen, and fills its interior by using the
current brush and fill mode.
See also L</PBegin>, L</PClip>, L</PEnd>, L</PAbort> and L</Fill>.
=head2 PEnd
$dc->PEnd();
The B<PEnd> method closes a path bracket and selects the path defined by
the bracket.
See also L</PBegin>, L</PClip>, L</PDraw> and L</PAbort>.
=head2 Pen
$handle = $dc->Pen([$width, $r, $g, $b, [$style]]);
($handle, $previous_handle) = $dc->Pen([$width, $r, $g, $b, [$style]]);
$previous_handle = $dc->Pen($handle);
The B<Pen> method creates a logical pen that has the specified style,
width, and color. The pen can subsequently be used to draw lines and curves.
Pen width is set in pts regardless of B<L</unit*>> attribute in B<L</new>> constructor
or whatever is set by B<L</Unit>> method.
Using dashed or dotted styles will set the pen width to 1 px!
If no parameters specified, creates transparent pen.
You may use the following pen styles:
PS_DASH = 0x00000001
Pen is dashed.
PS_DOT = 0x00000002
Pen is dotted.
PS_DASHDOT = 0x00000003
Pen has alternating dashes and dots.
PS_DASHDOTDOT = 0x00000004
Pen has alternating dashes and double dots.
PS_NULL = 0x00000005
Pen is invisible.
PS_INSIDEFRAME = 0x00000006
Pen is solid. When this pen is used in drawing method that takes a bounding
rectangle, the dimensions of the figure are shrunk so that it fits entirely in
the bounding rectangle, taking into account the width of the pen.
PS_SOLID = 0x00010000
Pen is solid (default).
PS_JOIN_ROUND = 0x00010000
Joins are round (default).
PS_ENDCAP_ROUND = 0x00010000
End caps are round (default).
PS_ENDCAP_SQUARE = 0x00010100
End caps are square.
PS_ENDCAP_FLAT = 0x00010200
End caps are flat.
PS_JOIN_BEVEL = 0x00011000
Joins are beveled.
PS_JOIN_MITER = 0x00012000
Joins are mitered.
See also L</Brush>.
=head2 Pie
$dc->Pie($x, $y, $width, $height, $start_angle, $end_angle2);
The B<Pie> method draws a pie-shaped wedge bounded by the intersection of an
ellipse and two radials. The pie is outlined by using the current pen and filled
by using the current brush.
B<$x, $y> sets the upper-left corner coordinates of bounding rectangle.
B<$width, $height> sets the width and height of bounding rectangle.
B<$start_angle, $end_angle2> sets the starting and ending angle of the pie
according to the center of bounding rectangle.
See also L</Ellipse>, L</Chord>, L</Arc> and L</ArcTo>.
=head2 Poly
$dc->Poly(@vertices);
The B<Poly> method draws a polygon consisting of two or more vertices
connected by straight lines. The polygon is outlined by using the current pen
and filled by using the current brush and polygon fill mode.
See also L</Rect> and L</Fill>.
=head2 Rect
$dc->Rect($x, $y, $width, $height, [$ellipse_width, $ellipse_height]);
The B<Rect> method draws a rectangle or rounded rectangle. The rectangle
is outlined by using the current pen and filled by using the current brush.
B<$x, $y> sets the upper-left corner coordinates of rectangle. B<$width,
$height> sets the width and height of rectangle. Optional parameters
B<$ellipse_width, $ellipse_height> sets the width and height of ellipse used to
draw rounded corners.
See also L</Poly>.
=head2 Space
$dc->Space($eM11, $eM12, $eM21, $eM22, $eDx, $eDy);
The B<Space> method sets a two-dimensional linear transformation
between world space and page space. This transformation can be used to scale,
rotate, shear, or translate graphics output. Transformation on the next page is
reset to default. Default page origin is upper-left corner, B<x> from left to
right and B<y> from top to bottom.
0
------- x
|
|
| y
For any coordinates B<(x, y)> in world space, the transformed coordinates in
page space B<(x', y')> can be determined by the following algorithm:
x' = x * eM11 + y * eM21 + eDx,
y' = x * eM12 + y * eM22 + eDy,
where the transformation matrix is represented by the following:
| eM11 eM12 0 |
| eM21 eM22 0 |
| eDx eDy 1 |
=head2 Start
$dc->Start([$description]);
The B<Start> method starts a print job.
Default description - "Printer".
B<NOTE!> Print job is automatically aborted if print job is not ended by
B<L</End>> or B<L</Close>> methods or if an error occurs!
Not allowed in B<L</Meta>> brackets!
See also L</Next>, L</End>, L</Abort> and L</Page>.
=head2 Unit
$dc->Unit([$unit]);
The B<Unit> method sets or gets current unit ratio.
Specified unit is used for all coordinates and sizes, except for
L<font sizes|/Font> and L<pen widths|/Pen>.
You may use strings:
'in' - inches
'mm' - millimeters
'cm' - centimeters
'pt' - points (in / 72)
Or unit ratio according to:
ratio = in / unit
Example: 2.5409836 cm = 1 in
B<Set units to 0 to use device units.>
See also L</unit*>.
=head2 Write
# String mode (SM):
$height = $dc->Write($text, $x, $y, [$format, [$just_width]]);
($width, $height) = $dc->Write($text, $x, $y, [$format, [$just_width]]);
# Draw mode (DM):
$height = $dc->Write($text, $x, $y, $width, $height, [$format, [$tab_stop]]);
($width, $height, $length, $text) = $dc->Write($text, $x, $y, $width, $height, [$format, [$tab_stop]]);
B<SM:>
The B<Write> method B<string mode> writes a character string at the specified
location, using the currently selected font, text color and alignment.
B<DM:>
The B<Write> method B<draw mode> draws formatted text in the specified rectangle.
In array context method returns array containing B<($width, $height, $length,
$text)>. B<$height> is returned in scalar context. B<$length> receives the
number of characters processed by B<Write>, including white-space characters.
See CALCRECT and MODIFYSTRING flags. Optional B<$tab_stop> parameter
specifies the number of average character widths per tab stop.
B<Warning!> - $widt must be less than 0x80000000 units.
Optional text format flags:
UTF8 = 0x20000000 (SM & DM)
Treat B<$text> as B<UTF-8> encoded string. Note that selected font must support
desired unicode characters. Available for NT platforms and also supported by
Microsoft Layer for Unicode.
NOUPDATECP = 0x00000000 (SM)
The current position is not updated after each text output call. The reference
point is passed to the text output method.
TOP = 0x00000000 (SM & DM)
B<SM:> The reference point will be on the top edge of the bounding rectangle.
B<DM:> Top justifies text. This value must be combined with SINGLELINE.
LEFT = 0x00000000 (SM & DM)
B<SL:> The reference point will be on the left edge of the bounding rectangle.
B<ML:> Aligns text to the left.
UPDATECP = 0x00000001 (SM)
The current position is updated after each text output call. The current
position is used as the reference point.
RIGHT = 0x00000002 (SM & DM)
B<SL:> The reference point will be on the right edge of the bounding rectangle.
B<ML:> Aligns text to the right.
VCENTER = 0x00000004 (DM)
Centers text vertically (single line only).
BOTTOM = 0x00000008 (SM & DM)
B<SL:> The reference point will be on the bottom edge of the bounding rectangle.
B<ML:> Justifies the text to the bottom of the rectangle. This value must be
combined with SINGLELINE.
WORDBREAK = 0x00000010 (DM)
Breaks words. Lines are automatically broken between words if a word extends
past the edge of the specified rectangle. A carriage return-linefeed sequence
also breaks the line.
BASELINE = 0x00000018 (SM)
The reference point will be on the base line of the text.
SINGLELINE = 0x00000020 (DM)
Displays text on a single line only. Carriage returns and linefeeds do not break
the line.
EXPANDTABS = 0x00000040 (DM)
Expands tab characters. Number of characters per tab is eight.
NOCLIP = 0x00000100 (DM)
Draws without clipping. B<Write> is somewhat faster when NOCLIP is used.
EXTERNALLEADING = 0x00000200 (DM)
Includes the font external leading in line height. Normally, external leading is
not included in the height of a line of text.
CALCRECT = 0x00000400 (DM)
Determines the B<$width> and B<$height> of the rectangle. If there are multiple
lines of text, B<Write> uses the width of the given rectangle and extends the
base of the rectangle to bound the last line of text. If there is only one line
of text, B<Write> modifies the width of the rectangle so that it bounds the
last character in the line. In either case, B<Write> returns the height of the
formatted text, but does not draw the text.
INTERNAL = 0x00001000 (DM)
Uses the system font to calculate text metrics.
EDITCONTROL = 0x00002000 (DM)
Duplicates the text-displaying characteristics of a multiline edit control.
Specifically, the average character width is calculated in the same manner as
for an edit control, and the method does not display a partially visible last
line.
PATH_ELLIPSIS = 0x00004000 (DM)
END_ELLIPSIS = 0x00008000 (DM)
Replaces part of the given string with ellipses, if necessary, so that the
result fits in the specified rectangle. The B<$text> element of returning
array is not modified unless the MODIFYSTRING flag is specified.
You can specify END_ELLIPSIS to replace characters at the end of the string,
or PATH_ELLIPSIS to replace characters in the middle of the string. If the
string contains backslash (\) characters, PATH_ELLIPSIS preserves as much as
possible of the text after the last backslash.
MODIFYSTRING = 0x00010000 (DM)
Modifies the B<$text> element of returning array to match the displayed text.
This flag has no effect unless the END_ELLIPSIS, PATH_ELLIPSIS or WORD_ELLIPSIS
flag is specified.
RTLREADING = 0x00020000 (SM & DM)
Layout in right to left reading order for bi-directional text when the selected
font is a Hebrew or Arabic font. The default reading order for all text is left
to right.
WORD_ELLIPSIS = 0x00040000 (DM)
Truncates text that does not fit in the rectangle and adds ellipses.
CENTER = 0x00080000 (SM & DM)
B<SL:> The reference point will be aligned horizontally with the center of the
bounding rectangle.
B<ML:> Centers text horizontally in the rectangle.
JUSTIFY = 0x80000000 (SM)
Extends space characters to match given justification width (B<$just_width>).
B<Note:> Allways use B<$just_width> parameter with B<JUSTIFY> flag!
See also L</Font>, L</Fit>, L</Color>, L</FontSpace> and L</Write2>.
=head2 Write2
$height = $dc->Write2($text, $x, $y, $w, [$flags, [$indento, [$hspace, [$vspace]]]]);
($width, $height, $proctext) = $dc->Write2($text, $x, $y, $w, [$flags, [$indent, [$hspace, [$vspace]]]]);
The B<Write2> method adds multiline justification, custom vertical and
horisontal spacing and left indent; Returns B<$height> in scalar context and
B<$width, $height, $proctext> where B<$proctext> is possibly modified text
(e.g. added line breaks).
Reasonable only when justification, left indent, custom vertical and/or
horizontal spacing is needed, othervise consider to use regular B<L</Write>>
method.
LEFT = 0x00000000
Aligns text to the left.
RIGHT = 0x00000002
Aligns text to the right.
CENTER = 0x00080000
Centers text horizontally in the rectangle.
JUSTIFY = 0x80000000
Extends space characters to match given width.
UTF8 = 0x20000000
Treat B<$text> as B<UTF-8> encoded string. Note that selected font must support
desired unicode characters. Available for NT platforms and also supported by
Microsoft Layer for Unicode.
See also L</Write>, L</Fit> and L</FontSpace>.
=head1 SEE ALSO
L<Win32::Printer::Enum>, L<Win32::Printer::Direct>, Win32 Platform SDK GDI
documentation.
=head1 AUTHOR
B<Edgars Binans>
=head1 COPYRIGHT AND LICENSE
This library may use I<FreeImage>, a free, open source image library
supporting all common bitmap formats. Get your free copy from
L<http://sourceforge.net>. I<FreeImage> is licensed under the terms of
B<GNU GPL>.
This library may use I<Ghostscript> for PDF support. I<GNU Ghostscript> is
licensed under terms of B<GNU GPL>. I<AFPL Ghostscript> is licensed under the
terms of B<Aladdin Free Public License>. Download I<Ghostscript> from
L<http://sourceforge.net>.
B<Win32::Printer, Copyright (C) 2003-2005 Edgars Binans.>
B<THIS LIBRARY IS LICENSED UNDER THE TERMS OF GNU LESSER GENERAL PUBLIC LICENSE
V2.1>
=cut