Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Hints formatieren (https://www.delphipraxis.net/138023-hints-formatieren.html)

Vasco da Gama 2. Aug 2009 12:49


Hints formatieren
 
Hallo ihr Experten!
Bei Problemen habe ich bereits häufig die DP zur Hilfe gezogen und muss sagen, ihr seid fantastisch.

Meine Frage:
Wie kann ich in einem Delphi-Programm in Hints einzelne Wörter Fett(, Kursiv, farbig, etc.) schreiben?
Möglichst indem ich den Hint zur Laufzeit zuweise:
z.B.

Delphi-Quellcode:
  Label1.Hint := ''+#bold+'Hinweis:'+#none+'blablabla';
Weitere Frage: Kann man in einem Hint ein Bild einbauen?

Danke, mfG

[edit=mkinzler]Tag korrigiert Mfg, mkinzler[/edit]

patti 2. Aug 2009 12:54

Re: Hints formatieren
 
Da hilft wohl bloß selber malen. Habe über die DP folgenden Link gefunden: Link, vielleicht hilft dir das schonmal etwas weiter. Ansonsten gibt es vielleicht auch fertige Komponenten, die sowas unterstützen...

Patti

mkinzler 2. Aug 2009 12:54

Re: Hints formatieren
 
Einen normalen Hint gar nicht, da es sich um einen normalen String handelt. In D2009 gibt es aber einen neuen Hint, der auf HTML basiert (TCustomHint)
http://www.codegear.com/article/3808...sandComponents

Vasco da Gama 2. Aug 2009 13:00

Re: Hints formatieren
 
Danke euch beiden, das zweite werde ich probieren, wenn ich was nicht verstehe melde ich mich hier.

mfG :dp:

himitsu 2. Aug 2009 13:06

Re: Hints formatieren
 
Zitat:

Hint, der auf HTML basiert (TCustomHint)
TCustomHint ist "nur" die Hint-Basisklasse und kann kein HTML,
davon abgeleitet gibt es eigentlich nur noch TBalloonHint.

Also, wie schon gesagt, entweder du leitest dir was von TCustomHint ab und übernimmst selber das Zeichnen (ist garnicht so schwer und es gibt auch Threads dazu in der DP)

oder du nimmst eine Fremdkomponente, welche dieses schon kann.

patti 2. Aug 2009 13:22

Re: Hints formatieren
 
Zitat:

Zitat von himitsu
...und übernimmst selber das Zeichnen (ist garnicht so schwer und es gibt auch Threads dazu in der DP)...

Da du ganz normal auf ein Canvas zeichnen kannst (siehe mein Link oben) sollte das wirklich nicht zu schwer werden. Das einzige Problem könnte es sein, den Hint-Inhalt dynamisch zu ändern bzw. einen string mit Tags zu verwenden, so wie du es in deinem ersten Post geschrieben hattest. Aber bei Problemen einfach fragen.

Patti

himitsu 2. Aug 2009 13:30

Re: Hints formatieren
 
wir haben auch hier eine dp-eigene Hintklasse:
http://www.delphipraxis.net/internal...highlight=hint

und hier wird auch einer der HTML-Hints erwähnt
http://www.delphipraxis.net/internal...highlight=hint

Bernhard Geyer 2. Aug 2009 13:55

Re: Hints formatieren
 
Der Hint vom ElPack (LMD) kann Unicode (aktuell wird noch D6 unterstützt) und unterstützt HTML

Vasco da Gama 2. Aug 2009 17:46

Re: Hints formatieren
 
Ok, jetzt wollte ich mir mal die Grundversion von pattis link ansehen.
Ich habe die Unit folgendermasen gemacht:
Delphi-Quellcode:
unit GraphicHint;

interface

implementation
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
{*********************************************************

 Mit Hilfe des folgendes Codes lassen sich leicht beliebige
 Hints erstellen. Dazu muss nur dir Prozedur "Paint" den
 Wünschen entsprechend angepasst werden.

 With the following Code you can simply create custom hints.
 You just have to change the procedur "Paint".

 *********************************************************}

type
  TGraphicHintWindow = class(THintWindow)
    constructor Create(AOwner: TComponent); override;
  private
    FActivating: Boolean;
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  protected
    procedure Paint; override;
  published
    property Caption;
  end;

  {...}

constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  {
   Hier können beliebige Schrift Eigenschaften gesetzt
   werden.

   Here you can set custom Font Properties:
   }

  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := Style + [fsBold];
    Color := clBlack;
  end;
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);

  {*******************************************************
   Der folgende Code ist ein Beispiel wie man die Paint
   Prozedur nutzen kann um einen benutzerdefinierten Hint
   zu erzeugen.

   The folowing Code ist an example how to create a custom
   Hint Object. :
   }

  bmp := TBitmap.Create;
  bmp.LoadfromFile('D:\hint.bmp');

  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clsilver;
    Pen.Color  := clgray;
    Rectangle(0, 0, 18, R.Bottom + 1);
    Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
  end;

  bmp.Free;
  //Beliebige HintFarbe
  //custom Hint Color
  Color := clWhite;

  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(20, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption);
  {********************************************************}
