自动适应分辨率

两种方法：一种是调整系统分比率适应程序，一种是程序适应分辨率，个人倾向于第一种

方法1：

 

 const //记录设计时的分辨率。
  PelsWidth = 1024;
  PelsHeight = 768;

var
  OldPelsWidth: Integer;
  OldPelsHeight: Integer;

function Resolution(AWidth, AHeight: Word): Boolean;
var
  DevMode:TDeviceMode;
begin
  Result:=EnumDisplaySettings(nil,0,DevMode);
  if Result then
  begin
    DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    DevMode.dmPelsWidth := AWidth;
    DevMode.dmPelsHeight := AHeight;
    Result:=ChangeDisplaySettings(DevMode, CDS_UPDATEREGISTRY)=DISP_CHANGE_SUCCESSFUL;
  end;
end;

initialization
  OldPelsWidth := Screen.Width;
  OldPelsHeight := Screen.Height;
  if (OldPelsWidth <> PelsWidth) or (OldPelsHeight <> PelsHeight) then
    Resolution(PelsWidth, PelsHeight); 

finalization
  if (OldPelsWidth <> PelsWidth) or (OldPelsHeight <> PelsHeight) then
    Resolution(OldPelsWidth, OldPelsHeight); //改回原始的分辨率 

方法二：

function PropertyExists(const AObject: TObject; const APropName: string): Boolean;
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;

procedure FitDeviceResolution(Sender: TForm);
const
  OriWidth = 1440;
  OriHeight = 900;
var
  i: Integer;
  j: Integer;
  LocAnchors: array of TAnchors;
  LocAlign: array of TAlign;
  LocList: TList;
  LocFontSize: Integer;
  LocFont: TFont;
  LocCmp: TComponent;
  LocFontRate: Double;
begin
  ScrResolutionRateH := Screen.Height / OriHeight;
  ScrResolutionRateW := Screen.Width / OriWidth;
  if Abs(ScrResolutionRateH - 1) < Abs(ScrResolutionRateW - 1) then
    LocFontRate := ScrResolutionRateH
  else
    LocFontRate := ScrResolutionRateW;
  LocList := TList.Create;
  try
    try
      if (screen.width <> OriWidth) or (screen.Height <> OriHeight) then
      begin
        Sender.Scaled := False;
        for i := Sender.ComponentCount - 1 downto 0 do
        begin
          LocCmp := Sender.Components[i];
          if LocCmp is TControl then
          LocList.Add(LocCmp);
          if PropertyExists(LocCmp, 'FONT') then
          begin
          LocFont := TFont(GetObjectProperty(LocCmp, 'FONT'));
          LocFontSize := Round(LocFontRate * LocFont.Size);
          LocFont.Size := LocFontSize;
          end;
        end;
        SetLength(LocAnchors, LocList.Count);
        SetLength(LocAlign, LocList.Count);
        for i := 0 to LocList.Count - 1 do
          with TControl(LocList.Items[i]) do
          begin
          LocAnchors[i] := Anchors;
          LocAlign[i] := Align;
          Align := alNone;
          Anchors := [akLeft, akTop];
          end;
        Sender.Top := Round(Sender.Top * ScrResolutionRateH);
        Sender.Left := Round(Sender.Left * ScrResolutionRateW);
        Sender.Height := Round(Sender.Height * ScrResolutionRateH);
        Sender.Width := Round(Sender.Width * ScrResolutionRateW);
        Sender.Font.size := Round(LocFontRate * Sender.Font.size);
        for i := 0 to LocList.Count - 1 do
        begin
          with TControl(LocList.Items[i]) do
          begin
          Top := Round(Top * ScrResolutionRateH);
          Left := Round(Left * ScrResolutionRateW);
          Height := Round(height * ScrResolutionRateH);
          Width := Round(width * ScrResolutionRateW);
          end;
        end;
        for i := 0 to LocList.Count - 1 do
          TControl(LocList.Items[i]).Align := LocAlign[i];
        for i := 0 to LocList.Count - 1 do
          TControl(LocList.Items[i]).Anchors := LocAnchors[i];
      end;
    except
      MessageDlg(LocCMP.Name, mtInformation, [mbOK], 0);
    end;
  finally
    LocList.Free;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  FitDeviceResolution(Self);
end;

 

第二种方法主要的记录是

function PropertyExists(const AObject: TObject; const APropName: string): Boolean;
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;

 

这两个函数，知道了这个两个函数，就可以实现很多其他功能，好比动态设置字体，颜色之类的功能