Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Показать TProgressBar в стиле XP (2)

Delphi , Компоненты и Классы , TProgressBar

Показать TProgressBar в стиле XP (2)

Code:

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 http://forum.vingrad.ru

Перевод контента на русский язык:

Код, предоставленный ниже, написан на Delphi и демонстрирует создание контрола TProgressBar, который behaves как марquee-contrол, часто встречающийся в приложениях Windows XP стиля.

Расшифровка кода:

  1. Первая часть кода определяет используемые единицы и интерфейсы программы.
  2. Класс TForm1 определен, который содержит компоненты формы (Button1, ProgressBar1 и Button2).
  3. Процедура Button1Click вызывается при клике кнопки Button1. Она устанавливает стиль ProgressBar в PBS_ MARQUEE, что позволяет активировать поведение марquee.
  4. Функция SendMessage используется для установки свойств марquee. В этом случае она устанавливает скорость марquee в FSpeed (который равен 100 в этом примере).
  5. Процедура Button2Click вызывается при клике кнопки Button2. Она отправляет сообщение ProgressBar, чтобы отключить поведение марquee.

Вот улучшенная версия кода с комментариями и предложениями альтернативных решений:

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
  // Enable marquee behavior with a speed of 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
  // Disable marquee behavior
  SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
end;

end.

Альтернативное решение:

Вместо использования функции SetWindowLong для изменения стиля ProgressBar, вы можете использовать свойство ProgressBar1.Style. Это более дельфийский способ установки стиля и является проще для чтения и поддержки.

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Enable marquee behavior with a speed of 100
  ProgressBar1.Style := psMarquee;
  ProgressBar1.Position := 0;
  ProgressBar1.Max := 100;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // Disable marquee behavior
  ProgressBar1.Style := psNormal;
end;

В этом альтернативном решении мы устанавливаем свойство Style в psMarquee, чтобы активировать поведение марquee. Мы также устанавливаем свойства Position и Max, чтобы начать марquee с начала и установить его максимальное значение в 100. Для отключения поведения марquee мы просто устанавливаем свойство Style обратно в psNormal.

В статье описано как изменить внешний вид TProgressBar в стиле XP, используя функцию SetWindowLong и SendMessage для включения или выключения эффекта маришоу.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: TProgressBar ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-10-12 15:39:38/0.0039749145507812/0