end;

procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  FActivating := True;
  try
    Caption := AHint;
    //Höhe des Hints setzen setzen
    //Set the "Height" Property of the Hint
    Inc(Rect.Bottom, 14);
    //Breite des Hints setzen
    //Set the "Width" Property of the Hint
    Rect.Right := Rect.Right + 20;
    UpdateBoundsRect(Rect);
    if Rect.Top + Height > Screen.DesktopHeight then
      Rect.Top := Screen.DesktopHeight - Height;
    if Rect.Left + Width > Screen.DesktopWidth then
      Rect.Left := Screen.DesktopWidth - Width;
    if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
    if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
    Invalidate;
  finally
    FActivating := False;
  end;
end;

end.
Im Form Create meines Projektes:
Delphi-Quellcode:
HintWindowClass := TGraphicHintWindow;
Allerdings der Fehler:
Zitat:

[DCC Fehler] BTest.pas(40): E2003 Undeklarierter Bezeichner: 'TGraphicHintWindow'

DeddyH 2. Aug 2009 17:49

Re: Hints formatieren
 
Hast Du auch GraphicHint in der uses-Klausel hinzugefügt und befindet sich diese im Suchpfad?

Vasco da Gama 2. Aug 2009 17:50

Re: Hints formatieren
 
GraphicHint ist in der uses klausel ganz oben in der unit des projektes.
Sie befindet sich im lib ordner und er hat sie auch kompiliert.

himitsu 2. Aug 2009 18:13

Re: Hints formatieren
 
es ist auch alles in implementation definiert ... und nur das in interface definierte kann man außerhalb einer Unit verwenden

DeddyH 2. Aug 2009 18:17

Re: Hints formatieren
 
:wall: Das hab ich glatt übersehen.

Vasco da Gama 3. Aug 2009 09:14

Re: Hints formatieren
 
Danke! Damit klappts erstmal gut, allerdings ignoriert er #13#10 und schreibt in der gleichen Zeile weiter...

himitsu 3. Aug 2009 11:06

Re: Hints formatieren
 
Canvas.TextOut nutzt Windows.ExtTextOut ... nimm stattdessen mal Windows.DrawText, denn dieses behandelt die Zeilenumbrüche.

MSDN-Library durchsuchenExtTextOut MSDN-Library durchsuchenDrawText

Vasco da Gama 3. Aug 2009 12:10

Re: Hints formatieren
 
Danke, kannst du mir bitte sagen, was die Parameter bedeuten?(Was ich dort einfüllen muss.) Die Englische Erklärung verstehe ich nicht wirklich...

danke, mfg

patti 3. Aug 2009 12:41

Re: Hints formatieren
 
Bitteschön: kurz zusammengetippt und getestet, sollte funktionieren:

