Textlänge abschneiden

[nahpets]

In einem Programm, in dem ich zur Laufzeit Buttons in eine Scrollbox lege, habe ich das so gelöst:

Delphi-Quellcode:

      lb             := TLabel.Create(Nil);
      lb.Font        := sbFavoriten.Font; // Scrollbox
      lb.Autosize    := True;
      lb.Caption     := fdSendername.AsString; // DB-Feld mit Sendername
      btn.Hint       := lb.Caption + #13 + fdKategorie.AsString;  // DB-Feld mit Senderkategorie
      if lb.Width > sbFavoriten.Width - 32 then begin
        lb.Caption := lb.Caption + '...';
        while lb.Width > sbFavoriten.Width - 32 do begin
          lb.Caption := Copy(lb.Caption,1,Length(lb.Caption) - 4) + '...';
        end;
      end;
      // Button den gekürzten Text und die erforderliche Höhe zuweisen.
      btn.Caption    := lb.Caption;
      btn.Height     := lb.Height + 4;

[EWeiss]

Nein es geht definitiv nicht.
Weil ich Controls dieser Art nicht addieren kann.
Ein Parent für den Label kann ich auch nicht setzen.

Habe es jetzt so geändert.
Aber auch das stimmt nicht weil es sich mit OpenGL nicht vereinbaren lässt.

Delphi-Quellcode:

function GetText(AText, AFontName: string; AFontSize: integer; MaxWidth: Integer): string;
var
  bmp: TBitmap;
  CurrWidth, n: Integer;

begin

  bmp := TBitmap.Create;
  try
    bmp.Canvas.Font.Name := AFontName;
    bmp.Canvas.Font.Size := AFontSize;

    MaxWidth :=  MaxWidth - bmp.Canvas.TextWidth('...');
    CurrWidth := bmp.Canvas.TextWidth(AText);

    n := Length(AText);
    repeat
      CurrWidth := CurrWidth - bmp.Canvas.TextWidth(AText[n]);
        dec(n);
    until (CurrWidth <= MaxWidth) or (n <= 0);

    if CurrWidth < MaxWidth then
      result := copy(AText, 1, (n + 1))
    else
    result := copy(AText, 1, (n + 1)) + '...';

  finally
    bmp.Free;
  end;
end;

zudem kommt noch das
CurrWidth < MaxWidth niemals mehr als MaxWidth ist.
Das hat zur folge das immer '...' angehängt wird.
Außerdem ist im vorherigen Code noch ein Fehler n muss mit 1 addiert werden ansonsten fehlt ein Buchstabe.

Wenn ich nun IIIIIIII anstelle von XXXXXX nehme geht I über meine Zeitanzeige hinaus
Ist also das gleiche in grün.

Delphi-Quellcode:

SongName := PAnsiChar(AnsiString(GetText(string(AnsiString(BassSoInfo.SongTitle)), 'Arial', 16, 570)));

geht mit X aber nicht mit I
Die breite der Zeichen ist nun mal nicht gleich wie die der Labels.
Auch wenn ich den gleichen Font, Font.size verwende.

Zitat:

aber das Verhältnis sollte ja auf jeden Fall gleich sein.

Also nein keinerlei Einklang in Verbindung mit OGL


gruss

[EWeiss]

Ich bekomme das nicht berechnet.

Gehe jetzt wie folgt vor.

Delphi-Quellcode:

    // Display Song Name
    SongNameTmp := BassSoInfo.SongTitle;
    OldTitle := string(BassSoInfo.Songfile);
 
    if assigned(SongNameTmp) then
    begin
      SetLength(Char, length(SongNameTmp));
 
      // Only change if Title different
      if (OldTitle <> CurrentTitle) then
      begin
        //Get max length of String
        fMaxStrLen := tsTextGetWidthA(SongNameTmp);
        if fMaxStrLen >= 635 then
        begin
          // Parse width of Glyph
          for I := 0 to High(Char) do
          begin
            Char[I] := WideChar(SongNameTmp[I]);
            CharLength := tsFontGetCharParameteri(Char[I], TS_CHAR_GLYPHRECT_RIGHT);
            CharLen := CharLen + CharLength;
          end;
          // CharLen = length of all combine Glyph
          if CharLen >= ((CharLen - fMaxStrLen) + 635) then
          begin
            SongName := PAnsiChar(Ansistring(Ansimidstr(string(SongNameTmp), 1, 58) + '...'));
          end;
        end
        else
          SongName := BassSoInfo.SongTitle;
 
        CurrentTitle := OldTitle;
      end;

Ich scheitere hier dran '58'
Der Abstand zur Zeitanzeige ist immer unterschiedlich abhängig davon wie groß die Glyphen sind.
Die Chars beider Dateien sind identisch.

gruss

[EWeiss]

Sorry das ich direkt nochmal Antworte.

Im Delphi Forum hat Lossy mir den Tip gegeben.

