Fontname aus *.TTF-Datei auslesen

[Catbytes]

Hallo,

ich habe hier mehrere Fonts in Form von *.TTF-Dateien vorliegen, die nicht als Schriftart in Windows registriert sind.

Mit

Code:

AddFontResource('dateiname.ttf');

registriere ich den Font zur zeitweisen Benutzung.

Wenn ich jetzt aber den Font einem Label zuordnen möchte, brauche ich ja den Fontnamen.

Beispiel:
Habe hier ein Font mit Dateinamen "14minute.ttf". Der Fontname lautet aber "14 minutes". Also müßte ich ja den Label mit

Code:

Label1.Font.Name:='14 minutes';

zuweisen. Doch wie komme ich an den Fontnamen?

Der stimmt zwar manchmal mit dem Dateinamen überein, aber eben nicht immer.

Interessant wäre natürlich auch Zusatzinfos zum Font, wie z.B. Schriftstil (fett, kursiv etc.) usw.

Hat da jemand 'ne Idee?

TFont geht ja IMHO nur mit Systemschriftarten, also mit Schriftarten, die schon in Windows registriert sind.

Vielleicht denke ich auch einfach zu kompliziert und die Lösung liegt so nahe ;-)

[Sprint]

Zitat:

Zitat von Catbytes

Hat da jemand 'ne Idee?

Ich glaube da bleibt dir der Weg über die Registry nicht erspart.

Code:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts

Code:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

[flomei]

Für HKEYLM braucht man doch Administratorrechte oder?

MfG Florian :hi:

[Luckie]

Nur wenn man schreibend zugreift, aber er braucht ja nur lesen und gucken, wie die Schrift heißt.

[Sprint]

Zitat:

Zitat von flomei

Für HKEYLM braucht man doch Administratorrechte oder?

Man muss ja nicht mit KEY_ALL_ACCESS auf den Schlüssel zugreifen. Ein KEY_QUERY_VALUE oder ein KEY_READ sollten reichen

[Catbytes]

Hallo,

vielen Dank erstmal für die Antworten.

Das Problem ist ja, daß der Font kein Windows-Standardfont ist.

Sprich unter:

Code:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts

wird mir folgendes angezeigt:
http://www.catbytes.de/fonts1.jpg

Und unter:

Code:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

folgendes:
http://www.catbytes.de/fonts2.jpg

Wie man sieht ist vom Font "14 minutes" leider nichts zu sehen.

Witzig ist aber, was mir Word anzeigt:
http://www.catbytes.de/word_fontliste.jpg

Ich habe auch die gesamte Registry nach "minute" bzw. "minutes" durchsucht - Nichts :-(

Es muß doch eine Möglichkeit geben, einen Fontdateinamen zu übergeben, aber trotzdem den Fontnamen herauszubekommen. Sonst hätte ja der ganze Befehl:

Code:

AddFontResource('14minute.ttf');

keinen Sinn, da ich ja nie damit arbeiten könnte - Fontname und Fontdateiname unterscheiden sich ja.

Übrigens: Nach dem Aufruf (und weiteren Routinen) entferne ich den Font natürlich mit:

Code:

RemoveFontResource('14minute.ttf');

wieder (trotzdem bleibt er in Word erhalten).

Sinn des ganzen: Ich baue gerade eine Fontseite im Netz auf. Für jeden Font brauche ich natürlich ein Vorschaubild - ich habe 3.000 Fonts vorliegen. Delphi soll nun jeden Font in einem bestimmten Verzeichnis kurz mit "AddFontResource" einbinden, ein Schnappschuß (*.JPG) wird geschossen, der Font wird mit "RemoveFontResource" wieder 'entladen' und ich habe mein Vorschaubild. So soll das ganze Verzeichnis durchgerattert werden. Admin-Rechte oder so wären also kein Problem, da das Programm sowieso nie meinen Rechner verlassen wird.

Hat noch jemand eine andere Idee?

[supermuckl]

wär es nicht einfacher, wenn du die fonts irgendwie mit delphi direkt "öffnest" ?
also ohne registrieren und wieder unregistrieren usw
ich denke mal, du kannst die 14minutes.ttf deshalb benutzen, weil windows evtl das fontdir durchsucht und nicht durch die registry wurschtelt.. aber das wäre ja total untypisch für windoof *g*

[Catbytes]

Hallo,

Zitat:

Zitat von supermuckl

wär es nicht einfacher, wenn du die fonts irgendwie mit delphi direkt "öffnest" ?
also ohne registrieren und wieder unregistrieren usw
ich denke mal, du kannst die 14minutes.ttf deshalb benutzen, weil windows evtl das fontdir durchsucht und nicht durch die registry wurschtelt.. aber das wäre ja total untypisch für windoof *g*

nunja - für meinen Screenshot muß ja das Label kurz den Font bekommen - also muß ich ihn kurz registrieren.

Die Fontdatei liegt übrigens nicht im FontDir, sondern im Programmverzeichnis (also in dem Verzeichnis, wo das selbst erstellte Delphi-Programm liegt).

BTW: Die Tipp aus der Code-Library
http://www.delphipraxis.net/internal...ct.php?t=10873
wir ad-absurdum geführt, weil auch hier am Ende steht:

Code:

Edit1.Font.Name := 'Echter Name der Schrift (nicht Dateiname)';

Die Frage ist nur: Wie?

Noch andere Ideen?

[Sprint]

Zitat:

Zitat von Catbytes

Noch andere Ideen?

Dieser Link sollte deine Probleme lösen.

[Catbytes]

Hallo,

danke Sprint!

Ich werde mir Deine Lösung später ansehen - beim kurzen überfliegen sieht das auch sehr gut aus.

Mittlerweile habe ich mir aus verschiedenen Quellen im Netz was eigenes gebastelt.

Die Autoren sind unbekannt. Sollte sich einer wiedererkennen, einfach melden ;)

