Club Delphi,
Revisen este código:
Código Delphi
[-]
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
public
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}
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;
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:
Espero sea útil
Nelson.