Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как сделать TProgressBar таким же, как на заставке Windows XP

01.01.2007
unit Unit1;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 
Dialogs, XPMan, ComCtrls, StdCtrls;
 
type
  TForm1
= class(TForm)
    Button1
: TButton;
    ProgressBar1
: TProgressBar;
    Button2
: TButton;
    procedure Button1Click
(Sender: TObject);
    procedure Button2Click
(Sender: TObject);
 
private
   
{ Private declarations }
 
public
   
{ Public declarations }
 
end;
 
var
  Form1
: TForm1;
 
const
  PBS_MARQUEE
= $08;
  PBM_SETMARQUEE
= WM_USER + 10;
 
implementation
 
{$R *.dfm}
 
procedure TForm1
.Button1Click(Sender: TObject);
var
 
FSpeed: Integer;
begin
 
FSpeed := 100;
 
SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
   
GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
 
{ Включить }
 
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, FSpeed);
end;
 
procedure TForm1
.Button2Click(Sender: TObject);
begin
 
{ Выключить }
 
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
end;
 
end.

Автор: Rrader

Взято с Vingrad.ru https://forum.vingrad.ru

 


{ 
 
Use this ProgressBar when you do not know the amount of progress toward
  completion but wish to indicate that progress
is being made.
 
 
This ProgressBar works only on Windows XP and the ComCtl32.dll version
 
6.00 or later is needed. To use the new ComCtrl you have to provide the manifest.
 
In Delphi 7 just drop TXPManifest on the form. For prior versions of Delphi
  you have to include the XP manifest resource
.
}
 
 
 unit
MarqueeProgressBar;
 
 
interface
 
 uses
   
SysUtils, Windows, Classes, Controls, ComCtrls, Messages;
 
 type
   
TMarqueeProgressBar = class(TProgressBar)
   
private
     
FActive: Boolean;
     
FAnimationSpeed: Integer;
     procedure
SetActive(const Value: Boolean);
     procedure
SetAnimationSpeed(const Value: Integer);
     procedure
UpdateProgressBar;
   
protected
     procedure
CreateParams(var Params: TCreateParams); override;
   
public
     
constructor Create(AOwner: TComponent); override;
   published
     property
Active: Boolean read FActive write SetActive;
     property
AnimationSpeed: Integer read FAnimationSpeed write SetAnimationSpeed;
   
end;
 
 
const
   PBS_MARQUEE  
= $08;
   PBM_SETMARQUEE
= WM_USER + 10;
 
 procedure
Register;
 
 implementation
 
 procedure
Register;
 
begin
   
RegisterComponents('SwissDelphiCenter', [TMarqueeProgressBar]);
 
end;
 
 
constructor TMarqueeProgressBar.Create(AOwner: TComponent);
 
begin
   inherited
;
   
FAnimationSpeed := 60;
 
end;
 
 procedure
TMarqueeProgressBar.CreateParams(var Params: TCreateParams);
 
begin
   inherited
;
   
Params.Style := Params.Style or PBS_MARQUEE;
 
end;
 
 procedure
TMarqueeProgressBar.SetActive(const Value: Boolean);
 
begin
   
FActive := Value;
   
UpdateProgressBar;
 
end;
 
 procedure
TMarqueeProgressBar.SetAnimationSpeed(const Value: Integer);
 
begin
   
FAnimationSpeed := Value;
   
UpdateProgressBar;
 
end;
 
 procedure
TMarqueeProgressBar.UpdateProgressBar;
 
begin
   
if FActive then
     
SendMessage(Self.Handle, PBM_SETMARQUEE, 1, FAnimationSpeed)
   
else
     
SendMessage(Self.Handle, PBM_SETMARQUEE, 0, 0);
 
end;
 
 
end.

Взято с сайта: https://www.swissdelphicenter.ch