RtTool/Delphi7/开发档案/马国钢开发代码/RTFunAndForm/Fun/U_MyClassHelpers.pas

unit U_MyClassHelpers;
interface
Uses
  SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs, Math,typinfo;
//  uMySysUtils;

Const   //<2F><>¼<EFBFBD><C2BC><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD>Ļ<EFBFBD>ֱ<EFBFBD><D6B1><EFBFBD>
   OriWidth=1366;
   OriHeight=768;

{var
   OriWidth,OriHeight:Integer;   }

Type
  TfmForm=Class(TForm)   //ʵ<>ִ<EFBFBD><D6B4><EFBFBD><EFBFBD><EFBFBD>Ļ<EFBFBD>ֱ<EFBFBD><D6B1>ʵ<EFBFBD><CAB5>Զ<EFBFBD><D4B6><EFBFBD><EFBFBD><EFBFBD>
  Private
    fScrResolutionRateW: Double;
    fScrResolutionRateH: Double;
    fIsFitDeviceDone: Boolean;
    procedure FitDeviceResolution;
  Protected
    Property IsFitDeviceDone:Boolean Read fIsFitDeviceDone;
    Property ScrResolutionRateH:Double Read fScrResolutionRateH;
    Property ScrResolutionRateW:Double Read fScrResolutionRateW;
  Public
    Constructor Create(AOwner: TComponent); Override;
  End;

  TfdForm=Class(TfmForm)   //<2F><><EFBFBD>ӶԻ<D3B6><D4BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>޸<EFBFBD>ȷ<EFBFBD><C8B7>
  Protected
    fIsDlgChange:Boolean;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Property IsDlgChange:Boolean Read fIsDlgChange default false;
  End;

implementation

//uses UMain;

constructor TfmForm.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  fScrResolutionRateH:=1;
  fScrResolutionRateW:=1;
  Try
    if Not fIsFitDeviceDone then
    Begin
      FitDeviceResolution;
      fIsFitDeviceDone:=True;
    End;
  Except
    fIsFitDeviceDone:=False;
  End;
end;

procedure TfmForm.FitDeviceResolution;
Var
  LocList:TList;
  LocFontRate:Double;
  LocFontSize:Integer;
  LocFont:TFont;
  locK:Integer;

//<2F><><EFBFBD><EFBFBD><EFBFBD>߶ȵ<DFB6><C8B5><EFBFBD><EFBFBD>Ļ<EFBFBD><C4BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  Procedure CalBasicScalePars;
  Begin
    try
      Self.Scaled:=False;
      fScrResolutionRateH:=screen.height/OriHeight;
      fScrResolutionRateW:=screen.Width/OriWidth;
      LocFontRate:=Min(fScrResolutionRateH,fScrResolutionRateW);
    except
      Raise;
    end;
  End;
  
  function PropertyExists(const AObject: TObject;const APropName:String):Boolean;
  //<2F>ж<EFBFBD>һ<EFBFBD><D2BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD><EFBFBD>
  var
   PropInfo:PPropInfo;
  begin
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
   Result:=Assigned(PropInfo);
  end;

  function GetObjectProperty(
     const AObject   : TObject;
     const APropName : string
     ):TObject;
  var
   PropInfo:PPropInfo;
  begin
   Result  :=  nil;
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
   if Assigned(PropInfo) and
       (PropInfo^.PropType^.Kind = tkClass) then
     Result  :=  GetObjectProp(AObject,PropInfo);
  end;

//<2F><><EFBFBD><EFBFBD>ԭ<EFBFBD><D4AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>λ<EFBFBD>ã<EFBFBD><C3A3><EFBFBD><EFBFBD>õݹ鷨<DDB9><E9B7A8><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀؼ<C4BF><D8BC><EFBFBD>ֱ<EFBFBD><D6B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD><D2BB>
  Procedure ControlsPostoList(vCtl:TControl;vList:TList);
  Var
    locPRect:^TRect;
    i:Integer;
    locCtl:TControl;
    locFontp:^Integer;
  Begin
    try
      New(locPRect);
      locPRect^:=vCtl.BoundsRect;
      vList.Add(locPRect);
      If PropertyExists(vCtl,'FONT') Then
      Begin
        LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
        New(locFontp);
        locFontP^:=LocFont.Size;
        vList.Add(locFontP);
