Delphi XE2 + SplashScreen

23/11/2011

6

Boa noite, estou tentando fazer um aplicativo em Delphi utilizando o framework Fireworks. Eu gostaria que a janela de splash aparecesse, em seguida uma barra de progresso começasse a ser executada e quando chegasse a 100% abrisse o aplicativo sozinho. Tenho este source:

unit SplashScreen;

interface

uses
  Windows, Messages,
  Principal,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Effects,
  FMX.Layouts, FMX.Memo, FMX.Grid, FMX.Ani;

type
  TFmSplashScreen = class(TForm)
    StyleBook1: TStyleBook;
    RoundRect1: TRoundRect;
    ShadowEffect1: TShadowEffect;
    Image1: TImage;
    BitmapAnimation1: TBitmapAnimation;
    Label1: TLabel;
    ShadowEffect2: TShadowEffect;
    Label2: TLabel;
    ShadowEffect3: TShadowEffect;
    ProgressBar1: TProgressBar;
    ShadowEffect5: TShadowEffect;
    progresso: TLabel;
    ShadowEffect4: TShadowEffect;
    procedure iniciarBarraProgresso;
    procedure FormCreate(Sender: TObject);
  private
    bFirstInit: Boolean;
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  FmSplashScreen: TFmSplashScreen;

implementation

{$R *.fmx}

procedure TFmSplashScreen.FormCreate(Sender: TObject);
begin
  bFirstInit := True;
  Application.OnIdle := IdleHandler;
end;

procedure TFmSplashScreen.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  if bFirstInit then begin
    bFirstInit := False;
    iniciarBarraProgresso;
    FmSplashScreen.Visible := False;
    try
      TFmPrincipal.Create(Self);
    except on E: Exception do
      ShowMessage((*) ERRO:  + E.Message);
    end;
  end;
end;

procedure TFmSplashScreen.iniciarBarraProgresso;
var
  i : Integer;
begin
  ProgressBar1.Value := 0;
  for i := 1 to 41 do begin
    if (i Mod 10)=0 then begin
      ProgressBar1.Value := ProgressBar1.Value + i;
      Application.ProcessMessages;
      Sleep(500);
    end;
  end;
end;

end.


Neste caso a barra de progresso só incrementa se eu mexer o mouse. Alguém têm alguma idéia de como fazer esta implementação? Desde já agradeço! Abraão
Responder

Posts

28/03/2020

Mário Reis

Boa noite, estou tentando fazer um aplicativo em Delphi utilizando o framework Fireworks. Eu gostaria que a janela de splash aparecesse, em seguida uma barra de progresso começasse a ser executada e quando chegasse a 100% abrisse o aplicativo sozinho. Tenho este source:

unit SplashScreen;

interface

uses
  Windows, Messages,
  Principal,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Effects,
  FMX.Layouts, FMX.Memo, FMX.Grid, FMX.Ani;

type
  TFmSplashScreen = class(TForm)
    StyleBook1: TStyleBook;
    RoundRect1: TRoundRect;
    ShadowEffect1: TShadowEffect;
    Image1: TImage;
    BitmapAnimation1: TBitmapAnimation;
    Label1: TLabel;
    ShadowEffect2: TShadowEffect;
    Label2: TLabel;
    ShadowEffect3: TShadowEffect;
    ProgressBar1: TProgressBar;
    ShadowEffect5: TShadowEffect;
    progresso: TLabel;
    ShadowEffect4: TShadowEffect;
    procedure iniciarBarraProgresso;
    procedure FormCreate(Sender: TObject);
  private
    bFirstInit: Boolean;
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  FmSplashScreen: TFmSplashScreen;

implementation

{$R *.fmx}

procedure TFmSplashScreen.FormCreate(Sender: TObject);
begin
  bFirstInit := True;
  Application.OnIdle := IdleHandler;
end;

procedure TFmSplashScreen.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  if bFirstInit then begin
    bFirstInit := False;
    iniciarBarraProgresso;
    FmSplashScreen.Visible := False;
    try
      TFmPrincipal.Create(Self);
    except on E: Exception do
      ShowMessage((*) ERRO:  + E.Message);
    end;
  end;
end;

procedure TFmSplashScreen.iniciarBarraProgresso;
var
  i : Integer;
begin
  ProgressBar1.Value := 0;
  for i := 1 to 41 do begin
    if (i Mod 10)=0 then begin
      ProgressBar1.Value := ProgressBar1.Value + i;
      Application.ProcessMessages;
      Sleep(500);
    end;
  end;
end;

end.


Neste caso a barra de progresso só incrementa se eu mexer o mouse. Alguém têm alguma idéia de como fazer esta implementação? Desde já agradeço! Abraão
Responder

28/03/2020

Mário Reis

Sobre este assunto IdleHandler(Sender: TObject; var Done: Boolean) como não uso nenhuma Frame Work não sei se vou poder ajudar, lamento.
No entanto podemos tentar, desde logo o parãmetro Done está sempre a TRUE!? Não percebi afinal
procedure TFrmCxa.IdleHandler(Sender: TObject; var Done: Boolean);
begin
//se Done then Entra Se Falso ÑEntra mais
if bFirstInit then // Aqui a ideia era usar o Done=False; e fazer com que rotina não voltar aqui mais em vez da minha variavel
begin
try
// E, não entra mais aqui
bFirstInit:=False ; // Done:=False mas ai ele volta de novo com True!? não entendi mto bem para que o Done
if FrmCxa<>Nil then
FrmCxa.edt5Click(Sender);


except

// Done:=False;
on E : Exception do
ShowMessage(E.ClassName+' Ocorreu um Erro: : '+E.Message);

end;
end;

end;

Se compreendeu a minha questão talvez possamos explorara outra abordagem? Obrigado
Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários. Para saber mais sobre o uso de cookies,
consulte nossa política de privacidade. Ao continuar navegando em nosso site, você concorda com a nossa política.

Aceitar