Текущий архив: 2006.08.20;
Скачать: CL | DM;

Вниз

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;

---

← →
Gydvin ©   (2006-07-30 21:15) [10]

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

---

← →
programania ©   (2006-07-30 22:34) [11]

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

---

← →
Gydvin ©   (2006-07-30 23:07) [12]

> programania ©   (30.07.06 22:34) [11]

Красиво, но медлено

---

← →
programania ©   (2006-07-31 01:40) [13]

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

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

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

---

Страницы: 1 вся ветка

Текущий архив: 2006.08.20;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.178 c