Einzelnen Beitrag anzeigen

PeterPanino

Registriert seit: 4. Sep 2004
1.465 Beiträge
 
Delphi 10.4 Sydney
 
#6

Re: Wie Druckerränder einstellen?

  Alt 6. Feb 2007, 05:05
So, nun ist auch die Umbruchfunktion fertig! Wer sagt denn, dass die Nacht zum Schlafen da ist?

Delphi-Quellcode:
procedure Ausdrucken(Text: TStringList; x, y: integer);
var
  i, j, z, w, m, c: integer;
  ThisLine: string;
  EndOfLine: Boolean;
  procedure PrintLine(const Line: string);
  begin
    Printer.Canvas.TextOut(x, y, Line);
    y := y + (Printer.Canvas.Font.Size * 11);
    if (y > (Printer.PageHeight - z - (printer.Canvas.Font.Size * 11))) then
    begin
      y := z;
      Printer.NewPage;
    end;
  end;
begin
  x := x * 10;
  y := y * 10;
  z := y;
  Printer.Begindoc;
  //printer.Canvas.Font.Name := 'Courier New';
  for i := 0 to Text.Count - 1 do
  begin
    m := i mod 8;
    case m of
      0: printer.Canvas.Font.Size := 16;
      1: printer.Canvas.Font.Size := 15;
      2: printer.Canvas.Font.Size := 14;
      3: printer.Canvas.Font.Size := 13;
      4: printer.Canvas.Font.Size := 12;
      5: printer.Canvas.Font.Size := 11;
      6: printer.Canvas.Font.Size := 10;
      7: printer.Canvas.Font.Size := 9;
    end;
    //Überlange Zeilen an Wortgrenzen umbrechen:
    ThisLine := Text[i];
    w := 1; //?
    c := 0;
    EndOfLine := False;
    repeat
    begin
      for j := 1 to Length(ThisLine) do
      begin
        if ThisLine[j] = ' then
          w := j - 1 //Wortgrenze merken
        else if ThisLine[j] in [',', '.', ';', ':', '!', '?', '-'] then
          w := j; //Wortgrenze merken
        if (Printer.Canvas.TextWidth(Copy(ThisLine, 1, j))) > (printer.PageWidth - (x * 2)) then
        begin
          PrintLine(Copy(ThisLine, 1, w));
          //Rest der Zeile:
          ThisLine := Trim(Copy(ThisLine, w + 1, Length(ThisLine)));
          BREAK;
        end;
        if j = Length(ThisLine) then
        begin
          EndOfLine := True;
          PrintLine(ThisLine);
        end;
      end;
      //Zur Sicherheit:
      if c > Text.Count then BREAK;
      Inc(c);
    end;
    until EndOfLine;
  end;
  Printer.Enddoc;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  Text: TStringList;
begin
  Text:= TStringList.Create;
  Text.LoadFromFile('C:\Test.txt');
  Ausdrucken(Text, 20, 17);
  Text.Free;
end;
  Mit Zitat antworten Zitat