(* ********** *)
(* *)
(* 设计:by BambooCaep (乱拳) QQ:24909824 *)
(* 上面的版权声明请不要移除。 *)
(* *)
(* ********** *)
// 默认状态下,delphi生成的android程序显示界面分辨率为640*360。
// 如果设计的界面小于这个尺寸,右方或下方会多出空白区。
// 解决方法有2种:
// 1:使用Align等方式重新布局,控件的相对位置会发生变化。
// 2:把窗体里面的控件整体移动到屏幕中心。
// 如果设计的界面超过这个尺寸,会显示不全。
// 解决方法有3种:
// 1:使用Align等方式重新布局,控件的相对位置会发生变化。
// 2:使用ScrollBox,用户滑动屏幕显示其它内容。
// 3:使用ScaledLayout,在屏幕上同时显示所有内容且不变形。
// 想要看到效果,那么窗体本身的BorderStyle要指明不允许改变窗体大小。以下3种情况不会自动调整
// 1:Self.BorderStyle = TFmxFormBorderStyle.Sizeable
// 2:Self.BorderStyle = TFmxFormBorderStyle.SizeToolWin
// 3:(Self.BorderStyle = TFmxFormBorderStyle.Single) and (TBorderIcon.biMaximize in Self.BorderIcons)
// 使用方法:
// 1:把.pas单元里面你设计的Form改为从TBambooScaledForm继承。
// 2:可以在程序初始化单元里面设置DefaultScaleOption_EnouthSize和DefaultScaleOption_NoEnouthSize改变所有尚未创建窗体的默认行为。
// 3:可以在你的Form里面重载Get_ScaleOption_EnouthSize和Get_ScaleOption_NoEnouthSize方法改变该窗体的默认行为。
// 4:可以在你的Form里面重载Change_ContainerOriginalSize方法,这样可以让该窗体在Windows下和Android下具有不同的分辨率(定义了NEXTGEN,windows下本单元无效果)。
// 注:未测试ios下的效果
unit FMX.BambooScaledForm;
interface
uses
{$IFDEF NEXTGEN}
FMX.Controls,
FMX.Layouts,
FMX.ScrollBox,
FMX.Types,
System.Classes,
System.Generics.Collections,
System.SysUtils,
System.UITypes,
{$ENDIF}
System.Types,
FMX.Forms;
type
// bfsoScroll:滚动。仅当设计尺寸超出640*360时才会使用。
// bfsoContents:原始状态,控件的Align等属性起作用。
// bfsoFit:原始窗体大小变到当前窗体大小(锁定纵横比),控件的Align等属性起作用。
// bfsoScale:原始窗体大小缩放到当前窗体大小(锁定纵横比)。
// bfsoCenter:原始窗体放在当前窗体中心。仅当设计尺寸不足640*360时才会使用。
TBambooFormScaleOption = (bfsoScroll, bfsoContents, bfsoFit, bfsoScale, bfsoCenter);
TBambooFormScaleOption_EnoughSize = bfsoContents .. bfsoCenter;
TBambooFormScaleOption_NoEnoughSize = bfsoScroll .. bfsoScale;
TBambooScaledForm = class(TForm)
{$IFDEF NEXTGEN}
strict private
FInited: Boolean;
FMainLayout: TLayout;
FOriginalContainerSize: TPointF;
FOriginalLayout: TLayout;
FScaledLayout: TScaledLayout;
FScrollBox: TScrollBox;
FScaleOption: TBambooFormScaleOption;
procedure Do_AfterResize;
procedure Do_Init;
procedure Do_Change_ContainerOriginalSize(var aOriginalContainerSize: TPointF);
protected
procedure Loaded; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
{$ENDIF}
protected
function Get_ScaleOption_EnouthSize: TBambooFormScaleOption_EnoughSize; virtual;
function Get_ScaleOption_NoEnouthSize: TBambooFormScaleOption_NoEnoughSize; virtual;
// aOriginalContainerSize为原始布局大小。
// aLandscape为当前屏幕是否横屏。
// aFixContainerSize默认值为(0, 0)。修改X>0代表把Width缩放到指定大小,修改Y>0代表把Height缩放到指定大小。Width和Height与aLandscape有关。
procedure Change_ContainerOriginalSize(const aOriginalContainerSize: TPointF; aLandscape: Boolean; var aFixContainerSize: TPoint); virtual;
public
class var DefaultScaleOption_EnouthSize: TBambooFormScaleOption_EnoughSize;
class var DefaultScaleOption_NoEnouthSize: TBambooFormScaleOption_NoEnoughSize;
end;
implementation
{ TBambooScaledForm }
{$IFDEF NEXTGEN}
constructor TBambooScaledForm.Create(AOwner: TComponent);
begin
FInited := False;
inherited Create(AOwner);
end;
procedure TBambooScaledForm.Do_AfterResize;
var
aScaleOption: TBambooFormScaleOption;
begin
if csDesigning in ComponentState then
Exit;
// 如果窗体的BorderStyle指明了允许改变大小,那么就让它自己处理。
if (Self.BorderStyle = TFmxFormBorderStyle.Sizeable) or (Self.BorderStyle = TFmxFormBorderStyle.SizeToolWin) or ((Self.BorderStyle = TFmxFormBorderStyle.Single) and (TBorderIcon.biMaximize in Self.BorderIcons)) then
aScaleOption := TBambooFormScaleOption.bfsoContents
else if (ClientWidth >= FOriginalContainerSize.X) and (ClientHeight >= FOriginalContainerSize.Y) then
aScaleOption := Get_ScaleOption_EnouthSize
else
aScaleOption := Get_ScaleOption_NoEnouthSize;
FScaleOption := aScaleOption;
case FScaleOption of
bfsoCenter:
begin
FOriginalLayout.Parent := FMainLayout;
FOriginalLayout.Align := TAlignLayout.None;
FOriginalLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
FOriginalLayout.Align := TAlignLayout.Center;
FOriginalLayout.BringToFront;
end;
bfsoContents:
begin
FOriginalLayout.Parent := FMainLayout;
FOriginalLayout.Align := TAlignLayout.Contents;
FOriginalLayout.BringToFront;
end;
bfsoFit:
begin
FOriginalLayout.Parent := FMainLayout;
FOriginalLayout.Align := TAlignLayout.None;
FOriginalLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
FOriginalLayout.Align := TAlignLayout.Fit;
FOriginalLayout.BringToFront;
end;
bfsoScale:
begin
FScaledLayout.Align := TAlignLayout.None;
FScaledLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
FOriginalLayout.Align := TAlignLayout.None;
FOriginalLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
FOriginalLayout.Parent := FScaledLayout;
FScaledLayout.OriginalWidth := FOriginalContainerSize.X;
FScaledLayout.OriginalHeight := FOriginalContainerSize.Y;
FScaledLayout.Align := TAlignLayout.Fit;
FScaledLayout.BringToFront;
end;
bfsoScroll:
begin
FOriginalLayout.Parent := FScrollBox;
FOriginalLayout.Align := TAlignLayout.None;
FOriginalLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
FScrollBox.BringToFront;
end;
end;
end;
procedure TBambooScaledForm.Do_Change_ContainerOriginalSize(var aOriginalContainerSize: TPointF);
var
aFixContainerSize: TPoint;
begin
aFixContainerSize.X := 0;
aFixContainerSize.Y := 0;
Change_ContainerOriginalSize(aOriginalContainerSize, Screen.Height < Screen.Width, aFixContainerSize);
if (aFixContainerSize.X <= 0) and (aFixContainerSize.Y <= 0) then
Exit;
if (aFixContainerSize.X > 0) and (aFixContainerSize.Y > 0) then
begin
aOriginalContainerSize.X := aFixContainerSize.X;
aOriginalContainerSize.Y := aFixContainerSize.Y;
end
else if aFixContainerSize.X > 0 then
begin
aOriginalContainerSize.X := aFixContainerSize.X;
aOriginalContainerSize.Y := Trunc(Self.ClientHeight * aFixContainerSize.X / Self.ClientWidth);
end
else
begin
aOriginalContainerSize.Y := aFixContainerSize.Y;
aOriginalContainerSize.X := Trunc(Self.ClientWidth * aFixContainerSize.Y / Self.ClientHeight);
end;
end;
procedure TBambooScaledForm.Do_Init;
var
aList: TList<TControl>;
i: Integer;
begin
if FInited then
Exit;
FInited := True;
if csDesigning in ComponentState then
Exit;
aList := TList<TControl>.Create;
for i := 0 to ChildrenCount - 1 do
begin
if Children[i] is TControl then
aList.Add(TControl(Children[i]));
end;
FOriginalContainerSize := OriginalContainerSize;
Do_Change_ContainerOriginalSize(FOriginalContainerSize);
Self.BeginUpdate;
FOriginalLayout := TLayout.Create(Self);
FOriginalLayout.BeginUpdate;
FOriginalLayout.Padding := Self.Padding;
FOriginalLayout.SetBounds(0, 0, FOriginalContainerSize.X, FOriginalContainerSize.Y);
for i := 0 to aList.Count - 1 do
begin
aList.Items[i].Parent := FOriginalLayout;
end;
aList.DisposeOf;
FOriginalLayout.EndUpdate;
FMainLayout := TLayout.Create(Self);
FMainLayout.Parent := Self;
FMainLayout.Align := TAlignLayout.Contents;
FScaledLayout := TScaledLayout.Create(Self);
FScaledLayout.Parent := FMainLayout;
FScrollBox := TScrollBox.Create(Self);
FScrollBox.Parent := FMainLayout;
FScrollBox.Align := TAlignLayout.Contents;
Self.EndUpdate;
Do_AfterResize;
end;
procedure TBambooScaledForm.Loaded;
begin
inherited Loaded;
Do_Init;
end;
procedure TBambooScaledForm.Resize;
begin
Do_Init;
inherited Resize;
FOriginalContainerSize := OriginalContainerSize;
Do_Change_ContainerOriginalSize(FOriginalContainerSize);
Do_AfterResize;
end;
{$ENDIF}
function TBambooScaledForm.Get_ScaleOption_EnouthSize: TBambooFormScaleOption_EnoughSize;
begin
Result := DefaultScaleOption_EnouthSize;
end;
function TBambooScaledForm.Get_ScaleOption_NoEnouthSize: TBambooFormScaleOption_NoEnoughSize;
begin
Result := DefaultScaleOption_NoEnouthSize;
end;
procedure TBambooScaledForm.Change_ContainerOriginalSize(const aOriginalContainerSize: TPointF; aLandscape: Boolean; var aFixContainerSize: TPoint);
begin
end;
procedure Do_InitDefault;
begin
TBambooScaledForm.DefaultScaleOption_EnouthSize := TBambooFormScaleOption.bfsoCenter;
TBambooScaledForm.DefaultScaleOption_NoEnouthSize := TBambooFormScaleOption.bfsoScale;
end;
initialization
Do_InitDefault;
end.
----------------------------------------------
-
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。