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

Вниз

Закрасить фигуру TShape бело-синим, плавным перетоком   Найти похожие ветки 

← →
Layner ©   (2004-04-01 11:28) [0]

От белого к синиму, как в стандартных Win окнах, вверху, подскажите плз. Заранее спасибо.

---

← →
Семен Сорокин ©   (2004-04-01 11:41) [1]

может пригодится.
unit GradShp;

interface

uses
 Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
 TGradDirect = (gdVert, gdHorz);

type
 TGradShape = class(TShape)
 private
   FColorBegin : TColor;
   FColorEnd   : TColor;
   FData       : pointer;
   FGradDirect : TGradDirect;
   FUseGradient: boolean;
   procedure SetColorBegin(const Value: TColor);
   procedure SetColorEnd(const Value: TColor);
   procedure SetGradDirect(const Value: TGradDirect);
   procedure SetUseGradient(const Value: boolean);
 protected
   procedure Paint; override;
 public
   constructor Create(AOwner: TComponent); override;
   property Data: pointer read FData write FData;
 published
   property ColorBegin: TColor read FColorBegin write SetColorBegin;
   property ColorEnd: TColor read FColorEnd write SetColorEnd;
   property GradDirect: TGradDirect read FGradDirect write SetGradDirect;
   property UseGradient: boolean read FUseGradient write SetUseGradient;
 end;

procedure Register;

implementation

uses
 Forms, Types;

procedure Register;
begin
 RegisterComponents("Samples", [TGradShape]);
end;

function iif(Cond: boolean; Value1, Value2: integer): integer;
begin
if Cond then
 Result := Value1
else
 Result := Value2
end;

function GetWRValue(Color: TColor): word;
begin
Result := Round(GetRValue(Color)/255*65535)
end;

function GetWGValue(Color: TColor): word;
begin
Result := Round(GetGValue(Color)/255*65535)
end;

function GetWBValue(Color: TColor): word;
begin
Result := Round(GetBValue(Color)/255*65535)
end;

{ ------------------------------ TGradShape --------------------------- }

constructor TGradShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FColorBegin := clBlack;
FColorEnd   := clWhite;
FGradDirect := gdVert;
FUseGradient:= true
end;

procedure TGradShape.Paint;
type
TRIVERTEX_NEW = packed record
  X,Y:Integer;
  R,G,B,Alpha: Word;
end;
var
 _vertex: array [0..1] of TRIVERTEX_NEW;
 _rect  : _GRADIENT_RECT;
begin
inherited Paint;
if FUseGradient then begin
 FillChar(_vertex, SizeOf(TRIVERTEX_NEW)*2, 0);
 _vertex[0].x    := 0;
 _vertex[0].y    := 0;
 _vertex[0].R    := GetWRValue(FColorBegin);
 _vertex[0].G    := GetWGValue(FColorBegin);
 _vertex[0].B    := GetWBValue(FColorBegin);
 _vertex[1].x    := Width;
 _vertex[1].y    := Height;
 _vertex[1].R    := GetWRValue(FColorEnd);
 _vertex[1].G    := GetWGValue(FColorEnd);
 _vertex[1].B    := GetWBValue(FColorEnd);
 _rect.UpperLeft := 0;
 _rect.LowerRight:= 1;
 GradientFill(Canvas.Handle, PTriVertex(@_vertex)^, 2, @_rect, 1,
              iif(FGradDirect = gdVert, GRADIENT_FILL_RECT_V, GRADIENT_FILL_RECT_H));
 Canvas.Brush.Style := bsClear;
 Canvas.Pen.Assign(Pen);
 Canvas.Rectangle(GetClientRect)
end
end;

procedure TGradShape.SetColorBegin(const Value: TColor);
begin
if FColorBegin <> Value then begin
 FColorBegin := Value;
 Invalidate
end
end;

procedure TGradShape.SetColorEnd(const Value: TColor);
begin
if FColorEnd <> Value then begin
 FColorEnd := Value;
 Invalidate
end
end;

procedure TGradShape.SetGradDirect(const Value: TGradDirect);
begin
if FGradDirect <> Value then begin
 FGradDirect := Value;
 Invalidate
end
end;

procedure TGradShape.SetUseGradient(const Value: boolean);
begin
if FUseGradient <> Value then begin
 FUseGradient := Value;
 Invalidate
end
end;

end.

---

← →
[lamer]Barmaglot ©   (2004-04-01 11:46) [2]

В виндовс есть встроенная функция GradientFill, используй её. Не придется писать такой большой код.

---

← →
Семен Сорокин ©   (2004-04-01 11:47) [3]

[lamer]Barmaglot ©   (01.04.04 11:46) [2]
именно эта ф-я и используется (см. метод Paint), а код большой из-за компонента, просто я привел весь код.

---

← →
[lamer]Barmaglot ©   (2004-04-01 11:50) [4]

Тогда наверное ты знаешь также и то, что её не рекомендуют использовать, поскольку она дает утечку ресурсов...(это не первоапрельская шутка-источкин Юнг, книга помоему называется "программирование графики в Виндовс")

---

← →
Семен Сорокин ©   (2004-04-01 11:56) [5]

[lamer]Barmaglot ©   (01.04.04 11:50) [4]
Тогда наверное ты знаешь также и то, что её не рекомендуют использовать, поскольку она дает утечку ресурсов...(это не первоапрельская шутка-источкин Юнг, книга помоему называется "программирование графики в Виндовс")
Хм.. этого я не знал, сенкс, а можно ссылочку в инете? если есть. Потому как довольно обширно использую.
Были грабли с неправильнфм обявлением _TRIVERTEX, именно поэтому идет его переопределение, хм, надо почитать.

---

← →
[lamer]Barmaglot ©   (2004-04-01 12:02) [6]

Боюсь ссылку не дам, поскольку книга дома в бумажном варианте, Автор Фень Юань(блин с автором напутал). Внешний вид книги нашел: http://www.piter.com/book_about.phtml?id=978531800297
Посмотреть дома номер страницы могу. Если найдешь эту книгу в электронном варианте, тогда может поможет...

---

← →
Семен Сорокин ©   (2004-04-01 12:20) [7]

Спасибо, вроде нашел описание, буду смотреть.

---

← →
MBo ©   (2004-04-01 12:29) [8]

>Семен Сорокин
Писалось об утечке при использовании этой функции в Win98. В 2K, XP все нормально

---

← →
Layner ©   (2004-04-01 13:08) [9]

Семен Сорокин ©   (01.04.04 11:41)
Спасибо! Компонент классный, установил, полностью то что надо.

---

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

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

Наверх

Память: 0.49 MB
Время: 0.026 c