printing strings/de

Dieser Artikel behandelt ausschließlich Windows.

Siehe auch: Multiplatform Programming Guide/de

│ Deutsch (de) │

Zurück zur Seite Code Beispiele.

Dieser Artikel handelt vom Drucken unter Windows7 und Windows XP.

Das Programm wurde auf beiden Betriebssystemen getestet.

Drucken

Das Beispiel zeigt, wie man im eigenen Programm den Inhalt eines Strings oder einer Stringliste auf dem Drucker ausgeben kann.

In diesem Beispiel wird die Klasse vom Typ Object abgeleitet.

unit uDrucken;

{$mode objfpc}{$H+}{$WRITEABLECONST ON}


// Verwendung:
// Var
//    ...
//    Drucken: TDrucken;
//    ...
// begin
// ...
//    Drucken.setOrientierung('LandScape');
// ...
// end;


interface

uses
  Classes, Printers, Graphics, SysUtils;

type { TDrucken }
  TDrucken = object
  private
  public
    procedure StringDrucken(const conText: string);
    procedure StringlisteDrucken(strList: TStrings);
    procedure setSchriftName(strSchrift: string);
    procedure setSchriftGroesse(intSchriftGroesse: integer);
    procedure setSchriftFarbe(intSchriftFarbe: integer);
    procedure setPapierformat(strPapierformatSet: string);
    procedure setOrientierung(strOrientierung: string);
  end;



implementation


type
  TSchrift = record
    Name: string;
    Size: word;
    Color: integer;
  end;


const
  conSchrift: TSchrift = (
    Name: 'Arial';
    Size: 12;
    Color: clBlack);

var
  strPapierformat: string = 'A4';
  enmOrientierung: TPrinterOrientation;


procedure TDrucken.setSchriftName(strSchrift: string);
begin
  conSchrift.Name := strSchrift;
end;



procedure TDrucken.setSchriftGroesse(intSchriftGroesse: integer);
begin
  if intSchriftGroesse > 7 then
    conSchrift.Size := intSchriftGroesse;
end;



procedure TDrucken.setSchriftFarbe(intSchriftFarbe: integer);
begin
  if intSchriftFarbe > -1 then
    conSchrift.Color := intSchriftFarbe;
end;



procedure TDrucken.setPapierformat(strPapierformatSet: string);
begin
  case LowerCase(strPapierformatSet) of
    'a4':
      strPapierformat := strPapierformatSet;
    'letter':
      strPapierformat := strPapierformatSet;
    'legal':
      strPapierformat := strPapierformatSet;
    else
      strPapierformat := 'a4';
  end;
end;



procedure TDrucken.setOrientierung(strOrientierung: string);
begin
  case LowerCase(strOrientierung) of
    'portrait':
      Printer.Orientation := enmOrientierung.poPortrait;
    'landscape':
      Printer.Orientation := enmOrientierung.poLandscape;
    else
      Printer.Orientation := enmOrientierung.poPortrait;
  end;
end;



procedure TDrucken.StringDrucken(const conText: string);
// Ausdruck unter Ausnutzung des vollständigen druckbaren Bereichs
var
  strList: TStringList;

begin

  strList := TStringList.Create;

  try
    strList.Add(conText);
    StringlisteDrucken(strList);
  finally
    strList.Free;
  end;

end;



procedure TDrucken.StringlisteDrucken(strList: TStrings);
// Kann z. B. mit:
// subStringlisteDrucken(Memo1.Lines);
// und
// subStringlisteDrucken(Listbox1.Items);
// verwendet werden.
// Ausdruck unter Ausnutzung des vollständigen druckbaren Bereichs

var
  intZeilenhoehe: longint;
  PaperWorkRect: TRect;
  intZeilen: longint;
  intAktuelleZeile: longint;
  I: longint;

  strListNeu: TStringList;
  intElement: longint;
  strBuffer: string;
  intBreite: longint;
  intMaxStringBreite: longint;
  intZeichenPosition: longint;
begin

  with Printer.Canvas.Font do
  begin
    PixelsPerInch := 300;
    Name := conSchrift.Name;
    Size := conSchrift.Size;
    Color := conSchrift.Color;
  end;

  with Printer do
  begin

    PaperSize.PaperName := strPapierformat;
    PaperWorkRect := Printer.PaperSize.PaperRect.WorkRect;

    // ************************************************
    // Erstellt eine neue Stringliste, deren Elemente an die Papierbreite
    // angepasst sind

    intZeichenPosition := 0;
    strBuffer := '';
    intMaxStringBreite := PaperWorkRect.Right - PaperWorkRect.Left;

    strListNeu := TStringList.Create;
    for intElement := 0 to (strList.Count - 1) do
    begin
      for I := 1 to Length(strList[intElement]) do
      begin
        strBuffer := strBuffer + strList[intElement][I];
        intBreite := Canvas.TextWidth(strBuffer);
        if intBreite > (intMaxStringBreite - 30) then
        begin
          strListNeu.Add(strBuffer);
          intZeichenPosition := I - 1;
          strBuffer := '';
        end;
      end;
      if length(strBuffer) > 0 then
        strListNeu.Add(strBuffer);
    end;
    // ************************************************
    // Berechnet wieviele Zeilen auf eine Seite passen

    // Berechnet die Zeilenhöhe
    intZeilenhoehe := Round(1.2 * Abs(Canvas.TextHeight('I')));
    // Berechnet, wieviele Zeilen auf eine Seite passen
    intZeilen := PaperWorkRect.Bottom div intZeilenhoehe;

    // ************************************************
    // Steuert den Ausdruck
    try

      BeginDoc;

      intAktuelleZeile := 0;
      for I := 0 to strListNeu.Count - 1 do
      begin
        // *** Steuert die Druckausgabe über mehrere Seiten ***
        if I > 0 then
          if (i mod intZeilen) = 0 then
          begin
            intAktuelleZeile := 0;
            NewPage;
          end
          else
            intAktuelleZeile := intAktuelleZeile + 1;

        // Druckvorgang
        Canvas.TextOut(PaperWorkRect.Left,
          PaperWorkRect.Top + (intZeilenhoehe * intAktuelleZeile),
          strListNeu.Strings[I]);
      end;
    finally
      EndDoc;
      strListNeu.Free;
    end;
  end;

end;

end.