Delphi program form and Control Adaptive resolution (change font size and up or down through componentcount traversal)

UnitUntfixform;InterfaceusesClasses, Sysutils, Controls, Forms;typeTfontedcontrol=class(Tcontrol) Public     PropertyFont;End; Tfontmapping=RecordSwidth:integer;    Sheight:integer; FName:string; Fsize:integer;End;procedureFixform (aform:tform);proceduresetfontmapping;varfontmapping:Array  oftfontmapping;Implementationproceduresetfontmapping;beginSetLength (fontmapping,3);//xfontmapping[0]. Swidth: = -; fontmapping[0]. Sheight: = -; fontmapping[0]. FName: ='Song Body'; fontmapping[0]. Fsize: =7;//1024x768 x 768fontmapping[1]. Swidth: =1024x768; fontmapping[1]. Sheight: =768; fontmapping[1]. FName: ='Song Body'; fontmapping[1]. Fsize: =9;//x 1024x768fontmapping[2]. Swidth: = the; fontmapping[2]. Sheight: =1024x768; fontmapping[2]. FName: ='Song Body'; fontmapping[2]. Fsize: = One;End;procedureFixform (aform:tform);varI, J:integer;t:tcontrol;begin withAform Dobegin     forI: =0  toComponentcount-1  Do    begin      TryT:=Tcontrol (Components[i]); T.left:= Trunc (T.left * (Screen.width/1024x768)); T.top:= Trunc (T.top * (Screen.height/768)); T.width:= Trunc (T.width * (Screen.width/1024x768)); T.height:= Trunc (T.height * (Screen.height/768)); except      End;{Try}    End;{For i}     forI: =0  toLength (fontmapping)-1  Do    begin      if(Screen.width = Fontmapping[i]. Swidth) and(Screen.height =Fontmapping[i]. Sheight) Then      begin         forJ: =0  toComponentcount-1  Do        begin          TryTfontedcontrol (Components[j]). Font.Name:=Fontmapping[i].            FName; Tfontedcontrol (Components[j]). FONT. Size:=Fontmapping[i].          Fsize; except          End;{Try}        End;{For J}      End;{if}    End;{For i}End;{ with}End;initializationsetfontmapping;End.

The Setfontmapping method can be modified by itself to accommodate more resolutions.
The invocation is also very simple, as follows:

procedure tform1.formshow (sender:tobject); begin if ' Do you want to use screen adaptive?  ' hint 'orthen      Exit; Untfixform.fixform (self); End;

http://blog.csdn.net/han_348154920/article/details/4762928

Delphi program form and Control Adaptive resolution (change font size and up or down through componentcount traversal)