Delphi-Quellcode:

if fMaxStrLen = 0 then begin
  fMaxStrLen := tsTextGetWidthA(SongName);
  if fMaxStrLen >= 635 then begin // eventuell reicht die while-schleife auch aus.
    // eventuell hier eine Kopie des Songnamens erstellen.
    while fMaxStrLen >= 635 do
      // string kürzen und '...' anhängen
      fMaxStrLen := tsTextGetWidthA(>gekürzter string<);
    end;
  end;
end;

Die frage wäre nur wie den String kürzen auf welcher Basis.
Und ob er dann wegen den Glyphen innerhalb des Bereiches von 635 passt wäre noch die Frage.

gruss

[Sir Rufo]

Nur mal so nebenbei etwas allgemeingültiges heruntergetippt:

Delphi-Quellcode:

unit Unit2;

interface

uses
  System.SysUtils,
  System.StrUtils;

type
  TCharMeasureWidthDelegate = function( const C: Char ): Integer of object;

function ShortenText( const Text: string; const MaxLength: Integer; const CharMeasurement: TCharMeasureWidthDelegate; const ShortenSuffix: string = '...' ): string;

implementation

function ShortenText( const Text: string; const MaxLength: Integer; const CharMeasurement: TCharMeasureWidthDelegate; const ShortenSuffix: string = '...' ): string;
var
  lText                   : string;
  lChar                   : Char;
  lCharLength             : Integer;
  lSuffixLength           : Integer;
  lTextLength             : Integer;
  lShortenedWithSuffix    : string;
  lShortendWithSuffixFound: Boolean;
begin
  if not Assigned( CharMeasurement )
  then
    raise EArgumentNilException.Create( 'CharMeasurement' );
  if MaxLength < 0
  then
    raise EArgumentOutOfRangeException.Create( 'MaxLength' );

  lSuffixLength := 0;
  for lChar in ShortenSuffix do
    begin
      lSuffixLength := lSuffixLength + CharMeasurement( lChar );
    end;

  if lSuffixLength > MaxLength
  then
    raise EArgumentOutOfRangeException.Create( 'SuffixLength > MaxLength' );

  Result                   := '';
  lText                    := TrimRight( Text );
  lTextLength              := 0;
  lShortendWithSuffixFound := False;

  for lChar in lText do
    begin
      lCharLength := CharMeasurement( lChar );

      if not lShortendWithSuffixFound and ( lTextLength + lCharLength + lSuffixLength > MaxLength )
      then
        begin
          lShortenedWithSuffix     := Result + ShortenSuffix;
          lShortendWithSuffixFound := True;
        end;

      if lTextLength + lCharLength > MaxLength
      then
        begin
          Result := lShortenedWithSuffix;
          Exit;
        end;

      Result := Result + lChar;
      Inc( lTextLength, lCharLength );
    end;

end;

end.

Und ein Test mit einer PaintBox (ja, es ist wurscht womit man das verwendet)

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel; // Width: 560; Font.Name: Courier New; Font.Size: 8
    procedure PaintBox1Paint( Sender: TObject );
    procedure Edit1Change( Sender: TObject );
  private
    function CalculateCharWith( const C: Char ): Integer;
    function CalculateFixedCharWidth( const C: Char ): Integer;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Unit2;

{ TForm1 }

function TForm1.CalculateCharWith( const C: Char ): Integer;
begin
  Result := PaintBox1.Canvas.TextWidth( C );
end;

function TForm1.CalculateFixedCharWidth( const C: Char ): Integer;
begin
  Result := 1;
end;

procedure TForm1.Edit1Change( Sender: TObject );
begin
  PaintBox1.Invalidate;
  // Ist von der Breite so angelegt, dass mit Courier New 8 genau 80 Zeichen hineinpassen
  Label2.Caption := ShortenText( Edit1.Text, 80, CalculateFixedCharWidth );
end;

procedure TForm1.PaintBox1Paint( Sender: TObject );
var
  lDrawText: string;
begin
  lDrawText      := ShortenText( Edit1.Text, PaintBox1.ClientWidth, CalculateCharWith );
  Label1.Caption := PaintBox1.ClientWidth.ToString( ) + ' / ' + PaintBox1.Canvas.TextWidth( lDrawText ).ToString( );
  PaintBox1.Canvas.TextOut( 0, 0, lDrawText );
end;

end.

[EWeiss]

Danke dir für deine mühe.
Aber ich kann leider davon nichts verwenden.
Ich muss den Text parsen/Ausgeben mit der Bibliothek mit der die Texte auch gezeichnet werden.

GetTextExtentPoint geht nicht GDI.
Auch alle anderen Texte (Berechnungen) die basierend auf GDI sind kann ich nicht verwenden.

Zitat von Lossy https://delphigl.com/forum/viewtopic...100413#p100413

Zitat:

