• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 962
  • Last Modified:

Retrieving Fixed -pitch true type font list

Environment: D5 Pro...

I need to populate a dropdown list with the names of all Fixed Pitch true type fonts that are installed on the system.  How do I do that?

An example of fixed pitch is Courier New, Lucida Console, etc.  It is those fonts where each letter is the same width.

Thanks
0
gspears060598
Asked:
gspears060598
1 Solution
 
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
putt a button and a combobox on a form and add this code to button1click

procedure TForm1.Button1Click(Sender: TObject);
  function IsFixedPitch(Index: Integer): Boolean;
var
  Metrics: TTextMetric;
  lf: TLogFont;
  oldFont, newFont: HFont;
begin
  with lf do begin
    lfHeight := 10;
    lfWidth := 10;
    lfEscapement := 0;
    lfWeight := FW_REGULAR;
    lfItalic := 0;
    lfUnderline := 0;
    lfStrikeOut := 0;
    lfCharSet := DEFAULT_CHARSET;
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    lfQuality := DEFAULT_QUALITY;
    lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
    StrPCopy(lfFaceName, combobox1.Items[Index]);
  end;
  newFont := CreateFontIndirect(lf);
  oldFont := SelectObject(Canvas.Handle, newFont);
  GetTextMetrics(Canvas.Handle, Metrics);
  Result := (Metrics.tmPitchAndFamily and TMPF_FIXED_PITCH) = 0;
  SelectObject(Canvas.Handle, oldFont);
  DeleteObject(newFont);
end;
var
i: Integer;
begin
with combobox1 do begin
      Items.Assign(Screen.Fonts);
  I := 0;
  repeat
   if Items[I] = 'Default' then
   begin
        Items.delete(I);
   end else
         if (not isfixedpitch(i)) then
            items.Delete(i)
      else inc(I);
  until I = Items.count;
  ItemIndex := 0;
  end;
end;

F68 ;-)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now