TProgressBar

ProgressBar в колонке TListView

2017-08-10T20:52:26+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

r: TRect;

pb: TProgressBar;

begin

Listview1.Columns.Add.Width := 100;

Listview1.Columns.Add.Width := 200;

Listview1.ViewStyle := vsReport;

Listview1.Items.Add.Caption := 'Text';

r := Listview1.Items[0].DisplayRect(drBounds);

r.Left := r.Left + Listview1.columns[0].Width;

r.Right := r.Left + Listview1.columns[1].Width;

pb := TProgressBar.Create(Self);

pb.Parent := Listview1;

pb.BoundsRect := r;

pb.Position := 30;

Listview1.Items[0].Data := pb;

end;

// Change the ProgressBar Position

// ProgressBar Position andern

procedure TForm1.Button2Click(Sender: TObject);

var

pb: TProgressBar;

begin

pb := TProgressBar(Listview1.Items[0].Data);

pb.StepIt;

end;

ProgressBar с невидимой рамкой

2017-08-10T20:51:07+07:00

Автор: VS

Заказчик моего проекта обратился с просьбой - "Сделать прогресс индикатор как в приложениях Нортона. Чтоб был в статус строке и НИКАКИХ рамок". ProgressBar в StatusBar - нет проблем, но как быть с рамкой от ProgressBar? ProgressBar всегда вычерчивает рамку и не имеет методов ее управления. Однако появилась интересная идея, воплотившаяся в компонент с новым свойством ShowFrame. Решение оказалось на удивление простым. На рисунке сравнение стандартного ProgressBar и ProgressBar с невидимой рамкой.

Подробнее...

ProgressBar, который не отображают реального прогресса

2017-08-10T20:48:36+07:00

Начиная с виньХР появились в системе забавные ProgressBar'ы, которые не отображают реального "прогресса", а лишь отображают, что что-нибудь работает... такой же появляется при загрузки виндыХР (бегает пару чёрточек слева вправо, а потом обратно возвращаются в начало). Такой же прогресс отображается если в ХР выбрать изображение, в меню нажать на Print (Печать), и вэтом диалоге при выборе шаблона печати - тоже такого стиля есть прогресс. (надеюсь, что теперь ясно что я имел в виду )

И сам вопрос: как такой сделать на делфи?

Подробнее...

TProgressBar при помощи фонового потока

2017-08-10T20:50:21+07:00

Code:

{

Question:

I am trying query to display records in a dbgrid.however, due to size

of tables and joins takes a while for the query to Execute.is

there any way to Show a prorgess bar with a timer that increments

position but continues to work while the query is being executed.BTW,

using access so BDE is not used.

Answer:

A progress bar would not be an ideal choice since you cannot determine up

front how long the query will take, so you do not know the range the progress

bar has to cover.A simple kind of animation that tells the user basically

only that the application is not hung would be more appropriate.One could do

such a thing in a secondary thread but it would have to be done using the

plain Windows API and * no * Synchronize calls (since the main thread is

blocked in the BDE call).Here is an example: unit anithread;

}

interface

uses

Classes, Windows, Controls, Graphics;

type

TAnimationThread = class(TThread)

private

{ Private declarations }

FWnd: HWND;

FPaintRect: TRect;

FbkColor, FfgColor: TColor;

FInterval: integer;

protected

procedure Execute; override;

public

constructor Create(paintsurface : TWinControl; {Control to paint on }

paintrect : TRect; {area for animation bar }

bkColor, barcolor : TColor; {colors to use }

interval : integer); {wait in msecs between

paints}

end;

implementation

constructor TAnimationThread.Create(paintsurface : TWinControl;

paintrect : TRect; bkColor, barcolor : TColor; interval : integer);

begin

inherited Create(True);

FWnd := paintsurface.Handle;

FPaintRect := paintrect;

FbkColor := bkColor;

FfgColor := barColor;

FInterval := interval;

FreeOnterminate := True;

Resume;

end; { TAnimationThread.Create }

procedure TAnimationThread.Execute;

var

image : TBitmap;

DC : HDC;

left, right : integer;

increment : integer;

imagerect : TRect;

state : (incRight, incLeft, decLeft, decRight);

begin

Image := TBitmap.Create;

try

with Image do

begin

Width := FPaintRect.Right - FPaintRect.Left;

Height := FPaintRect.Bottom - FPaintRect.Top;

imagerect := Rect(0, 0, Width, Height);

end; { with }

left := 0;

right := 0;

increment := imagerect.right div 50;

state := Low(State);

while not Terminated do

begin

with Image.Canvas do

begin

Brush.Color := FbkColor;

FillRect(imagerect);

case state of

incRight:

begin

Inc(right, increment);

if right > imagerect.right then

begin

right := imagerect.right;

Inc(state);

end; { if }

end; { Case incRight }

incLeft:

begin

Inc(left, increment);

if left >= right then

begin

left := right;

Inc(state);

end; { if }

end; { Case incLeft }

decLeft:

begin

Dec(left, increment);

if left <= 0 then

begin

left := 0;

Inc(state);

end; { if }

end; { Case decLeft }

decRight:

begin

Dec(right, increment);

if right <= 0 then

begin

right := 0;

state := incRight;

end; { if }

end; { Case decLeft }

end; { Case }

Brush.Color := FfgColor;

FillRect(Rect(left, imagerect.top, right, imagerect.bottom));

end; { with }

DC := GetDC(FWnd);

if DC <> 0 then

try

BitBlt(DC,

FPaintRect.Left,

FPaintRect.Top,

imagerect.right,

imagerect.bottom,

Image.Canvas.handle,

0, 0,

SRCCOPY);

finally

ReleaseDC(FWnd, DC);

end;

Sleep(FInterval);

end; { While }

finally

Image.Free;

end;

InvalidateRect(FWnd, nil, True);

end; { TAnimationThread.Execute }

end.

{Usage:

Place a TPanel on a form, size it as appropriate.Create an instance of the

TanimationThread call like this: procedure TForm1.Button1Click(Sender : TObject);

}

var

ani : TAnimationThread;

r : TRect;

begin

r := panel1.clientrect;

InflateRect(r, - panel1.bevelwidth, - panel1.bevelwidth);

ani := TanimationThread.Create(panel1, r, panel1.color, clBlue, 25);

Button1.Enabled := False;

Application.ProcessMessages;

Sleep(30000); // replace with query.Open or such

Button1.Enabled := True;

ani.Terminate;

ShowMessage('Done');

end;

Вставить ProgressBar в StatusBar

2017-08-10T20:51:42+07:00

Code:

procedure TForm1.FormCreate(Sender: TObject);

begin

with ProgressBar1 do

begin

Parent := StatusBar1;

Position := 100;

Top := 2;

Left := 0;

Height := StatusBar1.Height - Top;

Width := StatusBar1.Panels[0].Width - Left;

end;

Подробнее...

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

2017-08-10T20:47:43+07:00

Самый простой способ, это изменить цветовую схему в свойствах экрана...

А вот при помощи следующей команды можно разукрасить ProgressBar не изменяя системных настроек:

Подробнее...

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

2017-08-10T20:49:41+07:00

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

Code:

{

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.