SynEdit: Drucken

[Nils]

Hi,

wie kann mit SynEdit drucken ? Das Kommando .Print existiert nicht. Delphi hat die Komponente TSynEditPrint, aber die scheint unter Lazarus vollkommen zu fehlen. Als Alternative gäbe es dann immer noch direkt über die Unit Printers zu gehen, aber wie blende ich dann den Gutter etc. aus (den will ich nicht unbedingt mitdrucken, bzw. Zeilennummerierung wäre ja nicht schlecht, aber der komplette Gutter wäre etwas übertrieben) ? Wie skaliert man es am einfachsten auf die passende Größe ?

[DiBo33]

Hierfür habe ich mir eine eigene Unit gebastelt, aber Achtung diese ist noch absolutes Alphastatium

Code: Alles auswählen

unit DiBoPrint;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, PrintersDlgs, Printers, Graphics, ExtCtrls, GraphType;
 
type
  TTextHeader = class(TObject)
  private
    FFont: TFont;
    FMargin: integer;
    FTextLeft, FTextMiddle, FTextRight: string;
    FUnderLine: boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Print;
  published
    property Font: TFont read FFont write FFont;
    property Margin: integer read FMargin write FMargin;
    property TextLeft: string read FTextLeft write FTextLeft;
    property TextMiddle: string read FTextMiddle write FTextMiddle;
    property TextRight: string read FTextRight write FTextRight;
    property UnderLine: boolean read FUnderLine write FUnderLine;
  end;
 
  TTextFooter = class(TObject)
  private
    FFont: TFont;
    FMargin: integer;
    FTextLeft, FTextMiddle, FTextRight: string;
    FOverLine: boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Print;
  published
    property Font: TFont read FFont write FFont;
    property Margin: integer read FMargin write FMargin;
    property TextLeft: string read FTextLeft write FTextLeft;
    property TextMiddle: string read FTextMiddle write FTextMiddle;
    property TextRight: string read FTextRight write FTextRight;
    property OverLine: boolean read FOverLine write FOverLine;
  end;
 
  TTextPrint = class(TObject)
  private
    FFont: TFont;
    FTitle: string;
    FShowLineNumber: boolean;
    FWrapLine: boolean;
    FNumChars: integer;
  private
    Lines: TStringList;
    Header: TTextHeader;
    Footer: TTextFooter;
    PrintDialog: TPrintDialog;
    procedure PrintLine(Text: string);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Print(Text: TStrings);
  published
    property Font: TFont read FFont write FFont;
    property Title: string read FTitle write FTitle;
    property ShowLinenumber: boolean read FShowLineNumber write FShowLineNumber;
    property WrapLine: boolean read FWrapLine write FWrapLine;
    property NumChars: integer read FNumChars write FNumChars;
  end;
 
implementation
 
const
  WrapChars     = ' ==>: ';
  PageTitle     = '$TITLE$';
  PagePageNum   = '$PAGENUM$';
  PagePageCount = '$PAGECOUNT$';
  PageDate      = '$DATE$';
  PageTime      = '$TIME$';
{$ifdef Linux}
  Left_Margin   = 0;
  Font_Name     = 'monospaced';
{$else}
  Left_Margin   = 0;
  Font_Name     = 'Courier New';
{$endif}
  Font_Size     = 11;
 
var
  PDate, PTime, PTitle, PPNum, PPCount: string;
  PLine, PLines, PCount, LCount, PPage, Margin, LineHeight,
  HeaderPos, FooterPos: integer;
 
 
procedure ChangeText(var Text: string);
begin
  Text := StringReplace(Text, PageTitle, PTitle, [rfReplaceAll]);
  Text := StringReplace(Text, PagePageNum, PPNum, [rfReplaceAll]);
  Text := StringReplace(Text, PagePageCount, PPCount, [rfReplaceAll]);
  Text := StringReplace(Text, PageDate, PDate, [rfReplaceAll]);
  Text := StringReplace(Text, PageTime, PTime, [rfReplaceAll]);
end;
 
function CreateText(LText, MText, RText: string): string;
var
  s: string;
  n: integer;
begin
  s := '';
  ChangeText(LText);
  ChangeText(MText);
  ChangeText(RText);
  // Text kalkulieren
  n := length(MText) SHR 1;
  while length(LText) < (42 - n) do LText := LText + ' ';
  while length(RText) < (42 - n) do RText := ' ' + RText;
  s := LText + MText + RText;
  Result := s;
end;
 
procedure PrintLine(y: integer);
begin
  Printer.Canvas.Line(10, y, Printer.PageWidth - 10, y);
end;
 
