Javascript Disabled Detected

You currently have javascript disabled. Several functions may not work. Please re-enable javascript to access full functionality.

Barra de progreso infinita

Started by escafandra , Nov 07 2016 09:43 AM

Please log in to reply

1 reply to this topic

#1 escafandra

Advanced Member

Administrador
4107 posts

LocationMadrid - España

Posted 07 November 2016 - 09:43 AM

Tras la respuesta que di a JoAnCa aquí y para que quede ordenado en el foro como un truco más, publico el código de una barra de progreso infinita para tareas críticas en las que no conocemos ni podemos aventurar el tiempo que tardará una tarea:

delphi

unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls;
 
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Strat: TButton;
Stop: TButton;
procedure FormCreate(Sender: TObject);
procedure StratClick(Sender: TObject);
procedure StopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
const PBM_SETMARQUEE = WM_USER + 10;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(ProgressBar1.Handle, GWL_STYLE, GetWindowLong(ProgressBar1.Handle, GWL_STYLE) or PBM_SETMARQUEE);
end;
 
procedure TForm1.StratClick(Sender: TObject);
begin
SendMessage (ProgressBar1.Handle, PBM_SETMARQUEE, 1, 20); // Activa 100ms
end;
 
procedure TForm1.StopClick(Sender: TObject);
begin
SendMessage (ProgressBar1.Handle, PBM_SETMARQUEE, 0, 20); // Desactiva
end;
 
end.