Finding List of Fonts & Printers

[J-G]

A while ago I was pointed to a means by which I could get a list of Fonts & Printers available.  This was via an 'Assign' to a TComboBox :

Code: Pascal  [Select][+][-]

1. FontsAvailable: TComboBox;
2.  
3. procedure Read_Available_Fonts;
4. begin
5.   Form1.FontsAvailable.Items.Assign(Screen.Fonts);
6. end;
7.  

Similarly for the Printer List.

This does the job perfectly but it demands that there is a TComboBox on the Form.

I would like to make the proc 'universal' by placing it in a Unit (which is added to the Uses Clause of the main Program) but of course this unit does not have a 'Form'.

I have attempted to add a TComboBox as a Var in the interface section of the unit

Code: Pascal  [Select][+][-]

1. Var
2.   FontList,
3.   PrinterList : TComboBox;
4.  

... and create two procedures to get the data :

Code: Pascal  [Select][+][-]

1. procedure Read_Available_Fonts;
2. begin
3.   FontList.Items.Assign(Screen.Fonts);
4. end;
5. procedure Read_Printer_List;
6. begin
7.   PrinterList.Items.Assign(Printer.Printers);
8. end;

This was accepted once I added StdCtrls and Printers to the Uses Clause and the program compiles.

However, at Runtime I get an 'External: ACCESS VIOLATION' when I call the Read_Printer_List.  In debug mode I can continue and if I ignore a further warning I do get to see the main Form and from that I CAN see the list of Printers    but the call to read the Fonts (the next instruction) has not been done so there is obviously no Font list.

My next trial was to 'Create' the TComboBoxes :

Code: Pascal  [Select][+][-]

1.   PrinterList.Create(Nil);
2.   FontList.Create(Nil);
3.  

. . .  I initially tried (Self) as the argument but that wouldn't compile.

Now the ACCESS VIOLATION comes at  PrinterList.Create(Nil);

Do I need to do more work as far as creating the TComboBoxes ?  - The original versions (on the main form) have nothing changed in the Object Inspector - or is there something else that I'm simply missing?

[EDIT]  -  I've now tried using a TStringList rather than a TComboBox and the ACCESS VIOLATION comes at the end of function TScreen.GetFonts : TStrings;  In Screen.inc

[dseligo]

You can use Screen.Fonts directly or you could do something like this:

Code: Pascal  [Select][+][-]

1. var FontList: TStringList;
2. ...
3. FontList := TStringList.Create;
4. FontList.Assign(Screen.Fonts);

Now you can use it like this:

Code: Pascal  [Select][+][-]

1. var i: Integer;
2. ...
3. For i := 0 to FontList.Count - 1 do
4.   WriteLn(FontList[i]);

When you don't need it anymore, free it:

Code: Pascal  [Select][+][-]

1. FontList.Free;

[J-G]

Thanks @dseligo,  that works for Fonts - well as far as I've tested yet, which is only to actually compile and run - I haven't yet tried looking at the fontlist - (one step at a time) but I don't anticipate problems.

It doesn't work for the Printer List (which will be very much smaller than the Fonts List) - using the same structure :

Code: Pascal  [Select][+][-]

1. procedure Read_Printer_List;
2. begin
3.   PrinterList := TStringList.Create;
4.   PrinterList.Assign(Printer.Printers);
5. end;
6.  

I get ACCESS VIOLATION at line 701 (4) in Printers.pas :

Code: Pascal  [Select][+][-]

1. //Return & initialize the printers list
2. function TPrinter.GetPrinters: TStrings;
3. begin
4.   if not Assigned(fPrinters) then
5.     fPrinters:=TStringListUTF8Fast.Create;
6.   Result:=fPrinters;
7.  
8.   //Only 1 initialization
9.   if [pfPrintersValid, pfDestroying]*fFlags = [] then begin
10.     Include(fFlags, pfPrintersValid);
11.     DoEnumPrinters(fPrinters);
12.     if FPrinters.Count>0 then
13.       SelectCurrentPrinterOrDefault;
14.     DoInitialization;
15.   end;
16. end;
17.  

I appreciate that that code is quite different from the GetFonts code but I don't have the nouse to fathom what I should do differently 

I have FontList & PrintersList declared as Var TStringList (I presume that is needed?) and LazUTF8 & Printers are in the Uses Clause.

[dseligo]

I have FontList & PrintersList declared as Var TStringList (I presume that is needed?) and LazUTF8 & Printers are in the Uses Clause.

Add Printer4Lazarus to uses (and also to required packages in menu Project/Project inspector).

[J-G]

Appologies for my late response @dseligo - 'life' interupts my Thursday evening free time 

Adding Printer4Lazarus sorted the issue of ACCESS VIOLATION but I haven't had time to check further - which I will do tomorrow.

I have had a few thoughts though, mainly due to the confusion that I felt at being able to see the list of Printers even when the call to read the list hadn't happened - - - - this seems to indicate that I might be missing some point and I don't in fact need to Assign(Printer.Printers) at all, because the TPrintDialogue has already done that job. In the same way, the TFontDialogue may also have the list of available Fonts.

