Drucker Steuercodes aus Datei lesen und über canvas neu ausg

[mimi]

Ich habe sowas in dieser art selber mal angefangen:

Delphi-Quellcode:

procedure TPlutoDrawText.DrawText(const tx, ty: Integer; const aText: widestring);
var
  px, py, pw, ph, l, p,u,ph2,t,j,FontI, Level:Integer;
  str1:Widestring;
  str3,str4:String;
  str2:widestring;
  command, value:Widestring; TmpBG, TmpPN,TmpBG2:TColor;
  TmpFS, NewFS:TFontStyles;
  TmpFN:String;
  aText2:String;
  isText,isText2:Boolean;
  isList:Boolean;
begin
  px:=tx; py:=0; l:=1; p:=1; ph:=0;
  Level:=px;
  aText2:=aText;
//  DelSteuerzeichen(aText);
  isText:=False;
  
  repeat
    str1:=NextHtml(l,p,str2,aText2);
    ph2:=Canvas.TextHeight(str1);
    if ph2 > ph then ph:=ph2;
  until p = 0;

  l:=1; p:=1; pw:=0;   ph:=ph+2;
  repeat
    str1:=NextHtml(l,p,str2,aText2);
    pw:=canvas.TextWidth(str1);

    if pw > 0 then canvas.FillRect(px,py-1,px+pw,py+ph);

    isText2:=str1 <> '';
    if str1 <> '' then isText:=True;
      str1:=DelSteuerzeichen(str1);
    if islist then begin
      str1:=TrimLeft(str1);
     // str1:=TrimRight(str1);

    end;

    canvas.TextOut(px,py,str1);
    Canvas.font.Style:=TmpFS;
    tmpfs:=[];

    str2:=LowerCase(str2);
    u:=pos('=',str2)-1;
    j:=1; t:=1;
    if u > -1 then begin
      repeat
        str3:=GetTokenExt(str2,' ','"',j);
        command:=LowerCase(GetToken(GetTokenExt(str3,'=','"',1),'=',1));
        Value:=LowerCase(GetToken(GetTokenExt(str3,'=','"',2),'"',2));

//        Writeln('Value:[',Value+']');
//        writeln('Str3:[',str3,']');
        if Command = 'pn' then begin
          TmpPN:=Canvas.pen.Color;
          Canvas.Pen.Color:=String2ToColor('pl_'+Value);
        end; // Command = fg

        if Command = 'fg' then begin
          TmpFG:=Canvas.Font.Color;
          Canvas.Font.Color:=String2ToColor('pl_'+Value);
        end; // Command = fg

        if Command = 'bg' then begin
          TmpBG:=Canvas.Brush.Color;
          Canvas.Brush.Color:=String2ToColor('pl_'+Value);
        end; // Command = bg
        
        if command = 'fn' then begin
        end; // fn
        
        if Command = 'fs' then begin
          TmpFS:=Canvas.Font.Style; NewFS:=[];
//          writeln(Value);
          for FontI:=1 to NumToken(value,',') do begin
            str4:=GetToken(Value,',',FontI);
            if str4 = 'b' then include(Newfs, fsBold);
            if str4 = 'i' then include(Newfs, fsItalic);
            if str4 = 'u' then include(Newfs, fsUnderline);
            if str4 = 's' then include(Newfs, fsStrikeOut);

          end;
          canvas.Font.Style:=Newfs;
        end;

        inc(j);
      until str3 = '';
    end; // u > 0

    px:=px+pw;

    if u = -1 then begin
      command:=LowerCase(str2);

      if command ='list' then begin
        px:=level;
        isList:=True;
      end;

      if command = 'addlevel' then begin
        TmpBG2:=Canvas.brush.Color;
        Canvas.brush.Color:=clBlack;
        if isText2 then py:=py+ph+1;
        inc(level,10);
        px:=level;
