Как сделать ProgressBar таким же, как на заставке Windows XP?
Форма должна иметь манифест
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;
...
const
PBS_MARQUEE = $08;
PBM_SETMARQUEE = WM_USER + 10;
...
implementation
...
procedure TForm1.Button1Click(Sender: TObject);
var
FSpeed: Integer;
begin
FSpeed := 10;
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; |