Code:

type
  TTableDirectory = record
    Tag: LongInt;
    CheckSum: LongInt;
    Offset: LongInt;
    Length: LongInt;
  end;

  TNamingTable = record
    Format: Word;
    Count: Word;
    StringOffset: Word;
  end;

  TNameRecord = record
    PlatformID: Word;
    SpecificID: Word;
    LanguageID: Word;
    NameID: Word;
    Length: Word;
    Offset: Word;
  end;

function GetTypeFaceName(TrueTypeFile: string): string;
var
  I, FileHandle: Integer;
  TableDirectory: TTableDirectory;
  NamingTable: TNamingTable;
  NameRecord: TNameRecord;
  LongSwap: LongInt;
  Buffer: array[0..255] of Char;
  WideResult: string;
  MSNameFound: Boolean;

begin
  MSNameFound := False;
  Result := '';
  Buffer := '';
  WideResult := '';
  FileHandle := FileOpen(TrueTypeFile, fmOpenRead);
  if FileHandle < 0 then
    Exit;

  FileSeek(FileHandle, 12, 0);
  repeat
    if FileRead(FileHandle,
      TableDirectory,
      SizeOf(TableDirectory)) < SizeOf(TableDirectory) then
    begin
      FileClose(FileHandle);
      Exit;
    end;
  until TableDirectory.Tag = $656D616E; // tag_NamingTable - Name

  LongSwap := TableDirectory.Offset shr 16;
  TableDirectory.Offset := Swap(TableDirectory.Offset) shl 16 + Swap(LongSwap);
  FileSeek(FileHandle, TableDirectory.Offset, 0);
  FileRead(FileHandle, NamingTable, SizeOf(NamingTable));

  repeat
    if FileRead(FileHandle, NameRecord, SizeOf(NameRecord)) < SizeOf(NameRecord)
      then
    begin
      FileSeek(FileHandle, TableDirectory.Offset, 0);
      FileRead(FileHandle, NamingTable, SizeOf(NamingTable));
      repeat
        if FileRead(FileHandle, NameRecord, SizeOf(NameRecord)) <
          SizeOf(NameRecord) then
        begin
          FileClose(FileHandle);
          Exit;
        end;
      until (Swap(NameRecord.PlatformID) = 3) and (Swap(NameRecord.NameID) = 4);
      MSNameFound := True;
      Break;
    end;
  until (Swap(NameRecord.PlatformID) = 1) and (Swap(NameRecord.NameID) = 4);

  FileSeek(FileHandle,
    Swap(NamingTable.StringOffset) + Swap(NameRecord.Offset) +
    TableDirectory.Offset,
    0);
  FileRead(FileHandle, Buffer, Swap(NameRecord.Length));
  NameRecord.Length := Swap(NameRecord.Length);

  if not MSNameFound then
    WideResult := Copy(Buffer, 0, NameRecord.Length)
  else
  begin
    I := 1;
    repeat
      WideResult := WideResult + Buffer[I];
      Inc(I, 2);
    until I > NameRecord.Length;
  end;
  Result := WideResult;
  FileClose(FileHandle);
end;

Wer das ganze Programm möchte (so'n kleiner TTF-Viewer den ich jetzt zum testen geproggt habe), kann sich das ganze hier runterladen:
http://www.catbytes.de/fonts4u.zip

Mit Source natürlich (249kb).

Danke nochmals an alle. Den Source werde ich für die Code-Library vorschlagen...