//        ShowMessage(vCtl.Name+'Ori:='+InttoStr(LocFont.Size));
      End;
      If vCtl Is TWinControl Then
        For i:=0 to TWinControl(vCtl).ControlCount-1 Do
        begin
          locCtl:=TWinControl(vCtl).Controls[i];
          ControlsPosToList(locCtl,vList);
        end;
    except
      Raise;
    end;
  End;

//<2F><><EFBFBD><EFBFBD><EFBFBD>µ<EFBFBD><C2B5><EFBFBD><EFBFBD><EFBFBD>λ<EFBFBD>ã<EFBFBD><C3A3><EFBFBD><EFBFBD>õݹ鷨<DDB9><E9B7A8><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀؼ<C4BF><D8BC><EFBFBD>ֱ<EFBFBD><D6B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD>㡣
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ȼ<EFBFBD><C8BC>㶥<EFBFBD><E3B6A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ģ<EFBFBD>Ȼ<EFBFBD><C8BB><EFBFBD>𼶵ݽ<F0BCB6B5>
  Procedure AdjustControlsScale(vCtl:TControl;vList:TList;Var vK:Integer);
  Var
    locOriRect,LocNewRect:TRect;
    i:Integer;
    locCtl:TControl;
  Begin
    try
      If vCtl.Align<>alClient Then
      Begin
        locOriRect:=TRect(vList.Items[vK]^);
        With locNewRect Do
        begin
          Left:=Round(locOriRect.Left*fScrResolutionRateW);
          Right:=Round(locOriRect.Right*fScrResolutionRateW);
          Top:=Round(locOriRect.Top*fScrResolutionRateH);
          Bottom:=Round(locOriRect.Bottom*fScrResolutionRateH);
          vCtl.SetBounds(Left,Top,Right-Left,Bottom-Top);
        end;
      End;
      If PropertyExists(vCtl,'FONT') Then
      Begin
        Inc(vK);
        LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
        locFontSize:=Integer(vList.Items[vK]^);
        LocFont.Size := Round(LocFontRate*locFontSize);
//        ShowMessage(vCtl.Name+'New:='+InttoStr(LocFont.Size));
      End;
      Inc(vK);
      If vCtl Is TWinControl Then
        For i:=0 to TwinControl(vCtl).ControlCount-1 Do
        begin
          locCtl:=TWinControl(vCtl).Controls[i];
          AdjustControlsScale(locCtl,vList,vK);
        end;
    except
      Raise;
    end;
  End;

//<2F>ͷ<EFBFBD><CDB7><EFBFBD><EFBFBD><EFBFBD>λ<EFBFBD><CEBB>ָ<EFBFBD><D6B8><EFBFBD><EFBFBD><EFBFBD>б<EFBFBD><D0B1><EFBFBD><EFBFBD><EFBFBD>
  Procedure FreeListItem(vList:TList);
  Var
    i:Integer;
  Begin
    For i:=0 to vList.Count-1 Do
      Dispose(vList.Items[i]);
    vList.Free;
  End;

begin
  LocList:=TList.Create;
  Try
    Try
      if (Screen.width<>OriWidth)OR(Screen.Height<>OriHeight) then
      begin
        CalBasicScalePars;
//        AdjustComponentFont(Self);
        ControlsPostoList(Self,locList);
        locK:=0;
        AdjustControlsScale(Self,locList,locK);

      End;
    Except on E:Exception Do
      Raise Exception.Create('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ļ<EFBFBD>ֱ<EFBFBD><D6B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ<EFBFBD><D3A6><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD>ִ<EFBFBD><D6B4><EFBFBD>'+E.Message);
    End;
  Finally
    FreeListItem(locList);
  End;
end;


{ TfdForm }

constructor TfdForm.Create(AOwner: TComponent);
begin
  inherited;
  fIsDlgChange:=False;
end;

end.