--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/WinPrinterContext.st Mon Apr 16 12:40:02 2007 +0200
@@ -0,0 +1,1305 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libview2' }"
+
+GraphicsMedium subclass:#WinPrinterContext
+ instanceVariableNames:'name abort jobid printerInfo textAlign'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Printing'
+!
+
+!WinPrinterContext class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ I am the mediator between the smalltalk printing protocol
+ (which is the same as the graphics drawing protocol) and the
+ windows printer.
+ When youopena printer, you will typically talk to me, and I will
+ forward the graphics commands to my printer.
+
+ [author:]
+ Felix Madrid (fm@exept.de)
+"
+! !
+
+!WinPrinterContext class methodsFor:'instance creation'!
+
+fromPrinterInfo: aPrinterInfo
+ | aPrinter hDC|
+
+ hDC := aPrinterInfo createDC.
+ hDC = 0 ifTrue: [ ^self error: 'Error while opening printer.' ].
+
+ aPrinter := self new.
+ aPrinter printerInfo: aPrinterInfo.
+ aPrinter setDevice:(WinPrinter on: aPrinterInfo) id:nil gcId:hDC.
+ aPrinter initExtent.
+ ^aPrinter
+
+ "Created: / 03-08-2006 / 12:53:52 / fm"
+ "Modified: / 04-08-2006 / 12:55:01 / fm"
+ "Modified: / 16-04-2007 / 12:36:26 / cg"
+! !
+
+!WinPrinterContext class methodsFor:'accessing'!
+
+default
+ "Answer the default Printer, or nil if none."
+
+ |defaultName|
+
+ ^ (defaultName := self defaultPrinterName) isNil
+ ifTrue:[ nil ]
+ ifFalse:[ self named:defaultName ]
+
+ "
+ self default
+ "
+
+ "Created: / 27-07-2006 / 17:51:43 / fm"
+ "Modified: / 02-08-2006 / 17:27:09 / fm"
+ "Modified: / 10-10-2006 / 17:30:31 / cg"
+!
+
+defaultMargins
+ "Private - answer aPoint containing the default horizontal and vertical
+ margins for a page (units in inches)."
+
+ ^ 0.5 @ 0.75
+
+ "Created: / 01-08-2006 / 16:09:31 / fm"
+ "Modified: / 10-10-2006 / 17:30:49 / cg"
+!
+
+defaultPrinterName
+ "Answer the name of the default printer, or nil if none."
+
+ |printerInfo printerName|
+
+ printerInfo := OperatingSystem getDefaultPrinterName.
+ printerName := (printerInfo copyFrom:1 to:(printerInfo indexOf:$,) - 1) trimBlanks.
+ ^ printerName size == 0 ifTrue:[ nil ] ifFalse:[ printerName ]
+
+ "
+ PrinterContext defaultPrinterName
+ "
+
+ "Modified: / 02-08-2006 / 17:26:09 / fm"
+ "Modified: / 10-10-2006 / 17:32:45 / cg"
+!
+
+getPrinterInformation:printerNameString
+ " Answer the printer information for the printer named printerNameString. If no name is specified,
+ answer the information for the default printer."
+
+ |h|
+
+ h := OperatingSystem openPrinter:printerNameString.
+ ^ OperatingSystem
+ getDocumentProperties:nil
+ hPrinter:h
+ pDeviceName:printerNameString.
+
+ "Created: / 27-07-2006 / 10:22:32 / fm"
+ "Modified: / 01-08-2006 / 16:01:44 / fm"
+ "Modified: / 10-10-2006 / 18:57:45 / cg"
+!
+
+named: aName
+ "Answer a new instance of Printer which represents
+ the printer named aName as specified in the host
+ Control Panel."
+
+ aName isNil ifTrue: [ ^self default ].
+ ^self new printerInfoWithName: aName
+
+ "Created: / 27-07-2006 / 17:51:27 / fm"
+ "Modified: / 02-08-2006 / 17:26:29 / fm"
+ "Modified: / 10-10-2006 / 17:33:29 / cg"
+!
+
+printerNames
+ "Answer a collection of all known printer names."
+
+ ^ OperatingSystem getPrintersNames
+
+ "Created: / 27-07-2006 / 17:54:45 / fm"
+ "Modified: / 10-10-2006 / 18:57:51 / cg"
+! !
+
+!WinPrinterContext class methodsFor:'testing & examples'!
+
+print: aString font: aFont title: aTitle
+ "Open a print dialog to allow printing of the given string
+ using the given title & font."
+
+ self print: aString font: aFont title: aTitle wordWrap: false
+
+ "
+ PrinterContext print: 'Holaaaa!! (from: PrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test'
+ PrinterContext print: self printingTestString font: nil title: 'Printing Test String'
+ PrinterContext print: self printingTestString font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String'
+ "
+
+ "Created: / 27-07-2006 / 17:52:33 / fm"
+ "Modified: / 03-08-2006 / 18:52:31 / fm"
+ "Modified: / 10-10-2006 / 17:37:49 / cg"
+!
+
+print: aString font: aFont title: aTitle wordWrap: wordWrap
+ "Open a print dialog to allow printing of the given string
+ using the given title & font."
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer
+ print: aString
+ font: aFont
+ title: aTitle
+ wordWrap: wordWrap
+ marginsRect: nil
+ ] forkAt: 3
+
+ "
+ PrinterContext print: 'Holaaaa!! (from: PrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test' wordWrap: true
+ PrinterContext print: (PrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font:nil title:'Printing Test String' wordWrap:true
+ PrinterContext print: (PrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String' wordWrap: true
+ "
+
+ "Created: / 03-08-2006 / 18:51:53 / fm"
+ "Modified: / 10-10-2006 / 17:42:06 / cg"
+!
+
+printCircles: arrayOfPointsAndRadius
+ "Opens a print dialog and prints the given circles"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Circles'.
+ arrayOfPointsAndRadius
+ do:[:pointAndRadius |
+ printer displayCircle:(pointAndRadius at:1)
+ radius:(pointAndRadius at:2).
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printCircles:
+ (Array with: (Array with: 800@800 with: 600)
+ with: (Array with: 1500@1500 with: 1000)
+ with: (Array with: 4000@2500 with: 2000))
+ "
+
+ "Created: / 07-08-2006 / 11:46:52 / fm"
+ "Modified: / 10-10-2006 / 17:36:23 / cg"
+!
+
+printCirclesIn: rectangles
+ "Opens a print dialog and prints the given circles"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Circles In Rectangles'.
+ rectangles
+ do:[:rectangle |
+ printer displayCircleIn: rectangle.
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printCirclesIn:
+ (Array with: (Rectangle left:20 top:20 width:400 height:600)
+ with: (Rectangle left:40 top:40 width:600 height:400)
+ )
+ "
+
+ "Created: / 07-08-2006 / 11:48:46 / fm"
+ "Modified: / 10-10-2006 / 17:38:28 / cg"
+!
+
+printLines: pairOfPointsArray
+ "Opens a print dialog and prints the given lines"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Lines'.
+ printer foreground:Color black background:Color white.
+ pairOfPointsArray
+ do:[:pairOfPoints |
+ printer displayLineFrom: (pairOfPoints at:1) to: (pairOfPoints at:2).
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printLines:
+ (Array with: (Array with:10@10 with:100@10)
+ with: (Array with:10@10 with:35@200))
+ "
+
+ "Created: / 07-08-2006 / 12:09:48 / fm"
+ "Modified: / 07-08-2006 / 14:11:17 / fm"
+ "Modified: / 10-10-2006 / 17:38:44 / cg"
+!
+
+printPolygons: polygons
+ "Opens a print dialog and prints the given polygons"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Polygons'.
+ printer foreground:Color black background:Color white.
+ polygons
+ do:[:aPolygon |
+ aPolygon displayStrokedOn: printer.
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printPolygons:
+ (Array with: (Polygon vertices:(
+ Array
+ with:10@10
+ with:60@10
+ with:35@60)))
+ "
+
+ "Created: / 07-08-2006 / 12:09:48 / fm"
+ "Modified: / 07-08-2006 / 14:11:17 / fm"
+ "Modified: / 10-10-2006 / 17:39:23 / cg"
+!
+
+printRectangles: rectangles
+ "Opens a print dialog and prints the given rectangles"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Rectangles'.
+ rectangles
+ do:[:rectangle |
+ printer displayRectangleX: rectangle origin x
+ y: rectangle origin y
+ width: rectangle width
+ height: rectangle height.
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printRectangles:
+ (Array with: (Rectangle left:20 top:20 width:400 height:600)
+ with: (Rectangle left:40 top:40 width:600 height:400)
+ )
+ "
+
+ "Created: / 07-08-2006 / 11:40:48 / fm"
+ "Modified: / 10-10-2006 / 17:39:51 / cg"
+!
+
+printStrings: stringAndPositionsArray
+ "Opens a print dialog and prints the given strings"
+
+ | printerInfo printer |
+
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+ printer := self fromPrinterInfo: printerInfo.
+ [
+ printer startPrintJob: 'Strings with Position'.
+ printer foreground:Color black background:Color white.
+ stringAndPositionsArray
+ do:[:pairOfPointsAndPosition |
+ printer displayString:(pairOfPointsAndPosition at: 1)
+ x:(pairOfPointsAndPosition at: 2) x
+ y:(pairOfPointsAndPosition at: 2) y
+ ].
+ printer endPrintJob.
+ ] forkAt: 3
+
+ "
+ PrinterContext printStrings:
+ (Array with: (Array with:'Testing printing with standart method' with:10@10)
+ with: (Array with:'Another test string to print' with:80@200))
+ "
+
+ "Created: / 07-08-2006 / 12:09:48 / fm"
+ "Modified: / 07-08-2006 / 14:11:17 / fm"
+ "Modified: / 10-10-2006 / 17:40:07 / cg"
+! !
+
+!WinPrinterContext methodsFor:'abort handling'!
+
+abortPrintJob
+ "Abort the current print job."
+
+ abort := true.
+ jobid := nil.
+
+ "Modified: / 02-08-2006 / 15:40:26 / fm"
+ "Modified: / 10-10-2006 / 18:13:45 / cg"
+!
+
+aborted
+ "Answer whether the user aborted from PrintAbortDialog."
+
+ ^ abort
+
+ "Created: / 27-07-2006 / 10:20:10 / fm"
+ "Modified: / 10-10-2006 / 18:13:50 / cg"
+! !
+
+!WinPrinterContext methodsFor:'accessing'!
+
+container
+
+ ^self
+!
+
+getCharHeight
+ "Private - answer the height of the font selected in the receiver's
+ device context."
+
+ |textMetrics answer|
+
+
+ textMetrics := Win32OperatingSystem::TextMetricsStructure new.
+"/ (OperatingSystem getTextMetrics:gcId lpMetrics:textMetrics) ifFalse:[ ^ self error ].
+"/ Transcript showCR: 'CHAR HEIGHT PRIM ******* ', ' ', (textMetrics tmHeight + textMetrics tmExternalLeading) printString.
+"/ Transcript showCR: 'CHAR HEIGHT DEVICE ***** ', ' ', (self font heightOf:'PQWEXCZ' on:self device) printString.
+ answer := (self font heightOf:'PQWEXCZ' on:self device).
+"/ answer := textMetrics tmHeight + textMetrics tmExternalLeading.
+ ^answer
+
+ "Created: / 02-08-2006 / 17:47:20 / fm"
+ "Modified: / 03-08-2006 / 10:09:01 / fm"
+ "Modified: / 10-10-2006 / 18:15:17 / cg"
+!
+
+horizontalPixelsPerMeter
+ "Answer horizontal pixels per meter
+ on the screen."
+ ^self pixelsPerInchOfScreenWidth * 39.3700787
+!
+
+name
+ "Answer the receiver's name from the current printerInfo."
+
+ ^ self printerInfo printerName
+
+ "Modified: / 02-08-2006 / 16:55:03 / fm"
+ "Modified: / 10-10-2006 / 18:15:33 / cg"
+!
+
+name:aName
+ "Set the receiver's printer name to aName."
+
+ self printerInfo:(self class getPrinterInformation:aName)
+
+ "Modified: / 10-10-2006 / 18:15:36 / cg"
+!
+
+numberOfColorBitsPerPixel
+ ^ OperatingSystem getDeviceCaps:gcId index:12 "Bitspixel"
+
+ "Created: / 03-08-2006 / 09:58:18 / fm"
+ "Modified: / 10-10-2006 / 18:15:40 / cg"
+!
+
+physicalOffsetX
+
+ "Papierhöhe in Pixels"
+ "Changed by K3/EEZ3-Mg, 02.03.99"
+
+ ^ OperatingSystem getDeviceCaps:gcId index:112 "PhysicalOffsetX"
+
+ "Created: / 01-08-2006 / 16:28:34 / fm"
+!
+
+physicalOffsetY
+
+ "Papierhöhe in Pixels"
+ "Changed by K3/EEZ3-Mg, 02.03.99"
+
+ ^ OperatingSystem getDeviceCaps:gcId index:113 "PhysicalOffsetY"
+
+ "Created: / 01-08-2006 / 16:28:34 / fm"
+!
+
+pixelsPerInchOfScreenHeight
+ ^ OperatingSystem getDeviceCaps:gcId index:90 "Logpixelsy"
+
+ "Created: / 01-08-2006 / 16:29:16 / fm"
+!
+
+pixelsPerInchOfScreenWidth
+ ^ OperatingSystem getDeviceCaps:gcId index:88 "Logpixelsx"
+
+ "Created: / 01-08-2006 / 16:28:34 / fm"
+!
+
+printerHeightArea
+ ^ (OperatingSystem getDeviceCaps:gcId index:10)
+
+ "Modified: / 10-10-2006 / 18:18:31 / cg"
+!
+
+printerInfo
+ "Answer the receiver's name from the current printerInfo."
+
+ ^ printerInfo
+
+ "Created: / 02-08-2006 / 16:55:17 / fm"
+ "Modified: / 10-10-2006 / 18:18:34 / cg"
+!
+
+printerInfo:aPrinterInfo
+ "Sets the receiver's printerInfo."
+
+ printerInfo := aPrinterInfo
+
+ "Created: / 02-08-2006 / 16:55:34 / fm"
+ "Modified: / 03-08-2006 / 13:11:19 / fm"
+ "Modified: / 10-10-2006 / 18:18:37 / cg"
+!
+
+printerInfoWithName:aName
+ "Set the receiver's printer name to aName."
+
+ self printerInfo:(self class getPrinterInformation:aName).
+ ^ self
+
+ "Created: / 02-08-2006 / 16:55:52 / fm"
+ "Modified: / 10-10-2006 / 18:18:41 / cg"
+!
+
+printerPhysicalHeight
+ ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:111 "PhysicalHeight"
+
+ "Created: / 01-08-2006 / 16:14:08 / fm"
+!
+
+printerPhysicalWidth
+ ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:110 "PhysicalWidth"
+
+ "Created: / 01-08-2006 / 16:14:08 / fm"
+!
+
+printerUserFriendlyName
+ "Answer the receiver's name from the current printerInfo."
+
+ ^ self printerInfo userFriendlyName
+
+ "Created: / 03-08-2006 / 12:55:57 / fm"
+ "Modified: / 10-10-2006 / 18:18:55 / cg"
+!
+
+printerWidthArea
+ ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:8 "Horzres"
+
+ "Created: / 01-08-2006 / 16:14:08 / fm"
+!
+
+setPrinterFont:aFont
+
+ self font: aFont
+
+ "Created: / 27-11-2006 / 14:50:55 / User"
+!
+
+setTextAlign:aNumber
+
+"/ OperatingSystem setTextAlign: aNumber to: gcId.
+ textAlign :=aNumber.
+!
+
+setViewportOrg: aPoint
+
+ ^ OperatingSystem
+ setViewportOrg: gcId "deviceContext"
+ x: aPoint x
+ y: aPoint y
+ oldOrigin: nil
+
+ "Created: / 01-08-2006 / 16:14:08 / fm"
+!
+
+verticalPixelsPerMeter
+ "Answer vertical pixels per inch
+ on the screen."
+
+ ^self pixelsPerInchOfScreenHeight * 39.3700787
+! !
+
+!WinPrinterContext methodsFor:'initialization & release'!
+
+buildPrinter
+ "Private - create all the operating system resources needed."
+
+ self
+ createDC;
+ initExtent
+
+ "Created: / 27-07-2006 / 10:20:36 / fm"
+ "Modified: / 01-08-2006 / 15:57:49 / fm"
+ "Modified: / 10-10-2006 / 18:14:04 / cg"
+!
+
+createDC
+ "Private - Create a device context for the receiver"
+
+ gcId := printerInfo createDC
+
+ "Created: / 27-07-2006 / 10:21:05 / fm"
+ "Modified: / 02-08-2006 / 17:30:47 / fm"
+ "Modified: / 10-10-2006 / 18:14:28 / cg"
+!
+
+executor
+ |aCopy|
+
+ aCopy := WinWorkstation::PrinterDeviceContextHandle basicNew.
+ aCopy setDevice:device id:nil gcId:gcId.
+ ^ aCopy
+
+ "Created: / 16-04-2007 / 12:39:02 / cg"
+!
+
+initExtent
+ "Private - init the width and height of GraphicsTool for the receiver."
+
+ width := self printerWidthArea.
+ height := self printerHeightArea.
+ device
+ width:width;
+ height:height.
+
+
+ "Modified: / 01-08-2006 / 16:14:49 / fm"
+! !
+
+!WinPrinterContext methodsFor:'printing'!
+
+print:aString font:aFont title:aTitle wordWrap:wordWrapBoolean marginsRect:aMarginsRect
+ "Answer the receiver. Output the receiver string to
+ the printer using aFont. A Print abort dialog box will be opened
+ with aTitle. If collateBoolean is true, collate output, otherwise
+ do not. Print copiesInteger copies of the specified string. If
+ wordWrapBoolean is true, word wrap the lines, otherwise do not.
+ Left, top, right & bottom margins are specified in inches in
+ aMarginsRect."
+
+ |lines linesPerPage totalPage marginsRect firstPage abortDialog|
+
+ jobid isNil ifTrue:[
+ self startPrintJob:aTitle
+ ].
+ abortDialog := PrintAbortDialog new open:aTitle printer:self.
+ self font:aFont.
+ marginsRect := self marginsRectangleFor:aMarginsRect.
+ lines := self
+ asArrayOfStringLines:aString
+ in:marginsRect
+ wordWrap:wordWrapBoolean.
+ linesPerPage := self linesPerPageFor: marginsRect.
+ totalPage := (lines size + linesPerPage - 1) // linesPerPage.
+ firstPage := true.
+
+"/ collateBoolean
+"/ ifTrue: [
+"/ copiesInteger timesRepeat: [
+
+ 1 to:totalPage do:[:page |
+ abort ifTrue:[ ^ self ].
+ firstPage ifFalse:[
+ self formFeed
+ ].
+ abortDialog
+ updatePrintingPageInfo:(self class classResources
+ string:'Page %1/%2'
+ with:page printString
+ with:totalPage printString).
+
+"/ self device font: printerFont.
+
+ self font:aFont.
+ self
+ printPage:page
+ in:marginsRect
+ lines:lines
+ linesPerPage:linesPerPage.
+ firstPage := false
+ ].
+
+"/ ]
+"/ ] ifFalse: [
+"/ 1 to: totalPage do: [ :page |
+"/ copiesInteger timesRepeat: [
+"/ abort ifTrue: [ ^self endPrintJob ].
+"/ firstPage ifFalse: [ self formFeed ].
+"/ self device font: printerFont.
+"/ self printPage: page in: marginsRect lines: lines linesPerPage: linesPerPage.
+"/ firstPage := false
+"/ ]
+"/ ]
+"/ ].
+
+ jobid notNil ifTrue:[
+ self endPrintJob.
+ abortDialog close.
+ ].
+
+ "/ abort ifFalse: [ abortDialog close ]
+
+ "Created: / 03-08-2006 / 16:13:33 / fm"
+ "Modified: / 04-08-2006 / 13:40:02 / fm"
+ "Modified: / 10-10-2006 / 18:16:54 / cg"
+ "Modified: / 12-10-2006 / 11:50:37 / User"
+!
+
+print: aString
+ pageHeader: aString2
+ font: aFont
+ title: aTitle
+ collate: collateBoolean
+ copies: copiesInteger
+ wordWrap: wordWrapBoolean
+ marginsRect: aMarginsRect
+
+ "Private - Answer the receiver. Output the receiver string to
+ the printer using aFont. A Print abort dialog box will be opened
+ with aTitle. If collateBoolean is true, collate output, otherwise
+ do not. Print copiesInteger copies of the specified string. If
+ wordWrapBoolean is true, word wrap the lines, otherwise do not.
+ Left, top, right & bottom margins are specified in inches in
+ aMarginsRect.
+ Mg: Erweitert um pageHeader"
+ "Changed by K3/EES5-Mg, 08.01.96"
+
+ | lines linesPerPage totalPage marginsRect firstPage charHeight printerFont headerLines|
+
+ printerFont := self setPrinterFont: aFont.
+ charHeight := self "pen" getCharHeight.
+ marginsRect := self marginsRectangleFor: aMarginsRect.
+ lines := self "pen" asArrayOfStringLines: aString in: marginsRect wordWrap: wordWrapBoolean.
+ headerLines := self "pen" asArrayOfStringLines: aString2 in: marginsRect wordWrap: wordWrapBoolean.
+ linesPerPage := marginsRect bottom - marginsRect top // charHeight.
+
+ linesPerPage > headerLines size
+ ifFalse:
+ [Dialog information: 'Der Dokumentenkopf ist zu groß; wird ignoriert!!'.
+ headerLines := #().
+ ]
+ ifTrue: [linesPerPage := linesPerPage - headerLines size].
+ totalPage := lines size + linesPerPage - 1 // linesPerPage.
+ firstPage := true.
+
+"/ collateBoolean
+"/ ifTrue: [
+"/ copiesInteger timesRepeat: [
+
+ 1 to: totalPage do: [ :page |
+ abort ifTrue: [ ^self endPrintJob ].
+ firstPage ifFalse: [ self formFeed ].
+ self "pen" font: aFont "printerFont".
+ self printPage: page in: marginsRect lines: lines headerLines: headerLines linesPerPage: linesPerPage.
+ firstPage := false ]
+
+"/ ]
+"/ ]
+"/ ifFalse: [
+"/ 1 to: totalPage do: [ :page |
+"/ copiesInteger timesRepeat: [
+"/ abort ifTrue: [ ^self endPrintJob ].
+"/ firstPage ifFalse: [ self formFeed ].
+"/ self "pen" font: printerFont.
+"/ self printPage: page in: marginsRect lines: lines headerLines: headerLines linesPerPage: linesPerPage.
+"/ firstPage := false ] ] ].
+
+ "Created: / 30-11-2006 / 13:19:06 / User"
+!
+
+print:aString pageHeader:aString2 font:aFont title:aTitle wordWrap:wordWrapBoolean marginsRect:aMarginsRect
+ "Private - Answer the receiver. Output the receiver string to
+ the printer using aFont. A Print abort dialog box will be opened
+ with aTitle. If collateBoolean is true, collate output, otherwise
+ do not. Print copiesInteger copies of the specified string. If
+ wordWrapBoolean is true, word wrap the lines, otherwise do not.
+ Left, top, right & bottom margins are specified in inches in
+ aMarginsRect."
+
+ |lines linesPerPage totalPage marginsRect firstPage charHeight printerFont headerLines|
+
+ self font:aFont.
+ charHeight := self getCharHeight.
+ marginsRect := self marginsRectangleFor:aMarginsRect.
+ lines := self
+ asArrayOfStringLines:aString
+ in:marginsRect
+ wordWrap:wordWrapBoolean.
+ headerLines := self
+ asArrayOfStringLines:aString2
+ in:marginsRect
+ wordWrap:wordWrapBoolean.
+ linesPerPage := (marginsRect bottom - marginsRect top) // charHeight.
+ linesPerPage > headerLines size ifFalse:[
+ Dialog information:(self class classResources
+ string:'The header is too large - ignored!!').
+ headerLines := #().
+ ] ifTrue:[
+ linesPerPage := linesPerPage - headerLines size
+ ].
+ totalPage := (lines size + linesPerPage - 1) // linesPerPage.
+ firstPage := true.
+
+"/ collateBoolean
+"/ ifTrue: [
+"/ copiesInteger timesRepeat: [
+
+ 1 to:totalPage do:[:page |
+ abort ifTrue:[ ^ self ].
+ firstPage ifFalse:[
+ self formFeed
+ ].
+ self font:printerFont.
+ self
+ printPage:page
+ in:marginsRect
+ lines:lines
+ headerLines:headerLines
+ linesPerPage:linesPerPage.
+ firstPage := false
+ ]
+
+ "/ ]
+ "/ ] ifFalse: [
+ "/ 1 to: totalPage do: [ :page |
+ "/ copiesInteger timesRepeat: [
+ "/ abort ifTrue: [ ^self endPrintJob ].
+ "/ firstPage ifFalse: [ self formFeed ].
+ "/ self device font: printerFont.
+ "/ self printPage: page in: marginsRect lines: lines headerLines: headerLines linesPerPage: linesPerPage.
+ "/ firstPage := false
+ "/ ]
+ "/ ]
+ "/ ].
+
+ "Created: / 03-08-2006 / 16:14:10 / fm"
+ "Modified: / 10-10-2006 / 18:18:03 / cg"
+! !
+
+!WinPrinterContext methodsFor:'printing process'!
+
+endPage
+ "Informs device that we are finished writing to a page."
+
+ (OperatingSystem endPage:gcId) > 0 ifFalse:[
+ self error
+ ]
+
+ "Created: / 27-07-2006 / 18:20:48 / fm"
+ "Modified: / 01-08-2006 / 16:01:34 / fm"
+ "Modified: / 10-10-2006 / 18:14:44 / cg"
+!
+
+endPrintJob
+ "End the print job. Everything drawn between startPrintJob
+ and endPrintJob will become one entry in the print queue."
+
+ |result|
+
+ self endPage.
+ result := OperatingSystem endDoc:gcId.
+ device close.
+ gcId := nil.
+ jobid := nil.
+ result >= 0 ifFalse:[ self error ]
+
+ "Created: / 27-07-2006 / 18:21:04 / fm"
+ "Modified: / 01-08-2006 / 16:01:38 / fm"
+ "Modified: / 10-10-2006 / 18:50:43 / cg"
+!
+
+formFeed
+ "Send a form feed to the printer."
+
+ self
+ endPage;
+ startPage
+
+ "Created: / 27-07-2006 / 18:25:40 / fm"
+ "Modified: / 10-10-2006 / 18:15:07 / cg"
+!
+
+startPage
+ "Starts a page."
+
+ (OperatingSystem startPage:gcId) > 0 ifFalse:[
+ ^ self error
+ ].
+
+ "Created: / 27-07-2006 / 18:25:55 / fm"
+ "Modified: / 28-07-2006 / 18:19:04 / fm"
+ "Modified: / 10-10-2006 / 18:19:02 / cg"
+!
+
+startPrintJob
+ "Start a print job. Everything drawn between startPrintJob
+ and endPrintJob will become one entry in the print queue."
+
+ self startPrintJob:nil
+
+ "Created: / 27-07-2006 / 18:18:52 / fm"
+ "Modified: / 10-10-2006 / 18:19:05 / cg"
+!
+
+startPrintJob:aString
+ "Start a print job, using aString as the job title; everything
+ drawn between startPrintJob and endPrintJob will become
+ one entry in the print queue."
+
+ ^ self startPrintJob:aString fileName:nil
+
+ "Created: / 27-07-2006 / 18:19:09 / fm"
+ "Modified: / 10-10-2006 / 18:19:12 / cg"
+!
+
+startPrintJob:aString fileName:aFileName
+ "Start a print job, using aString as the job title; everything
+ drawn between startPrintJob and endPrintJob will become
+ one entry in the print queue."
+
+ |docInfoStruct nameAddress title fileNameAddress|
+
+ gcId isNil ifTrue:[
+ self buildPrinter
+ ].
+ abort := false.
+ title := aString ? 'Smalltalk/X'.
+ nameAddress := title asExternalBytes unprotectFromGC.
+ aFileName isNil ifFalse:[
+ fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC
+ ].
+ docInfoStruct := Win32OperatingSystem::DocInfoStructure new.
+ docInfoStruct
+ cbSize:docInfoStruct sizeInBytes;
+ lpszDocName:nameAddress address.
+ fileNameAddress isNil ifFalse:[
+ docInfoStruct lpszOutput:fileNameAddress address
+ ].
+ jobid := OperatingSystem startDoc:gcId docInfo:docInfoStruct.
+ jobid > 0 ifFalse:[
+ jobid = -1 ifTrue:[
+ abort := true.
+ ^ nil
+ ].
+ ^ self error
+ ].
+ self startPage
+
+ "Created: / 27-07-2006 / 18:19:31 / fm"
+ "Modified: / 03-08-2006 / 15:11:19 / fm"
+ "Modified: / 10-10-2006 / 18:20:01 / cg"
+! !
+
+!WinPrinterContext methodsFor:'queries'!
+
+supportsColor
+
+"/ | retVal info |
+"/
+"/ info := (self class getPrinterInformation: self name) asUppercase.
+"/ (info includesSubstring: ',PSCRIPT,')
+"/ ifTrue: [
+"/ retVal := (DAPASX::DapasSystemInfo getYesNoInfoApp: 'Printer' profile: 'PostScriptBlackWhite') not.
+"/ ]
+"/ ifFalse: [
+"/ retVal := (info includesSubstring: 'PDF')
+"/ ifTrue: [true]
+"/ ifFalse: [self numberOfColorBitsPerPixel > 1].
+"/ ].
+"/
+"/ ^retVal
+
+ ^ false.
+
+ "Created: / 03-08-2006 / 09:55:26 / fm"
+ "Modified: / 04-08-2006 / 13:20:40 / fm"
+ "Modified: / 10-10-2006 / 18:21:07 / cg"
+!
+
+supportsGraphics
+ ^(OperatingSystem getDeviceCaps: gcId "asParameter" index: 2 "Technology") ~= 4
+
+ "Created: / 03-08-2006 / 10:07:43 / fm"
+ "Modified: / 10-10-2006 / 18:21:14 / cg"
+! !
+
+!WinPrinterContext methodsFor:'text printing'!
+
+asArrayOfStringLines:aString in:aRectangle wordWrap:wordWrapBoolean
+ "Private - convert aString into an array of lines; if wordWrapBoolean
+ is true, also perform word wrapping on the lines, within aRectangle."
+
+ |line lines stream x0 x1 partialLine leftMargin rightMargin partialLineWidth index|
+
+ stream := ReadStream on:aString.
+ lines := OrderedCollection new.
+ wordWrapBoolean ifTrue:[
+ leftMargin := aRectangle left.
+ rightMargin := aRectangle right
+ ].
+ [ stream atEnd ] whileFalse:[
+ line := stream nextLine.
+ wordWrapBoolean ifFalse:[
+ lines add:line
+ ] ifTrue:[
+ x0 := x1 := 1.
+ 1 to:line size do:[:i |
+ ((line at:i) = Character space "32"
+ and:[ (partialLine := line copyFrom:x0 to:i) trimBlanks notEmpty ])
+ ifTrue:[
+ partialLineWidth := self stringWidthOf:partialLine.
+ (leftMargin + partialLineWidth) > rightMargin ifTrue:[
+ partialLine := line copyFrom:x0 to:x1.
+ lines add:partialLine.
+ x0 := x1 + 1
+ ] ifFalse:[ x1 := i ]
+ ].
+ index := i
+ ].
+ line isEmpty ifTrue:[
+ lines add:line
+ ] ifFalse:[
+ partialLine := line copyFrom:x0 to:index.
+ partialLineWidth := self stringWidthOf:partialLine.
+ (leftMargin + partialLineWidth) > rightMargin ifTrue:[
+ partialLine := line copyFrom:x0 to:x1.
+ lines add:partialLine.
+ partialLine := line copyFrom:x1 + 1 to:index
+ ].
+ lines add:partialLine
+ ]
+ ]
+ ].
+ ^ lines asArray
+
+ "Created: / 02-08-2006 / 17:56:51 / fm"
+ "Modified: / 04-08-2006 / 13:39:50 / fm"
+ "Modified: / 10-10-2006 / 18:14:00 / cg"
+!
+
+displayString:aString at:aPoint in:aRect options:ignoredForNow adx:unknownForNow
+ |x y|
+ x := aPoint x.
+ y := aPoint y.
+ (textAlign isNil or:[textAlign == 0 ]) ifTrue:[
+ self displayString:aString at:aPoint.
+ ^ self
+ ].
+ (textAlign == 8 "TaBottom") ifTrue:[
+ y := aPoint y - (self container font ascent) "container font ascent".
+ ] ifFalse:[ (textAlign == 6 "TaCenter") ifTrue:[
+ #TODO.
+"/ x := aRect left + ((aRect width-(container font widthOf:aString))//2).
+ ] ifFalse:[ (textAlign == 2 "TaRight") ifTrue:[
+ x := aRect right - (self "container font widthof:" stringWidthOf:aString).
+ y := self "container font ascent" getCharHeight + aPoint y .
+ ] ifFalse:[ (textAlign == 14 "TaCenterBottom") ifTrue:[
+ y := aRect bottom - self getCharHeight "container font ascent".
+ x := aRect left + ((aRect width-(self "container font widthOf:" stringWidthOf:aString))//2).
+ ] ifFalse:[ (textAlign == 10) ifTrue:[
+ x := aRect right - (self "container font widthof:" stringWidthOf:aString).
+ y := aRect bottom "aPoint y - (self container font ascent)" - self getCharHeight.
+ ]]]]].
+"/ Transcript showCR: 'Original Pos: ', aPoint x printString, '@', aPoint y printString,
+"/ ' Pos: ', x printString, '@', y printString,
+"/ ' Text: ', aString.
+ self displayString:aString at:(x@y).
+
+ "Modified: / 14-12-2006 / 12:29:13 / User"
+!
+
+displayStringLines:anIndexedCollection from:startIndex to:endIndex in:aRectangle
+ "Private - display Strings in anIndexedCollection starting at startIndex and
+ ending at endIndex, clipped within the bounds of aRectangle."
+
+ |charHeight ta region ascent|
+
+ charHeight := self getCharHeight.
+ ascent := self font ascentOn:self device.
+ startIndex to:endIndex do:[:i |
+ |lineToPrint|
+
+ lineToPrint := (anIndexedCollection at:i).
+ self device
+ displayString:lineToPrint
+ from:1
+ to:lineToPrint size
+ x:aRectangle left
+ y:(aRectangle top + ((i - startIndex) * charHeight))
+ in:nil
+ with:gcId
+ opaque:false
+ fontAscent:ascent.
+ ].
+
+ "/ region := self setClipRect: aRectangle.
+ "/ ta := self getTextAlign.
+ "/ self setTextAlign: TaTop.
+ "/ startIndex to: endIndex do: [ :i |
+ "/ self
+ "/ displayText: ( anIndexedCollection at: i )
+ "/ at: aRectangle left @ ( aRectangle top + ( i - startIndex * charHeight ) ) ].
+ "/ self setTextAlign: ta.
+ "/ self destroyRegion: region
+
+ "Created: / 03-08-2006 / 11:37:52 / fm"
+ "Modified: / 03-08-2006 / 12:38:43 / fm"
+ "Modified: / 10-10-2006 / 18:14:36 / cg"
+!
+
+displayStringLines:anIndexedCollection in:aRectangle
+ "Private - display anIndexedCollection of Strings clipped within
+ the bounds of aRectangle."
+
+ self
+ displayStringLines:anIndexedCollection
+ from:1
+ to:anIndexedCollection size
+ in:aRectangle
+
+ "Created: / 03-08-2006 / 16:03:07 / fm"
+ "Modified: / 10-10-2006 / 18:14:40 / cg"
+!
+
+displayText: aString at: aPoint
+
+self displayString:aString x:aPoint x y:aPoint y
+!
+
+linesPerPageFor: aRectangle
+
+|marginsRect charHeight|
+
+ marginsRect := aRectangle isNil
+ ifTrue:[self marginsRectangleFor: nil]
+ ifFalse:[aRectangle].
+
+ charHeight := self getCharHeight.
+ ^(marginsRect bottom - marginsRect top) // charHeight
+
+ "Created: / 12-10-2006 / 11:52:57 / User"
+!
+
+marginsRectangleFor:aRectangle
+ "Private - Answer a Rectangle defining margins based on aRectangle.
+ Units for aRectangle are in inches, returned margins rectangle is
+ in device units (pixels)."
+
+ |left top right bottom pixelsPerInchX pixelsPerInchY horzRes vertRes inset rectangle|
+
+ pixelsPerInchX := self pixelsPerInchOfScreenWidth.
+pixelsPerInchX == 0 ifTrue:[self halt].
+ pixelsPerInchY := self pixelsPerInchOfScreenHeight.
+ aRectangle isNil ifTrue:[
+ horzRes := self printerWidthArea.
+ vertRes := self printerHeightArea.
+ inset := self class defaultMargins.
+ left := (inset x * pixelsPerInchX) asInteger.
+ top := (inset y * pixelsPerInchY) asInteger.
+ right := horzRes - (inset x * pixelsPerInchX) asInteger.
+ bottom := vertRes - (inset y * pixelsPerInchY) asInteger
+ ] ifFalse:[
+ left := (aRectangle left * pixelsPerInchX) asInteger.
+ top := (aRectangle top * pixelsPerInchY) asInteger.
+ right := (aRectangle right * pixelsPerInchX) asInteger.
+ bottom := (aRectangle bottom * pixelsPerInchY) asInteger
+ ].
+ rectangle := left @ top corner:right @ bottom.
+ ^ rectangle
+
+ "Created: / 27-07-2006 / 18:22:57 / fm"
+ "Modified: / 04-08-2006 / 13:39:45 / fm"
+ "Modified: / 16-04-2007 / 11:57:21 / cg"
+!
+
+printPage:pageIndex in:aRectangle lines:lines headerLines:headerLines linesPerPage:linesPerPage
+ "Private - print page # pageIndex from lines, assuming
+ the given number of linesPerPage."
+
+ |firstLine lastLine l indexString p cHeight rect hLines|
+
+ firstLine := (pageIndex - 1) * linesPerPage + 1.
+ lastLine := (firstLine + linesPerPage - 1) min:lines size.
+ rect := aRectangle deepCopy.
+ hLines := headerLines deepCopy.
+ headerLines size > 0 ifTrue:[
+ l := hLines first.
+ p := l indexOfSubCollection: "indexOfString:"'#P'.
+ p = 0 ifFalse:[
+ indexString := pageIndex printString , ' '.
+ l := (l copyFrom:1 to:p - 1) , indexString , (l copyFrom:p + 2 to:l size).
+ hLines at:1 put:l.
+ ].
+ cHeight := self getCharHeight.
+ rect top:rect top + (hLines size * cHeight).
+ ].
+ self displayStringLines:hLines in:aRectangle.
+ self
+ displayStringLines:lines
+ from:firstLine
+ to:lastLine
+ in:rect.
+
+ "Created: / 27-07-2006 / 18:28:00 / fm"
+ "Modified: / 03-08-2006 / 16:03:15 / fm"
+ "Modified: / 10-10-2006 / 18:18:15 / cg"
+ "Modified: / 30-11-2006 / 13:34:44 / User"
+!
+
+printPage:pageIndex in:aRectangle lines:lines linesPerPage:linesPerPage
+ "Private - print page # pageIndex from lines, assuming
+ the given number of linesPerPage."
+
+ |firstLine lastLine|
+
+ firstLine := (pageIndex - 1) * linesPerPage + 1.
+ lastLine := (firstLine + linesPerPage - 1) min:lines size.
+ self
+ displayStringLines:lines
+ from:firstLine
+ to:lastLine
+ in:aRectangle
+
+ "Created: / 27-07-2006 / 18:24:59 / fm"
+ "Modified: / 03-08-2006 / 12:47:24 / fm"
+ "Modified: / 10-10-2006 / 18:18:22 / cg"
+!
+
+stringWidthOf:aString
+ "Return the width of aString
+ when written using the current font."
+
+ ^ self stringWidthOf:aString at:aString size.
+
+ "Modified: / 03-08-2006 / 10:18:23 / fm"
+ "Modified: / 10-10-2006 / 18:20:08 / cg"
+!
+
+stringWidthOf:aString at:index
+ "Return the width of aString up to index
+ when written using the current font; expand tabs out
+ to 4 spaces for calculations"
+
+ |answer str size spaceWidth|
+
+ index <= 0 ifTrue:[ ^ 0 ].
+ str := index >= aString size ifTrue:[ aString ] ifFalse:[ aString copyFrom:1 to:index ].
+ true "self font isNil" ifTrue:[
+ "if font not set yet, calculate based on default font"
+ "/ extString := str asExternalString.
+ size := Win32OperatingSystem::WinPointStructure new.
+ (OperatingSystem
+ getTextExtentPoint:gcId
+ string:str
+ size:size) ifFalse:[ ^ self error ].
+ answer := size x.
+"/ Transcript showCR: 'FROM PRIM ******* ', str, ' ', answer printString.
+"/ Transcript showCR: 'FROM DEVICE ***** ', str, ' ',(self font widthOf:str on:self device) printString.
+ #TODO.
+ ] ifFalse:[
+ answer := self font widthOf:str on:self device
+ ].
+ index > aString size ifTrue:[
+ spaceWidth := self font widthOf:Character space on:self device.
+ answer := answer + ((index - aString size) * spaceWidth)
+ ].
+ ^ answer.
+
+ "Created: / 03-08-2006 / 10:27:20 / fm"
+ "Modified: / 04-08-2006 / 12:27:26 / fm"
+ "Modified: / 10-10-2006 / 18:20:43 / cg"
+!
+
+withLineStyle:aSymbol lineWidth:lw paint:paintColor do:aBlock
+ |savStyle savWidth savPaint|
+
+ savStyle := self lineStyle.
+ savWidth := self lineWidth.
+ savPaint := self paint.
+
+ self lineStyle:aSymbol.
+ self lineWidth:lw.
+ self paint:paintColor.
+ aBlock value.
+ self paint:savPaint.
+ self lineWidth:savWidth.
+ self lineStyle:savStyle.
+
+ "Created: / 13-09-2006 / 15:38:56 / User"
+! !
+
+!WinPrinterContext class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview2/WinPrinterContext.st,v 1.1 2007-04-16 10:40:02 cg Exp $'
+! !