home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
windows
/
printit
/
winprint.pas
< prev
Wrap
Pascal/Delphi Source File
|
1994-04-11
|
15KB
|
457 lines
{************************************************}
{ }
{ Turbo Pascal for Windows }
{ Tips & Techniques Demo Program }
{ Copyright (c) 1991 by Borland International }
{ }
{************************************************}
unit WinPrint;
{$R PRINTER}
interface
uses WinTypes, WinProcs, WObjects, Strings;
type
{ TComboXferRec }
{ The transfer buffer used for the ComboBox in the TPrinterInfo method
SelectPrinter. The fields, Strings and Selection, are set up in the
TPrinterInfo constructor Init. The routine GetCurrentPrinter is used
to find current printing device which is placed in Selection. And the
routine GetPrinterTypes is used to fill out the Strings field.}
TComboXferRec = record
Strings: PStrCollection;
Selection: array[0..80] of Char;
end;
{ TAbortDialog }
{ A descendant of TDialog used for the Abort Dialog seen when printing is
in progress. The AbortDialog is installed as a data field of TPrinterInfo
and is initialized and displayed in its StartDoc method. The EndDoc
method will Close the dialog if necessary.}
PAbortDialog = ^TAbortDialog;
TAbortDialog = object(TDlgWindow)
procedure SetUpWindow; virtual;
procedure WMCommand(var Msg: TMessage);
virtual wm_First + wm_Command;
end;
{ TPrinterInfo }
{ The controlling object for printing. It is intended that this object be
initialized as a data field of a TWindow or TApplication descendant. This
printing object must be used OWL based applications. The data fields are
not supposed to be used directly but may need to be accessed in special
situations. PrintDC and Error are the two most likely to be used without
a specific method call. The description of the data fields are as
follows.
-AbortDialog holds a pointer to the abort dialog when it valid. It is
valid only after a call to the method StartDoc and before the call to the
method EndDoc.
-AbortCallBackProc holds the address of the Abort Dialog's callback
function. It's definition is found in the function AbortCallBack in the
implementation section of this unit.
-SelectDialog is a pointer to the dialog used when selecting the current
printer. To be used when overriding the function of the SelectPrinter
method.
-SelectInfo is the transfer record used in SelectDialog. Holds
descriptions of all printers available and the currently selected printer.
-Driver, PrinterType, Port are null terminated strings holding information
relevant to the current printer.
-DriverHandle is a handle to the library of the current printer driver. It
is setup in Init constructor and is freed in the Done destructor. It is
used for setting up the DeviceMode configuration call.
-PrintDC is the device control established for printing. It is created by
the StartDoc method and valid until the EndDoc method call. May be
accessed directly or by the GetPrinterDC method call.
-Error holds the results of printer escape calls. If an error occurs, the
result is placed here. Is tested to determine if further printing output
is appropriate.
-ExtDeviceMode holds the ExtDeviceMode procedure used for retrieving,
installing, and prompting for printing configurations.
-DeviceModeVar holds the DeviceMode procedure used for prompting the
user for printer configurations.
}
PPrinterInfo = ^TPrinterInfo;
TPrinterInfo = object
AbortDialog: PAbortDialog;
AbortCallBackProc: TFarProc;
SelectDialog: PDialog;
SelectInfo: TComboXferRec;
Driver,
PrinterType,
Port: PChar;
DriverHandle: THandle;
PrintDC: HDC;
Error: Integer;
ExtDeviceMode: TExtDeviceMode;
DeviceModeVar: TDeviceMode;
RasterCaps: integer;
constructor Init;
destructor Done;
procedure SelectPrinter; virtual;
function GetPrinterDC: HDC;
procedure DeviceMode;
function BitMapCapable: boolean;
function BandingRequired: boolean;
procedure StartDoc(Name: PChar); virtual;
procedure NewFrame; virtual;
procedure NextBand(var R:TRect); virtual;
procedure EndDoc; virtual;
end;
var
PrinterAbort: Boolean;
{ Holds true when the user has aborted printing. }
implementation
const
id_ComboBox = 101;
{ ID for the ComboBox used for Selecting the current printer }
var
AbortWindow: HWnd;
{ Window handle for the Abort Dialog. It is used by the
AbortCallBackProc.}
function GetItem(var S: PChar): PChar;
{ Retrieves comma separated data from a null terminated string. It
returns the first data item and advances the pointer S to the next
data item in the string.}
var
P: PChar;
I: Integer;
begin
I:=0;
while (S[I]<>',') and (S[I]<>#0) do
inc(I);
S[I]:=#0;
GetMem(P, Strlen(S)+1);
StrCopy(P,S);
GetItem:=P;
if S[0]<>#0 then S:=@S[I+1];
end;
procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
{ Retrieves all the device types from the WIN.INI and places this
information into the PStrCollection parameter.}
var
Buffer, BufferItem: PChar;
Item: PChar;
Count, I: Integer;
begin
New(PrinterTypes, init(5,1));
GetMem(Buffer, 1024);
Count:=GetProfileString('devices', nil, ',,', Buffer, 1024);
BufferItem:=Buffer;
I:=0;
while I<Count do
begin
GetMem(Item, StrLen(BufferItem)+1);
StrCopy(Item, BufferItem);
PrinterTypes^.Insert(Item);
while (BufferItem[i]<>#0) and (I<Count) do
inc(I);
inc(I);
if BufferItem[I]=#0 then I:=Count;
if I<Count then
begin
BufferItem:=@BufferItem[I];
Count:=Count-I;
I:=0;
end;
end;
FreeMem(Buffer, 1024);
end;
procedure GetCurrentPrinter(var Driver, PrinterType, Port: PChar);
{ Retrieves the current printing device information from the WIN.INI
file.}
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
CurrentItem:=ProfileInfo;
PrinterType:=GetItem(CurrentItem);
Driver:=GetItem(CurrentItem);
Port:=GetItem(CurrentItem);
FreeMem(ProfileInfo, 80+1);
end;
procedure GetPrinter(PrinterType: PChar; var Driver, Port: PChar);
{ Given a PrinterType string, this procedure returns the appropriate
driver and port information.}
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
CurrentItem:=ProfileInfo;
Driver:=GetItem(CurrentItem);
Port:=GetItem(CurrentItem);
end;
procedure TAbortDialog.SetUpWindow;
{ Initializes PrinterAbort and AbortWindow. Then set the focus to the
AbortDialog.}
begin
PrinterAbort:=false;
SetFocus(HWindow);
AbortWindow:=HWindow;
end;
procedure TAbortDialog.WMCommand(var Msg: TMessage);
{ If any command messages occur, a user abort has taken place. Normally,
this will include pressing ENTER, ESCAPE, the SPACEBAR or clicking the
mouse on the Abort Dialog's Escape button.}
begin
PrinterAbort:=true;
end;
function AbortCallBack(DC: HDC; Code: Integer): Bool; export;
{ While printing is taking place, checks to see if PrinterAbort is
true. Otherwise messages are passed on.}
var
Msg: TMsg;
begin
while (not PrinterAbort) and PeekMessage(Msg, 0, 0, 0, pm_Remove) do
if not IsDialogMessage(AbortWindow, Msg) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
if PrinterAbort then AbortCallBack:=false else AbortCallBack:=true;
end;
constructor TPrinterInfo.Init;
{ Gets the current printer information (Type, Driver, & Port) and
the printer types currently available. Then retrieves the
ExtDeviceMode and DeviceModeVar address from the current printer's
library.}
var
I: Integer;
FullDriverName: PChar;
P: TFarProc;
begin
GetCurrentPrinter(Driver, PrinterType, Port);
for I:= 0 to StrLen(PrinterType) do
SelectInfo.Selection[I]:=PrinterType[I];
GetPrinterTypes(SelectInfo.Strings);
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
FreeMem(FullDriverName, 12+1);
P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode:=TExtDeviceMode(P);
P:=GetProcAddress(DriverHandle, 'DeviceMode');
DeviceModeVar:=TDeviceMode(P);
PrintDC:=0;
end;
destructor TPrinterInfo.Done;
{ Frees up the library taken in the constructor Init.}
begin
FreeLibrary(DriverHandle);
end;
procedure TPrinterInfo.SelectPrinter;
{ Displays a Printer Select dialog called PISELECT and changes the
current printer information as is done in Init.}
var
FullDriverName: PChar;
P: TFarProc;
ComboBox: PComboBox;
begin
new(SelectDialog, Init(Application^.MainWindow,
'PISELECT'));
New(ComboBox, InitResource(SelectDialog, id_ComboBox, 80));
SelectDialog^.TransferBuffer:=@SelectInfo;
if Application^.ExecDialog(SelectDialog) = id_Ok then
begin
FreeLibrary(DriverHandle);
if PrintDC<>0 then DeleteDC(PrintDC);
FreeMem(PrinterType, StrLen(PrinterType)+1);
GetMem(PrinterType, StrLen(@SelectInfo.Selection)+1);
StrCopy(PrinterType, @SelectInfo.Selection);
FreeMem(Driver, StrLen(Driver)+1);
FreeMem(Port, StrLen(Port)+1);
GetPrinter(PrinterType, Driver, Port);
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
FreeMem(FullDriverName, 12+1);
P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode:=TExtDeviceMode(P);
P:=GetProcAddress(DriverHandle, 'DeviceMode');
DeviceModeVar:=TDeviceMode(P);
end;
end;
function TPrinterInfo.GetPrinterDC: HDC;
{ Retrieves the Device control associated with the printer. May only be
called after a call to the StartDoc method. }
begin
GetPrinterDC:=PrintDC;
end;
procedure TPrinterInfo.StartDoc(Name: PChar);
{ Called immediately before printing is to begin. Establishes the
device control. Sets up the Abort Dialog. And send the STARTDOC
escape call.}
begin
Error:=0;
PrintDC:=CreateDC(Driver, PrinterType, Port, nil);
if LowMemory then
AbortDialog:=Nil
else
begin
new(AbortDialog, Init(Application^.MainWindow, 'PIABORT'));
AbortDialog^.Create;
end;
if AbortDialog<>Nil then
begin
AbortCallBackProc:=MakeProcInstance(@AbortCallBack, HInstance);
Escape(PrintDC, SETABORTPROC, 0, AbortCallBackProc, nil);
end;
RasterCaps:=GetDeviceCaps(PrintDC, WINTYPES.RASTERCAPS);
Error:=Escape(PrintDC, WINTYPES.STARTDOC, StrLen(Name), Name, nil);
end;
procedure TPrinterInfo.NewFrame;
{ Sends the NEWFRAME escape call and performs appropriate error
checking.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.NEWFRAME, 0, nil, nil);
if Error<0 then
case Error of
SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
'General Printer Error', nil, mb_Ok or mb_IconStop);
SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
'No disk space for spooling', nil, mb_Ok or mb_IconStop);
SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
'No memory space for spooling', nil, mb_Ok or mb_IconStop);
SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
else
MessageBox(Application^.MainWindow^.HWindow,
'Printing Halted', nil, mb_OK or mb_IconStop);
end;
end;
procedure TPrinterInfo.NextBand(var R:TRect);
{ When Bitmap banding is required, this routine returns the next
rectangular region to be printed. This method is not required but
can speed up printing bitmaps.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.NEXTBAND, 0, nil, @R);
if Error<0 then
case Error of
SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
'General Printer Error', nil, mb_Ok or mb_IconStop);
SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
'No disk space for spooling', nil, mb_Ok or mb_IconStop);
SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
'No memory space for spooling', nil, mb_Ok or mb_IconStop);
SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
else
MessageBox(Application^.MainWindow^.HWindow,
'Printing Halted', nil, mb_OK or mb_IconStop);
end;
end;
procedure TPrinterInfo.EndDoc;
{ Sends the ENDDOC escape call and closes the Abort Dialog if no errors
have occurred.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.ENDDOC, 0, nil, nil);
if Error>=0 then
begin
DeleteDC(PrintDC);
if AbortDialog<>Nil then AbortDialog^.CloseWindow;
end;
end;
procedure TPrinterInfo.DeviceMode;
{ Calls the printer driver's DeviceMode routine. Normally displays a
dialog allowing the user to change the printer's configuration.}
begin
DeviceModeVar(Application^.MainWindow^.HWindow,
DriverHandle, PrinterType, Port);
end;
function TPrinterInfo.BitMapCapable: boolean;
{ Returns true if the current printing device can handle bitmap
graphics.}
begin
BitMapCapable:=(RasterCaps and RC_BITBLT)<>0;
end;
function TPrinterInfo.BandingRequired: boolean;
{ Returns true if banding of bitmap images will enhance printing speed.}
begin
BandingRequired:=(RasterCaps and RC_BANDING)<>0;
end;
end.
{ Here are the descriptions of the dialogs PIABORT and PISELECT found in
the resources file PRINTER.RES
PIABORT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 46, 175, 78
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Printing in Progress"
BEGIN
CONTROL "Press Escape to Halt Printing" 101, "STATIC", WS_CHILD |
WS_VISIBLE, 37, 17, 98, 12
CONTROL "Escape" 102, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
73, 49, 40, 13
END
PISELECT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 37, 145, 85
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Select Printer"
BEGIN
CONTROL "COMBOBOX" 101, "COMBOBOX", WS_CHILD | WS_VISIBLE | WS_VSCROLL |
0x101L, 26, 11, 84, 43
CONTROL "Ok" 1, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
29, 61, 40, 12
CONTROL "Cancel" 2, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
86, 61, 40, 12
END
}