Hier solltest du grundsätzlich die TextBreite etc. nur mit der Bibliothek erfragen mit der du die Texte auch zeichnest. Alles andere kann nicht funktionieren. Bzw. Birgt einfach zu viele Risiken.

Ich weiß nicht wie ich hier den Text zuschneiden soll.
Habe keinen Anhaltspunkt.

Delphi-Quellcode:

    while fMaxStrLen >= 635 do
       // string kürzen und '...' anhängen
       fMaxStrLen := tsTextGetWidthA(>gekürzter string<);
     end;

gruss

[Sir Rufo]

Hast du eine Möglichkeit die effektive Breite eines Zeichens abzufragen?
Geht das nicht mit

Delphi-Quellcode:

tsFontGetCharParameteri

?

Dann so eine Funktion der

Delphi-Quellcode:

ShortenText

mitgeben und du bekommst den Text, den du zeichnen kannst.

[EWeiss]

Zitat:

Zitat von Sir Rufo (Beitrag 1340492)

Hast du eine Möglichkeit die effektive Breite eines Zeichens abzufragen?
Geht das nicht mit

Delphi-Quellcode:

tsFontGetCharParameteri

?

Dann so eine Funktion der

Delphi-Quellcode:

ShortenText

mitgeben und du bekommst den Text, den du zeichnen kannst.

Ja doch..

Delphi-Quellcode:

          // Parse width of Glyph
           for I := 0 to High(Char) do
           begin
             Char[I] := WideChar(SongNameTmp[I]);
             CharLength := tsFontGetCharParameteri(Char[I], TS_CHAR_GLYPHRECT_RIGHT);
             CharLen := CharLen + CharLength;
           end;

CharLength ist die länge des Aktuellen Chars basierend auf i

Nur wie soll ich da den Titel mit kürzen.
Es geht aber wie man an den Bildern sieht ist der Abstand zur Zeitanzeige basierend auf der Breite der Chars unterschiedlich.
Aber vielleicht geht es auch nicht anders. ?

Ich setze hier die länge des Strings auf 58.

Delphi-Quellcode:

SongName := PAnsiChar(Ansistring(Ansimidstr(string(SongNameTmp), 1, 58) + '...'));

Die 58 jedoch ist eigentlich der Bereich den ich berechnen müsste, wenn ich denn einen Anhaltspunkt hätte.

gruss

[Sir Rufo]

Nun ja, wenn dir ein kompletter Source noch nicht reicht, wie soll man dann noch helfen?

Mir scheint, du schaust einfach nur flüchtig drüber und "... oh, der hat da was mit VCL verwendet, dann passt es eh nicht ..."

Schau dir meinen Source an und du wirst sehen, wie der Text so passend wie nur möglich zurechtgestutzt wird.

BTW:

Delphi-Quellcode:

ShortenText

weiß nicht, wie man die Breite eines Zeichens bestimmt (dafür ist der Parameter

Delphi-Quellcode:

CharMeasurement

da - CallbackFunktion).

[EWeiss]

Zitat:

Zitat von Sir Rufo (Beitrag 1340494)

Nun ja, wenn dir ein kompletter Source noch nicht reicht, wie soll man dann noch helfen?

Mir scheint, du schaust einfach nur flüchtig drüber und "... oh, der hat da was mit VCL verwendet, dann passt es eh nicht ..."

Schau dir meinen Source an und du wirst sehen, wie der Text so passend wie nur möglich zurechtgestutzt wird.

Mir hat dein Quelltext immer gereicht.
Und ich kann auch gerne drüber schauen.
Das Problem ist nur die länge der Chars ist nicht identisch alleine deshalb schon nicht weil ich unter OpenGL Schatten verwende.
Ich werde nie auch nur halbwegs an die korrekte breite jedes einzelnen Chars herankommen.

Es geht nicht um nicht wollen ich schätze deinen Code.
Aber es wird damit nicht funktionieren.
Tut mir leid ;)

Aber ich denke andere die ein ähnliches Problem unter VCL haben werden sich darüber sicher freuen (Was nicht bedeutet ich hätte mich nicht gefreut ;) )

Vielleicht muss ich wirklich auf Lossy warten er hat die Bibliothek geschrieben.
Er kann mir vielleicht zu einigen Parametern noch genauere Auskunft geben.

Zitat:

Courier New

Monotype Fonts.
Damit hätte ich auch kein Problem weil hier alle Zeichen gleich breit sind.
Aber ehrlich? Das sieht bescheiden aus.
Da bekomme ich vom Text her gerade mal die hälfte auf meinem Rendercontex wie bisher.
Aber, könnte dann mit einer fixen Anzahl von Char's Arbeiten wie ich es jetzt tue 58 und der abstand wäre immer gleich.
Wenn es nicht so bescheiden aussehen würde.

Im Fall von Monotypen Fonts könnte man komplett auf deinen Code verzichten.
Wie gesagt da alle Chars gleich breit sind.

gruss