source: trunk/Sibyl/SPCC/PRINTERS.PAS@ 105

Last change on this file since 105 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 22.8 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10{************************************************}
11{ }
12{ Speed-Pascal 2.0 Printer support Unit }
13{ }
14{ Copyright (C) 1996-1997 Joerg Pleumann }
15{ }
16{ Please mail All bugs And suggestions To: }
17{ }
18{ Internet: pleumann @ uni-duisburg.de }
19{ FidoNet: Joerg Pleumann @ 2:2448/136.6 }
20{ }
21{************************************************}
22
23Unit Printers;
24
25Interface
26
27{$IFDEF OS2}
28Uses
29 Os2Def, PmSpl;
30{$ENDIF}
31
32Uses SysUtils, Classes, Forms, Graphics;
33
34Type
35 EPrinter = Class(Exception);
36 { raised In Case Of Printer errors. }
37
38 TPrinterOrientation = (poPortrait, poLandscape);
39 { used For Orientation Property. }
40
41 TPrinterState = (psNoHandle, psHandleIC, psHandleDC);
42 { internal. }
43
44 {$IFDEF OS2}
45 TQueueInfo = Array[0..1023] Of PRQINFO3;
46 PQueueInfo = ^TQueueInfo;
47 { internal. }
48
49 TDeviceInfo = Array[0..1023] Of PRDINFO3;
50 PDeviceInfo = ^TDeviceInfo;
51 { internal. }
52 {$ENDIF}
53
54 TPrinter = Class
55 Private
56 Public // temporary only
57 {$IFDEF OS2}
58 FQueues: PQueueInfo; // Pointer To Queue Info Buffer
59 {$ENDIF}
60 FQueueCount: LongInt; // Number Of queues available
61 FQueueIndex: LongInt; // Currently Selected Queue
62 FQueueSize: LongInt; // Size Of Queue Info Buffer
63
64 {$IFDEF OS2}
65 FDevices: PDeviceInfo; // Pointer To Device Info Buffer
66 {$ENDIF}
67 FDeviceCount: LongInt; // Number Of Devices available
68 FDeviceIndex: LongInt; // Currently Selected Device
69 FDeviceSize: LongInt; // Size Of Device Info Buffer
70
71 FDeviceName: cstring[32]; // Name Of Currently Selected Device
72 {$IFDEF OS2}
73 FDeviceData: DEVOPENSTRUC; // Data Needed To Open Device contect
74 {$ENDIF}
75
76 FPrintToFile: Boolean; // Print To File instead Of printer?
77 FFileName: AnsiString; // Name Of Output File
78
79 FPrinters: TStrings; // Printer Names Visible To End user
80
81 FHandle: HDC; // Printer Device context
82 FCanvas: TCanvas; // Printer Canvas
83
84 FState: TPrinterState; // Current State Of Printer Object
85
86 FTitle: AnsiString; // Document Title
87 FCopies: LongInt; // Number Of copies To be printed
88 FAborted: Boolean; // True when Last job was aborted
89 FPageNumber: LongInt; // Number Of Current page
90
91 Procedure Error(Id: Word);
92 Procedure FmtError(Id: Word; Args: Array Of Const);
93 Function GetOrientation: TPrinterOrientation;
94 Function GetPageHeight: LongInt;
95 Function GetPageWidth: LongInt;
96 Procedure GetPrinterInfo;
97 Function GetPrinting: Boolean;
98 Procedure SetFileName(Value: AnsiString);
99 Procedure SetPrinterIndex(Value: LongInt);
100 Procedure SetPrinterState(Value: TPrinterState);
101 Procedure SetPrintToFile(Value: Boolean);
102
103 Public
104 Constructor Create;
105 { Create Printer Object. one Printer Object
106 Is automatically created And stored In the
107 Printer variable. no need To Create more
108 Printer Objects. }
109 Destructor Destroy; Override;
110 { Destroy Printer Object. the Instance stored
111 In the Printer variable Is automatically
112 destroyed In the unit's Finalization Code. }
113
114 Procedure Abort;
115 { Abort Current Document. only available inside
116 Document. }
117 Procedure BeginDoc;
118 { Begin New Document. only available when Last
119 job has either been completed Or aborted. }
120 Procedure EndDoc;
121 { End Document. only available inside Document. }
122 Procedure NewPage;
123 { Start A New, blank page. only available inside
124 Document. }
125 Procedure OptionsDlg;
126 { display job properties Dialog For Currently
127 Selected Printer. allow the user To Change
128 job properties. only available While Not In
129 Document. }
130 procedure PrintBitmap(Bitmap: TBitmap; SrcRec, DstRec: TRect);
131 { Prints a bitmap. SrcRec and DstRec specify
132 the source and destination rectangles.
133
134 You should always use this method to display
135 bitmaps on the printer. Never use the blitting
136 operations provided by the canvas or graphics
137 objects, since they can't cooperate with a
138 printer canvas. }
139 procedure PrintForm(Form: TForm; DstRec: TRect);
140 { Prints the contents of a form. DstRec
141 specifies the destination rectangle on
142 the page.
143
144 Please note the following differences from
145 form printing under Borland Delphi:
146
147 (a) A print job must already be initiated.
148 (b) Only the currently visible part of the
149 the form can be printed. This is due to
150 an OS/2 limitation. }
151 Property Aborted: Boolean Read FAborted;
152 { True If Last job has been aborted. }
153 Property Canvas: TCanvas Read FCanvas;
154 { Printer Canvas. only available inside
155 Document. }
156 Property Copies: LongInt Read FCopies Write FCopies;
157 { Number Of copies To be printed Of Next
158 Document. MUST be Set before BeginDoc,
159 Otherwise ignored. }
160 Property FileName: AnsiString Read FFileName Write SetFileName;
161 { destination when printing To A File. }
162 Property Handle: HDC Read FHandle;
163 { Printer Device context. }
164 Property Orientation: TPrinterOrientation Read GetOrientation;
165 { page Orientation. }
166 Property PageHeight: LongInt Read GetPageHeight;
167 { page Height In Pixels. }
168 Property PageNumber: LongInt Read FPageNumber;
169 { Current page Number. }
170 Property PageWidth: LongInt Read GetPageWidth;
171 { page Width In Pixels. }
172 Property PrinterIndex: LongInt Read FQueueIndex Write SetPrinterIndex;
173 { Currently Selected Printer. Change only While Not
174 In Document. Set PrinterIndex To -1 For System
175 Default Printer. }
176 Property Printers: TStrings Read FPrinters;
177 { Names Of Printers (aka queues) available. If
178 Printers.Count Is 0, the System doesn't have
179 any Printers installed. }
180 Property Printing: Boolean Read GetPrinting;
181 { True when inside Document. }
182 Property PrintToFile: Boolean Read FPrintToFile Write SetPrintToFile;
183 { when True, Output Is sent To File specified
184 In the FileName Property. }
185 Property Title: AnsiString Read FTitle Write FTitle;
186 { Title Of Next Document. MUST be Set before
187 BeginDoc, Otherwise ignored. }
188 End;
189
190Var
191 Printer: TPrinter;
192
193Implementation
194
195{$IFDEF OS2}
196Uses
197 PmWin, PmDev, PMSHL, PmGpi;
198{$ENDIF}
199
200{$IFDEF WIN32}
201Uses WinDef,WinNT,WinBase,WinUser,WinGDI;
202{$ENDIF}
203
204
205{$ifdef os2}
206{ --- OS/2 DevEscape Network printer fix in NETAPI.DLL (12 October 2004, M. Vieregg, A. Laurence) }
207{for more information about this problem, visit:
208"Stack requirements of API functions" in comp.os.os2.programmer.misc, Date:2003-06-16
209 But the mentioned stack size of 512 bytes is not sufficient!
210 1024 did not work with my application, 2048 did it, but 4096 is more secure.}
211
212const
213 NETAPIwants16bitStackMin = 4096;
214FUNCTION DevEscape_extrastack(ahdc:HDC;lCode,lInCount:LONG;VAR pbInData;
215 VAR plOutCount:LONG;VAR pbOutData):LONG;
216var
217 Dummy2EatStack: array[0..NETAPIwants16bitStackMin] of char;
218begin
219 Dummy2EatStack[0] := #0;{omit compiler warning}
220 result := DevEscape (ahdc,lCode,lInCount,pbInData,plOutCount,pbOutData);
221end;
222
223FUNCTION DevEscape_fixed(ahdc:HDC;lCode,lInCount:LONG;VAR pbInData;
224 VAR plOutCount:LONG;VAR pbOutData):LONG;
225var
226 Dummy: longword;
227begin
228 Dummy := 0;{omit compiler warning}
229 if ( longword( Addr( dummy ) ) and $ffff ) < NETAPIwants16bitStackMin then
230 result := DevEscape_extrastack (ahdc,lCode,lInCount,pbInData,plOutCount,pbOutData)
231 else
232 result := DevEscape (ahdc,lCode,lInCount,pbInData,plOutCount,pbOutData);
233end;
234{$endif}
235
236const
237 Null: long = 0;
238
239{ --- For debugging purposes only --- }
240
241Procedure DisplayPrinterInfo;
242Var
243 C: cstring;
244 I: LongInt;
245Begin
246 {$IFDEF OS2}
247 PrfQueryProfileString(HINI_PROFILE,
248 'PM_SPOOLER',
249 'QUEUE',
250 Nil,
251 C,
252 SizeOf(C));
253
254 I := 0;
255 While (C[I] <> #0) And (C[I] <> ';') Do Inc(I);
256 C[I] := #0;
257
258 WriteLn(Printer.FQueueCount, ' queues, ',
259 Printer.FDeviceCount, ' devices, ',
260 'default queue is ', C);
261
262 For I := 0 To Printer.FQueueCount - 1 Do
263 Begin
264 WriteLn('--- Queue #', I, ': ---');
265 With Printer.FQueues^[I] Do
266 Begin
267 WriteLn('pszName: ', pszName);
268 WriteLn('pszPrinters: ', pszPrinters);
269 WriteLn('pszDriverName: ', pszDriverName);
270 End;
271 End;
272
273 For I := 0 To Printer.FDeviceCount - 1 Do
274 Begin
275 WriteLn('--- Device #', I, ': ---');
276 With Printer.FDevices^[I] Do
277 Begin
278 WriteLn('pszPrinterName: ', pszPrinterName);
279 WriteLn('pszLogAddr ', pszLogAddr);
280 WriteLn('pszDrivers: ', pszDrivers);
281 End;
282 End;
283 {$ENDIF}
284End;
285
286{ --- TPrinter --- }
287
288Constructor TPrinter.Create;
289Begin
290 Inherited Create;
291 FPrinters := TStringList.Create;
292 FCanvas := TCanvas.Create(Nil);
293 FCanvas.NonDisplayDevice:=True;
294 FPrintToFile := false;
295 FFileName := 'print.txt';
296 Try
297 GetPrinterInfo;
298 If Printers.Count <> 0 Then SetPrinterIndex(-1);
299 Except
300 ON E: EPrinter Do
301 ErrorBox2(LoadNLSStr(SPrinterInit1)
302 + #13#13
303 + E.Message
304 + #13#13
305 + LoadNLSStr(SPrinterInit2));
306 End;
307End;
308
309Destructor TPrinter.Destroy;
310Begin
311 SetPrinterState(psNoHandle);
312 {$IFDEF OS2}
313 If FQueueSize <> 0 Then FreeMem(FQueues, FQueueSize);
314 If FDeviceSize <> 0 Then FreeMem(FDevices, FDeviceSize);
315 {$ENDIF}
316
317 FPrinters.Free;
318 FCanvas.Free;
319 Inherited Destroy;
320End;
321
322Procedure TPrinter.Abort;
323Begin
324 If Not printing Then FmtError(SPrinterIdle, ['Abort']);
325
326 {$IFDEF OS2}
327 DevEscape_fixed(FHandle,
328 DEVESC_ABORTDOC,
329 0,
330 Null,
331 Null,
332 Null);
333 {$ENDIF}
334 {$IFDEF WIN32}
335 WinGDI.AbortDocAPI(FHandle);
336 {$ENDIF}
337
338 SetPrinterState(psNoHandle);
339 FAborted := True;
340End;
341
342Procedure TPrinter.BeginDoc;
343{$IFDEF WIN32}
344Var DI:DOCINFO;
345{$ENDIF}
346var
347 DefFnt: TFont;
348Begin
349 If printing Then FmtError(SPrinterBusy, ['BeginDoc']);
350
351 SetPrinterState(psHandleDC);
352
353 {$IFDEF OS2}
354 DevEscape_fixed(FHandle,
355 DEVESC_STARTDOC,
356 Length(FTitle) + 1,
357 PChar(FTitle)^,
358 Null,
359 Null);
360 {$ENDIF}
361 {$IFDEF WIN32}
362 DI.cbSize:=SizeOf(DOCINFO);
363 DI.lpszDocName:=PChar(FTitle);
364 DI.lpszOutput:=Nil;
365 DI.lpszDatatype:=Nil;
366 DI.fwType:=0;
367 StartDocAPI(FHandle,DI);
368 {$ENDIF}
369
370 with FCanvas do
371 begin
372 {$IFDEF OS2}
373 GpiCreateLogColorTable(Handle, LCOL_RESET, LCOLF_RGB, 0, 0, nil);
374 {$ENDIF}
375
376 with Pen do
377 begin
378 Color := clBlack;
379 Mode := pmCopy;
380 Style := psSolid;
381 end;
382
383 with Brush do
384 begin
385 Color := clWhite;
386 Mode := bmOpaque;
387 Style := bsSolid;
388 end;
389
390 DefFnt := Screen.GetFontFromPointSize('Courier New', 10);
391
392 if DefFnt = nil then
393 DefFnt := Screen.GetFontFromPointSize('Courier', 10);
394
395 Font := DefFnt;
396 end;
397
398 FAborted := False;
399 FPageNumber := 1;
400End;
401
402Procedure TPrinter.EndDoc;
403Begin
404 If Not printing Then FmtError(SPrinterIdle, ['EndDoc']);
405
406 try
407 NewPage;
408 except
409 // swallow exception if it occurs to allow tidyup
410 end;
411
412 {$IFDEF OS2}
413 DevEscape_fixed(FHandle,
414 DEVESC_ENDDOC,
415 0,
416 Null,
417 Null,
418 Null);
419 {$ENDIF}
420 {$IFDEF WIN32}
421 WinGDI.EndDocAPI(FHandle);
422 {$ENDIF}
423
424 SetPrinterState(psHandleIC);
425End;
426
427Procedure TPrinter.Error;
428Begin
429 Raise EPrinter.Create(LoadNLSStr(Id));
430End;
431
432Procedure TPrinter.FmtError;
433Begin
434 Raise EPrinter.Create(FmtLoadNLSStr(Id, Args));
435End;
436
437Function TPrinter.GetOrientation;
438Begin
439 If PageHeight >= PageWidth Then Result := poPortrait
440 Else Result := poLandscape;
441End;
442
443Function TPrinter.GetPageHeight;
444Begin
445 {$IFDEF OS2}
446 DevQueryCaps(FHandle, CAPS_HEIGHT, 1, Result);
447 {$ENDIF}
448 {$IFDEF WIN32}
449 Result := GetDeviceCaps(FHandle, VertRes);
450 {$ENDIF}
451End;
452
453Function TPrinter.GetPageWidth;
454Begin
455 {$IFDEF OS2}
456 DevQueryCaps(FHandle, CAPS_WIDTH, 1, Result);
457 {$ENDIF}
458 {$IFDEF WIN32}
459 Result := GetDeviceCaps(FHandle, HorzRes);
460 {$ENDIF}
461End;
462
463Procedure TPrinter.GetPrinterInfo;
464{$IFDEF OS2}
465Var
466 dummy, I, J, QueueTotal, DeviceTotal: LongInt;
467 S: String;
468{$ENDIF}
469Begin
470 {$IFDEF OS2}
471 SplEnumQueue('',
472 3,
473 dummy,
474 0,
475 LongWord(FQueueCount),
476 LongWord(QueueTotal),
477 LongWord(FQueueSize),
478 Nil);
479
480 GetMem(FQueues, FQueueSize);
481
482 SplEnumQueue('',
483 3,
484 FQueues^,
485 FQueueSize,
486 LongWord(FQueueCount),
487 LongWord(QueueTotal),
488 LongWord(FQueueSize),
489 Nil);
490
491 SplEnumDevice('',
492 3,
493 dummy,
494 0,
495 LongWord(FDeviceCount),
496 LongWord(DeviceTotal),
497 LongWord(FDeviceSize),
498 Nil);
499
500 GetMem(FDevices, FDeviceSize);
501
502 SplEnumDevice('',
503 3,
504 FDevices^,
505 FDeviceSize,
506 LongWord(FDeviceCount),
507 LongWord(DeviceTotal),
508 LongWord(FDeviceSize),
509 Nil);
510
511 For I := 0 To FQueueCount - 1 Do
512 Begin
513 S := FQueues^[I].pszComment^;
514 J := 1;
515 While J <= Length(S) Do
516 Begin
517 Case S[J] Of
518 #10: Delete(S, J, 1);
519 #13: S[J] := ' ';
520 End;
521 Inc(J);
522 End;
523 FPrinters.Add(S);
524 End;
525 {$ENDIF}
526End;
527
528Function TPrinter.GetPrinting;
529Begin
530 Result := (FState = psHandleDC);
531End;
532
533Procedure TPrinter.NewPage;
534var
535 rc: LONG;
536Begin
537 If Not printing Then FmtError(SPrinterIdle, ['NewPage']);
538
539 {$IFDEF OS2}
540 rc := DevEscape_fixed( FHandle,
541 DEVESC_NEWFRAME,
542 0,
543 Null,
544 Null,
545 Null );
546 if rc <> DEV_OK then
547 raise EPrinter.Create( 'Error doing New Page: '
548 + IntToStr( rc )
549 + ' WinGetLastError: '
550 + IntToHex( WinGetLastError( AppHandle ), 8 ) );
551 {$ENDIF}
552 {$IFDEF WIN32}
553 StartPage(FHandle);
554 {$ENDIF}
555
556 Inc(FPageNumber);
557End;
558
559Procedure TPrinter.OptionsDlg;
560Var
561 I: LongInt;
562Begin
563 If printing Then FmtError(SPrinterBusy, ['OptionsDlg']);
564
565 {$IFDEF OS2}
566 With FDeviceData Do
567 Begin
568 I := DevPostDeviceModes(AppHandle,
569 Nil,
570 pszDriverName^,
571 pDriv^.szDeviceName,
572 Nil,
573 DPDM_POSTJOBPROP);
574
575 If I > pDriv^.cb Then FmtError(SJobProperties, [I, pDriv^.cb]);
576
577 DevPostDeviceModes(AppHandle,
578 pDriv^,
579 pszDriverName^,
580 pDriv^.szDeviceName,
581 Nil,
582 DPDM_POSTJOBPROP);
583 End;
584 {$ENDIF}
585 SetPrinterState(FState);
586End;
587
588procedure TPrinter.PrintBitmap;
589{$IFDEF OS2}
590var
591 DC: HDC;
592 PS: HPS;
593 BM: HBITMAP;
594 Size: SIZEL;
595 Points: array[0..1] of TRect;
596{$ENDIF}
597begin
598 {$IFDEF OS2}
599 If not Printing Then FmtError(SPrinterIdle, ['PrintBitmap']);
600
601 if Bitmap = nil then Exit;
602
603 DC := 0;
604 PS := 0;
605
606 try
607 DC := DevOpenDC(AppHandle, OD_MEMORY, '*', 0,
608 nil, Handle);
609
610 Size.CX := 0;
611 Size.CY := 0;
612
613 PS := GpiCreatePS(AppHandle, DC, Size,
614 PU_PELS or GPIT_MICRO or GPIA_ASSOC);
615
616 BM := Bitmap.Handle;
617 try
618 GpiSetBitmap(Bitmap.Canvas.Handle, 0);
619 GpiSetBitmap(PS, BM);
620
621 Points[0] := DstRec;
622 Points[1] := SrcRec;
623
624 GpiBitBlt(Canvas.Handle,
625 PS,
626 4,
627 Points[0].LeftBottom,
628 ROP_SRCCOPY,
629 BBO_IGNORE);
630
631 finally
632 GpiSetBitmap(PS, 0);
633 GpiSetBitmap(Bitmap.Canvas.Handle, BM);
634 end;
635
636 finally
637 if PS <> 0 then GpiDestroyPS(PS);
638 if DC <> 0 then DevCloseDC(DC);
639 end;
640 {$ENDIF}
641end;
642
643procedure TPrinter.PrintForm;
644var
645 Image: TBitmap;
646begin
647 If not Printing Then FmtError(SPrinterIdle, ['PrintForm']);
648
649 Image := TBitmap(Form.GetFormImage);
650 try
651 PrintBitmap(Image,
652 Forms.Rect(0, 0, Image.Width, Image.Height),
653 DstRec);
654 finally
655 Image.Free;
656 end;
657end;
658
659Procedure TPrinter.SetPrinterIndex;
660{$IFDEF OS2}
661Var
662 C: cstring;
663 P: PChar;
664 I: LongInt;
665{$ENDIF}
666Begin
667 If printing Then FmtError(SPrinterBusy, ['SetPrinterIndex']);
668
669 {$IFDEF OS2}
670 If Value = -1 Then
671 Begin
672 // Query Default Queue Name
673 PrfQueryProfileString(HINI_PROFILE,
674 'PM_SPOOLER',
675 'QUEUE',
676 Nil,
677 C,
678 SizeOf(C));
679
680 // Remove useless semicolon At End
681 I := 0;
682 While (C[I] <> #0) And (C[I] <> ';') Do
683 Inc(I);
684 C[I] := #0;
685
686 // Find Index Of Default Queue
687 I := 0;
688 While (I < FQueueCount) And (C <> FQueues^[I].pszName^) Do
689 Inc(I);
690
691 If I < FQueueCount Then Value := I Else Value := 0;
692 End;
693
694 // Change Current Queue If Value Is legal
695 If (Value < 0) Or (Value >= FQueueCount) Then FmtError(SInvalidIndex, [Value, Printers.Count]);
696 FQueueIndex := Value;
697
698 // Get Printer Name Of Selected Queue, Find matching Device
699 P := FQueues^[FQueueIndex].pszPrinters;
700
701 I := 0;
702 While (I < FDeviceCount) And (P^ <> FDevices^[I].pszPrinterName^) Do
703 Inc(I);
704
705 If I = FDeviceCount Then FmtError(SDeviceNotFound, [P]);
706
707 FDeviceIndex := I;
708
709 // Set Device Name
710 C := FQueues^[FQueueIndex].pszDriverName^;
711 I := 0;
712 While (C[I] <> #0) And (C[I] <> '.') Do Inc(I);
713 C[I] := #0;
714 FDeviceName := C;
715
716 // Fill Device Open structure
717 With FDeviceData Do
718 Begin
719 If FPrintToFile Then pszLogAddress := PChar(FileName)
720 Else pszLogAddress := FQueues^[FQueueIndex].pszName;
721
722 pszDriverName := @FDeviceName;
723 pszDataType := 'PM_Q_STD';
724 pDriv := FQueues^[FQueueIndex].pDriverData;
725 End;
726 {$ENDIF}
727
728 // Get Info context
729 SetPrinterState(psHandleIC);
730End;
731
732Procedure TPrinter.SetPrinterState;
733{$IFDEF OS2}
734Var
735 C: cstring[16];
736 S: SIZEL;
737 D, E: LongInt;
738{$ENDIF}
739Begin
740 {$IFDEF OS2}
741 If FCanvas.Handle <> 0 Then
742 Begin
743 GpiDestroyPS(FCanvas.Handle);
744 FCanvas.Handle := 0;
745 End;
746
747 If FHandle <> 0 Then
748 Begin
749 DevCloseDC(FHandle);
750 FHandle := 0;
751 End;
752
753 If FCopies > 1 Then
754 Begin
755 C := 'COP=' + tostr(FCopies);
756 FDeviceData.pszQueueProcParams := @C;
757 End;
758
759 Case Value Of
760 psHandleIC:
761 Begin
762 FHandle := DevOpenDC(AppHandle,
763 OD_INFO,
764 '*',
765 4,
766 FDeviceData,
767 0);
768
769 If FHandle = 0 Then
770 Begin
771 E := WinGetLastError(AppHandle);
772 FmtError(SNoHandleIC, [E]);
773 End;
774 End;
775
776 psHandleDC:
777 Begin
778 If FPrintToFile Then D := OD_DIRECT Else D := OD_QUEUED;
779
780 FHandle := DevOpenDC(AppHandle,
781 D,
782 '*',
783 9,
784 FDeviceData,
785 0);
786
787 If FHandle = 0 Then
788 Begin
789 E := WinGetLastError(AppHandle);
790 FmtError(SNoHandleDC, [E]);
791 End;
792
793 S.CX := 0;
794 S.CY := 0;
795
796 FCanvas.Handle := GpiCreatePS(AppHandle,
797 FHandle,
798 S,
799 //PU_ARBITRARY Or GPIF_DEFAULT Or GPIT_MICRO Or GPIA_ASSOC
800 PU_PELS or GPIT_MICRO or GPIA_ASSOC
801 );
802
803 If FCanvas.Handle = 0 Then
804 Begin
805 E := WinGetLastError(AppHandle);
806 DevCloseDC(FHandle);
807 FHandle := 0;
808 FmtError(SNoHandlePS, [E]);
809 End;
810 End;
811 End;
812 {$ENDIF}
813
814 FState := Value;
815End;
816
817Procedure TPrinter.SetPrintToFile;
818Begin
819 FPrintToFile := Value;
820 {$IFDEF OS2}
821 With FDeviceData Do
822 Begin
823 If FPrintToFile Then pszLogAddress := PChar(FileName)
824 Else pszLogAddress := FDevices^[FDeviceIndex].pszLogAddr;
825 End;
826 {$ENDIF}
827End;
828
829Procedure TPrinter.SetFileName;
830Begin
831 FFileName := Value;
832 SetPrintToFile(FPrintToFile);
833End;
834
835Initialization
836 Try //just To Make sure <G>
837 Printer := TPrinter.Create; { cannot Fail anymore }
838 Except
839 Printer:=Nil;
840 End;
841
842Finalization
843 Printer.Free;
844
845End.
846
847{ -- date -- - changes ------------------------------------------
848
849 22-Dec-97 Initial Release.
850 28-Jan-97 printing To File didn't work when FileName was
851 specified With PrintToFile already being True.
852 08-Feb-97 Device Name now 32 characters. Problems With
853 systems where several Printer Objects Use the same
854 Device. results In 'No queue for device'. don't
855 know how To fix This.
856 27-Feb-97 removed Some debugging stuff.
857 05-Mar-97 FIXED bug that resulted In 'No queue for device'.
858 moved Error Messages To Resource Id 65300.
859 13-Mar-97 Some changes by Rene Nrnberger
860 04-Apr-97 GetPrinterInfo now replaces #13#10 by A space
861 If the Printer Name Is Multi-Line.
862 15-Apr-97 additional diagnostic information when DevOpenDC
863 Or GpiCreatePS Fail. New Error Handling For
864 startup sequence. Existence Of Printer Instance
865 guaranteed.
866 16-Apr-97 Rene: Saved Initialization part With Try..Except.
867 This Is only For safety If For Instance A GPF
868 occurs within the Constructor.
869 05-Aug-97 J”rg: Fixed bug reported by Alex Vermeulen.
870 Printer had no palette, which resulted in
871 empty pages when trying to use RGB colors.
872 Some other initialization also done on
873 every BeginDoc: Pen, Brush and Font set to
874 default values.
875 06-Aug-97 J”rg: Default printer font is now either
876 "Courier New" or "Courier", depending on
877 which one is available. Changes to BeginDoc
878 and SetPrinterState.
879 16-Aug-97 J”rg: Added methods PrintBitmap and PrintForm.
880
881 --------------------------------------------------------------- }
Note: See TracBrowser for help on using the repository browser.