Mikes Delphi Site

Mikes Delphi Site

Programmierung mit ObjectPascal

Routine zur Skalierung eines Bildes für den Druck

Eingestellt: 21.04.2003

Die folgende Prozedur stellt ein Verfahren vor, mit dem man ein Bild oder eine Grafik passgenau in eine Seite platzieren kann. Die Prozedur berechnet aus den übergebenen Parametern ein Rechteck, das genau in eine Druckseite zentriert platziert wird und das als Parameter an die Methode StretchDraw übergeben werden kann.

Folgende Parameter werden an die Prozedur übergeben:
 

  • rtBild: Dieser VAR-Parameter vom Typ TRect stellt das Ergebnis-Rechteck für die Druckausgabe zur Verfügung. In der Prozedur werden die 4 Parameter der Struktur gefüllt. Beim Aufruf der Prozedur müssen die Druckränder bereits eingetragen sein.

  • iBlattBreite: In dieser Integer-Variablen wird die Druckbreite (=Blattbreite - Druckränder) übergeben, die für den Ausdruck zur Verfügung steht. Die Maßeinheit ist das Pixel.

  • iBlattHoehe: In dieser Integer-Variablen wird die Druckhöhe (=Blatthöhe - Druckränder) übergeben, die für den Ausdruck zur Verfügung steht. Die Maßeinheit ist das Pixel

  • iBildBreite: In dieser Integer-Variablen wird die Breite der Bitmap übergeben. Die Maßeinheit ist das Pixel.

  • iBildHoehe: In dieser Integer-Variablen wird die Höhe der Bitmap übergeben. Die Maßeinheit ist das Pixel.

  • rXRes: In dieser Double-Variablen wird ein Verhältniswert für die X-Achse übergeben, der sich aus folgender Formel berechnet: (Drucker-Pixel per Inch) / (Bildschirm-Pixel per Inch).

  • rYRes: In dieser Double-Variablen wird ein Verhältniswert für die Y-Achse übergeben, der sich aus folgender Formel berechnet: (Drucker-Pixel per Inch) / (Bildschirm-Pixel per Inch).


Quelltext:

procedure DruckSkalierung(var rtBild: TRect;
                                                   iBlattBreite: Integer;
                                                   iBlattHoehe: Integer;
                                                   iBildBreite: Integer;
                                                   iBildHoehe: Integer;
                                                   rXRes: Double;
                                                   rYRes: Double);
var
    rFaktor: Double;
    iAnpassung: Integer;
