Print Picture

download 36,7 Kb
download here





'Beispiel : Druckt eine Grafik so gross wie moeglich...
'           Passend auf die Druckermoeglichkeiten.

Public Function Drucken(objPrinter As Printer, _
    objGrafik As Picture) As Boolean
 
    Const vbHiMetric As Integer = 8

    Dim dblBildVerhaeltnis      As Double
    Dim dblDruckerWeite         As Double
    Dim dblDruckerHoehe         As Double
    Dim dblDruckerVerhaeltnis   As Double
    Dim dblDruckBildWeite       As Double
    Dim dblDruckBildHoehe       As Double

    On Error GoTo Fehler
    'Seitenorientierung setzen [Hoch oder Querformat]
    If objGrafik.Height >= objGrafik.Width Then
    objPrinter.Orientation = vbPRORPortrait
    Else
    objPrinter.Orientation = vbPRORLandscape
    End If
    'Berechnung der Geraeteunabhaengigkeit.Weiten- und
    'Hoehenverhaeltnis der Grafik.
    dblBildVerhaeltnis = objGrafik.Width / objGrafik.Height
    'Berechnung des Druckbereiches in HiMetric
    dblDruckerWeite = objPrinter.ScaleX(objPrinter.ScaleWidth, _
    objPrinter.ScaleMode, vbHiMetric)
    dblDruckerHoehe = objPrinter.ScaleY(objPrinter.ScaleHeight, _
    objPrinter.ScaleMode, vbHiMetric)
    'Berechnung der Geraeteunabhaengigkeit. Weiten- und
    'Hoehenverhaelltnis des Druckers.
    dblDruckerVerhaeltnis = dblDruckerWeite / dblDruckerHoehe
    'Ausgabescalierung des Druckbereiches.
    If dblBildVerhaeltnis >= dblDruckerVerhaeltnis Then
    'Bild scalieren auf den vollen Druckbereich.(Weite)
    dblDruckBildWeite = objPrinter.ScaleX(dblDruckerWeite, _
    vbHiMetric, objPrinter.ScaleMode)
    dblDruckBildHoehe = objPrinter.ScaleY(dblDruckerWeite / dblBildVerhaeltnis, _
    vbHiMetric, objPrinter.ScaleMode)
    Else
    'Bild scalieren auf den vollen Druckbereich.(Hoehe)
    dblDruckBildHoehe = objPrinter.ScaleY(dblDruckerHoehe, _
    vbHiMetric, objPrinter.ScaleMode)
    dblDruckBildWeite = objPrinter.ScaleX(dblDruckerHoehe * dblBildVerhaeltnis, _
    vbHiMetric, objPrinter.ScaleMode)
    End If
    'Bild drucken mit der PaintPicture Methode.
    objPrinter.PaintPicture objGrafik, 0, 0, dblDruckBildWeite, _
    dblDruckBildHoehe
    Drucken = True
    objPrinter.EndDoc '
    Exit Function
Fehler:
    Drucken = False
End Function

Private Sub Command1_Click()
    Drucken Printer, Picture1
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub




optimiert fuer msi 800 x 600 © by heinz prelle lenbachstrasse 42 , 30655 hannover germany