Barra de Progreso Infinita en Windows con Delphi 7

[[nlsgarcia]]

Club Delphi,

Revisen este código:

Código Delphi [-]
// Barra de Progreso Infinita en Delphi 7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellAPI, XPMan, StdCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function EnableTheming(fEnable : Boolean) : HResult; stdcall; external 'UxTheme.dll'

const
  PBS_MARQUEE = $08;
  PBS_SMOOTH = $01;
  PBM_SETMARQUEE = WM_USER + 10;

var
  Form1: TForm1;
  D7Theme: TXPManifest;
  CS: Cardinal;

implementation

{$R *.dfm}

// Enable ProgressBar Infinity
procedure TForm1.Button1Click(Sender: TObject);
begin
   CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
   CS := CS or PBS_MARQUEE;
   SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(True), 0);
end;

// Disable ProgressBar Infinity
procedure TForm1.Button2Click(Sender: TObject);
begin
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(False), 0);
   CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
   CS := CS or PBS_SMOOTH;
   SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
   SendMessage(ProgressBar1.Handle, PBS_SMOOTH, Integer(False), 0);
end;

initialization
  D7Theme := TXPManifest.Create(nil);

finalization
  D7Theme.Free;

end.

El código anterior permite implementar una barra de progreso infinita por medio de Visuals Themes, el código fue hecho en Delphi 7 bajo Windows 7 Professional x32 y probado en Windows XP Professional x32, Windows Vista Home Premium x32, Windows 7 Profesional x32 y x64 y Windows 8.1 Professional x32 funcionando correctamente en todos los casos, como se muestra en la siguiente imagen:



El ejemplo esta disponible en : http://terawiki.clubdelphi.com/Delph...r+Infinity.rar

Referencia:

About Progress Bar Controls : http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

Espero sea útil

Nelson.

[Casimiro Notevi]

[radenf]

Muchas gracias [nlsgarcia]
Funciona perfecto en W7 x64 compilada con D2007.
Saludos y muchas felicidades

[[ElKurgan]]

gracias por el aporte, amigo

[FideRosado]

a mi me da un error en windows xp.. miren a ver si me ayudan a resolverlo..

http://www.clubdelphi.com/foros/atta...1&d=1389575751

[[nlsgarcia]]

FideRosado,

Empezado por FideRosado

...me da un error en Windows XP...

Te comento:

1- La Barra de Progreso Infinita funciona correctamente en Windows XP Professional x32.

2- El error que se presenta en Windows XP no esta asociado al estilo PBS_MARQUEE que permite implementar la Barra de Progreso Infinita, si no en el estilo PBS_SMOOTH el cual no es soportado en XP Themes.

Revisa este código:

Código Delphi [-]
// Disable ProgressBar Infinito
procedure TForm1.Button2Click(Sender: TObject);
begin
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(False), 0);
   if SysUtils.Win32MajorVersion >= 6 then // Verifica la versión de Windows
   begin
      CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
      CS := CS or PBS_SMOOTH;
      SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
      SendMessage(ProgressBar1.Handle, PBS_SMOOTH, Integer(False), 0);
   end;
end;

El código anterior permite detener la ejecución de la Barra de Progreso Infinita y no aplica el estilo PBS_SMOOTH si la versión de Windows es inferior a Windows Vista.

Espero sea útil

Nelson.