//        if not isText2 then

        Canvas.FillRect(px-5,py,px,py+5);

        Canvas.brush.Color:=TmpBG2
      end;
      
      if command = '/addlevel' then begin
        if isText2 then py:=py+ph+1;
        dec(level,10);
        px:=level;
      end;

      if command ='/list' then begin
        px:=level;
        isList:=False;
      end;

      if command = 'br' then begin
        py:=py+ph+1;
        px:=level;
      end;

      if command = 'hr' then begin
        if isText then
          py:=py+ph+1;
        px:=tx;
        Canvas.MoveTo(0,py);
        Canvas.LineTo(canvas.ClipRect.Right,py);
        py:=py+3;

      end;

      if command = '/fg' then Canvas.Font.Color:=TmpFG;
      if command = '/bg' then Canvas.Brush.Color:=TmpBG;
      if command = '/pn' then Canvas.Pen.Color:=TmpPN;

      if command = '/fs' then begin
      end;

      if command = '/' then begin
        Canvas.Font.Color:=TmpFG;
        Canvas.Brush.Color:=TmpBG;
        Canvas.Pen.Color:=TmpPN;
  //      Canvas.font.Style:=TmpFS;
//        tmpfs:=[];

      end;

    end; // u = -1

  until p = 0;
end;

// Außerdem wird noch diese Funktion gebraucht:

Delphi-Quellcode:

function NextHtml(var FirstIndex, LastIndex: Integer;
  var aCommand:widestring; const asoruce: widestring): String;
begin
  lastindex:=PosExt('<',asoruce,FirstIndex);

//  writeln(Firstindex,'\',Length(asoruce));

  if LastIndex > 0 then begin
    result:=Copy(asoruce,FirstIndex,abs(LastIndex-FirstIndex)-1);
    FirstIndex:=PosExt('>',asoruce,LastIndex);
    aCommand:=Copy(asoruce,LastIndex,abs(LastIndex-(FirstIndex-1)));
  end
  else begin
    aCommand:='';
    result:=Copy(asoruce,FirstIndex,Length(asoruce));
  end;


end;  // NextHtml

und diese hier:

Delphi-Quellcode:

function DelSteuerzeichen(const aString:String):String;
var
  x:Integer;
  NewStr:String;
begin
  for x:=1 to Length(aString) do begin
    if aString[x] <> #10 then
      NewStr:=NewStr+aString[x]
  end;
  result:=NewStr;
end;

müsstest du evlt. anpassen unter Windows ist das glaube ich #10#13 oder so.
das habe ich jetzt in Lazarus erstellt. soltle aber auch bei dir laufen. Evlt. müsstest du noch eine Gobale Variable anlegen:
Canvas:TCanvas;
Da wird der Text drauf gezeichnet.
und das hier wird noch gebraucht:

Delphi-Quellcode:

function NumToken(aString: String; SepChar: Char):Byte;
var
   RChar     : Char;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  if SepChar = '#' then begin
    RChar := '*'
  end
  else begin
    RChar := '#'
  end;
   StrLen := Length(aString);
   TNum   := 0;
   TEnd   := StrLen;
  while TEnd <> 0 do  begin
    Inc(TNum);
    TEnd := Pos(SepChar,aString);
    if TEnd <> 0 then begin
      aString[TEnd] := RChar;
    end;
  end;
  Result := TNum;
end;

function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;
var
   Token     : String;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  if aString <> '' then begin
    StrLen := Length(aString);
    TNum   := 1;
    TEnd   := StrLen;
    while ((TNum <= TokenNum) and (TEnd <> 0)) do begin
    //"Test wie geht es dir so" hallo "Tach"
      TEnd := Pos(SepChar,aString);
      if TEnd <> 0 then begin
        Token := Copy(aString,1,TEnd-1);
        Delete(aString,1,TEnd);
        Inc(TNum);
      end else Token := aString;
    end;

    if TNum >= TokenNum then
      Result := Token
    else begin
      Result := Format('Fehler: Tokennummer (%s) ist größer als token !',[aString]);
//      MessageBox(0,pchar(Result),nil,MB_OK or MB_ICONEXCLAMATION);
    end;
  end;
end;

Evlt. hilft es dir oder anderen.
Ich habe das gleiche noch mal in einer anderen Variante dort wird zunäst eine TObjectlist gefült.
jede Zeile besteht aus Blöcken je nach Zeichen Formatierung. Damit ist dann auch per Scrollbar ein einfaches Scrollen möglich. Bei Intresse lade ich mal das ganze Projekt hoch. Es ist ein Lazarus Projekt was aber leicht nach Delphi umgewandelt werden kann.

Das Projekt hat zwar weniger mit dem Drucken zu tun sollte aber eine Grundlage da stellen, weil du beim Drucken ja "nur" die Auflösung ändern müsstest....