Mögliche Größen für eine Font ermitteln

[berens]

Hallo!

Bezugnehmend auf
http://www.delphipraxis.net/internal...umfontfamilies
und
http://www.delphipraxis.net/internal...umfontfamilies

Wie in den anderen Theman angesprochen möchte auch ich wissen, welche Schriftgrößen eine Schriftart unterstützt.

Es gibt 2 Listboxen, FlbArt (Schriftart) und FlbGrad (Schriftgröße), wobei FlbArt.Items.Assign(Screen.Fonts).

Sobald nun die Callback-Funktion EnumFontSizes aufgerufen wird, stürzt das Programm an der markierten Stelle ab mit der nichtssagenden Fehlermeldung
---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt TMyFontDialog.exe ist eine Exception der Klasse $C0000005 mit der Meldung 'access violation at 0x004c22fb: read of address 0xffffffff' aufgetreten.
---------------------------
Anhalten Fortsetzen Hilfe
---------------------------

Da ich, da es sich um eine Callback-Funktion handelt, FlbGrad nicht als Parameter übergeben kann, weiss ich nicht, was ich nun tun soll...

Delphi-Quellcode:

procedure TMyFontDialog.lbArtClick(_Sender: TObject);
  function EnumFontSizes(var EnumLogFont: TEnumLogFont; PTextMetric: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer; export; stdcall;
  var s: String;
      i,v,v2: Integer;
  begin
    if (FontType and TRUETYPE_FONTTYPE)<>0 then begin
      FlbGrad.Items.Add('8'); // <-- Hier Fehler
      FlbGrad.Items.Add('9');
      FlbGrad.Items.Add('10');
      FlbGrad.Items.Add('11');
      FlbGrad.Items.Add('12');
      FlbGrad.Items.Add('14');
      FlbGrad.Items.Add('16');
      FlbGrad.Items.Add('18');
      FlbGrad.Items.Add('20');
      FlbGrad.Items.Add('22');
      FlbGrad.Items.Add('24');
      FlbGrad.Items.Add('26');
      FlbGrad.Items.Add('28');
      FlbGrad.Items.Add('36');
      FlbGrad.Items.Add('48');
      FlbGrad.Items.Add('72');
      Result := 0;
      end
    end;
  end;
var
  DC: HDC;
  OC: TNotifyEvent;
  Fontname: String;
begin
  if FlbArt.ItemIndex < 0 then exit;
  DC := GetDC(0);
  with FlbGrad do begin
    Items.BeginUpdate;
    try
      Items.Clear;
      PixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
      Fontname := FlbArt.Items[FlbArt.ItemIndex];
      EnumFontFamilies(DC, PChar(Fontname), @EnumFontSizes, Longint(Self));
      OC := OnClick;
      OnClick := nil;
      ItemIndex := Items.IndexOf(Text);
      OnClick := OC;
      if Assigned(OnClick) then
        OnClick(Self);
    finally
      Items.EndUpdate;
      ReleaseDC(0, DC);
    end;
  end;
end;

[marabu]

Hallo,

da deine callback function keine Methode von TMyFontDialog ist, musst du die Form-Variable FlbArt als public property bereitstellen und beim Zugriff mit dem Namen der Form qualifizieren: MyFontDialog.LBArt

Grüße vom marabu

[berens]

Auch mit

Delphi-Quellcode:

  public
    property lbGrad: TListBox read FlbGrad write FlbGrad;
  ...
  lbGrad.Items.Add('8');
  ...

ändert sich da leider nichts...

Ich hatte auch schonmal versucht, die Funktion direkt dem Form unterzuordnen und dann mit

EnumFontFamilies(DC, PChar(Fontname), @TMyFontDialog.EnumFontSizes, Longint(Self)); was allerdings den selben Effekt hatte.

Ich nehme auch sehr gerne Tips zu Alternativen an, wie ich die Schriftgrößen ermitteln kann an. Die LMDFontSizeComboBox kann das ganze super, allerdings würde ich gerne auf LMD verzichten, zumal dies nur eine ComboBox ist.

Und... eine LMDFontSizeComboBox einfügen (unsichtbar) und dann mit Assign die Items rübernehmen ist auch nicht die feine Art oder?

Irgendwer Ideen? Danke schonmal für die Antwort und die, die da folgen mögen.

[marabu]

Aber du hast ja den public property name (lbArt) garnicht qualifiziert:

Delphi-Quellcode:

var
  fd: TMyFontDialog;
begin
  fd := Pointer(Data);
  // ...
  fd.lbArt.Items.Add();
  // ...
end;

Oder du übergibst gleich die Referenz auf lbArt.Items.

Grüße

[berens]

Ok, so klappt es, vielen Dank!

Jetzt muss ich nur noch die Schriftgrößen für die nicht-true-type Schriften bestimmen können. Mal schauen, was sich da machen lässt.

[berens]

Delphi-Quellcode:

  function EnumFontSizes(var EnumLogFont: TEnumLogFont; PTextMetric: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer; export; stdcall;
  var s: String;
      i,v,v2: Integer;
      fd: TMyFontDialog;
    begin
    fd := Pointer(Data);
    if (FontType and TRUETYPE_FONTTYPE)<>0 then begin
      fd.lbGrad.Items.Add('8');
      fd.lbGrad.Items.Add('9');
      fd.lbGrad.Items.Add('10');
      fd.lbGrad.Items.Add('11');
      fd.lbGrad.Items.Add('12');
      fd.lbGrad.Items.Add('14');
      fd.lbGrad.Items.Add('16');
      fd.lbGrad.Items.Add('18');
      fd.lbGrad.Items.Add('20');
      fd.lbGrad.Items.Add('22');
      fd.lbGrad.Items.Add('24');
      fd.lbGrad.Items.Add('26');
      fd.lbGrad.Items.Add('28');
      fd.lbGrad.Items.Add('36');
      fd.lbGrad.Items.Add('48');
      fd.lbGrad.Items.Add('72');
      Result := 0;
      end
    else begin
      v := Round((EnumLogFont.elfLogFont.lfHeight-PTextMetric.tmInternalLeading)*72 /
        fd.PixelsPerInch);
      s := IntToStr(v);
      Result := 1;
      for i := 0 to fd.lbGrad.Items.Count-1 do begin
        v2 := StrToInt(fd.lbGrad.Items[i]);
        if v2=v then
          exit;
        if v2>v then begin
          fd.lbGrad.Items.Insert(i,s);
          exit;
        end;
      end;
      fd.lbGrad.Items.Add(s);
    end;
  end;

Thx to Sergey Tkachenko (www.trichview.com) und marabu

[shmia]

Wenn schon, dann sollte man schon unabhängig vom Formular programmieren.
Folgender Code ist wiederverwendbar:

Delphi-Quellcode:

// private Hilfsfunktion
function EnumFontSizes(var EnumLogFont: TEnumLogFont; PTextMetric: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer; export; stdcall;
var
   list : TStrings;
begin
   if Data <> 0 then
   begin
      list := TStrings(Data);

      list.Add(EnumLogFont.elfFullName+ ','+
         IntToStr(EnumLogFont.elfLogFont.lfHeight)+'*'+IntToStr(EnumLogFont.elfLogFont.lfWidth)
         );
      Result := 1;
   end
   else
      Result := 0;
end;

procedure GetFontFamilies(DC:HDC; const fontname:string; list:Tstrings);
var
   fn : PChar;
begin
   if fontname <> '' then
      fn := PChar(fontname)
   else
      fn := nil;

   Assert(Assigned(list));
   list.BeginUpdate;
   try
      EnumFontFamilies(DC, fn, @EnumFontsizes, integer(list));
   finally
      list.EndUpdate;
   end;
end;