How to "create" a TFont and change it's name multiple times correctly?

Forum > LCL

(1/3) > >>

Hartmut:
I want to play with Fonts. At first I want to see, which are Monospace and which not. Here is my code, which does not work:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject); var F: TFont; i: integer; begin F:=TFont.Create; for i:=0 to Screen.Fonts.Count-1 do // 'Screen.Fonts' contains all Font-names begin write(i:3, ') ', Screen.Fonts[i]); F.Name:=Screen.Fonts[i]; writeln(' ', F.IsMonoSpace); end; F.Free; end;
With this code, function IsMonoSpace() returns always False. I get correct results, when I change the creation of 'F' this way:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject); var F: TFont; i: integer; begin for i:=0 to Screen.Fonts.Count-1 do // 'Screen.Fonts' contains all Font-names begin write(i:3, ') ', Screen.Fonts[i]); F:=TFont.Create; F.Name:=Screen.Fonts[i]; writeln(' ', F.IsMonoSpace); F.Free; end; end;
But this is very slow with 379 Fonts. So my question is: Is it possible, to create 'F' only once (as in my 1st example) and then to change the Font-name multiple times? Must I do some kind of "reset" between?

I use Lazarus 2.0.10 with FPC 3.2.0 on Linux Ubuntu 22.04. Thanks in advance.

KodeZwerg:
I suggest to not mix CLI and GUI stuff.
This works like it should:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject);var F: TFont; i: Integer;begin F := TFont.Create; try for i := 0 to Pred(Screen.Fonts.Count) do begin F.Name := Screen.Fonts[i]; if F.IsMonoSpace then Memo1.Lines.Add('MonoSpace: ' + F.Name) else Memo1.Lines.Add(F.Name); end; finally F.Free; end;end;

dseligo:

--- Quote from: KodeZwerg on November 28, 2023, 09:15:39 am ---I suggest to not mix CLI and GUI stuff.
This works like it should:

--- End quote ---

I don't think mixing CLI and GUI is problem here.
I just tried your code and it doesn't work (not a single monospace font is reported), Laz 2.2.6, Windows 11.

Hartmut:
Thank you KodeZwerg for your suggestion, but unfortunately it does not work. Not on my Linux and not on Windows 7 (not a single monospace font is reported on both OS). Did you test it?

BTW: I often mix writeln() with GUI code and never had problems by this.

I assume, that there must be some kind of "reset" between the assignment of different Font-names. What could this be?

Thank you dseligo for your feedback.

KodeZwerg:
The "Name" property gets updated but the rest of metrics not, so only solution in FPC/Lazarus is to free "F" and create new for each individual font.

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject);var F: TFont; i: Integer; Total, Mono: Integer;begin Mono := 0; Total := 0; Memo1.Lines.BeginUpdate; Memo1.Lines.Clear; for i := 0 to Pred(Screen.Fonts.Count) do begin F := TFont.Create; try F.Name := Screen.Fonts[i]; if F.IsMonoSpace then Memo1.Lines.Add('MonoSpace: ' + F.Name) else Memo1.Lines.Add(F.Name); if F.IsMonoSpace then Inc(Mono); Inc(Total); finally F.Free; end; end; Memo1.Lines.Add('Detected ' + IntToStr(Mono) + ' MonoSpace within ' + IntToStr(Total) + ' Fonts'); Memo1.Lines.EndUpdate;end;

Navigation

[0] Message Index

[#] Next page