Basic Univers
; Author : Gillou
; Date : 17/02/2007
; Description : Impression en format paysage

; Ne pas lancer tel quel, sous peine de consommer beaucoup d'encre
;   Car de très grands carrés/cercles seront imprimés sur toute la page



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() ; De quoi remplir une listicon pour choisir l'imprimante : D
FirstElement(Imprimante())
PrintersName.s = Imprimante()\Nom
If OpenPrinter_(PrintersName, @PrinterHandle.l, 0) ; Retourne 0 si non OK
    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 ; Paysage
    lpszDriver.s = Imprimante()\Pilote
    PrinterDC.l = CreateDC_(@lpszDriver, PrintersName, 0, *PrinterParameters)
     FreeMemory(*DevBufferIn)
     FreeMemory(*DevBufferOut)
     If PrinterDC <> 0 ; On peut imprimer
        
        W = GetDeviceCaps_(PrinterDC, #HORZRES )
        H = GetDeviceCaps_(PrinterDC, #VERTRES )
        
        Size = 2000 ; Taille max de l'image vu que PureBasic ne supporte pas les grandes images
        
         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 ; PAGE 1
                     StartDrawing( ImageOutput(Image)) ; on dessine ce que l'on a envie
                         Box(0, 0, WImg, HImg, $0000FF)
                         DrawText(20, 20, "PAGE 1" , 0, $0000FF)
                     StopDrawing()
                    PrintImage(Image, PrinterDC)
                 EndPage_(PrinterDC)
                 StartPage_(PrinterDC) ; PAGE 2
                     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