begin
    if (trunc(iBildBreite * rXRes) <= iBlattBreite) and (trunc(iBildHoehe * rYRes) <= iBlattHoehe) then
    begin
        // Bild passt auf das Blatt
        rtBild.Left := rtBild.Left + ((iBlattBreite - trunc((iBildBreite * rXRes))) div 2) + 1;
        rtBild.Top := rtBild.Top + ((iBlattHoehe  - trunc((iBildHoehe * rYRes))) div 2) + 1;
        rtBild.Right := rtBild.Left + trunc((iBildBreite * rXRes)) - 1;
        rtBild.Bottom := rtBild.Top + trunc((iBildHoehe * rYRes)) - 1;
    end
    else if (trunc(iBildBreite * rXRes) > iBlattBreite) and (trunc(iBildHoehe * rYRes) > iBlattHoehe) then
    begin
        // Bild passt nicht mehr aufs Blatt: Skalierung
        if (trunc(iBildBreite * rXRes) > iBlattBreite) then
        begin
            // Bild ist für das Blatt zu breit...
            if iBildBreite > iBildHoehe then
            begin
                // 1. Möglichkeit: Bildbreite ist größer als die Bildhöhe
                rFaktor := iBlattBreite / (iBildBreite * rXRes);
                if (trunc(iBildHoehe * rYRes * rFaktor ) > iBlattHoehe) then
                begin
                    // Problem: resultierende Bildhöhe paßt nicht auf das Blatt
                    iAnpassung := 0;
                    while (trunc(iBildHoehe * rYRes * rFaktor) > iBlattHoehe) do
                    begin
                        rFaktor := iBlattBreite / ((iBildBreite  + iAnpassung) * rXRes);
                        Inc(iAnpassung);
                    end;
                end;
                rtBild.Left := rtBild.Left + ((iBlattBreite - trunc(iBildBreite * rXRes * rFaktor)) div 2);
                rtBild.Right := rtBild.Left + trunc(iBildBreite * rXRes * rFaktor);
                rtBild.Top := rtBild.Top + ((iBlattHoehe - trunc(iBildHoehe * rYRes * rFaktor)) div 2);
                rtBild.Bottom := rtBild.Top + trunc(iBildHoehe * rYRes * rFaktor);
            end
            else
            begin
                // 2. Möglichkeit: Die Bildhöhe ist größer als das Blatt
                rFaktor := iBlattHoehe / (iBildHoehe * rYRes);
                if (trunc(iBildBreite * rXRes * rFaktor ) > iBlattBreite) then
                begin
                    // Problem: die resultierende Breite ist zu groß für das Blatt
                    iAnpassung := 0;
                    while (trunc(iBildBreite * rXRes * rFaktor) > iBlattBreite) do
                    begin
                        rFaktor := iBlattHoehe / ((iBildHoehe  + iAnpassung) * rYRes);
                        Inc(iAnpassung);
                    end;
                end;
                rtBild.Top := rtBild.Top + ((iBlattHoehe - trunc(iBildHoehe * rYRes * rFaktor)) div 2);
                rtBild.Bottom := rtBild.Top + trunc(iBildHoehe * rYRes * rFaktor);
                rtBild.Left := rtBild.Left + ((iBlattBreite - trunc(iBildBreite * rXRes * rFaktor)) div 2);
                rtBild.Right := rtBild.Left + trunc(iBildBreite * rXRes * rFaktor);
            end;
        end;
    end
    else if (trunc(iBildBreite * rXRes) > iBlattBreite) then
    begin
        // Bildbreite ist für das Blatt zu groß
        rFaktor := iBlattBreite / (iBildBreite * rXRes);
        if (trunc(iBildHoehe * rYRes * rFaktor ) > iBlattHoehe) then
        begin
            // Problem: resultierende Bildhöhe paßt nicht auf das Blatt
            iAnpassung := 0;
            while (trunc(iBildHoehe * rYRes * rFaktor) > iBlattHoehe) do
            begin
                rFaktor := iBlattBreite / ((iBildBreite  + iAnpassung) * rXRes);
                Inc(iAnpassung);
            end;
        end;
        rtBild.Left := rtBild.Left + ((iBlattBreite - trunc(iBildBreite * rXRes * rFaktor)) div 2);
        rtBild.Right := rtBild.Left + trunc(iBildBreite * rXRes * rFaktor);
        rtBild.Top := rtBild.Top + ((iBlattHoehe - trunc(iBildHoehe * rYRes * rFaktor)) div 2);
        rtBild.Bottom := rtBild.Top + trunc(iBildHoehe * rYRes * rFaktor);
    end
    else if (trunc(iBildHoehe * rYRes) > iBlattHoehe) then
    begin
        // Bildhöhe für das Blatt ist zu groß
        rFaktor := iBlattHoehe / (iBildHoehe * rYRes);
        if (trunc(iBildBreite * rXRes * rFaktor ) > iBlattBreite) then
        begin
            // Problem: die resultierende Breite ist zu groß für das Blatt
            iAnpassung := 0;
            while (trunc(iBildBreite * rXRes * rFaktor) > iBlattBreite) do
            begin
                rFaktor := iBlattHoehe / ((iBildHoehe  + iAnpassung) * rYRes);
                Inc(iAnpassung);
            end;
        end;
        rtBild.Top := rtBild.Top + ((iBlattHoehe - trunc(iBildHoehe * rYRes * rFaktor)) div 2);
        rtBild.Bottom := rtBild.Top + trunc(iBildHoehe * rYRes * rFaktor);
        rtBild.Left := rtBild.Left + ((iBlattBreite - trunc(iBildBreite * rXRes * rFaktor)) div 2);
        rtBild.Right := rtBild.Left + trunc(iBildBreite * rXRes * rFaktor);
    end
    else
        MessageDlg(Format('FEHLER!%sFehler bei der Skalierung!', [#13#10]), mtError, [mbCancel], 0);
end;

 

© 2017 Michael Kraemer, erstellt mit WebsiteBaker CE (WBCE 1.1.11)