Форум: "Потрепаться";
Текущий архив: 2004.03.05;
Скачать: [xml.tar.bz2];

Вниз

Разыскивается   Найти похожие ветки 

← →
Manulo   (2004-02-13 16:27) [0]

Особо нужный компонент.
Умеет: Делать градиент (плавный переход от одного цвета ц другому)
Особые приметы: В качестве начальных цветов -- любые

---

← →
Johnmen   (2004-02-13 16:30) [1]

Что раскрашиваешь ?

---

← →
Альф   (2004-02-13 16:33) [2]

GlobusLib

---

← →
Manulo   (2004-02-13 16:36) [3]

> Johnmen © (13.02.04 16:30) [1]

Форму

> Альф © (13.02.04 16:33) [2]

А какой там компонент? Может, просто не досмотрел

---

← →
pasha_golub   (2004-02-13 16:41) [4]

Ну, а что сложно?

R1,G1,B1,R2,G2,B2,Steps:integer;

R(i) := R1 + Trunc((R2-R1)/Steps), r2>r1, 1<i<steps
...

---

← →
Manulo   (2004-02-13 17:00) [5]

> pasha_golub © (13.02.04 16:41) [4]

С точки зрения алгорится -- нет. Просто не очень разбираюсь в перекрытии стандартных методов

---

← →
Dimka Maslov   (2004-02-13 18:15) [6]

http://delphibase.endimus.com/?action=viewfunc&topic=mediaimg&id=10438

---

← →
Семен Сорокин   (2004-02-13 18:18) [7]

unit GradPnl;

interface

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

type
TGradDirect = (gdVert, gdHorz);

type
TGradPanel = class(TPanel)
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", [TGradPanel]);
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;

{ ----------------------------- TGradPanel ---------------------------------- }

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

procedure TGradPanel.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;
_r : TRect;
begin
inherited Paint;
if FUseGradient then begin
FillChar(_vertex, SizeOf(TRIVERTEX_NEW)*2, 0);
_r := GetClientRect;
AdjustClientRect(_r);
_vertex[0].x := _r.Left;
_vertex[0].y := _r.Top;
_vertex[0].R := GetWRValue(FColorBegin);
_vertex[0].G := GetWGValue(FColorBegin);
_vertex[0].B := GetWBValue(FColorBegin);
_vertex[1].x := _r.Right;
_vertex[1].y := _r.Bottom;
_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.Color := Font.Color;
Canvas.Font.Assign(Font);
Canvas.TextOut(Round(Width/2 - Canvas.TextWidth(Text)/2),
Round(Height/2 - Canvas.TextHeight(Text)/2), Text)
end
end;

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

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

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

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

end.

---

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

Форум: "Потрепаться";
Текущий архив: 2004.03.05;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.007 c