Hints formatieren

[patti]

Wenn du nur Formatierungen wie z.B. fett oder unterstrichen haben willst, dann sollte das relativ einfach zu machen sein. Du musst dir halt nur eine Möglichkeit überlegen, wie du die Formatierungs-Befehle in den String einbaust (z.B. ähnlich dem BBCode aus der DP mit eckigen Klammern, etc.) und dann den String Zeichen für Zeichen in einer Schleife durchgehen und analysieren. Wenn du an einen Formatierungsbefehl kommst musst du diesen halt noch dementsprechend umsetzen.

[patti]

Wollte mich hier nochmal nach eventuellen Fortschritten von dir erkundigen. Habe nämlich mal selber etwas zusammengeschrieben und auf die Schnelle getestet. Ist sicherlich nicht der sauberste Quellcode und vielleicht auch nicht der allerschnellste, aber für deine Bedürfnisse sollte er allemal taugen. Wenn du Interesse daran hast oder nur einen Denkanstoß in Form von etwas Quelltext haben willst, kann ich dir meinen Quelltext zeigen.

Patti

[himitsu]

Falls du in diesem "kranken" Code etwas durchsiehst...

In der Unit DigiCircuitry.pas verstecken sich Prozeduren wie PaintText, welche einen Text formatiert ausgeben.
allerdings arbeitet diese intern über ByteCodes (z.B. #3 für Fett oder #14 für Fontsize 4) ... versteckt sich weiter oben in der Unit eine Tabelle
BinTextToText und TextToBinText wandeln diese Byte Codes in lesbareren Code um. (z.B. {Bold} {Size=4} )
irgenwo wird auch der "Editor" aus der DigiCircuitry_Text.pas mit diesem lesbarerem Code aufgerufen.

eigentlich sollte sich der Editor anzeigen, wenn man diesen über's Popupmenü aufruft ... wird er aber nicht
(ein Textfeld in das Formular ziehen, Rechtsklick auf's Textfeldchen und dann Option wählen)


nja, wie dem auch sei, der Code zum Anzeigen funktioniere zumindestens (glaub ich )

[Vasco da Gama]

Hallo, ich habe inzwische keine Fortschritte gemacht.(Habe mich mit Andorra 2D beschäftigt.)
patti, deines sieht sehr gut aus. Da würde mich der Quellcode schon interessieren.
himitsu, genau sowas habe ich gesucht, allerdings wirft diese Unit DigiCircuitry.pas etliche Fehler. Leider kann ich dein Projekt also nicht starten.

mfG

[himitsu]

Zitat von Vasco da Gama:

himitsu, genau sowas habe ich gesucht, allerdings wirft diese Unit DigiCircuitry.pas etliche Fehler. Leider kann ich dein Projekt also nicht starten.

ist ja auch unter D7 oder D2006 geschrieben wurden und nicht unbedingt D2009-tauglich
ja und wie gesagt, sind da auch Fehler drin (war/ist 'nen kleines Nebenherspaßprojekt gegen lange Weile gewesen und ich hatte noch keine Zeit da weiter was dran zu machen)

[patti]

Hier ist also mal mein Quelltext. Ich weise nochmal darauf hin, dass er vielleicht nicht unbedingt besonders "sauber" geschrieben ist oder sehr schnell funktioniert, zumal jeder Buchstabe auf der Canvas einzeln ausgegeben wird. Als Denkanstoß sollte es aber allemal reichen. Bei Bedarf kannst du ihn ja noch erweitern. Zu erwähnen ist außerdem noch, dass der Font-Name und die Schriftgröße von den Canvas-Eigenschaften übernommen werden. Aber auch das ließe sich natürlich per Formatierungsbefehl noch ändern.

Delphi-Quellcode:

// PROCEDURE FormatText
//
// Gibt auf einer Canvas an einer bestimmten Stelle (APosition) einen string formatiert aus
// Formatierungs-Befehle sind dem Quelltext zu entnehmen und können nach den eigenen Wünschen
// angepasst werden
//
// by Patrick Kreutzer, August 2009
//
procedure FormatText(ACanvas : TCanvas; APosition : TPoint; AInput : string);
var CurComand : string;
var c         : integer;
var x,y       : integer;
var OldFont   : TFont;
var Comand    : boolean;
var ComandEnd : boolean;
// <--
   procedure ChangeFontStyle(AComandEnd : boolean; AFontStyle : TFontStyle);
   begin
        //--
        if AComandEnd then ACanvas.Font.Style := ACanvas.Font.Style - [AFontStyle]
        else ACanvas.Font.Style := ACanvas.Font.Style + [AFontStyle];
   end;
// -->
begin
     //--
     if AInput <> '' then
     begin
          OldFont := ACanvas.Font;
          //
          x := APosition.X;
          y := APosition.Y;
          //
          with ACanvas, ACanvas.Font do
          begin
               Font.Color  := clBlack;
               Style       := [];
               Brush.Style := bsClear;
               //
               CurComand   := '';
               Comand      := false;
               //
               c := 1;
               //
               repeat
                   if not(AInput[c] in ['[',']']) and not(Comand) then
                   begin
                        TextOut(x,y,AInput[c]);
                        //
                        x := x + TextWidth(AInput[c]);
                   end
                   else
                   begin
                        case AInput[c] of
                        '[' : Comand := true;
                        ']' : begin
                                   Comand    := false;
                                   ComandEnd := false;
                                   //
                                   if Length(CurComand) > 0 then
                                   begin
                                        if CurComand[1] = '/' then
                                        begin
                                             ComandEnd := true;
                                             //
                                             CurComand := Copy(CurComand,2,Length(CurComand)-1);
                                        end;
                                        //
                                        CurComand := AnsiUpperCase(CurComand);
                                        //
                                        if CurComand = 'B' then ChangeFontStyle(ComandEnd,fsBold);
                                        if CurComand = 'I' then ChangeFontStyle(ComandEnd,fsItalic);
                                        if CurComand = 'U' then ChangeFontStyle(ComandEnd,fsUnderline);
                                        if CurComand = 'S' then ChangeFontStyle(ComandEnd,fsStrikeOut);
                                        //
                                        if CurComand = 'BREAK' then
                                        begin
                                             y := y + TextHeight('Aq');
                                             x := APosition.X;
                                        end;
                                        //
                                        if CurComand = 'BLACK'  then Font.Color := clBlack;
                                        if CurComand = 'BLUE'   then Font.Color := clBlue;
                                        if CurComand = 'RED'    then Font.Color := clRed;
                                        if CurComand = 'GREEN'  then Font.Color := clGreen;
                                        if CurComand = 'YELLOW' then Font.Color := clYellow;
                                        if CurComand = 'WHITE'  then Font.Color := clWhite;
                                   end;
                                   //
                                   CurComand := '';
                              end;
                        else
                          CurComand := CurComand + AInput[c];
                        end;
                   end;
                   //
                   Inc(c);
               until c > Length(AInput);
          end;
          //
          ACanvas.Font := OldFont;
     end;
end;

Und so könnte beispielweise ein Aufruf ausschauen:

Delphi-Quellcode:

//--
PaintBox1.Repaint;
FormatText(PaintBox1.Canvas,Point(0,10),'Das [b]ist ein [i][u]Test [/u][/i][/b][i][u][/u][/i][u][/u]!!!');

Viel Spaß damit

Patti

[Vasco da Gama]

Danke, funktioniert super.

[himitsu]

bei mir im Code hatte ich allerdings gleich gante Textstücke zusammenhängend ausgegeben.

ist eigentlich recht einfach
- zwei Laufvariable, welche die aktuellen Positionen angeben
- erste Variable auf Anfang
- schleifenstart
- zweite auf die Position der ersten setzen
- solange 2. ein Zeichen weiter, bis Steuercde oder Stringende gefunden wird
- wenn mindestens ein zeichen gefunden, dann alles zwischen 1. und 2. Laufvariable ausdrucken
- 1. auf 2. setzen
- prüfen ob an 1. ein steuercode steht und diesen auswerten und 1. Var ans Codeende
(die 2. kann man auch hier zum suchen des Codeendes nutzen)
- wenn 1. ungleich Stringende, dann schleife wiederholen

und dann braucht man noch 3 variablen für X, Y und nochmal X (Xs) #das 2. X gibt di Xposition des Zeilenanfangs an, bei Zeilenumbruch einfach Y:=Y+Zeilenhöhe und X=Xs

bei mir im Code wurde allerdings noch einiges mehr bezüglich Y gemacht, damit bei unterschiedlicher Schrifthöhe der Text auch in der Zeile ordenzlich ausgerichtet ist
und bezürlich X wurde auch noch rechtsbündig und zentriert behandelt


was aber bestimmt unglücklich wirkt ist, daß bei mir auch noch ein Zoom mit integriert ist

[patti]

Bitte

Zitat:

bei mir im Code hatte ich allerdings gleich gante Textstücke zusammenhängend ausgegeben.

Ist bei meinem Code auch kein Problem, hatte ich anfangs auch drin, hab mich dann aber (warum auch immer ) doch für einzelne Buchstaben entschieden. Sollte aber überhaupt kein Problem sein, das in meinem Code zu ändern

Zitat:

bei mir im Code wurde allerdings noch einiges mehr bezüglich Y gemacht, damit bei unterschiedlicher Schrifthöhe der Text auch in der Zeile ordenzlich ausgerichtet ist
und bezürlich X wurde auch noch rechtsbündig und zentriert behandelt

Da ich in der obigen Fassung keine Schriftgrößenänderungen unterstütze, entfällt das bei mir natürlich. Und auch die unterschiedliche X-Position habe ich mir gespart Ich denke, dass er für seinen Hint das nicht unbedingt benötigt. Wenn doch: Selber machen

Patti

[Jens01]

Habe hier das Programmteil von patti ergänzt :
FormatTextSize gibt die Größe des Textstrings an.
FormatText ist um einen Tab-Sprung [/P11] und Änderung der Zeichengröße [/FS11] ergänzt. Außerdem werden eckige Klammern ohne / hier ausgegeben.

Delphi-Quellcode:

procedure FormatText(ACanvas : TCanvas; APosition : TPoint; AInput : string);
var
  CurComand: string;
  c, x, y, THmax: integer;
  OldFont: TFont;
  Comand, ComandEnd: boolean;

  procedure ChangeFontStyle(AComandEnd : boolean; AFontStyle : TFontStyle);
  begin
    if AComandEnd then ACanvas.Font.Style := ACanvas.Font.Style - [AFontStyle]
      else ACanvas.Font.Style := ACanvas.Font.Style + [AFontStyle];
  end;

begin
  if AInput <> '' then
  begin
    OldFont := ACanvas.Font;
    x := APosition.X;
    y := APosition.Y;

    with ACanvas, ACanvas.Font do
    begin
      Font.Color  := clBlack;
      Style       := [];
      Brush.Style := bsClear;
      CurComand   := '';
      Comand      := false;
      THmax       := TextHeight('Aq'); //setz die Anfangtexthöhe (max)
      c := 1;

      repeat
        if not(AInput[c] in ['[',']']) and not(Comand) then
        begin
          TextOut(x,y,AInput[c]);
          x := x + TextWidth(AInput[c]);
        end
        else
        begin
          case AInput[c] of
          '[' : Comand := true;
          ']' : begin
                  Comand    := false;
                  ComandEnd := false;

                  if Length(CurComand) > 0 then
                  if CurComand[1] = '/' then
                  begin
                    ComandEnd := true;
                    CurComand := Copy(CurComand,2,Length(CurComand)-1);
                    CurComand := AnsiUpperCase(CurComand);

                    if CurComand = 'B' then ChangeFontStyle(ComandEnd,fsBold);
                    if CurComand = 'I' then ChangeFontStyle(ComandEnd,fsItalic);
                    if CurComand = 'U' then ChangeFontStyle(ComandEnd,fsUnderline);
                    if CurComand = 'S' then ChangeFontStyle(ComandEnd,fsStrikeOut);

                    if CurComand = 'BREAK' then //Zeilenumbruch
                    begin
                      THmax := TextHeight('Aq');
                      y := y + THmax;
                      x := APosition.X;
                    end;

                    if copy(CurComand,1,1) = 'P' then // Tab
                    begin
                      CurComand := Copy(CurComand,2,Length(CurComand)-1);
                      x := APosition.X + StrToInt(CurComand);
                    end;

                    if copy(CurComand,1,2) = 'FS' then //FontSize
                    begin
                      CurComand := Copy(CurComand,3,Length(CurComand)-1);
                      Font.Size := StrToInt(CurComand);
                      if THmax < TextHeight('Aq') then THmax := TextHeight('Aq');
                    end;

                    if CurComand = 'BLACK'  then Font.Color := clBlack;
                    if CurComand = 'BLUE'   then Font.Color := clBlue;
                    if CurComand = 'RED'    then Font.Color := clRed;
                    if CurComand = 'GREEN'  then Font.Color := clGreen;
                    if CurComand = 'YELLOW' then Font.Color := clYellow;
                    if CurComand = 'WHITE'  then Font.Color := clWhite;
                  end
                  else
                  begin
                    CurComand := '[' + CurComand + ']';
                    TextOut(x, y, CurComand);
                    x := x + TextWidth(CurComand);
                  end;

                  CurComand := '';
                end;
          else
            CurComand := CurComand + AInput[c];
          end;
        end;

        Inc(c);
      until c > Length(AInput);
    end;

    ACanvas.Font := OldFont;
  end;
end;

function FormatTextSize(ACanvas : TCanvas; AInput : string): TSize ;
var
  CurComand: string;
  c, x, y, THmax, Xmax, Ymax: integer;
  Comand, ComandEnd: boolean;
begin
  if AInput <> '' then
  with ACanvas, ACanvas.Font do
  begin
    CurComand := '';
    Comand := false;
    c := 1;
    x := 0;
    y := 0;
    THmax := TextHeight('Aq'); //setzt die Anfangtexthöhe (max)
    Xmax := 0;
    Ymax := 0;

    repeat
      if not(AInput[c] in ['[',']']) and not(Comand) then
      begin
        x := x + TextWidth(AInput[c]);
        if x > Xmax then Xmax := x;
      end
      else
      begin
        case AInput[c] of
        '[' : Comand := true;
        ']' : begin
                Comand    := false;
                ComandEnd := false;

                if Length(CurComand) > 0 then
                if CurComand[1] = '/' then
                begin
                  ComandEnd := true;
                  CurComand := Copy(CurComand,2,Length(CurComand)-1);

                  CurComand := AnsiUpperCase(CurComand);
                  if CurComand = 'BREAK' then
                  begin
                    y := y + THmax;
                    THmax := TextHeight('Aq');
                    x := 0;
                  end;

                  if copy(CurComand,1,1) = 'P' then // Tab
                  begin
                    CurComand := Copy(CurComand,2,Length(CurComand)-1);
                    x := x + StrToInt(CurComand);
                    if x > Xmax then Xmax := x;
                  end;

                  if copy(CurComand,1,2) = 'FS' then
                  begin
                    CurComand := Copy(CurComand,3,Length(CurComand)-1);
                    Font.Size := StrToInt(CurComand);
                    if THmax < TextHeight('Aq') then THmax := TextHeight('Aq');
                  end;
                end
                else
                begin
                  CurComand := '[' + CurComand + ']';
                  x := x + TextWidth(CurComand);
                  if x > Xmax then Xmax := x;
                end;

                CurComand := '';
              end;
        else
          CurComand := CurComand + AInput[c];
        end;
      end;

      Inc(c);
    until c > Length(AInput);
  end;

  result.cx := Xmax;
  result.cy := y + THmax;
end;