This will have to be an area of further research.

[J-G]

After many hours of research - experiment - making syntax and many other mistakes leading to many more ACCESS VIOLATION reports, I have eventually beaten my 'problem' into submission!

After going around in many circles trying to fathom why my project refused to submit to MY logic, I decided to try a new aproach - start a new Project where there were no dependencies upon exicting Units (my own) - though minimally 'lifting' some code from those - and compiling after each small addition / modificaion.  I still made many errors, particularly in 'assignment' of 'Strings' to components that couldn't accept them 

Specifically. I needed to transfer a TStringList to a TComboBox which proved rather more complex that I had imagined - and finding the correct 'syntax' proved ellusive.  There were many occasions when the project compiled only to throw an ACCESS VIOLATION at runtime usually when selecting a font name from a drop-down list.

Having got the new project able to read the list of fonts available and allow me to select one for use on another component; I was able to transfer that 'Logic' to the original program where there are Unit 'dependencies' - which makes the process 'universal'  -  which is the ultimate aim.

The upshot is that I have two projects operational;  One ('FindFonts', which I will attach as a 'published' project) which is self-contained (A single Unit) and the other which does need two of my personal Units.

'FindFonts' only handles the first 255 characters in the font but can be useful to inspect that aspect of any font. The main program also handles UNICODE in addition to showing Hex. Octal & Binary equivalent numbers up to $FFFFFFF.

What I've still been unable to solve is how to find the ItemIndex of a particular font name in the list. I had thought to do a simple comparison test on the name whilst traversing the list - after this fashion :

Code: Pascal  [Select][+][-]

1. procedure Populate_FontList;
2. Var
3.   I,L : word;
4.   S : String;
5. begin
6.   Found := false;
7.   Def := Form1.Character.Font.Name;
8.   L := FontList.Count;
9.   for I := 0 to L-1 do
10.     begin
11.       Form1.ListOfFonts.AddItem(FontList[I],FontList);
12.       S := Form1.ListOfFonts.Items.Names[I];
13.       If S = Def then
14.         FIdx := I;
15.     end;
16. end;
17.  

. . . .  but 'S' is always returned as 'Nil'.

If anyone can shed light upon what I'm missing, I'd be most grateful.  I've got around it for now by specifying the Index number manually - knowing the position of the 'default' name. (Empirically)

[Thausand]

Is can remove fontlist:

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   Top  := 200;
4.   Left := 540;
5.   ListOfFonts.Items.Assign(Screen.Fonts);
6.   ListOfFonts.ItemIndex:=285;
7.   FontSize  := StrToInt(FntSz.Caption);
8.   FontInUse := Character.Font;
9. end;
10.  

Code: Pascal  [Select][+][-]

1. procedure TForm1.ListOfFontsSelect(Sender: TObject);
2. Var
3.   I : word;
4.   FN : String;
5. begin
6.   I := ListofFonts.ItemIndex;
7.   FN := ListOfFonts.Items[ListOfFonts.ItemIndex];
8.   FontInUse.Name := FN;
9.   FontInUse.Size := FontSize;
10.   Character.Font := FontInUse;
11. end;
12.  

If anyone can shed light upon what I'm missing, I'd be most grateful.  I've got around it for now by specifying the Index number manually - knowing the position of the 'default' name. (Empirically)

Sorry I not looked for that then I no idea.

[Thausand]

If anyone can shed light upon what I'm missing, I'd be most grateful.  I've got around it for now by specifying the Index number manually - knowing the position of the 'default' name. (Empirically)

Sorry I not looked for that then I no idea.

I make look 

You want do this ?

Code: Pascal  [Select][+][-]

1.   index := ListOfFonts.Items.IndexOf('name font');
2.  

If name font is no find then is return -1

[jamie]

Code: Pascal  [Select][+][-]

1. procedure Populate_FontList;
2. Var
3.   I,L : word;
4.   S : String;
5. begin
6.   Found := false;
7.   Def := Form1.Character.Font.Name;
8.   L := FontList.Count;
9.   for I := 0 to L-1 do
10.     begin
11.       Form1.ListOfFonts.AddItem(FontList[I],FontList);
12.       S := Form1.ListOfFonts.Items.Names[I];
13.       IF Pos(UpperCase(Def),UpperCase(S)) <> 0 Then
14.         FIdx := I;
15.     end;
16. end;
17.  
18.  

[J-G]

Thanks for the input @Jamie, I have tested the concept and 'stepped through' the code and find that 'S' is still returned as 'Nil'. More salient, line 14 is never reached - but with 'S' at Nil that is hardly surprising - but I hadn't considered the possibility of a case mis-match.

The suggestion from @Thausand works perfectly 👏🤣👏

This further points up (to me) that finding the correct order of selecting the various properties of Pascal Objects is a minefield that I've yet to find a safe passage through

