Ermittlung der Schriftfamilie

[mani64]

Hallo,

damit ich in meinem RTF-Konverter bei Änderung im RTF-Kopf die richtige Schriftart eintragen kann, benötige ich auch die Familie und den Zeichensatz, zu dem die Schrift gehört. Allerdings bekomme ich mit LogFont hier keine Ergebnisse.

Ich gehe so vor: In einer Combobox wird die Schriftart ausgewählt. Einem Label wird die neue Schriftart zugewiesen (damit man auch sehen kann, was man da gewählt hat).
Nun möchte ich Familie und Zeichensatz ermitteln:

Delphi-Quellcode:

if GetObject(Form3.Label7.Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then
       begin
          logFont.lfPitchAndFamily:= logfont.lfPitchAndFamily shr 4;
          case logFont.lfPitchAndFamily of
             FF_DONTCARE: neufamilie:='fnil';
             FF_ROMAN: neufamilie:='froman';
             FF_SWISS: neufamilie:='fswiss';
             FF_MODERN: neufamilie:='fmodern';
             FF_SCRIPT: neufamilie:='fscript';
             FF_DECORATIVE: neufamilie:='fdecor';
          end;
          neucharset:='\fcharset' + IntToStr(logFont.lfCharset) + ' ';
       end;

Allerdings enthält LogFont bei lfPitchAndFamily und bei lfCharset immer 0! Was muss ich anders machen, damit ich z.B. bei Times New Roman auch FF_ROMAN erhalte und bei Symbol z.B. SYMBOL_CHARSET, wie es doch eigentlich richtig sein sollte?
Anscheinend wird LogFont richtig gefüllt, denn die Eigenschaften von Label7.Font stimmen mit denen in Logfont überein: Charset ist bei der Schriftart Symbol z.B. 0.
Wieso ist das so? Werden nicht die "Standardwerte" geladen, wenn man einem Label eine Schriftart zuweist? Wie komme ich an die Standardwerte ran?

[blackdrake]

Hallo.

Ich würde nicht auf logFont.lfPitchAndFamily schreiben. Das könnte irgendwelche unerwünschten Effekte haben. Besser mal in eine Variable.

Am besten gibst du logFont.lfPitchAndFamily einmal zu Testzwecken aus und analysierst durch Umrechnung Dez -> 8'Bin, ob die Bytes 4..7 wie in der MSDN beschrieben wirklich den korrekten Wert haben (Vergleich mit den Konstanten).

Ich habe mit shr und shl noch nie gearbeitet. Bist du dir sicher, dass wenn du "shr 4" schreibst, auch auf die Bytes 4..7 kommt? Müsstest du nicht nach links schieben?

Außer: Wenn du an die Bytes 4..7, also die "zweite" Hälfte möchtest, kannst du doch gleich Lo() verwenden. Wäre einfacher.

Delphi-Quellcode:

if GetObject(Form3.Label7.Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then 
begin 
  case Lo(logFont.lfPitchAndFamily) of 
    FF_DONTCARE: neufamilie:='fnil'; 
    FF_ROMAN: neufamilie:='froman'; 
    FF_SWISS: neufamilie:='fswiss'; 
    FF_MODERN: neufamilie:='fmodern'; 
    FF_SCRIPT: neufamilie:='fscript'; 
    FF_DECORATIVE: neufamilie:='fdecor'; 
  end; 
  neucharset:='\fcharset' + IntToStr(logFont.lfCharset) + ' '; 
end;

Gruß
blackdrake

[mani64]

Zitat von blackdrake:

Hallo.

Ich würde nicht auf logFont.lfPitchAndFamily schreiben. Das könnte irgendwelche unerwünschten Effekte haben. Besser mal in eine Variable.

Am besten gibst du logFont.lfPitchAndFamily einmal zu Testzwecken aus und analysierst durch Umrechnung Dez -> 8'Bin, ob die Bytes 4..7 wie in der MSDN beschrieben wirklich den korrekten Wert haben (Vergleich mit den Konstanten).

Ich habe mit shr und shl noch nie gearbeitet. Bist du dir sicher, dass wenn du "shr 4" schreibst, auch auf die Bytes 4..7 kommt? Müsstest du nicht nach links schieben?

Außer: Wenn du an die Bytes 4..7, also die "zweite" Hälfte möchtest, kannst du doch gleich Lo() verwenden. Wäre einfacher.

Delphi-Quellcode:

if GetObject(Form3.Label7.Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then 
begin 
  case Lo(logFont.lfPitchAndFamily) of 
    FF_DONTCARE: neufamilie:='fnil'; 
    FF_ROMAN: neufamilie:='froman'; 
    FF_SWISS: neufamilie:='fswiss'; 
    FF_MODERN: neufamilie:='fmodern'; 
    FF_SCRIPT: neufamilie:='fscript'; 
    FF_DECORATIVE: neufamilie:='fdecor'; 
  end; 
  neucharset:='\fcharset' + IntToStr(logFont.lfCharset) + ' '; 
end;

Danke für die Antwort.

LogFont ist doch bereits meine lokale Variable, die von GetObject nur beschrieben wird. Dürfte also nix machen, sie rechnerisch zu verändern.
lfpitchandfamily ist ein Byte, dessen 4 obere Bits die Familie enthalten. shr4 verschiebt die Bits um 4 nach rechts, was einer Division durch 16 entspricht und mir den oberen Teil des Byte liefern sollte. Lo gibt doch das niederwertige Byte eines Word oder Integer zurück, lfpitchandfamily ist aber nur ein Byte groß, nicht Word oder Integer. (Und dann müsste ich doch wohl Hi verwenden, falls es um das obere Byte ginge...)
Aber der Wert von lfpitchandfamily ist immer 0 (hab ihn mir im Debugger angeschaut, bevor ich damit rechne).
Meine Frage war, wieso GetObject nicht die von mir erwarteten Werte liefert (Familie, Zeichensatz).

[jaenicke]

Das mit dem Shiften der Bits ist schon richtig so, der Wert für PitchAndFamily ist bei mir aber in der Tat ebenfalls immer 0. Der für CharSet hat bei mir aber die korrekten Werte.

Jedenfalls fehlt da vor GetHandle noch:FillChar(LogFont, SizeOf(LogFont), 0); Und das CharSet habe ich um Testen in einem TFontDialog jeweils umgestellt und so dann stets korrekt bekommen:

Delphi-Quellcode:

    case LogFont.lfCharSet of
      ANSI_CHARSET: neucharset := 'ANSI_CHARSET';
      BALTIC_CHARSET: neucharset := 'BALTIC_CHARSET';
      CHINESEBIG5_CHARSET: neucharset := 'CHINESEBIG5_CHARSET';
      DEFAULT_CHARSET: neucharset := 'DEFAULT_CHARSET';
      EASTEUROPE_CHARSET: neucharset := 'EASTEUROPE_CHARSET';
      GB2312_CHARSET: neucharset := 'GB2312_CHARSET';
      GREEK_CHARSET: neucharset := 'GREEK_CHARSET';
      MAC_CHARSET: neucharset := 'MAC_CHARSET';
      OEM_CHARSET: neucharset := 'OEM_CHARSET';
      RUSSIAN_CHARSET: neucharset := 'RUSSIAN_CHARSET';
      SHIFTJIS_CHARSET: neucharset := 'SHIFTJIS_CHARSET';
      SYMBOL_CHARSET: neucharset := 'SYMBOL_CHARSET';
      TURKISH_CHARSET: neucharset := 'TURKISH_CHARSET';
      VIETNAMESE_CHARSET: neucharset := 'VIETNAMESE_CHARSET';
      JOHAB_CHARSET: neucharset := 'JOHAB_CHARSET';
      ARABIC_CHARSET: neucharset := 'ARABIC_CHARSET';
      HEBREW_CHARSET: neucharset := 'HEBREW_CHARSET';
      THAI_CHARSET: neucharset := 'THAI_CHARSET';
    else
      neucharset := '\fcharset' + IntToStr(LogFont.lfCharset) + ' ';
    end;

[Flocke]

<Offtopic>
Tja, die RTF-Entwickler hätten es damals \ffontfamily nennen sollen und nicht \fcharset.
</Offtopic>

Delphi kümmert sich nur insofern um das Feld PitchAndFamily, als dass dort VARIABLE_PITCH oder FIXED_PITCH gesetzt wird. Die Schriftfamilie wird ignoriert - und da das Feld bei CreateFontIndirect nicht gefüllt ist, liefert die Abfrage immer den gleichen Wert zurück (0). Dies kannst du in der Unit Graphics nachlesen (Methode TFont.GetHandle).

Du könntest dir mit der Funktion EnumFontFamiliesEx eine interne Liste mit den Schriftfamilien aller installierten Schriften machen (z.B. in einer TStringList) - schau dir mal in der Unit Forms in der Methode TScreen.GetFonts an wie Delphi das macht. In der TLogFont-Struktur, die du in der Callback-Routine EnumFontsProc vom System übergeben bekommst, sollte das Feld PitchAndFamily gefüllt sein.

[mani64]

Zitat von Flocke:

<Offtopic>
Tja, die RTF-Entwickler hätten es damals \ffontfamily nennen sollen und nicht \fcharset.
</Offtopic>

Delphi kümmert sich nur insofern um das Feld PitchAndFamily, als dass dort VARIABLE_PITCH oder FIXED_PITCH gesetzt wird. Die Schriftfamilie wird ignoriert - und da das Feld bei CreateFontIndirect nicht gefüllt ist, liefert die Abfrage immer den gleichen Wert zurück (0). Dies kannst du in der Unit Graphics nachlesen (Methode TFont.GetHandle).

Du könntest dir mit der Funktion EnumFontFamiliesEx eine interne Liste mit den Schriftfamilien aller installierten Schriften machen (z.B. in einer TStringList) - schau dir mal in der Unit Forms in der Methode TScreen.GetFonts an wie Delphi das macht. In der TLogFont-Struktur, die du in der Callback-Routine EnumFontsProc vom System übergeben bekommst, sollte das Feld PitchAndFamily gefüllt sein.

Ich dachte, GetObject wäre eine Funktion des Windows und würde immer die Windows-Daten liefern.
Schließlich ruft die Unit Graphics (bevor es CreateFontIndirect aufruft) mit dieser Funktion die Daten ab und belegt von daher seine Daten. Ist es so, dass die Funktion GetObject dann nur noch die Daten liefert, mit denen Graphics den Font durch createFontIndirect kreiert hat?

Übrigens: In RTF gibt es eben beides: family und charset, und ich möchte gerne beides angeben.
Wenn ich einen Text in Wordpad schreibe und im RTF-Format speichere dann steht da z.B.
f0\froman\fcharset0 Times New Roman oder
f2\fswiss\fcharset0 Arial oder
f3\fnil\fcharset2 Symbol

Wie kommt WordPad an diese Daten heran?

Kann ich also mit GetObject gar nicht die ursprünglich (vom Erfinder des Fonts) vorgesehenen Daten abrufen? Muss ich den indirekten Weg über EnumFontFamiliesEx gehen? Und stehen nach Aufruf dieser Funktion in LogFont andere Daten, d.h. die, die ich brauche?
Es gibt auch noch die Funktion ChooseFont (Win32 Developer's References), die eine eigene Dialogbox liefert. Dort kann man mit WM_ChooseFont_GetLogFont die Daten abrufen. Aber das verstehe ich alles nicht so ganz.
Stellt Windows selbst diese Dialogbox zur Verfügung? Sind das also Aufrufe, die Delphi direkt an Windows weiterleitet? Oder ist das Ganze in Delphi-Dlls oder Units integriert und wird dort bearbeitet?
Und es gibt noch die Funktion GetTextMetrics, die ebenfalls die Daten PitchandFamily zurück liefern soll, aber das nutzt mir ja auch nichts, wenn Delphi bei CreateFontIndirect keine Familie einträgt, oder?

Ich habe gerade mal das Delphi-Demoprogramm zu Richedit getestet. Dort steht im Header als Familie immer \fnil! Also dieses Programm ist auch nicht in der Lage, die Familie zu bestimmen und im RTF-Header einzutragen. Allerdings den charset gibt es "richtig" an, bei Symbol z.B. 2. Wenn ich Label7 die Schriftart Symbol zuweise, dann bleibt Font.charset aber bei 0, obwohl im Label die Schrift genauso aussieht, wie sie soll.

[Flocke]

Zitat von mani64:

Ist es so, dass die Funktion GetObject dann nur noch die Daten liefert, mit denen Graphics den Font durch createFontIndirect kreiert hat?

Ich denke ja. Anders könnte es aussehen mit GetTextMetrics - probiere das doch mal. Dazu musst die die Schrift aber in einen DC selektieren.

Zitat von mani64:

Übrigens: In RTF gibt es eben beides: family und charset, und ich möchte gerne beides angeben.
Wenn ich einen Text in Wordpad schreibe und im RTF-Format speichere dann steht da z.B.
f0\froman\fcharset0 Times New Roman oder
f2\fswiss\fcharset0 Arial oder
f3\fnil\fcharset2 Symbol

Du hast Recht. Ich nehme meine Kritik über die RTF-Entwickler hiermit zurück.

Zitat von mani64:

Wie kommt WordPad an diese Daten heran?

WordPad gar nicht, das muss schon das RichEdit-Control erledigen, da das den RTF-Code erzeugt.

Zitat von mani64:

Kann ich also mit GetObject gar nicht die ursprünglich (vom Erfinder des Fonts) vorgesehenen Daten abrufen? Muss ich den indirekten Weg über EnumFontFamiliesEx gehen? Und stehen nach Aufruf dieser Funktion in LogFont andere Daten, d.h. die, die ich brauche?

Probiere es aus, der Code sieht dann etwa so aus:

Delphi-Quellcode:

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
var
  S: TStrings;
  Temp: string;
begin
  S := TStrings(Data);
  Temp := LogFont.lfFaceName;
  if (S.Count = 0) or (AnsiCompareText(S[S.Count-1], Temp) <> 0) then
    S.AddObject(Temp, Pointer(MakeLong(LogFont.lfPitchAndFamily, LogFont.lfCharSet)));
  Result := 1;
end;

function GetFonts: TStrings;
var
  DC: HDC;
  LFont: TLogFont;
begin
  Result := TStringList.Create;
  DC := GetDC(0);
  try
    FillChar(LFont, sizeof(LFont), 0);
    LFont.lfCharset := DEFAULT_CHARSET;
    EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(Result), 0);
    TStringList(Result).Sorted := true;
  finally
    ReleaseDC(0, DC);
  end;
end;

Natürlich solltest du GetFonts nur einmal aufrufen und dir das Ergebnis merken.
Die Abfrage geht dann über den Namen:

Delphi-Quellcode:

function GetFontInfo(const Name: string; Fonts: TStrings): LongInt;
var
  k: Integer;
begin
  k := Fonts.IndexOf(Name);
  if k < 0 then
    Result := MakeWord(DEFAULT_PITCH or FF_DONTCARE, DEFAULT_CHARSET);
  else
    Result := LowWord(LongInt(Fonts.Objects[k]));
end;

function GetFontFamily(const Name: string; Fonts: TStrings): Byte;
begin
  Result := Byte(LoWord(GetFontInfo(Name, Fonts)) and $00f0);
end;

function GetFontCharSet(const Name: string; Fonts: TStrings): Byte;
begin
  Result := Byte(HiWord(GetFontInfo(Name, Fonts)) and $00ff);
end;

Zitat von mani64:

Es gibt auch noch die Funktion ChooseFont (Win32 Developer's References), die eine eigene Dialogbox liefert. Dort kann man mit WM_ChooseFont_GetLogFont die Daten abrufen. Aber das verstehe ich alles nicht so ganz.
Stellt Windows selbst diese Dialogbox zur Verfügung? Sind das also Aufrufe, die Delphi direkt an Windows weiterleitet? Oder ist das Ganze in Delphi-Dlls oder Units integriert und wird dort bearbeitet?
Und es gibt noch die Funktion GetTextMetrics, die ebenfalls die Daten PitchandFamily zurück liefern soll, aber das nutzt mir ja auch nichts, wenn Delphi bei CreateFontIndirect keine Familie einträgt, oder?

Leider stimmt das.

Zitat von mani64:

Ich habe gerade mal das Delphi-Demoprogramm zu Richedit getestet. Dort steht im Header als Familie immer \fnil! Also dieses Programm ist auch nicht in der Lage, die Familie zu bestimmen und im RTF-Header einzutragen. Allerdings den charset gibt es "richtig" an, bei Symbol z.B. 2. Wenn ich Label7 die Schriftart Symbol zuweise, dann bleibt Font.charset aber bei 0, obwohl im Label die Schrift genauso aussieht, wie sie soll.

Das könnte mit der Version des RichEdit zusammenhängen. Das VCL-RichEdit-Control benutzt IMO noch die 1.0er-Version. Probiere mal ein TJvRichEdit.

[mani64]

Super!

Vielen Dank für den Code, das sieht sehr gut aus und funktioniert großartig.

Mit einer Ausnahme: Symbol wird als froman deklariert mit Zeichensatz 0 (ansi). Keine Ahnung, aber die Funktion EnumFontFamiliesEx scheint es so zurück zu melden.

Jetzt ist mein Programm komplett!
Vielen Dank!