On Mon, 1 Apr 2019 00:42:45 +0200, Werner Pamler via lazarus
<lazarus@lists.lazarus-ide.org> wrote:
>procedure BoldGroup(AControl: TWinControl);
>var
> i: Integer;
> propinfo: PPropInfo;
> cntrl: TControl;
> fnt: TFont;
>begin
> for i:=0 to AControl.ControlCount-1 do begin
> cntrl := AControl.Controls[i];
> propinfo := GetPropInfo(cntrl, 'ParentFont');
> if propinfo <> nil then
> SetOrdProp(cntrl, propinfo, Longint(false));
> propinfo := GetPropInfo(cntrl, 'Font');
> if propinfo <> nil then begin
> fnt := TFont(GetObjectProp(cntrl, 'Font'));
> fnt.Style := [];
> SetObjectProp(cntrl, 'Font', fnt);
> end;
> end;
> AControl.Font.Style := [fsBold];
So I tried to put this into Lazarus 2.0.0...
After struggling with illegal whitespace characters when copy pasting
from the news reader into Lazarus I put it into a text editor and
cleaned up these before copy-paste into Lazarus again.
procedure BoldGroup(AControl: TWinControl);
var
i: Integer;
propinfo: PPropInfo;
cntrl: TControl;
fnt: TFont;
begin
for i:=0 to AControl.ControlCount-1 do
begin
cntrl := AControl.Controls[i];
propinfo := GetPropInfo(cntrl, 'ParentFont');
if propinfo <> nil then
SetOrdProp(cntrl, propinfo, Longint(false));
propinfo := GetPropInfo(cntrl, 'Font');
if propinfo <> nil then
begin
fnt := TFont(GetObjectProp(cntrl, 'Font'));
fnt.Style := [];
SetObjectProp(cntrl, 'Font', fnt);
end;
end;
AControl.Font.Style := [fsBold];
end;
I also had to add typinfo to uses.
Now it did work but only after rearranging the calls from OnCreate:
This works:
BoldGroup(gbxValues);
BoldGroup(gbxDHT);
BoldGroup(gbxNetwork);
BoldGroup(gbxAPmode);
BoldGroup(gbxStationmode);
But this does not work:
BoldGroup(gbxDHT);
BoldGroup(gbxNetwork);
BoldGroup(gbxAPmode);
BoldGroup(gbxStationmode);
BoldGroup(gbxValues);
gbxValues is a container groupbox for all of the others.
In the nonworking case the ONLY groupbox that get bold caption is the
gbxValues box...
Seems like the call to bold the caption of the gbxValues container
removes the bold already set on the internal groupboxes...
--
Bo Berglund
Developer in Sweden
--
_______________________________________________
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus
