盒子论坛 v2.1

(* ********** *)
(* *)
(* 设计：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.
----------------------------------------------
-

作者：

badwood (badwood)	★☆☆☆☆	-
	盒子活跃会员

2017/1/16 11:43:36

1楼：

顶楼主！谢谢分享
----------------------------------------------
-

作者：

yuzhenguo0 (金远见)	▲▲▲▲▲	-
	普通会员

2017/1/17 7:47:53

2楼：

即使 form可以控件也不可以
----------------------------------------------
学DELPHI http://www.studydelphi.com

作者：

bdl1 (bdl1)	▲▲▲▲▲	-
	普通会员

2017/1/17 8:27:49

3楼：

顶楼主！谢谢分享
----------------------------------------------
-我的博客

信息

登陆以后才能回复