Schriftgröße dynamisch anpassen

[Surrounder]

Hallo Forum,

ich würde gerne folgendes machen:

Ich muss ein Etikett mit einem Namen bedrucken, was soweit auch kein Problem ist. Nun möchte ich aber den Platz auf dem Etikett optimal ausnutzen, und da es nun mal lange und kurze Namen gibt hatte ich mir überlegt die Schriftgröße dynamisch zu ändern.

Irgendwie drehe ich mich nun aber im Kreis. Ich habe die Anzahl der Zeichen im String ermittelt und in 5er Schritten (also bei 20 Zeichen = Schriftgröße 30, bei 25 Zeichen = Schriftgröße 25 etc.) abhängig davon die Schriftgröße verändert. Das geht zwar, hatte mir das aber doch etwas felxibler vorgestellt.

Hat jemand eine Idee wie ich einfach egal wieviele Buchstaben ein Name hat die Schriftgröße mathematisch errechnen könnte? Die maximale breite meines Etiketts habe ich ja, die Anzahl der Buchstaben auch, da müsste sich doch irgendwie ausrechnen lassen welche Schriftgröße die optimalste ist oder? Schriftart wäre egal.

Danke für jeden Tipp.

Steffen

[Matze]

Hallo,

geht es um Delphi?

Du könntest du die Pixelbreite über das Canvas ermitteln, falls dir das hilft bzw. du sowieso das Canvas-Objekt nutzt:

StringWidthInPixels := Canvas.TextWidth('Etikettentext') Wenn du natürlich eine Schriftart wie "Courier New" nutzt, bei der jeder Buchstabe gleich breit ist, kannst du die Buchstabenbreite mit der Anzahl der Buchstaben multiplizieren. Nur das hilft dir vermutlich nichts.

Edit: Da es mich selbst interessiert hat, habe ich eine kleine Funktion geschrieben, die dir die Breite des Texts in Pixeln zurück gibt:

Delphi-Quellcode:

function GetTextWidthInPixels(Text: string; Font: TFont): Integer;
var
  PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result := PxWidth;
end;

Ein möglicher Aufruf könnte so aussehen:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  TextWidthPx: Integer;
  Font: TFont;
begin
  Font := TFont.Create;
  try
    Font.Name := 'Arial';
    Font.Size := 12;
    Font.Style := [fsBold, fsUnderline];
    TextWidthPx := GetTextWidthInPixels('Der Text', Font);
  finally
    FreeAndNil(Font);
  end;

  // oder mit FontDialog
  if FontDialog1.Execute then
    TextWidthPx := GetTextWidthInPixels('Der Text', FontDialog1.Font);

  ShowMessage(IntToStr(TextWidthPx) + ' Pixel');
end;

Grüße, Matze

[p80286]

Also die Lösung von Matze ist die Grundlage. Du mußt nur Size solange anpassen, bis es paßt.

Zitat von Surrounder:

Schriftart wäre egal.

Die Schriftart ist nicht egal, da es bei gleichem Text und gleichem Size in der Höhe und der Breite recht große Unterschiede gibt!

Gruß
K-H

[invalid_operation]

Mit etwas Abstand vom Ausdruck kann ich - altersbedingt - 8pt noch halbwegs lesen, bei 6pt brauch ich die Lesebrille. Bei kleinen Schriftarten (<= 8pt) geht nur noch Sans Serif (serifenlose Schriftarten).

http://de.wikipedia.org/wiki/Serifenlose_Schrift

Allerdings:

Wenn mir ein Programm - abhängig von der auszudruckenden Stringlänge - automatisch andere Schriftgrößen auf dem Ausdruck "unterjubeln" würde, wäre ich etwas brüskiert/verunsichert!

Und würde mittels heftiger Bedenken meinerseits den "Verantwortlichen" zu einem Überdenken seinerseits durch die Brust von hinten ins Auge auffordern

HARTZ IV ist näher, als man denkt ;-(

[Surrounder]

Vielen Dank für Eure Antworten.

Ich will den Anwender da nicht schocken, es ist auch so abgesprochen. Es geht einfach darum den Platz auf dem Label optimal auszunutzen.

Mit Schriftart ist egal meinte ich dass mir / dem Anwender egal ist welche Schriftart verwendet wird, wenn es eine Schriftart gibt die besonders geeignet ist dann kann ich auf diese wechseln.

Steffen

[Matze]

Hallo,

ist deine Frage nun geklärt und handelt es sich um ein Delphi-Thema? Dann verschiebe ich's.

Du kannst das ganze natürlich auch umgekehrt machen: Die Breite in Pixeln vorgeben und die Schriftgröße berechnen lassen.
Das ist vielleicht nicht super elegant, aber die Demo im Anhang zeigt ein mögliches Vorgehen.
Hierbei werden die Breite und die Höhe berücksichtigt.

Delphi-Quellcode:

function GetTextHeightInPixels(Text: string; Font: TFont): Integer;
var
  PxHeight: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxHeight := TmpBmp.Canvas.TextHeight(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result := PxHeight;
end;

function GetTextWidthInPixels(Text: string; Font: TFont): Integer;
var
  PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result := PxWidth;
end;

function GetFontSizeFromPixels(Text: string; WidthPixels: Integer; HeightPixels: Integer; FontName: string; MinSize: Integer = 1): Integer;
var
  Font: TFont;
  TmpWidthPx, TmpHeightPx: Integer;
begin
  Font := TFont.Create;
  try
    Font.Name := FontName;

    // check if MinSize is ok
    Font.Size := MinSize;
    TmpWidthPx := GetTextWidthInPixels(Text, Font);
    TmpHeightPx := GetTextHeightInPixels(Text, Font);

    if (TmpWidthPx > WidthPixels) or (TmpHeightPx > HeightPixels) then
      Result := -1
    // width at MinSize is smaller than WidthPixels
    else begin
      repeat
        inc(MinSize);
        Font.Size := MinSize;
        TmpWidthPx := GetTextWidthInPixels(Text, Font);
        TmpHeightPx := GetTextHeightInPixels(Text, Font);
      until (TmpWidthPx > WidthPixels) or (TmpHeightPx > HeightPixels);

      Result := MinSize - 1;
    end;
  finally
    FreeAndNil(Font);
  end;
end;

Die Breite und Höhe lässt sich auch mit einer Funktion ermitteln und erfordert so nur ein temporäres Bitmap:

Delphi-Quellcode:

function GetTextSizeInPixels(Text: string; Font: TFont): TPoint;
var
  PxHeight, PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
    PxHeight := TmpBmp.Canvas.TextHeight(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result.X := PxWidth;
  Result.Y := PxHeight;
end;

Grüße, Matze

[Surrounder]

Meine Frage ist beantwortet, vielen Dank. Ja ist für Delphi.