DBR Delphi-Ecke

// Es wird unter Umgehung des Druckertreibers ein Text (TMemo) direkt auf
// den Drucker geschickt. Da deshalb Umlaute nicht korrekt umgesetzt werden,
// bietet das Beispiel zwei Varianten der Umlaut-Behandlung an.
// Zur Ermittlung der korrekten System-Drucker-Bezeichnung
// siehe Drucker auflisten/auswählen

// Getestet mit D4 unter XP

// Variante 1:

uses winspool; 
 
function DirektDruck(txt: TStrings; Drucker, Ziel: string; 
  RandLinks, Tab: byte; Variante1: boolean): boolean; 
var 
  h: THandle; 
  di: DOC_INFO_1; 
  geschrieben, druckstellen: longword; 
  x: integer; 
  sl: TStringlist; 
begin 
  result := false; 
  sl := TStringlist.create; 
  sl.add(''); 
  for x := 0 to txt.count - 1 do 
    sl.add(stringofchar(#32, RandLinks) + txt[x]); 
  sl.text := stringreplace(sl.text, #9, stringofchar(#32, Tab), [rfreplaceall]); 
  if Variante1 then begin 
    sl.text := stringreplace(sl.text, 'ä', #204, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ä', #216, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ö', #206, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ö', #218, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ü', #207, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ü', #219, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ß', #222, [rfreplaceall]); 
  end else begin 
    sl.text := stringreplace(sl.text, 'ä', 'ae', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ä', 'Ae', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ö', 'oe', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ö', 'Oe', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ü', 'ue', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ü', 'Ue', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ß', 'ss', [rfreplaceall]); 
  end; 
  if (OpenPrinter(pchar(Drucker), h, nil)) 
    then begin 
    di.pDocName := 'Direktdruck'; 
    di.pOutputFile := pchar(Ziel); 
    di.pDatatype := 'RAW'; 
    if StartDocPrinter(h, 1, @di) <> 0 then begin 
      druckstellen := length(sl.text) + 1; 
      WritePrinter(h, pchar(sl.text + #12), druckstellen, geschrieben); 
      result := geschrieben = druckstellen; 
    end; 
    EndDocPrinter(h); 
    ClosePrinter(h); 
  end; 
  sl.free; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button6Click(Sender: TObject); 
var 
  LeerzeichenLinks, TabWeite: byte; 
  Port, DruckerBezeichnung: string; 
  UmlautVariante: boolean; 
begin 
  DruckerBezeichnung := 'Kyocera FS-680'; 
  Port := 'LPT1:'; 
  TabWeite := 8; 
  LeerzeichenLinks := 10; 
  UmlautVariante := true; 
  if not DirektDruck(Memo1.Lines, DruckerBezeichnung, Port, LeerzeichenLinks, 
    TabWeite, UmlautVariante) then showmessage('Fehler'); 
end;

// --------------------------------------------------------------

// Variante 2:

function DirektDruck2(txt: TStrings; prt: string; 
  RandLinks, Tab: byte; Variante1: boolean): boolean; 
var 
  f: Textfile; 
  x: integer; 
  sl: TStringlist; 
begin 
  sl := TStringlist.create; 
  sl.add(#$1B#$45); 
  for x := 0 to txt.count - 1 do 
    sl.add(stringofchar(#32, RandLinks) + txt[x]); 
  sl.text := stringreplace(sl.text, #9, stringofchar(#32, Tab), [rfreplaceall]); 
  if Variante1 then begin 
    sl.text := stringreplace(sl.text, 'ä', #204, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ä', #216, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ö', #206, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ö', #218, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ü', #207, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ü', #219, [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ß', #222, [rfreplaceall]); 
  end else begin 
    sl.text := stringreplace(sl.text, 'ä', 'ae', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ä', 'Ae', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ö', 'oe', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ö', 'Oe', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ü', 'ue', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'Ü', 'Ue', [rfreplaceall]); 
    sl.text := stringreplace(sl.text, 'ß', 'ss', [rfreplaceall]); 
  end; 
  sl.add(#12); 
  assignfile(f, prt); 
  result := true; 
{$I-} 
  rewrite(f); 
  if ioresult = 0 then begin 
    try 
      write(f, sl.text); 
    except 
      result := false; 
    end; 
    closefile(f); 
  end else result := false; 
{$I+} 
  sl.free; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  if not 
    DirektDruck2(Memo1.lines, 'LPT1:', 10, 8, true) 
    then showmessage('Fehler'); 
end;