Содержание материала

Еще, как вариант, воспользоваться стандартной функцией GradientFill:

 

Code:

uses ..., Math;

{©Drkb v.3: www.drkb.ru}

 

procedure TForm1.Button1Click(Sender: TObject);

 

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;

 

type

  TRIVERTEX_NEW = packed record

    X,Y:Integer;

    R,G,B,Alpha: Word;

  end;

  TGradDirect = (gdVert, gdHorz);

 

const

FColorBegin = clRed; // Начальный цвет

FColorEnd = clBlue; // Конечный цвет

FGradDirect = gdHorz; // Направление заливки

 

var

_vertex: array [0..1] of TRIVERTEX_NEW;

_rect  : _GRADIENT_RECT;

_r     : TRect;

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,

              IfThen(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;

  

Автор Rouse_

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить