FAQ VCL
Компоненты\ProgressBar

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как изменить стандартный цвет ProgressBar?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   PostMessage( ProgressBar1.Handle, $0409, 0, clGreen );
end;

// Способ второй
uses
  {...,} CommCtrl;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Progressbar1.Brush.Color := clTeal;
   SendMessage( ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clYellow );
end;


Как убрать рамку у ProgressBar?

procedure TForm1.FormCreate(Sender: TObject);
begin
   SetWindowRgn( ProgressBar1.Handle,
                 CreateRectRgn( 1, 1, ProgressBar1.Width-1,
                 ProgressBar1.Height-1 ), true );
end;


Как узнать значение ProgressBar в месте, по которому щелкнули мышью?

// Для горизонтального
procedure TForm1.ProgressBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  val: Int64;
begin
   val := Round( X * ( ProgressBar1.Max - ProgressBar1.Min) / ProgressBar1.Width ) + ProgressBar1.Min;
end;

// Для вертикального
procedure TForm1.ProgressBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  val: Int64;
begin
   val := ProgressBar1.Max - Round( Y * ( ProgressBar1.Max - ProgressBar1.Min ) / ProgressBar1.Height );
end;


Как сделать 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;


Как изменить позицию ProgressBar по щелчку мыши на нем?

// Для горизонтального
procedure TForm1.ProgressBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   ProgressBar1.Position :=
      Round( X * ( ProgressBar1.Max - ProgressBar1.Min ) / ProgressBar1.Width ) + ProgressBar1.Min;
end;

// Для вертикального
procedure TForm1.ProgressBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   ProgressBar1.Position :=
      ProgressBar1.Max - Round( Y * ( ProgressBar1.Max - ProgressBar1.Min ) / ProgressBar1.Height );
end;

При использовании материала - ссылка на сайт обязательна