printing strings/de
From Free Pascal wiki
Jump to navigationJump to search
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.
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.