Delphi-Quellcode:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var x : string;
var r : TRect;
begin
     //--
     x := 'Das ist ein' + #13#10 + 'langer Text mit Zeilenumbruch...'; // Test-String
     //
     r := Rect(0,0,0,0); // Rect mit Standardwerten setzen
     // Left und Top zur Positionierung verwenden, Right und Bottom wird spaeter berechnet
     //
     with PaintBox1.Canvas do  // Font-Eigenschaften setzen
     begin
          Font.Color := clBlue;
          Font.Name := 'Arial';
          Font.Style := [fsBold];
     end;
     //
     // Die DrawText-Routine mit DT_CALCRECT als letzen Parameter zeichnet den Text nicht,
     // sondern berechnet lediglich die Groesse (Right, Bottom) fuer das Rect
     //
     DrawText(PaintBox1.Canvas.Handle,PChar(x),Length(x),r,DT_CALCRECT);
     //
     // Ausgabe des Textes (linksbuendig)
     //
     DrawText(PaintBox1.Canvas.Handle,PChar(x),Length(x),r,0);
     //
     // ueber der letzten Parameter kann zudem der Text formatiert werden, beispielsweise
     // mittig zentriert werden, etc.
     //
end;
Kannst ja mal ein Test-Projekt machen mit einer Paintbox drauf und den obigen Code zum Zeichnen verwenden.

Bei Fragen einfach fragen ;-)

Patti

himitsu 3. Aug 2009 12:57

Re: Hints formatieren
 
versuch mal
Delphi-Quellcode:
procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
  R := ClientRect;
  //Inc(R.Left, 2);   wenn, dann gleich alle seiten beschneiden,
  //Inc(R.Top, 2);    aber da diese Werte hier eh nicht benutzt wurde,
  //Dec(R.Bottom, 2); kann es auch weggelassen werden
  //Dec(R.Right, 2);  (vorallem da Bottom und Right da unten "etwas" falsch verrechnet werden)

  {*******************************************************
   Der folgende Code ist ein Beispiel wie man die Paint
   Prozedur nutzen kann um einen benutzerdefinierten Hint
   zu erzeugen.

   The folowing Code ist an example how to create a custom
   Hint Object. :
   }

  bmp := TBitmap.Create;
  bmp.LoadfromFile('D:\hint.bmp');

  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clsilver;
    Pen.Color  := clgray;
    Rectangle(0, 0, 18, R.Bottom + 1);
    Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
  end;

  bmp.Free;
  //Beliebige HintFarbe
  //custom Hint Color
  Color := clWhite;

  Canvas.Brush.Style := bsClear;
  R.Left := 20;
  R.Top := (R.Bottom div 2) - (Canvas.TextHeight(Caption) div 2);
  DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP);
  {********************************************************}
end;

PS: http://translate.google.com/
oder gib da gleich statt dem einzelnem Text die URL ein
http://translate.google.com/translate?js=y&prev=_t&hl=de&ie=UTF-8&u=http%3A%2F%2Fmsdn.microsoft.com%2Fde-de%2Flibrary%2Fdd162498(en-us%2CVS.85).aspx&sl=en&tl=de&history_state0=

Vasco da Gama 3. Aug 2009 13:00

Re: Hints formatieren
 
Danke, das funktioniert erstmal, später werd ich probieren, dass er einzelne Wörter fett und co. schreiben kann. Da werd ich sicher noch Fragen haben :lol:

Bis Später also, mfG

@ himitsu:
Danke ebenfalls

himitsu 3. Aug 2009 13:23

Re: Hints formatieren
 
da wirst du dann den String zerlegen und alles einzeln zeichnen müssen.

patti 3. Aug 2009 15:10

Re: Hints formatieren
 
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 6. Aug 2009 18:21

Re: Hints formatieren
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 6. Aug 2009 19:09

Re: Hints formatieren
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 :nerd: )

Vasco da Gama 7. Aug 2009 09:14

Re: Hints formatieren
 
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 7. Aug 2009 09:24

Re: Hints formatieren
 
Zitat:

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 7. Aug 2009 14:47

Re: Hints formatieren
 
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 7. Aug 2009 17:44

Re: Hints formatieren
 
Danke, funktioniert super.

himitsu 7. Aug 2009 19:07

Re: Hints formatieren
 
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) :mrgreen: #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 8. Aug 2009 10:53

Re: Hints formatieren
 
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 :gruebel:) 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 :stupid:

Patti

Jens01 27. Okt 2009 15:34

Re: Hints formatieren
 
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:20 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz