盒子论坛 v2.1

难道要用这个帖子说的方法？
https://blogs.embarcadero.com/simulating-transparent-dialog-on-firemonkey-mobile/

这不是做假吗?
----------------------------------------------
-

作者：

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

2021/4/15 11:15:25

2楼：

用Frame做，不要用Form
----------------------------------------------
-

作者：

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

2021/4/15 12:05:54

3楼：

@thinknet (thinknet):
用Frame,那怎么显示？能大概说下吗？谢谢
是不是在调用窗体放一个Layout,然后放这个Frame,用完隐藏？
github上有个大牛的TStandFrame，在Android上怎么用没搞明白....

我现在就是用https://blogs.embarcadero.com/simulating-transparent-dialog-on-firemonkey-mobile/这个帖子说的MakeScreenshot来做假，但是只能是静态窗体...
----------------------------------------------
-

作者：

edwardweng (EDWARD)	★☆☆☆☆	-
	普通会员

2021/4/18 11:36:34

4楼：

這篇可參考用frame做的對話視窗

https://blog.csdn.net/pulledup/article/details/102960922
----------------------------------------------
-

作者：

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

2021/4/19 12:47:45

5楼：

https://blog.csdn.net/pulledup/article/details/102960922
也是用的屏幕截图方法，功能比较全。利用剪切板了。

我参考
https://blogs.embarcadero.com/simulating-transparent-dialog-on-firemonkey-mobile/
这个帖子说的，用TLayout.MakeScreenShot来截图：（图片怎么贴啊)
算了，看这吧: https://blog.csdn.net/jankercsdn/article/details/115741524

----------------------------------------------
-

作者：

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

2021/4/19 14:02:58

6楼：

丑陋的代码:

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts,
  FMX.Objects;

type
  TDefaultActionKind = (dakOK, dakCancel);

  TModaleResultProc = reference to procedure(const AResult: Boolean);

  TfrmGeneralTimeoutDialog = class(TForm)
    slytBase: TScaledLayout;
    imgBackupground: TImage;
    rctDialogBase: TRectangle;
    lytTop: TLayout;
    imgLogo: TImage;
    imgClose: TImage;
    lytBottom: TLayout;
    spbtnOK: TSpeedButton;
    spbtnCancel: TSpeedButton;
    lytClient: TLayout;
    tmrClose: TTimer;
    txtTile: TText;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tmrCloseTimer(Sender: TObject);
    procedure imgCloseClick(Sender: TObject);
    procedure spbtnCancelClick(Sender: TObject);
    procedure spbtnOKClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FModaleResult: Boolean;
    FDefaultActionStr: string;
    FTimeoutCount: Integer;
    FDefaultActionKind: TDefaultActionKind;
    FModaleResultProc: TModaleResultProc;
    procedure SetDefaultActionKind(const Value: TDefaultActionKind);
    procedure SetDefaultActionStr(const Value: string);
    procedure SetTimeoutCount(const Value: Integer);
  protected
    procedure SetTipsShowArea(const ATipInfos: TArray<string>;
        const AFirstLineFontColor: TAlphaColor = $FF363636; const AFirstLineFontSize: Integer = 18;
        const AGeneralLineFontColor: TAlphaColor = $FF363636; const AGeneralLineFontSize: Integer = 18);
  public
    property DefaultActionStr: string read FDefaultActionStr write SetDefaultActionStr;
    property TimeoutCount: Integer read FTimeoutCount write SetTimeoutCount;
    property DefaultActionKind: TDefaultActionKind read FDefaultActionKind write SetDefaultActionKind;
    property ModaleResultProc: TModaleResultProc read FModaleResultProc write FModaleResultProc;

    /// ATipInfos 显示的内容，最多8行
    /// ABackupImage 模拟调用窗体的背景图片
    /// ADialogColor 对话框本身的颜色
    /// ADialogOpacity 对话框透明度
    /// ATimeoutCount 超时设置，秒单位
    /// ALogoImage Logo Image
    /// ATileText 标题文字
    /// AOKText 确定按钮的文字
    /// ACancelText 取消按钮的文字
    /// AFirstLineFontColor 第一行内容的颜色
    /// AFirstLineFontSize  第一行内容的字体大小
    /// AGeneralLineFontColor 一般内容的颜色
    /// AGeneralLineFontSize  一般内容的字体大小
    /// ADefaultAction 默认都在按钮
    /// AModaleResultProc 回调方法
    class procedure ShowModaleDialog(const ATipInfos: TArray<string>; const ABackupImage: TBitmap;
        const ADialogColor: TalphaColor = $FF6CB68D; const ADialogOpacity: Single = 0.8;
        const ATimeoutCount: Integer = 15; const ALogoImage: TBitmap = nil;  const ATileText: string = '提示信息';
        const AOKText: string = '确定'; const ACancelText: string = '取消';
        const AFirstLineFontColor: TAlphaColor = $FF363636; const AFirstLineFontSize: Integer = 18;
        const AGeneralLineFontColor: TAlphaColor = $FF363636; const AGeneralLineFontSize: Integer = 18;
        const ADefaultAction: TDefaultActionKind = TDefaultActionKind.dakCancel;
        AModaleResultProc: TModaleResultProc = nil);
  end;

