Progressbar

← →
Homo Sapiens © (2006-07-30 18:42) [0]

Не подскажете-ли какой-нить компонент progressbar красивый,
жедательно градиентный как в том же райзе компонентс?

← →
Eraser © (2006-07-30 18:45) [1]

> красивый,

красота понятие относительное и индивидуальное, поэтому я бы посоветовал использовать стандартный компонент, который отображается в соответствии со стилем оформления windows.

← →
Gydvin © (2006-07-30 19:02) [2]

Самому сделать либо имитировать

← →
Ivolg © (2006-07-30 19:32) [3]

Юзай RbСontrols...

← →
Homo Sapiens © (2006-07-30 19:33) [4]

> красота понятие относительное и индивидуальное

Уже сказал: ГРАДИЕНТНЫЙ
> Самому сделать либо имитировать

Попросил же дать ссылочку...

← →
Anatoly Podgoretsky © (2006-07-30 19:43) [5]

И вся сила в красоту уйдет, а программирование побоку.

← →
Gydvin © (2006-07-30 20:32) [6]

Какая ссылка, элементарное программирование.
Вот древний вариант

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure progressbar1(max, value: integer); procedure Button1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } rom, progress, buffer: tbitmap; progresswidth, progressheight, progressleft, progresstop, progressvalue: integer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure tform1.progressbar1(max, value: integer); function RoundFloat(R: Extended; Decimals: Integer): Extended; var Factor: Extended; begin Factor := Int(Exp(Decimals * Ln(10))); Result := Round(Factor * R) / Factor; end; var a: real; b: integer; begin if max = 0 then exit; a := max / progresswidth; a := value / a; a := RoundFloat(a, 0); b := strtoint(floattostr(a)); bitblt(buffer.canvas.Handle, 0, 0, progresswidth, progressheight, rom.Canvas.Handle, 0, 0, SRCCOPY); bitblt(buffer.canvas.Handle, 0, 0, b, progressheight, progress.Canvas.Handle, 0, 0, SRCCOPY); bitblt(canvas.Handle, progressleft, progresstop, progresswidth, progressheight, buffer.Canvas.Handle, 0, 0, SRCCOPY); application.ProcessMessages; end; procedure TForm1.Button1Click(Sender: TObject); var x: integer; begin rom.Canvas.CopyRect(rect(0, 0, progresswidth, progressheight), canvas, rect(progressleft, progresstop, progresswidth + progressleft, progressheight + progresstop)); rom.PixelFormat := pf24bit; canvas.Draw(220, 220, rom); for x := 0 to 1000 do progressbar1(1000, x); for x := 1000 downto 0 do progressbar1(1000, x); end; procedure TForm1.FormShow(Sender: TObject); begin rom := tbitmap.Create; progress := tbitmap.Create; buffer := tbitmap.Create; progress.LoadFromFile("progress.bmp"); //Gruzim progressbar progress.PixelFormat := pf24bit; progresswidth := progress.Width; progressheight := progress.Height; progressleft := 50; progresstop := 40; rom.Width := progresswidth; rom.Height := progressheight; buffer.Width := progresswidth; buffer.Height := progressheight; form1.DoubleBuffered := true; end; procedure TForm1.FormDestroy(Sender: TObject); begin rom.Free; progress.Free; buffer.Free; end; end.

← →
Gydvin © (2006-07-30 20:39) [7]

canvas.Draw(220, 220, rom);

Убрать

← →
Homo Sapiens © (2006-07-30 21:08) [8]

Пасибо

← →
Gydvin © (2006-07-30 21:14) [9]

Забыл (((

procedure tform1.progressbar1(max, value: integer);
function RoundFloat(R: Extended; Decimals: Integer): Extended;
var
Factor: Extended;
begin
Factor := Int(Exp(Decimals * Ln(10)));
Result := Round(Factor * R) / Factor;
end;

var
a: real;
b: integer;
begin
if max = 0 then exit;
a := max / progresswidth;

a := value / a;
a := RoundFloat(a, 0);
b := strtoint(floattostr(a));
if progressvalue<>b then begin
bitblt(buffer.canvas.Handle, 0, 0, progresswidth, progressheight, rom.Canvas.Handle, 0, 0, SRCCOPY);
bitblt(buffer.canvas.Handle, 0, 0, b, progressheight, progress.Canvas.Handle, 0, 0, SRCCOPY);
bitblt(canvas.Handle, progressleft, progresstop, progresswidth, progressheight, buffer.Canvas.Handle, 0, 0, SRCCOPY);
progressvalue:=b;
application.ProcessMessages;
end;
end;

Так будет быстрее. Убираем лишнюю отрисовку

http://programania.com/poloska.zip 1кб

>Gydvin © (30.07.06 23:07) [12]
>Красиво, но медлено

В примере специально медленно, чтоб было лучше видно
а на самом деле достаточно 100 вызвать, это мгновенно
для этого можно добавить в начало процедуры:

if (abs(p-i.tag)<max div 100) and (p<max) then exit;
i.tag:=p;

Progressbar Найти похожие ветки