string drucken/de

From Free Pascal wiki
Jump to: navigation, search

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.