Delphi XE2 + SplashScreen
23/11/2011
0
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:
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
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
Abraão Monteiro
Curtir tópico
+ 0
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:
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
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
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
Clique aqui para fazer login e interagir na Comunidade :)
