--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PrinterContext.st Mon Aug 07 15:26:45 2006 +0200
@@ -0,0 +1,1013 @@
+"{ Package: 'stx:libview2' }"
+
+GraphicsMedium subclass:#PrinterContext
+ instanceVariableNames:'name abort jobid printerInfo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Printing'
+!
+
+
+!PrinterContext class methodsFor:'instance creation'!
+
+fromPrinterInfo: aPrinterInfo
+ "Private - Answer a Printer object given an hDC"
+ | 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"
+!
+
+printWith: aRecordingPen
+ "Print the contents of aRecordingPen on
+ the system printer."
+ self new drawUsing: aRecordingPen
+
+ "Created: / 27-07-2006 / 17:53:59 / fm"
+! !
+
+!PrinterContext 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"
+!
+
+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"
+!
+
+defaultPrinterName
+ "Answer the name of the default printer, or nil if none."
+ | printerInfo printerName |
+ printerInfo := OperatingSystem getDefaultPrinterName. " get default "
+ 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"
+!
+
+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"
+!
+
+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 ].
+ ^super new printerInfoWithName: aName
+
+ "Created: / 27-07-2006 / 17:51:27 / fm"
+ "Modified: / 02-08-2006 / 17:26:29 / fm"
+!
+
+printerNames
+ "Answer a collection of all known printer names."
+
+ ^OperatingSystem getPrintersNames
+
+ "Created: / 27-07-2006 / 17:54:45 / fm"
+! !
+
+!PrinterContext class methodsFor:'printing'!
+
+print: aString font: aFont title: aTitle
+ "Open a print dialog to allow printing of the given string
+ using the given title & font; answer the receiver."
+
+ 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"
+!
+
+print: aString font: aFont title: aTitle wordWrap: wordWrap
+ "Open a print dialog to allow printing of the given string
+ using the given title & font; answer the receiver."
+ | printerInfo printer |
+ printerInfo := PrintingDialog getPrinterInfo.
+ printerInfo isNil ifTrue:[^self].
+
+"/ ( hDCPrinter := printerInfo hDCPrinter ) isNil ifTrue: [ ^self ].
+"/ hDCPrinter := printerInfo createDC.
+ 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: self printingTestString font: nil title: 'Printing Test String' wordWrap: true
+ PrinterContext print: self printingTestString font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String' wordWrap: true
+
+"
+
+ "Created: / 03-08-2006 / 18:51:53 / fm"
+! !
+
+!PrinterContext class methodsFor:'testing'!
+
+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"
+!
+
+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"
+!
+
+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"
+!
+
+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"
+!
+
+printingTestString
+
+^'GetTextExtentPoint Note
+
+The GetTextExtentPoint function computes the width and height of the specified string of text.
+
+Note This function is provided only for compatibility with 16-bit versions of Windows. Applications should call the GetTextExtentPoint32 function, which provides more accurate results.
+
+BOOL GetTextExtentPoint(
+ HDC hdc, // handle to DC
+ LPCTSTR lpString, // text string
+ int cbString, // number of characters in string
+ LPSIZE lpSize // string size
+);
+
+Parameters
+
+hdc
+ [in] Handle to the device context.
+lpString
+ [in] Pointer to the string that specifies the text. The string does not need to be zero-terminated, since cbString specifies the length of the string.
+cbString
+ [in] Specifies the length of the string pointed to by lpString.
+
+ Windows 95/98/Me: This value may not exceed 8192.
+lpSize
+ [out] Pointer to a SIZE structure that receives the dimensions of the string, in logical units.
+
+Return Values
+
+If the function succeeds, the return value is nonzero.
+
+If the function fails, the return value is zero.
+
+Windows NT/2000/XP: To get extended error information, call GetLastError.
+Remarks
+
+The GetTextExtentPoint function uses the currently selected font to compute the dimensions of the string. The width and height, in logical units, are computed without considering any clipping. Also, this function assumes that the text is horizontal, that is, that the escapement is always 0. This is true for both the horizontal and vertical measurements of the text. Even if using a font specifying a nonzero escapement, this function will not use the angle while computing the text extentthe application must convert it explicitly.
+
+Because some devices kern characters, the sum of the extents of the characters in a string may not be equal to the extent of the string.
+
+The calculated string width takes into account the intercharacter spacing set by the SetTextCharacterExtra function.
+
+Windows 95/98/Me: For compatibility with Windows 3.1, GetTextExtentPoint adds an extra pixel for bold simulation fonts. However, the bold Tahoma font is not simulated, so it does not have any extra pixel. To correct for the extra pixel in a bold simulation font, decrease the length of every substring passed to GetTextExtentPoint by one pixel and add an extra pixel for the entire string.
+
+Windows 95/98/Me: Although GetTextExtentPointW exists on Windows 95/98/Me, it is supported by the Microsoft Layer for Unicode to give more consistent behavior across all Windows operating systems. To use this, you must add certain files to your application, as outlined in Microsoft Layer for Unicode on Windows 95/98/Me Systems.
+Requirements
+
+ Windows NT/2000/XP/Vista: Included in Windows NT 3.1 and later.
+ Windows 95/98/Me: Included in Windows 95 and later.
+ Header: Declared in Wingdi.h; include Windows.h.
+ Library: Use Gdi32.lib.
+ Unicode: Implemented as Unicode and ANSI versions on all platforms. Also supported by Microsoft Layer for Unicode.
+See Also'
+
+ "Created: / 03-08-2006 / 13:22:14 / fm"
+ "Modified: / 07-08-2006 / 14:28:16 / fm"
+! !
+
+!PrinterContext methodsFor:'abort handling'!
+
+abortPrintJob
+ "Abort the current print job."
+
+ abort := true.
+ jobid := nil.
+
+ "Modified: / 02-08-2006 / 15:40:26 / fm"
+!
+
+aborted
+ "Answer whether the user aborted from PrintAbortDialog."
+ ^abort
+
+ "Created: / 27-07-2006 / 10:20:10 / fm"
+! !
+
+!PrinterContext methodsFor:'accessing'!
+
+getCharHeight
+ "Private - answer the height of the font selected in the receiver's
+ device context."
+
+ | textMetrics |
+ textMetrics := Win32OperatingSystem::TextMetricsStructure new.
+ ( OperatingSystem
+ getTextMetrics: gcId "deviceContext"
+ lpMetrics: textMetrics "asParameter" )
+ ifFalse: [ ^self error ].
+ ^textMetrics tmHeight + textMetrics tmExternalLeading
+
+ "Created: / 02-08-2006 / 17:47:20 / fm"
+ "Modified: / 03-08-2006 / 10:09:01 / fm"
+!
+
+name
+ "Answer the receiver's name from the current printerInfo."
+
+ ^self printerInfo printerName
+
+ "Modified: / 02-08-2006 / 16:55:03 / fm"
+!
+
+name: aName
+ "Set the receiver's printer name to aName."
+
+ self printerInfo: (self class getPrinterInformation: aName)
+
+ "Created: / 27-07-2006 / 10:33:04 / fm"
+ "Modified: / 02-08-2006 / 16:54:46 / fm"
+!
+
+numberOfColorBitsPerPixel
+
+ ^ OperatingSystem getDeviceCaps:gcId index:12 "Bitspixel"
+
+ "Created: / 03-08-2006 / 09:58:18 / 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"
+!
+
+printerInfo
+ "Answer the receiver's name from the current printerInfo."
+
+ ^printerInfo
+
+ "Created: / 02-08-2006 / 16:55:17 / fm"
+!
+
+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"
+!
+
+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"
+!
+
+printerUserFriendlyName
+ "Answer the receiver's name from the current printerInfo."
+
+ ^self printerInfo userFriendlyName
+
+ "Created: / 03-08-2006 / 12:55:57 / fm"
+! !
+
+!PrinterContext methodsFor:'displaying lines'!
+
+displayLines: 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"
+!
+
+displayLines: anIndexedCollection in: aRectangle
+ "Private - display anIndexedCollection of Strings clipped within
+ the bounds of aRectangle."
+ self
+ displayLines: anIndexedCollection
+ from: 1
+ to: anIndexedCollection size
+ in: aRectangle
+
+ "Created: / 03-08-2006 / 16:03:07 / fm"
+! !
+
+!PrinterContext 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"
+!
+
+createDC
+ "Private - Create a device context for the receiver"
+
+ gcId := printerInfo createDC
+
+"/ | printerInfo driverNm mediumNm deviceNm hPrinter driverData|
+"/ printerInfo := self class getPrinterInformation: self name.
+"/ driverNm := printerInfo driverName.
+"/ mediumNm := printerInfo medium.
+"/ deviceNm := printerInfo printerName.
+"/
+"/ hPrinter := OperatingSystem openPrinter:deviceNm.
+"/ driverData := OperatingSystem getDocumentProperties:nil hPrinter:hPrinter pDeviceName:deviceNm.
+"/ Win32OperatingSystem primClosePrinter:hPrinter.
+"/
+"/ "deviceContext" gcId := OperatingSystem createPrinterDC:driverNm device:deviceNm output:mediumNm initData:driverData.
+
+"/ ( deviceContext := GDILibrary
+"/ createDC: driverName asParameter
+"/ deviceName: deviceName asParameter
+"/ output: printerPort asParameter
+"/ initData: nil ) = 0
+"/ ifTrue: [ ^self osError ].
+
+ "Created: / 27-07-2006 / 10:21:05 / fm"
+ "Modified: / 02-08-2006 / 17:30:47 / fm"
+!
+
+initExtent
+ "Private - init the width and height of GraphicsTool for the receiver."
+
+ device
+ width:self printerWidthArea;
+ height:self printerHeightArea
+
+ "Modified: / 01-08-2006 / 16:14:49 / fm"
+!
+
+printerHeightArea
+ ^ (OperatingSystem getDeviceCaps:gcId index:10 "Vertres")
+
+ "Created: / 01-08-2006 / 16:14:49 / fm"
+!
+
+printerWidthArea
+ ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:8 "Horzres"
+
+ "Created: / 01-08-2006 / 16:14:08 / fm"
+! !
+
+!PrinterContext 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 charHeight abortDialog |
+
+ jobid isNil
+ ifTrue: [ self startPrintJob: aTitle ].
+ abortDialog := PrintAbortDialog new open: aTitle printer: self.
+ Delay forMilliseconds: 3000.
+ self setPrinterFont: aFont.
+ marginsRect := self marginsRectangleFor: aMarginsRect.
+ lines := self asArrayOfLines: aString in: marginsRect wordWrap: wordWrapBoolean.
+ charHeight := self getCharHeight.
+ linesPerPage := marginsRect bottom - marginsRect top // charHeight.
+ 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: 'Page ', page printString, '/', totalPage printString.
+"/ self device font: printerFont.
+ self setPrinterFont: 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"
+!
+
+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.
+ Mg: Erweitert um pageHeader"
+ "Changed by K3/EES5-Mg, 08.01.96"
+
+ | lines linesPerPage totalPage marginsRect firstPage charHeight printerFont headerLines|
+
+ self setPrinterFont: aFont.
+ charHeight := self getCharHeight.
+ marginsRect := self marginsRectangleFor: aMarginsRect.
+ lines := self asArrayOfLines: aString in: marginsRect wordWrap: wordWrapBoolean.
+ headerLines := self asArrayOfLines: 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].
+ 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"
+!
+
+printPage: pageIndex in: aRectangle lines: lines headerLines: headerLines linesPerPage: linesPerPage
+
+ "Private - print page # pageIndex from lines, assuming
+ the given number of linesPerPage."
+ "Changed by K3/EES5-Mg, 30.07.97"
+
+ | 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 indexOfString: '#P') = 0 ifFalse:
+ [indexString := pageIndex printString,' '.
+ "l replaceFrom: p to: p + indexString size - 1 with: indexString startingAt: 1."
+ 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 displayLines: hLines in: aRectangle.
+ self displayLines: lines from: firstLine to: lastLine in: rect.
+
+ "Created: / 27-07-2006 / 18:28:00 / fm"
+ "Modified: / 03-08-2006 / 16:03:15 / fm"
+!
+
+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 displayLines: lines from: firstLine to: lastLine in: aRectangle
+
+ "Created: / 27-07-2006 / 18:24:59 / fm"
+ "Modified: / 03-08-2006 / 12:47:24 / fm"
+! !
+
+!PrinterContext methodsFor:'processing'!
+
+asArrayOfLines: 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"
+!
+
+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"
+!
+
+endPrintJob
+
+ "End the print job. Everything drawn between startPrintJob
+ and endPrintJob will become one entry in the print queue."
+ "Changed by K3EES5-Mg, 19.09.97"
+
+ | result |
+ self endPage.
+ result := OperatingSystem endDoc: gcId "deviceContext".
+ "graphicsTool" device close "deleteDC".
+ "deviceContext" gcId := nil.
+ jobid := nil.
+ result >= 0 "> geändert in >=: Mg 22.6.95"
+ ifFalse: [ ^self error "osError" ]
+
+ "Created: / 27-07-2006 / 18:21:04 / fm"
+ "Modified: / 01-08-2006 / 16:01:38 / fm"
+!
+
+formFeed
+ "Send a form feed to the printer."
+ self
+ endPage;
+ startPage
+
+ "Created: / 27-07-2006 / 18:25:40 / fm"
+!
+
+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.
+ 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 extent: right @ bottom.
+ ^ rectangle
+
+ "Created: / 27-07-2006 / 18:22:57 / fm"
+ "Modified: / 04-08-2006 / 13:39:45 / fm"
+!
+
+setPrinterFont: aFont
+ "Private - set a font in the receiver's medium whose characteristics
+ (pointSize, etc.) match those of aFont."
+ | printerFont |
+ aFont notNil ifTrue: [
+ self basicFont: aFont.
+"/ printerFont := Font fromLogicalFont: aFont logicalFont graphicsMedium: self.
+"/ printerFont pointSize: aFont pointSize graphicsMedium: self.
+"/ printerFont makeFont.
+"/ self device font: printerFont
+ ].
+ ^aFont
+
+ "Created: / 27-07-2006 / 18:21:59 / fm"
+ "Modified: / 03-08-2006 / 16:29:16 / fm"
+!
+
+startPage
+ "Starts a page."
+ ( OperatingSystem startPage: gcId ) > 0
+ ifFalse: [ ^self error "osError" ].
+
+ "Created: / 27-07-2006 / 18:25:55 / fm"
+ "Modified: / 28-07-2006 / 18:19:04 / fm"
+!
+
+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"
+!
+
+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.
+
+ Mg: Bei SpUserabort (bei Drucken in Datei) wird abort auf true gesetzt
+ und SpUserabort zurückgegeben.
+ "
+ "Changed by K3/EES5-Mg, 21.07.97"
+ "Changed by K3EES5-Mg, 19.09.97"
+
+ ^self startPrintJob: aString fileName: nil
+
+ "Created: / 27-07-2006 / 18:19:09 / fm"
+!
+
+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."
+ "Changed by K3/EES5-Mg, 21.07.97"
+ "Changed by K3EES5-Mg, 19.09.97"
+ "Changed by GS/EEZ3-Vr, 15.03.02"
+
+ | docInfoStruct nameAddress title fileNameAddress |
+
+ gcId "deviceContext" isNil ifTrue: [ self buildPrinter ].
+ abort := false.
+ "self setAbortProc."
+ title := aString isNil ifTrue: [ 'Smalltalk/X' "WindowLabelPrefix" ] ifFalse: [ aString ].
+
+ nameAddress := title asExternalBytes unprotectFromGC.
+"/ nameAddress := ExternalAddress copyToNonSmalltalkMemory: title.
+ aFileName isNil ifFalse: [fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC].
+"/ aFileName isNil ifFalse: [fileNameAddress := ExternalAddress copyToNonSmalltalkMemory: aFileName].
+
+ docInfoStruct := Win32OperatingSystem::DocInfoStructure new "some value".
+ docInfoStruct cbSize: docInfoStruct sizeInBytes;
+ lpszDocName: nameAddress address.
+"/ ( docInfoStruct := SelfDefinedStructure named: 'DOCINFO' )
+"/ cbSize: docInfoStruct sizeInBytes;
+"/ lpszDocName: nameAddress "asParameter".
+
+ fileNameAddress isNil ifFalse:[docInfoStruct lpszOutput: fileNameAddress address"asParameter"].
+
+ jobid := OperatingSystem startDoc: gcId "deviceContext"
+ docInfo: docInfoStruct "asParameter".
+"/ nameAddress free.
+"/ fileNameAddress isNil ifFalse: [fileNameAddress free].
+
+ jobid > 0
+ ifFalse: [jobid = -1
+ ifTrue: [abort := true. ^nil].
+ ^self error "osError" ].
+ self startPage
+
+ "Created: / 27-07-2006 / 18:19:31 / fm"
+ "Modified: / 03-08-2006 / 15:11:19 / fm"
+!
+
+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"
+!
+
+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 "self handle"
+ string: str
+ size: size)
+ ifFalse: [ ^self error ].
+ answer := size x.
+#TODO.
+ ] ifFalse: [ answer := self font widthOf: str on: self device "self handle" ].
+ 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"
+! !
+
+!PrinterContext methodsFor:'queries'!
+
+supportsColor
+
+ "Changed by K3/EES5-Vo, 11.03.98"
+ "Changed by GS-EC/EES3-Vo, 06.10.05"
+
+"/ | 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
+
+ "Created: / 03-08-2006 / 09:55:26 / fm"
+ "Modified: / 04-08-2006 / 13:20:40 / fm"
+!
+
+supportsGraphics
+
+ "Private & DEFAULT!!."
+ "Changed by K3/EES5-Mg, 26.01.96"
+
+ ^(OperatingSystem getDeviceCaps: gcId asParameter index: 2 "Technology") ~= 4
+
+ "Created: / 03-08-2006 / 10:07:43 / fm"
+! !
+
+!PrinterContext class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview2/PrinterContext.st,v 1.1 2006-08-07 13:26:45 fm Exp $'
+! !