[Mike.Cornflake]

G'day,

I don't know what you ListOfFonts is, and I know you have a solution, but I'm intrigued why this failed

Code: Pascal  [Select][+][-]

1.       Form1.ListOfFonts.AddItem(FontList[I],FontList);
2.       S := Form1.ListOfFonts.Items.Names[I];

For Names[ i ] to work, this assumes your StringList (which is presumably what .Items is) is populated with strings that look like 'name=value' & that NameValueSeparator is set to '='.  The corresponding calls (to find the value) are .ValueFromIndex(I) or .Value['name']

As the .Names[ ] fails, then my guess is that in fact your stringlist is populated with strings that look like 'name' only.  No NameValueSeparator.

If the latter is correct, then the correct way of returning the text is simply ListofFonts.items[ I ];

[J-G]

Hi Mike,  you seem to be in the same 'minefield' as myself - but probably with better understanding 

I attached a complete project to my post #6 but it seems to have atracted only one download which I presume was not you.

'ListOfFonts' is a TComboBox  and 'FontList' is a TStringList 

The FontList is populated with the names of available fonts with a call to Assign(Screen.Fonts) because I couldn't make a similar call, when using a TComboBox  work,  but I need a TComboBox to make selection of a particular font possible. - - -  Unless someone can tell me of a better option.

This means that I have to transfer the data and I came across the 'structure' empirically by selecting the 'properties' that were available in the drop-down list that appear after typing the 'dot'  -  mostly by guesswork but based upon logic.

I'll attach the now fully working project again -  it still has the code that doesn't work since it's not detrimental at lines 96 - 99  so you could test it if yo are so inclined

[Mike.Cornflake]

Oops :-)

My excuse is I've been on night shift for the past 6 weeks, and I'm not sure which time is up right now :-)

This code works.  .Names was the wrong call to make, those strings were not name=value pairs.

Code: Pascal  [Select][+][-]

1. procedure Populate_FontList;
2. Var
3.   I,L : word;
4.   S : String;
5. begin
6.   Found := false;
7.   Def := Form1.Character.Font.Name;
8.   L := FontList.Count;
9.   for I := 0 to L-1 do
10.     begin
11.       Form1.ListOfFonts.AddItem(FontList[I],FontList);
12.       S := Form1.ListOfFonts.Items[I];
13.       IF Pos(UpperCase(Def),UpperCase(S)) <> 0 Then
14.         FIdx := I;
15.     end;
16. end;

Update:

This change also works - for me, a more readable way of comparing strings that are case insensitive.  If I need Case Sensitive, I use CompareText

Code: Pascal  [Select][+][-]

1.       IF SameText(s, Def) <> 0 Then    

[J-G]

No need for an excuse @Mike.  We are all in many different time zones and have all manner of calls upon our time.

The fact that you often greet with "G'Day" leads me to assume that you are resident in what I might refer to as the antipodes so my 'mid-day' (Now) could be your  8, 9:30, 10 or 10:30pm irrespective of any separate day/night 'work'.

That small change to the code absolutly solves the mystery - and I (now) have no recollection as to why the addition of 'Names' seemed appropriate.  Fortunately, @Jamie's prompt about case sensitivity was also in place so I have two methods available. (both have the same result   )

[J-G]

Update:

This change also works - for me, a more readable way of comparing strings that are case insensitive.  If I need Case Sensitive, I use CompareText

Code: Pascal  [Select][+][-]

1.       IF SameText(s, Def) <> 0 Then    

That doesn't compile for me - I'm told that an Int64 is expected but a Boolean is found. The header for SameText does have 2 strings as the argument and it returns a Boolean though ???

I did cause a bit of an hiatus though, I've changed 'Def' (which stood for Default) to a simple 'F' (a String) to which I assigned the name of the font as  F := FontInUse.Name and this caused the ACCESS VIOLATION that I'd been having so often yesterday.  FontInUse is a TFont and 'Name' seems to be a property thereof so the logic appears (to me) to be sound - but apparently not.

When I assign 'F' to the Font.name of a component ('Character' - a TLabel) which is declared at Design time, as 'F := Form1.Character.Font.Name;' then all is OK so the code became

Code: Pascal  [Select][+][-]

1.       IF SameText(S,F) <> 0 Then FIdx := I;    

Changing that to

Code: Pascal  [Select][+][-]

1.       IF CompareText(S,F) <> 0 Then FIdx := I;    

. . . does compile but on 'stepping through' I find that the compare is always 'true' - ie. FIdx := I is always executed so on completion FIdx is always the total number of fonts available.

💡Light Bulb Moment💡
Further  tests . . . .

Ah  -  now I see it  -  the compare should be for EQUALITY !!

Code: Pascal  [Select][+][-]

1.       IF CompareText(S,F) = 0 Then  FIdx := I;  

That DOES work!

Why  F := FontInUse.Name  is unacceptable still puzzles me.  ?? 🤷‍♂️