{ -- TTextHeader ------------------------------------------------------------- }
constructor TTextHeader.Create;
begin
  inherited;
  FFont := TFont.Create;
  FFont.Name := Font_Name;
  FFont.Size := Font_Size;
  FTextLeft := '';
  FTextMiddle := PageTitle;
  FTextRight := PageDate;
  FUnderLine := true;
end;
 
destructor TTextHeader.Destroy;
begin
  FFont.Free;
  inherited;
end;
 
procedure TTextHeader.Print;
var
  s: string;
begin
  inc(PPage);
  PPNum := IntToStr(PPage);
  if PPage > 1 then Printer.NewPage;
  s := CreateText(FTextLeft, FTextMiddle, FTextRight);
  Printer.Canvas.TextOut(Margin, HeaderPos, s);
  if FUnderLine then PrintLine(HeaderPos + LineHeight + 2);
end;
 
{ -- TTextFooter ------------------------------------------------------------- }
constructor TTextFooter.Create;
begin
  inherited;
  FFont := TFont.Create;
  FFont.Name := Font_Name;
  FFont.Size := Font_Size;
  FTextLeft := '';
  FTextMiddle := PagePageNum + ' / ' + PagePageCount;
  FTextRight := '';
  FOverLine := true;
end;
 
destructor TTextFooter.Destroy;
begin
  FFont.Free;
  inherited;
end;
 
procedure TTextFooter.Print;
var
  s: string;
begin
  if FOverLine then PrintLine(FooterPos - 2);
  s := CreateText(FTextLeft, FTextMiddle, FTextRight);
  Printer.Canvas.TextOut(Margin, FooterPos, s);
  PLines := 0;
end;
 
{ -- TTextPrint -------------------------------------------------------------- }
constructor TTextPrint.Create;
begin
  inherited;
  FFont := TFont.Create;
  Margin := Left_Margin;
  FFont.Name := Font_Name;
  FFont.Size := Font_Size;
  FFont.Color:= clBlack;
  FTitle := '';
  FShowLineNumber := true;
  FWrapLine := true;
  PrintDialog := TPrintDialog.Create(nil);
  Header := TTextHeader.Create;
  Footer := TTextFooter.Create;
  Lines := TStringList.Create;
  FNumChars := 80;
end;
 
destructor TTextPrint.Destroy;
begin
  Lines.Free;
  FFont.Free;
  PrintDialog.Free;
  Header.Free;
  Footer.Free;
  inherited;
end;
 
procedure TTextPrint.PrintLine(Text: string);
begin
  inc(PLines);
  Printer.Canvas.TextOut(Margin, LineHeight * PLines + HeaderPos + 10, Text);
  if PLines = LCount then begin
    Footer.Print;
    if PLine < Lines.Count then Header.Print;
  end;
  inc(PLine);
end;
 
procedure TTextPrint.Print(Text: TStrings);
var
  s, x, n: string;
  i: integer;
begin
  if PrintDialog.Execute then begin
    Printer.BeginDoc;
    Printer.Canvas.Font := FFont;
    // Calculate Lines
    Lines.Clear;
    for i := 0 to pred(Text.Count) do begin
      s := TrimRight(Text[i]);
      n := Format('%4d: ', [succ(i)]);
      repeat
        if length(s) > FNumChars then begin
          x := TrimRight(copy(s, 1, FNumChars));
          s := TrimRight(copy(s, succ(FNumChars), length(s) - FNumChars));
        end else begin
          x := s;
          s := '';
        end;
        Lines.Add(n + x);
        n := WrapChars;
      until length(s) = 0;
    end;
 
    Printer.Title := FTitle;
    LineHeight := Printer.Canvas.TextHeight('Gg') + 2;
    LCount := (Printer.PageHeight - 20) DIV LineHeight - 4;
 
    PCount := Lines.Count DIV LCount;
    if Lines.Count MOD LCount > 0 then inc(PCount);
 
    // Genaue Positionen müssen noch berechnet werden !!!!!!!!!!!!!!!!!!!!!!!!!
    HeaderPos := 10;
    FooterPos := Printer.PageHeight - 10 - LineHeight;
 
    PDate   := FormatDateTime('dd.mm.yyyy', now);
    PTime   := FormatDateTime('hh:nn', now);
    PTitle  := FTitle;
    PPNum   := '0';
    PPCount := IntToStr(PCount);
 
    try
      PLine := 0; PLines := 0; PPage := 0;
      Header.Print;
      while PLine < Lines.Count do PrintLine(Lines[PLine]);
      if PLines > 0 then Footer.Print;
      Printer.EndDoc;
      Printer.Refresh;
    except
      on E:Exception do begin
        Printer.Abort;
        raise Exception.Create(e.message);
      end;
    end;
  end;
end;
 
end.