AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Textlänge abschneiden

Ein Thema von EWeiss · begonnen am 14. Jun 2016 · letzter Beitrag vom 20. Jun 2016
Antwort Antwort
EWeiss
(Gast)

n/a Beiträge
 
#1

AW: Textlänge abschneiden

  Alt 14. Jun 2016, 09:33
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

Geändert von EWeiss (14. Jun 2016 um 09:45 Uhr)
  Mit Zitat antworten Zitat
nahpets
(Gast)

n/a Beiträge
 
#2

AW: Textlänge abschneiden

  Alt 14. Jun 2016, 12:18
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;
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#3

AW: Textlänge abschneiden

  Alt 14. Jun 2016, 13:12
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

Geändert von EWeiss (14. Jun 2016 um 14:41 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#4

AW: Textlänge abschneiden

  Alt 17. Jun 2016, 21:00
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

Geändert von EWeiss (11. Jul 2019 um 16:44 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#5

AW: Textlänge abschneiden

  Alt 17. Jun 2016, 21:36
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

Geändert von EWeiss (17. Jun 2016 um 21:39 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Textlänge abschneiden

  Alt 17. Jun 2016, 22:26
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.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#7

AW: Textlänge abschneiden

  Alt 17. Jun 2016, 22:35
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

Geändert von EWeiss (17. Jun 2016 um 22:45 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:33 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz