OCX - APERÇU AVANT IMPRESSION

' COMMENT UTILISER LE COMPOSANT

Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Sub Command1_Click()
    If CInt(Text1.Text) < 1 Then Text1.Text = "1"
    If CInt(Text1.Text) > PrinterPreview1.Count Then Text1.Text = CStr(PrinterPreview1.Count)
    ' on va à la page désirée
    PrinterPreview1.GoPage CInt(Text1.Text)
End Sub

Private Sub Command2_Click()
    ' on sélectionne toutes les pages
    PrinterPreview1.SelAll
End Sub

Private Sub Command3_Click()
    ' on déselectionne toutes les pages
    PrinterPreview1.UnSelAll
End Sub

Private Sub Command4_Click()
    ' on lance l'impression
    PrinterPreview1.StartPrint
End Sub

Private Sub Command5_Click()
    PrinterPreview1.PrintProperties
End Sub

Private Sub Command6_Click()
    PrinterPreview1.About
End Sub

Private Sub Form_Load()

    Label1.Caption = "Nombre de page: " & CStr(PrinterPreview1.Count)

    ' on prépare l'aperçu avant impression
    PrinterPreview1.Border3D = True
    PrinterPreview1.PageWidth = Printer.Width ' toujours en Twips les coordonnées
    PrinterPreview1.PageHeight = Printer.Height ' toujours en Twips les coordonnées
    PrinterPreview1.MarginLeft = 400 ' toujours en Twips les coordonnées
    PrinterPreview1.MarginTop = 400 ' toujours en Twips les coordonnées
    PrinterPreview1.DrawPageNum = True
    PrinterPreview1.ShowDatetime = True
    PrinterPreview1.PrintQuality = qHIGH
    PrinterPreview1.DocumentName = "Essai d'impression"
    
    Dim Page As Integer
    Dim P As IPictureDisp
    Dim W As Long, H As Long, R As Double
    
    ' on charge une image
    Set P = LoadPicture(App.Path & "\family tux.jpg")
    ' on ajoute une nouvelle page
    Page = PrinterPreview1.Add("PaintPicture Mode : mDEFAULT et  2 x mUSER")
    ' on définit sa couleur de fond
    PrinterPreview1.SetBackColor Page, RGB(255, 255, 255), False
    ' on dessine l'image chargée
    PrinterPreview1.PaintPicture Page, P, mDEFAULT, 0, 0
    ' on charge une image
    Set P = LoadPicture(App.Path & "\Kuantum2 1024-768.jpg")
    ' on calcule sa taille suivant son ratio
    R = P.Height / P.Width
    W = 5000
    H = W * R
    ' on dessine cette image
    PrinterPreview1.PaintPicture Page, P, mUSER, 2000, 3000, W, H, pmINVERT
    ' on charge une image
    Set P = LoadPicture(App.Path & "\usual suspect.jpg")
    ' on calcule sa taille suivant son ratio
    R = P.Height / P.Width
    W = 8000
    H = W * R
    ' on dessine cette image
    PrinterPreview1.PaintPicture Page, P, mUSER, 5000, 6000, W, H

    ' on charge une image
    Set P = LoadPicture(App.Path & "\Big Tux 1280-1024.jpg")
    ' on ajoute une nouvelle page
    Page = PrinterPreview1.Add("PaintPicture Mode : mAUTO, SetBackColor avec Bordure, 2 x DrawString, 3 x DrawLine")
    ' on définit sa couleur de fond
    PrinterPreview1.SetBackColor Page, RGB(230, 233, 236), True, RGB(115, 133, 153), 1
    ' on dessine l'image chargée
    PrinterPreview1.PaintPicture Page, P, mAUTO
    ' on dessine une chaine de caractère
    PrinterPreview1.DrawString Page, "Essai 1", "Tahoma", 14, True, 1000, 1000, 5000, 3000, fLEFT, 0, 0, False, False, False, FW_BOLD, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, vbBlue
    ' on dessine une chaine de caractère
    PrinterPreview1.DrawString Page, "Essai 2" & vbCrLf & "de bob", "Tahoma", 21, True, 3000, 3000, 5000, 3000, fLEFT, 0, 0, True, True, True, FW_THIN, DEFAULT_CHARSET, OUT_DEVICE_PRECIS, CLIP_STROKE_PRECIS, PROOF_QUALITY, VARIABLE_PITCH, vbRed
    ' on dessine une ligne
    PrinterPreview1.DrawLine Page, 1500, 1500, 7000, 7000, vbMagenta, 3
    ' on dessine une ligne
    PrinterPreview1.DrawLine Page, 7000, 7000, 2000, 7000, vbMagenta, 3
    ' on dessine une ligne
    PrinterPreview1.DrawLine Page, 2000, 7000, 2000, 4000, vbMagenta, 3
    
    ' on ajoute une page
    Page = PrinterPreview1.Add("3 x DrawRectangle, DrawRectangle : Rounded, DrawEllipse")
    ' on définit sa couleur de fond
    PrinterPreview1.SetBackColor Page, RGB(255, 255, 255), False
    ' on dessine un rectangle
    PrinterPreview1.DrawRectangle Page, 2000, 3000, 5000, 5000, True, vbYellow, vbBlack, 1
    ' on dessine un rectangle
    PrinterPreview1.DrawRectangle Page, 5000, 6000, 10000, 5000, False, vbBlue
    ' on dessine un rectangle
    PrinterPreview1.DrawRectangle Page, 3500, 4500, 5000, 20000, True, vbGreen, vbWhite, 3
    ' on dessine un rectangle
    PrinterPreview1.DrawRectangle Page, 1000, 1000, 4000, 1800, True, vbMagenta, vbBlack, 1, True, 50
    ' on dessine une ellipse
    PrinterPreview1.DrawEllipse Page, 1500, 1500, 6000, 6000, True, vbCyan, vbRed, 1, pmAND
   
    Picture1.Cls
    Picture1.Width = Screen.Width
    Picture1.Height = Screen.Height
    StretchBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, GetDC(0), 0, 0, Screen.Width, Screen.Height, vbSrcCopy
    Picture1.Refresh
    Page = PrinterPreview1.Add("Capture d'écran")
    PrinterPreview1.SetBackColor Page, RGB(250, 250, 250), True, RGB(100, 100, 100), 1
    PrinterPreview1.PaintPicture Page, Picture1.Image, mAUTO, , , , , pmCOPY
    PrinterPreview1.DrawString Page, "Capture d'écran 1", "Tahoma", 10, True, PrinterPreview1.MarginLeft, PrinterPreview1.MarginTop + PrinterPreview1.PixelsToTwipsY(200), PrinterPreview1.PageWidth, PrinterPreview1.TextHeight(Page, "Tahoma", 10, "Capture d'écran 1"), fCENTER, 0, 0, False, False, False, FW_BLACK, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, RGB(0, 100, 100)
   
    Me.Show
    DoEvents

End Sub

Private Sub Form_Resize()
    PrinterPreview1.Left = 0
    PrinterPreview1.Top = Command1.Top + Command1.Height + Command1.Top
    PrinterPreview1.Width = Me.ScaleWidth
    PrinterPreview1.Height = Me.ScaleHeight - PrinterPreview1.Top
End Sub

Private Sub PrinterPreview1_Added()
    Label1.Caption = "Nombre de page: " & CStr(PrinterPreview1.Count)
End Sub

Télécharger le zip

16 novembre 2004 15:09:49 :

Correction orthographique