| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Progressbar

Homo Sapiens ©   (2006-07-30 18:42:00) 

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

---

programania   (2006-07-31 01:40:00) [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;

---

Gydvin   (2006-07-30 23:07:00) [2]

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

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

---

programania   (2006-07-30 22:34:00) [3]

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

---

Gydvin   (2006-07-30 21:15:00) [4]

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

---

Gydvin   (2006-07-30 21:14:00) [5]

Забыл (((

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;

---

Homo Sapiens   (2006-07-30 21:08:00) [6]

Пасибо

---

Gydvin   (2006-07-30 20:39:00) [7]

canvas.Draw(220, 220, rom);

Убрать

---

Gydvin   (2006-07-30 20:32:00) [8]

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

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.

---

Anatoly Podgoretsky   (2006-07-30 19:43:00) [9]

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

---

Homo Sapiens   (2006-07-30 19:33:00) [10]

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

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

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

---

Ivolg   (2006-07-30 19:32:00) [11]

Юзай RbСontrols...

---

Gydvin   (2006-07-30 19:02:00) [12]

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

---

Eraser   (2006-07-30 18:45:00) [13]

> красивый,

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

---

Наверх