https://www.cnblogs.com/zhangzhifeng/category/835602.html
Это проблема, которая долго меня смущает, и она, наконец, была решена по сей день.
Говорят, что у Delphi есть сильный дизайнер окон, который заставляет фанатов VC жаждать трех правил. Тем не менее, окно, разработанное в Delphi, не автоматически адаптируется к атрибутам разрешения экрана. То есть, идеальная компоновка управления окном регулируется во время проектирования программного обеспечения, и он может стать всемогущими при запуске на машинах с различным разрешением экрана. Элементы управления будут смещены друг на друга, а некоторые даже будут удалены из окна.
Этот вопрос много раз искал в Интернете, но большинство из них являются масштабными или изменчивыми в соответствии с методом управления. Я попробовал это, используя эти два метода для адаптивных корректировок, но эффект не идеален. Позже я также написал базовый класс, унаследованный от окна, покрыл конструктор и назвал метод самоодаптации разрешения устройства. Этот метод пересекал все элементы управления в окне и в соответствии с разрешением экрана и текущим экраном дизайна Конструкция, и текущий экран был основан на конструкции экрана и текущего экрана. Соотношение разрешения рассчитывается одно за другим для расчета положения и размера управления. Эта идея хороша, и эффект также лучше. Она лучше, чем просто использовать метод Scaleby или Changescale, но это не очень идеально. Она не отвечает требованиям моего собственного воображения. Где причина, я никогда не знал.
Мой оригинальный код был опубликован на Delphi Box и CSDN.
Эта проблема наконец решилась сегодня! Пересечение
Причина заключалась в том, что я думал, что свойство Align всех элементов управления было установлено на альноне, а свойство якоря было установлено на пустое [], а размер и размер управления не будет затронут размером его контейнера. Сегодня, когда я проверил это в течение периода проектирования, я обнаружил, что это не так. Когда размер окна меняется, даже если выравнивание: = alnone, якоря: = [] определенного управления изменится при изменении шкалы окна. Это означает, что мне нужен массив, чтобы сохранить исходное положение и размер всех элементов управления заранее. Когда окно автоматически корректируется из -за изменений в разрешении экрана, основание вычисления по -прежнему остается неизменным исходным данными о размере местоположения окна, так что проблема решается.
Меньше сплетен, верхний исходный код.
unit uMyClassHelpers;
interface
Uses
SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs,
uMySysUtils;
Const // для записи разрешения экрана во время дизайна
OriWidth=1366;
OriHeight=768;
Type
Tfmform = class (tform) // Автоматическая регулировка разрешения экрана окна
Private
fScrResolutionRateW: Double;
fScrResolutionRateH: Double;
fIsFitDeviceDone: Boolean;
fPosition:Array of TRect;
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) // Добавить подтверждение модификации окна диалогового окна
Protected
fIsDlgChange:Boolean;
Public
Constructor Create(AOwner: TComponent); Override;
Property IsDlgChange:Boolean Read fIsDlgChange default false;
End;
implementation
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
i:Integer;
LocList:TList;
LocFontSize:Integer;
LocFont:TFont;
LocCmp:TComponent;
LocFontRate:Double;
LocRect:TRect;
LocCtl:TControl;
begin
LocList:=TList.Create;
Try
Try
if (Screen.width<>OriWidth)OR(Screen.Height<>OriHeight) then
begin
Self.Scaled:=False;
fScrResolutionRateH:=screen.height/OriHeight;
fScrResolutionRateW:=screen.Width/OriWidth;
Try
if fScrResolutionRateH<fScrResolutionRateW then
LocFontRate:=fScrResolutionRateH
Else
LocFontRate:=fScrResolutionRateW;
Finally
ReleaseDC(0, GetDc(0));
End;
For i:=Self.ComponentCount-1 Downto 0 Do
Begin
LocCmp:=Self.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(fPosition,LocList.Count+1);
For i:=0 to LocList.Count-1 Do
With TControl(LocList.Items[i])Do
fPosition[i+1]:=BoundsRect;
fPosition[0]:=Self.BoundsRect;
With LocRect Do
begin
Left:=Round(fPosition[0].Left*fScrResolutionRateW);
Right:=Round(fPosition[0].Right*fScrResolutionRateW);
Top:=Round(fPosition[0].Top*fScrResolutionRateH);
Bottom:=Round(fPosition[0].Bottom*fScrResolutionRateH);
Self.SetBounds(Left,Top,Right-Left,Bottom-Top);
end;
i:= LocList.Count-1;
While (i>=0) Do
Begin
LocCtl:=TControl(LocList.Items[i]);
If LocCtl.Align=alClient Then
begin
Dec(i);
Continue;
end;
With LocRect Do
begin
Left:=Round(fPosition[i+1].Left*fScrResolutionRateW);
Right:=Round(fPosition[i+1].Right*fScrResolutionRateW);
Top:=Round(fPosition[i+1].Top*fScrResolutionRateH);
Bottom:=Round(fPosition[i+1].Bottom*fScrResolutionRateH);
LocCtl.SetBounds(Left,Top,Right-Left,Bottom-Top);
end;
Dec(i);
End;
End;
Except on E:Exception Do
Повысить excection.create (‘error’+e.message);
End;
Finally
LocList.Free;
End;
end;
{ TfdForm }
constructor TfdForm.Create(AOwner: TComponent);
begin
inherited;
fIsDlgChange:=False;
end;
end.
Выше приведено два класса, один -это общий класс окон, а другой -тип диалогового окна подгруппа. В фактическом процессе подачи заявления, пока формы, созданные самим собой, наследуют один из двух вышеуказанных классов, такие как TFORM1 = Class (TFDFORM), вам не нужно добавлять какой -либо исходный код. Создайте опыт окна, чтобы автоматически регулировать размер управления выше. Для адаптации к различному разрешению экрана.
Приведенный выше исходный код был проверен, и эффект очень хороший, решающий проблему, которая не была решена в течение многих лет!
unit uMyClassHelpers;
{Реализуйте размер адаптивной регулировки окна, чтобы адаптироваться к проблеме дисплея разных экранов.
Инструкции по использованию:
Но вы можете просто сделать пример.
Создайте новое окно и измените класс, унаследованный новым окном на TFMFORM или TFDFORM,
Затем просто перетащите некоторые элементы управления в окне, чтобы изменить значение Oriwidth и Oriheight, чтобы имитировать разрешение экрана при разработке.
Или, если вы измените разрешение экрана вашего компьютера, чтобы моделировать фактическую ситуацию, вы можете легко продемонстрировать адаптивное изменение окна.
Нет необходимости добавлять исходный код на весь процесс.
}
interface
uses
SysUtils, Windows, Classes, Graphics, Controls, Forms, Dialogs, Math,
TypInfo;
const // для записи разрешения экрана во время дизайна
OriWidth = 1920;
OriHeight = 1080;
type
Tfmform = class (tform) // Автоматическая регулировка разрешения экрана окна
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) // Добавить подтверждение модификации окна диалогового окна
protected
fIsDlgChange: Boolean;
public
constructor Create(AOwner: TComponent); override;
property IsDlgChange: Boolean read fIsDlgChange default false;
end;
implementation
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;
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;
{Рассчитайте основные параметры корректировки шкалы}
procedure CalBasicScalePars;
begin
try
Self.Scaled := False;
fScrResolutionRateH := screen.height / OriHeight;
fScrResolutionRateW := screen.Width / OriWidth;
LocFontRate := Min(fScrResolutionRateH, fScrResolutionRateW);
except
raise;
end;
end;
{Сохраните исходную позицию координаты: используйте рекурсивный метод, чтобы пройти контроль в контейнерах на всех уровнях до последнего уровня}
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;
{Рассчитайте новую позицию координаты: рекурсивно используйте для контроля в контейнерах на всех уровнях до последнего уровня.
Рассчитайте контейнер с верхнего уровня при расчете координат, а затем шаг за шагом прогрессируйте}
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;
{Выпустить указатель и объект списка координат}
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
Повысить excection.create ('error' + e.message);
end;
finally
FreeListItem(locList);
end;
end;
{ TfdForm }
constructor TfdForm.Create(AOwner: TComponent);
begin
inherited;
fIsDlgChange := False;
end;
end.