To get a list of fonts available we have to use EnumFontFamilies or EnumFonts Win32 API functions. For a description of the differences between those two functions please refer to Win32 SDK documentation. I'll use the first one (EnumFontFalimiles) for this example.
Win32 API provides several enumeration functions for various tasks. There are functions capable of enumerating installed fonts, printers and so on. All those enumerating functions require you to pass a callback function, actually the function pointer, as one of its parameters.
A callback function is one function coded and provided to the system by the programmer. The system uses the function, the programmer passes as a parameter to an EnumXXXX function, to pass the requested information back.
Here is how you might code a call to EnumFontFamilies function:
var
DC: HDC;
begin
DC := GetDC(0); { get screen's device context }
try
EnumFontFamilies(DC, nil, @EnumFontsProc, LongInt(ComboBox1));
finally
ReleaseDC(0, DC); { release device context }
end;
end;
The first parameter, DC, is a device context. Check "Device Contexts" topic of the Win32 SDK for more info on device contexts. We are passing screen's device context here since we are interested for screen fonts.
The second parameter is a PChar specifying the family name of the desired fonts. Since we want all the available information we pass nil.
The third parameter is the pointer to the callback function we provide. We didn't actually code it yet. We'll do that in a minute. As you know the "@ operator returns the address of a variable, or of a function, procedure, or method; that is, @ constructs a pointer to its operand" as Delphi's online help states.
The last parameter is a Longint. Anything that could be typecasted as a LongInt could be passed here. It's up to us to decide what to pass.
Remember, an object could be typecasted to a LongInt as
Longint(MyObject)
and then pass it to the function.
Here is how the EnumFontsProc, the callback function provided by the programmer, might look like:
function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontName: string;
CB : TComboBox;
begin
CB := TComboBox(Data);
FontName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
if (CB.Items.IndexOf(FontName) < 0) then
if (FontType = TRUETYPE_FONTTYPE) then
CB.Items.Add(FontName);
Result := 1;
end;
For a complete description of the TEnumLogFont and TNewTextMetric please refer to Win32 SDK. I think it's enough to say that they hold all the info the system could provide us regarding a font. They are declared in Windows.pas.
The FontType could be one of the following integer constants declared in Windows.pas too
RASTER_FONTTYPE = 1;
DEVICE_FONTTYPE = 2;
TRUETYPE_FONTTYPE = 4;
Here is how this mechanism works:
Windows randomly selects one font of each available type family, since we have passed nil as the second parameter to EnumFontFamilies, and passes the available information for that font to your callback function, EnumFontsProc in this case.
The enumeration will continue until either the callback return 0 (we constantly retrun 1) or there are no more fonts to enumerate.
Inside the EnumFontsProc we might examine each font passed and do what we want to do with the available information. In the above code I just add the FontNames to a ComboBox items.
Following is a class I've coded to make the task easier:
type
TFontType = (ftRaster, ftDevice, ftTrueType);
(*----------------------------------------------------------------------------------*)
TFontInfo = class
private
FShortName : string;
FFullName : string;
FStyle : string;
FLF : TLogFont;
FFontType : TFontType;
FTM : TNewTextMetric;
public
property FullName : string read FFullName ;
property ShortName : string read FShortName;
property Style : string read FStyle ;
property FontType : TFontType read FFontType ;
property TM : TNewTextMetric read FTM ;
property LF : TLogFont read FLF ;
end;
(*----------------------------------------------------------------------------------*)
TFontList = class
private
procedure ClearList;
procedure AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer);
public
List : TStringList;
constructor Create;
destructor Destroy; override;
procedure RefreshFontInfo;
end;
{ TFontList }
(*----------------------------------------------------------------------------------*)
constructor TFontList.Create;
begin
inherited Create;
List := TStringList.Create;
List.Sorted := True;
end;
(*----------------------------------------------------------------------------------*)
destructor TFontList.Destroy;
begin
ClearList;
inherited Destroy;
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.ClearList;
begin
while List.Count > 0 do
begin
TFontInfo(List.Objects[0]).Free;
List.Delete(0);
end;
end;
(*----------------------------------------------------------------------------------*)
function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontList : TFontList;
begin
FontList := TFontList(Data);
FontList.AddFont(EnumLogFont, TextMetric, FontType);
Result := 1;
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer);
var
FI : TFontInfo;
begin
FI := TFontInfo.Create;
FI.FShortName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
FI.FFullName := StrPas(EnumLogFont.elfFullName);
FI.FStyle := StrPas(EnumLogFont.elfStyle);
FI.FLF := EnumLogFont.elfLogFont;
case FontType of
RASTER_FONTTYPE : FI.FFontType := ftRaster;
DEVICE_FONTTYPE : FI.FFontType := ftDevice;
TRUETYPE_FONTTYPE : FI.FFontType := ftTrueType;
end;
FI.FTM := TextMetric;
List.AddObject(FI.FShortName, FI);
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.RefreshFontInfo;
var
DC: HDC;
begin
ClearList;
DC := GetDC(0);
try
EnumFontFamilies(DC, nil, @EnumFontsProc, Longint(Self));
finally
ReleaseDC(0, DC);
end;
end;
And here is an example use:
procedure TForm1.Button1Click(Sender: TObject);
var
FontList : TFontList;
begin
ListBox1.Clear;
FontList := TFontList.Create;
try
FontList.RefreshFontInfo;
ListBox1.Items.AddStrings(FontList.List);
finally
FontList.Free;
end;
end;
Subscribe to:
Post Comments (Atom)
Howdy would you mind letting me know which web host you're using? I've loaded your blog in 3 different browsers
and I must say this blog loads a lot quicker then most. Can you recommend a good web hosting provider at a reasonable price?
Thanks, I appreciate it!
My web site: easy diets that work
Yesterday, while I was at work, my cousin stole my apple ipad and tested to see if it can survive a 40 foot
drop, just so she can be a youtube sensation. My apple ipad
is now destroyed and she has 83 views. I know this is completely off topic but I had to share it with someone!
My web-site :: best registry cleaner
I quite like reading a post that can make people think.
Also, thank you for allowing me to comment!
my webpage; Minecraft Lets Play
I like the helpful information you provide in your articles.
I'll bookmark your weblog and check again here regularly. I am quite certain I'll learn plenty
of new stuff right here! Good luck for the next!
Also visit my webpage :: walking calculator
I have been surfing on-line more than 3 hours as of late,
but I never found any attention-grabbing article like yours.
It is lovely worth sufficient for me. In my view, if all website owners
and bloggers made good content as you probably did, the web will probably be a lot more useful than ever before.
my web-site :: Action RPG
IIka it must have figured you lured me
My webpage - http://www.drjoekrupa.org
To begin with, allow me to state that your page is actually
very good. I love the theme that you have got. It had been extremely effortless on the eye.
Appreciate your own write-up furthermore.
Just subscribed to your very own feed to assure
we won't become devoid out on any kind of the most recent. Excellent job! Cheers to a successful enterprise
my blog; bad acne pictures
This is my first time visit at here and i am genuinely pleassant to read all at single place.
Here is my webpage; rosacea relief serum
hello!,I like your authorship very so a great deal!
proportion we be in contact more approximately your very own
post on AOL? we require a specialist on this area to solve my issue.
Possibly that's you! Having a look forward to observe you.
Feel free to surf to my blog :: google adwords
Attractive section of content. I just stumbled upon your site
and in accession capital to claim that I acquire in fact loved account your blog posts.
Anyway I'll be subscribing to your augment and even I achievement you get admission to consistently quickly.
Take a look at my page ... cellulite treatment reviews
Woah! I'm really digging the template/theme of this blog. It's simple, yet
effective. A lot of times it's very hard to get that "perfect balance" between superb usability and visual appearance. I must say you've
done a very good job with this. Also, the blog loads extremely quick for me on Safari.
Superb Blog!
Stop by my weblog: Bukkit Setup
Keep on working, great job!
Feel free to surf to my web page - Minecraft Part 1
Good post. I learn something new and challenging on blogs I stumbleupon on a
daily basis. It's always helpful to read through articles from other writers and use something from other web sites.
My blog post :: Bukkit Setup
Simply wanna admit that this is extremely convenient,
Many thanks for taking your time for you write this.
Here is my weblog ... internet marketing affiliate article online business make money
Advantageously, the article is definitely in fact
the best topic on curing acne naturally.
we concur with your conclusions and will excitedly look
forward to the long-term updates. Simply suggesting thanks a lot will not simply be enough,
for the great understanding in your very own authorship.
I will immediately grab your rss supply to stay abreast of any
changes.
my website ... lucioferrelllfa
you're really a good webmaster. The web site loading speed is amazing. It sort of feels that you are doing any unique trick. Furthermore, The contents are masterpiece. you have performed a fantastic activity on this topic!
my web site :: dermefface fx7 - http://community.shalombaptistchapel.org/ -
Howdy! I know this is kinda off topic but I was wondering if you knew where I could locate a captcha plugin for my comment form?
I'm using the same blog platform as yours and I'm having difficulty finding one?
Thanks a lot!
Here is my web blog internet marketing ()
Fabulous, what a web site it is! This web site
presents helpful data to us, keep it up.
Feel free to visit my site: fruit loops beat
I blog quite often and I really thank you for your information.
This great article has really peaked my interest. I am going to book
mark your site and keep checking for new details about once per
week. I opted in for your Feed too.
Also visit my web-site :: tips To lose weight in 1 week
I am regular reader, how are you everybody? This article posted at this
web site is genuinely nice.
My blog post ... alteril 60 count
Hi there! This post could not be written any better!
Reading through this post reminds me of my previous room mate!
He always kept talking about this. I will forward this post to him.
Pretty sure he will have a good read. Many thanks for
sharing!
My weblog: telecharger subway surfers
Hmm is anyone else experiencing problems with
the images on this blog loading? I'm trying to find out if its
a problem on my end or if it's the blog.
Any responses would be greatly appreciated.
Here is my web blog; ganhar dinheiro
Pretty section of content. I just stumbled upon your website and in accession capital
to assert that I get actually enjoyed account your blog posts.
Any way I will be subscribing to your augment and even I achievement you access consistently rapidly.
Feel free to surf to my blog ... adult sex toys, adult toys, xxx toys, adult online store
Yes! Finally something about american dream.
Also visit my blog: After effects Animation Logo
Great article! That is the type of information that are supposed to be shared around the
web. Shame on the seek engines for no longer positioning this
submit higher! Come on over and seek advice from my web site .
Thanks =)
Also visit my site sua dumex
This is really interesting, You're a very skilled blogger.
I have joined your feed and look forward to seeking more of your
fantastic post. Also, I've shared your site in my social networks!
Here is my web site :: have a healthy lifestyle with daily vitamins
What a data of un-ambiguity and preserveness of precious familiarity regarding unexpected emotions.
My site: throne rush hack toolthrone rush cheats (Tinyurl.com)
I all the time used to read piece of writing in news papers
but now as I am a user of net thus from now I am using net for articles or reviews, thanks to web.
Here is my blog - minecraft games
Provided that you simply will communicate via the web with customers from various corners with the world, and also with clientele from diverse backgrounds,
and diverse numbers of education, a significant volume of basic culture can help you stay just one step facing another ladyboy chat
model. They include the biggest webcam company about the internet today
and also have countless thousands of viewers online watching the cam-models
at any one time. It can affect your job as well as dollars earning potential.
Feel free to visit my web site - webcam models reviews, ,
It's impressive that you are getting ideas from this
paragraph as well as from our discussion made at this place.
Have a look at my blog; feliz aniversario amiga
I all the time emailed this website post page to all my contacts, since if like to read it then my contacts
will too.
Here is my web site; free games
chenlina20160713
polo ralph kids
fitflops sale clearance
michael kors
toms outlet
longchamp outlet
burberry outlet
nike basketball shoes
celine outlet
louis vuitton outlet
michael kors outlet clearance
coach factory outlet online
michael kors purses
cheap jerseys
adidas shoes
coach outlet store online
gucci belts
true religion jeans
louis vuitton outlet
michael kors outlet
polo ralph lauren outlet
oakley sunglasses outlet
louis vuitton
louis vuitton handbags
michael kors outlet clearance
oakley sunglasses
true religion
michael kors handbags
cheap jordan shoes
toms outlet
coach outlet store online
ralph lauren
beats by dr dre
jordan 3
louboutin
christian louboutin shoes
michael kors outlet online sale
jordan retro 3
true religion jeans
jordan 11 concord
nike trainers uk
as
تعرف الان معنا على افضل الخصومات العالمية التى نقدمة الان وباقل الاسعار الرائعة التى نقدمة الان من افضل عطور العربية للعود المتخصص فى جمع انواع الخصومات الان وباقل الاسعار الرائعة حيث اننا نقدم اليكم افضل تجول طيران التى نقدمة الان فى اقل وقت كممكن وبافقل التكالف المختلفة التى نقدمة الان modanisa موقع التى تنقدمة الان وباقل الاسعار الرائعة والمختلفة التى لا مثيل لها الان
اليكم افضل المنتجات و افضل السلع من خلال توفير افضل الملابس و الاحذيه و مستحضرات التجميل من خلال موقع اي هيرب موقعنا الاليكتروني بافضل الاسعار الان و بافضل اكواد الخصم كود خصم جولي شيك و بافضل الاسعار و الخصومات الان تواصلو معنا الان من خلال موقعنا كود خصم شي ان تواصلو معنا الان من خلال موقعنا
استخدم الان كوبون خصم نون من خلال التواصل معنا عبر متجر نون الالكترونى لتحصل على خصم نون فقط اتصل بنا الان لتتعرف على اقل سعر للمشتريات عند استخدام كوبون نون زور موقعنا الان للمزيد
تواصل الان معنا على تقدم افضل الخصومات العالمية التى نقدمة الان من شنط سفر صغيرة لاننا نقدم اليكم افضل المميزات والخصومات والعرةض الرائعة من افضل شنط دعاية بلاستيك التى نقدمة الان فىق ال وقت ممكن وباقل الاسعار الرائعة التى من خلتالها نعمل على تقدم افضل مصنع شنط هدايا بمصر التى نقدمة الان شنط سفر كبيرة لتى لا مثيل لها الان وباقل الاسعار
من خلال كوبونات سبري يمكن لكل العملاء الحصول على كل منتجات الموقع باقل الاسعار المناسبة للجميع حيث يوفر سبري السعودية العديد من العروض المميزة و التخفيضات التى لا تصدق
ترتيب المنزل يحتاج لجهد ووقت واذا كان لدي ربه المنزل عمل يصبح الموضع اصعب ولذا كود خصم ماتيك باسعار اقل لتحصل علي نظافه متكامله مع الحفاظ علي سريه المنزل ويوجد ايضا عرض كوبون خصم ماتيك الذي يعطيك افضل العروض والاسعار
Company cleaning boards in Hail
Swimming pool cleaning company in Hail
Tank cleaning company in Hail
A carpet cleaning company in Hail
Hail Cleaning Company
Pest control company in Hail
A sofa cleaning company in Hail
jordan shoes
yeezy 700
golden goose
bape hoodie
yeezy shoes
golden goose
supreme
supreme hoodie
golden goose outlet
supreme sweatshirt
replica bags for sale replica bags for sale 9a replica bags
Continue Reading dolabuy hermes check my blog dolabuy.co website here click this
r9r18m3x68 e3s82e3g08 j1z49q3p60 f3r81r0j73 e5n82w0x98 o3m99p5w46
supreme shirt
supreme hoodie
off white jordan
yeezy boost 700
goyard
off white
fear of god
bape sta
jordan 11
curry 9