implementation

{$R *.fmx}

const
  DefShowAreaHeight = 250;    //默认可以显示4行文字, 每行的高度默认30
  DefShowAreaWidth  = 300;    //默认宽度时， 18大小的文字一行大约可以容纳16个

{ TfrmSimpleTimeoutDialog }

procedure TfrmGeneralTimeoutDialog.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FModaleResultProc) then
    FModaleResultProc(FModaleResult);
  Action := TCloseAction.caFree;
end;

procedure TfrmGeneralTimeoutDialog.FormCreate(Sender: TObject);
begin
  tmrClose.Interval := 1000;
  tmrClose.Enabled := False;
end;

procedure TfrmGeneralTimeoutDialog.FormShow(Sender: TObject);
begin
  case FDefaultActionKind of
    dakOK:
    begin
      FDefaultActionStr := spbtnOK.Text;
      spbtnOK.Text := FDefaultActionStr + '(' + IntToStr(FTimeoutCount) + ')';
    end;
    dakCancel:
    begin
      FDefaultActionStr := spbtnCancel.Text;
      spbtnCancel.Text := FDefaultActionStr + '(' + IntToStr(FTimeoutCount) + ')';
    end;
  end;
  tmrClose.Enabled := True;
end;

procedure TfrmGeneralTimeoutDialog.SetDefaultActionKind(const Value: TDefaultActionKind);
begin
  FDefaultActionKind := Value;
end;

procedure TfrmGeneralTimeoutDialog.SetDefaultActionStr(const Value: string);
begin
  FDefaultActionStr := Value;
end;

procedure TfrmGeneralTimeoutDialog.SetTimeoutCount(const Value: Integer);
begin
  FTimeoutCount := Value;
end;

procedure TfrmGeneralTimeoutDialog.SetTipsShowArea(const ATipInfos: TArray<string>;
        const AFirstLineFontColor: TAlphaColor; const AFirstLineFontSize: Integer;
        const AGeneralLineFontColor: TAlphaColor; const AGeneralLineFontSize: Integer);
var
  LTipLine: Integer;
  LTmpHeight: Single;
  LLayout: TLayout;
  LText: TText;

procedure ShowText;
begin
  for var I := 0 to LTipLine - 1 do
  begin
    LLayout := TLayout.Create(Self);
    LLayout.Parent := lytClient;
    if I = 0 then
      LLayout.Height := 36
    else
      LLayout.Height := 30;
    if (LTipLine = 1) and (I = 0) then
      LLayout.Align := TAlignLayout.VertCenter
    else
      LLayout.Align := TAlignLayout.Top;
    LText := TText.Create(Self);
    LText.Parent := LLayout;
    LText.Align := TAlignLayout.Client;
    if I = 0 then
    begin
      LText.TextSettings.Font.Size := AFirstLineFontSize;
      LText.TextSettings.FontColor := AFirstLineFontColor;
    end
    else
    begin
      LText.TextSettings.Font.Size := AGeneralLineFontSize;
      LText.TextSettings.FontColor := AGeneralLineFontColor;
    end;
    LText.TextSettings.HorzAlign := TTextAlign.Leading;
    LText.Text := ATipInfos[I];
  end;

end;

begin
  lytClient.BeginUpdate;
  try
    LTipLine := Length(ATipInfos);
    if LTipLine = 0 then
    begin
      Exit;
    end
    else if (LTipLine > 0) and (LTipLine <= 4) then
    begin
      ShowText;
    end
    else if (LTipLine > 4) and (LTipLine <= 8) then
    begin
      LTmpHeight := (LTipLine - 4) * 30;
      rctDialogBase.Height := rctDialogBase.Height + LTmpHeight;
      ShowText;
    end
    else if LTipLine > 8 then
    begin
      LTipLine := 8;
      LTmpHeight := (LTipLine - 4) * 30;
      rctDialogBase.Height := rctDialogBase.Height + LTmpHeight;
      ShowText;
    end;
  finally

  end;
  lytClient.EndUpdate;
end;

class procedure TfrmGeneralTimeoutDialog.ShowModaleDialog(const ATipInfos: TArray<string>;
    const ABackupImage: TBitmap; const ADialogColor: TalphaColor; const ADialogOpacity: Single;
    const ATimeoutCount: Integer; const ALogoImage: TBitmap;  const ATileText: string;
    const AOKText: string; const ACancelText: string;
    const AFirstLineFontColor: TAlphaColor; const AFirstLineFontSize: Integer;
    const AGeneralLineFontColor: TAlphaColor; const AGeneralLineFontSize: Integer;
    const ADefaultAction: TDefaultActionKind; AModaleResultProc: TModaleResultProc);
begin
  TThread.Synchronize(nil,
      procedure
      var
        LForm: TfrmGeneralTimeoutDialog;
      begin
        LForm := TfrmGeneralTimeoutDialog.Create(nil);
        try
          //LForm.txtTipInfo.Text := ATipInfo;
          LForm.SetTipsShowArea(ATipInfos, AFirstLineFontColor, AFirstLineFontSize,
          AGeneralLineFontColor, AGeneralLineFontSize);
          LForm.rctDialogBase.Fill.Color := ADialogColor;
          LForm.rctDialogBase.Opacity := ADialogOpacity;
          LForm.TimeoutCount := ATimeoutCount;
          if Assigned(ALogoImage) then
          LForm.imgLogo.Bitmap.Assign(ALogoImage)
          else
          LForm.imgLogo.Width := 0;
          if not ATileText.IsEmpty then
          LForm.txtTile.Text := ATileText;
          if not AOKText.IsEmpty then
          LForm.spbtnOK.Text := AOKText;
          if not ACancelText.IsEmpty then
          LForm.spbtnCancel.Text := ACancelText;
          LForm.DefaultActionKind := ADefaultAction;
          LForm.ModaleResultProc := AModaleResultProc;
          LForm.imgBackupground.Bitmap.Assign(ABackupImage);
          LForm.Show;
        except
          LForm.Free;
        end;
      end);
end;

procedure TfrmGeneralTimeoutDialog.imgCloseClick(Sender: TObject);
begin
  tmrClose.Enabled := False;
  FModaleResult := False;
  Close;
end;

procedure TfrmGeneralTimeoutDialog.spbtnCancelClick(Sender: TObject);
begin
  tmrClose.Enabled := False;
  FModaleResult := False;
  Close;
end;

procedure TfrmGeneralTimeoutDialog.spbtnOKClick(Sender: TObject);
begin
  tmrClose.Enabled := False;
  FModaleResult := True;
  Close;
end;

procedure TfrmGeneralTimeoutDialog.tmrCloseTimer(Sender: TObject);
begin
  Dec(FTimeOutCount);
  case FDefaultActionKind of
    dakOK: spbtnOK.Text := FDefaultActionStr + '(' + IntToStr(FTimeoutCount) + ')';
    dakCancel: spbtnCancel.Text := FDefaultActionStr + '(' + IntToStr(FTimeoutCount) + ')';
  end;
  if FTimeOutCount <= 0 then
  begin
    tmrClose.Enabled := False;
    case FDefaultActionKind of
      dakOK: spbtnOKClick(nil);
      dakCancel: spbtnCancelClick(nil);
    end;
  end;
end;

end.

调用：

procedure TfrmMain.spbtnSimpleClick(Sender: TObject);
var
  LBackImage: TBitMap;
  LTips: TArray<string>;
begin
  LTips := TArray<string>.Create('发现新版本...    V1.5.8', '1、优化细节和体验，更加稳定',
      '2、修复已知的BUG和卡顿', '3、增加好友文件传输功能');
//         '通用定时对话框5', '通用定时对话框6', '通用定时对话框7', '通用定时对话框8',
//      '通用定时对话框9', '通用定时对话框10');
  TThread.CreateAnonymousThread(
      procedure
      begin
        //要在同步线程里截图
        TThread.Synchronize(nil,
          procedure
          begin
          LBackImage := slytMain.MakeScreenshot;
          end);
        try
          TfrmGeneralTimeoutDialog.ShowModaleDialog(LTips, LBackImage, $FF6CB68D, 0.8, 15, nil, '博士平台',
          '立即更新', '以后再说', TAlphaColors.White, 20, $FF363636, 18, TDefaultActionKind.dakOK,
          procedure(const AResult: Boolean)
          begin
          TThread.Synchronize(nil,
          procedure
          begin
          if AResult then
          lbl1.Text := '通用确定'
          else
          lbl1.Text := '通用取消';
          spbtnSimple.Enabled := True;
          end);

          end);
          spbtnSimple.Enabled := False;
        finally
          LBackImage.Free;
        end;
      end).Start;
end;
----------------------------------------------
-

信息

登陆以后才能回复