Basic Univers
Structure Imprimante
Nom.s
Pilote.s
Port.s
EndStructure
Global NewList Imprimante.Imprimante()
Procedure PrinterList()
*Buffer = AllocateMemory(4096): Vide$ = Space(1024)
GetProfileString_( "devices" , 0, "" , *Buffer, 4096)
LongChaine = 0
ClearList(Imprimante())
Repeat
Chaine$ = PeekS(*Buffer + LongChaine)
LongChaine = LongChaine + Len(Chaine$) + 1
If Chaine$ <> ""
AddElement(Imprimante())
Imprimante()\Nom = Chaine$
GetPrivateProfileString_( "devices" , Chaine$, "" , Vide$, 1024, "Win.Ini" )
Imprimante()\Pilote = StringField(Vide$, 1, "," )
Imprimante()\Port = StringField(Vide$, 2, "," )
EndIf
Until Chaine$ = ""
FreeMemory(*Buffer)
EndProcedure
Procedure PrintImage(Image, PrinterDC)
ImageID = ImageID(Image)
hdc = CreateCompatibleDC_(0)
If hdc
bmi.BITMAPINFO
bm.BITMAP
GetObject_( ImageID(Image), SizeOf(BITMAP), @bm.BITMAP)
bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
bmi\bmiHeader\biWidth = bm\bmWidth
bmi\bmiHeader\biHeight = bm\bmHeight
bmi\bmiHeader\biPlanes = 1
bmi\bmiHeader\biBitCount = 32
bmi\bmiHeader\biCompression = #BI_RGB
W = GetDeviceCaps_(PrinterDC, #HORZRES )
H = GetDeviceCaps_(PrinterDC, #VERTRES )
HList = AllocateMemory(bm\bmWidth * bm\bmHeight * 4)
GetDIBits_(hdc, ImageID(Image), 0, bm\bmHeight, HList, bmi, #DIB_RGB_COLORS )
StretchDIBits_(PrinterDC, 0, 0, W, H, 0, 0, bm\bmWidth - 1, bm\bmHeight - 1, HList, bmi, #DIB_RGB_COLORS , #SRCCOPY )
FreeMemory(HList)
ReleaseDC_(0, hdc)
EndIf
EndProcedure
PrinterList()
FirstElement(Imprimante())
PrintersName.s = Imprimante()\Nom
If OpenPrinter_(PrintersName, @PrinterHandle.l, 0)
Buffersize.l = DocumentProperties_(0, PrinterHandle, PrintersName, 0, 0, 0)
*DevBufferIn = AllocateMemory(Buffersize)
*DevBufferOut = AllocateMemory(Buffersize)
DocumentProperties_(0, PrinterHandle, PrintersName, *DevBufferIn, *DevBufferOut, #DM_OUT_BUFFER | #DM_IN_BUFFER )
*PrinterParameters.DEVMODE = *DevBufferIn
ClosePrinter_(PrinterHandle)
*PrinterParameters\dmOrientation = 2
lpszDriver.s = Imprimante()\Pilote
PrinterDC.l = CreateDC_(@lpszDriver, PrintersName, 0, *PrinterParameters)
FreeMemory(*DevBufferIn)
FreeMemory(*DevBufferOut)
If PrinterDC <> 0
W = GetDeviceCaps_(PrinterDC, #HORZRES )
H = GetDeviceCaps_(PrinterDC, #VERTRES )
Size = 2000
If W/H > H/W
WImg = Size
HImg = H*Size/W
Else
HImg = Size
WImg = W*Size/H
EndIf
DocInf.DOCINFO
DocInf\cbSize = SizeOf(DOCINFO)
DocInf\lpszDocName = @ "Impression en paysage"
DocInf\lpszOutput = #Null
Image = CreateImage( #PB_Any , WImg, HImg)
If StartDoc_(PrinterDC, @DocInf) > 0
If StartPage_(PrinterDC) > 0
StartDrawing( ImageOutput(Image))
Box(0, 0, WImg, HImg, $0000FF)
DrawText(20, 20, "PAGE 1" , 0, $0000FF)
StopDrawing()
PrintImage(Image, PrinterDC)
EndPage_(PrinterDC)
StartPage_(PrinterDC)
StartDrawing( ImageOutput(Image))
Box(0, 0, WImg, HImg, $FFFFFF)
Box(WImg/4, HImg/4, WImg/2, HImg/2, $0000FF)
Circle(500, 500, 400, $00FF00)
DrawText(20, 20, "PAGE 2" , $FF0000, $FFFFFF)
StopDrawing()
PrintImage(Image, PrinterDC)
EndPage_(PrinterDC)
EndIf
FreeImage(Image)
EndDoc_(PrinterDC)
ReleaseDC_(0, DC)
EndIf
EndIf
EndIf