Textlänge abschneiden

[EWeiss]

Zitat von Neutral General:

Da scheint Lab.Canvas nil zu sein. Mit einem vorhandenen und gültigem Canvas bei dem du vorher Font und FontSize einstellst sollte aber wie p80286 und ich gesagt haben gute Ansätze liefern.

Nö der ist nicht Nil

Delphi-Quellcode:

Lab := TLabel.Create(nil);
Lab.Font.Name := 'Arial';
Lab.Font.Size := 16;
Lab.Caption := string(SongName);
Lab.AutoSize := True;

Ja Vielleicht wenn es nicht wie gesagt krachen würde bei dieser Procedure.

EDIT:
Ich denke das ist nicht möglich da ich für den Label kein Parent zuweisen kann.
Und ohne Parent denke ich mal kein gültiger Canvas ?

gruss

[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.

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