VPF::Разработка компонентов на базе существующих

PsiMagistr

Дата 20.10.2010, 18:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 479
Регистрация: 31.12.2009

Репутация: 1
Всего: 1

Ребята, пытаюсь собрать новый класс (кнопка с прогрессбаром), доработав кнопку класса TBitBtn. Вот код класса.

Код


unit Unit2;


interface
 uses Classes,Buttons, Graphics,Dialogs, SysUtils;

 type

 TProgressBtn = class(TBitBtn)
 private
 fMaxValue:Integer;
 fValue:Integer;
 function GetMaxValue:integer;
 procedure SetMaxValue (MV:integer);
 function GetValue:integer;
 procedure SetValue (V:integer);
 public
 MyForeColor:TColor;
 property MaxValue:integer read GetMaxValue write SetMaxValue;
 property Value : integer read GetValue write SetValue;
 constructor Create(a:TComponent;W:integer;H:integer;L:Integer;T:Integer;c:TColor); overload;
 procedure DrawProgressBar(X1:integer;Y1:Integer;X2:integer;Y2:Integer; c:Tcolor);
 end;

implementation

constructor TprogressBtn.Create(a: TComponent; W:integer; H:integer;L:Integer;T:Integer; c:Tcolor);
begin
 inherited Create(a);
 MyForeColor:=clBlack;
 self.fMaxValue:=0;
 self.fValue:= 0;
 self.Width:=W;
 self.Height:=H;
 self.Left := L;
 self.Top := T;
 self.Glyph.Width := self.Width;
 self.Glyph.Height := self.Height;
 self.DrawProgressBar(10,Height-20,width-10,Height-10,c);
end;

procedure TProgressBtn.DrawProgressBar(X1: Integer; Y1: Integer; X2: Integer; Y2: Integer; c: TColor);
begin
self.Glyph.Canvas.Brush.Color := c;
self.Glyph.Canvas.Rectangle(X1,Y1,X2,Y2);
end;

function TProgressBtn.GetMaxValue;
begin
GetMaxValue:=fMaxValue;
end;

procedure TProgressBtn.SetMaxValue(MV: Integer);
begin
fMaxValue:=MV;
end;

 function TProgressBtn.GetValue;
begin
  GetValue:=fValue;
end;

procedure TProgressBtn.SetValue(V: Integer);
begin
if V < fMaxValue  then
FValue:= V
else
FValue:= FMaxValue;
self.DrawProgressBar(10,Height-20,width-10,Height-10,clMoneyGreen);
self.DrawProgressBar(10,Height-20,Round((width-20)*fValue/fMaxValue)+10,Height-10,MyForeColor);
end;

end.

Необходимо доработать свойства Width и Height, так, чтобы при обращении к ним вызывалась перерисовка прогрессбара. Маленькой кнопке - маленький прогрессбар, большой кнопке - побольше.

Как это грамотно сделать?

Пытался вмешаться в OnPaint и даже Resize. Не получилось..

Заранее спасибо всем.

--------------------

"Арфы нет? Возьмите бубен!

Ребята, будем жить!"

(с) "В бой идут одни старики"

---

"ИЕ" - один из самых сумасшедших браузеров в нашей галактике.

Frees

Дата 21.10.2010, 10:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54

примерно так

Код


TProgressBtn = class(TBitBtn)
...
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;

...

procedure TBitBtn.WMPaint(var Message: TWMPaint);
begin
  inherited;
  //рисуем свое
  DrawProgressBar;
end;

Добавлено через 1 минуту и 17 секунд
вместо

Цитата(PsiMagistr @ 20.10.2010, 21:02

)

Код

self.DrawProgressBar(10,Height-20,Round((width-20)*fValue/fMaxValue)+10,Height-10,MyForeColor);end;

просто
invalidate;

--------------------

Кольцов Виктор Владимирович

PsiMagistr

Дата 21.10.2010, 14:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 479
Регистрация: 31.12.2009

Репутация: 1
Всего: 1

Я пытался так сделать, но увы... Выходят странные глюки... У меня три таких кнопки так однавообще не отрисовывается, пока не проведешь по ней мышкой.

С этим событием что то не так...

Это сообщение отредактировал(а) PsiMagistr - 21.10.2010, 14:42

--------------------

Frees

Дата 21.10.2010, 14:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54

Цитата(PsiMagistr @ 21.10.2010, 17:34

)

С этим событием что то не так...

это не событие а виндовое сообщение, с ним все так, это ты не там рисуешь, рисовать надо на канве кнопки а не на self.Glyph.Canvas

Код


TProgressBtn = class(TBitBtn)
   private
   FCanvas: TCancas

    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;

...

constructor TprogressBtn.Create(a: TComponent; W:integer; H:integer;L:Integer;T:Integer; c:Tcolor);
var dc: HDC;
begin
 inherited Create(a);
....
  dc := GetDC(Handle);//на destroy освободить ReleaseDC()
  FCanvas := TCanvas.Create; //на destroy освободить
  FCanvas.Handle := dc;
end;

procedure TProgressBtn.WMPaint(var Message: TWMPaint);
begin
  inherited;
  //рисуем свое
  self.DrawProgressBar(10,Height-20,Round((width-20)*fValue/fMaxValue)+10,Height-10,MyForeColor);
end;

procedure TProgressBtn.DrawProgressBar(X1: Integer; Y1: Integer; X2: Integer; Y2: Integer; c: TColor);
begin
  FCanvas.Brush.Color := c;
  FCanvas.Rectangle(X1,Y1,X2,Y2);
end;

Это сообщение отредактировал(а) Frees - 21.10.2010, 14:55

--------------------

Кольцов Виктор Владимирович

PsiMagistr

Дата 21.10.2010, 16:08 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 479
Регистрация: 31.12.2009

Репутация: 1
Всего: 1

Ребята, спасибо, пробую, но выходит ошибка при загрузке формы:

Control has no ParentWindow.

По видимому здесь дело:

dc := GetDC(Handle);//Что здесь
FCanvas := TCanvas.Create;
FCanvas.Handle := dc;

ReleaseDC() Что сюда передавать?

Это сообщение отредактировал(а) PsiMagistr - 21.10.2010, 16:12

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »