Плавный переход одного цвета в другой

Советы » Цвета и Палитра » Плавный переход одного цвета в другой

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Плавный переход одного цвета в другой

Две процедуры, служащие для отображения прямоугольников с поавным переходом
цветов. Первая процедура рисует вертикальный переход, вторая - горизонтальный.

Параметры процедур:
Canvas - задаёт графический контекст объекта для рисования
Left, Top, Width, Height - границы закрашиваемого прямоугольника
NonGradientArea - ширина области, закрашиваемой цветом Color1 (cм. ниже).
При положительном значении этого параметра, область располагается сверху или
справа, при отрицательном - снизу или слева.
FrameColor - цвет рамки прямоугольника
Color1 - начальный цвет заливки
Color2 - конечный цвет заливки

Зависимости: Windows, SysUtils, Classes, Graphics
Автор:       Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright:   Dimka Maslov
Дата:        11 июня 2003 г.
***************************************************** }

function

GetColor(Color: Integer): Integer; register

; asm

cmp eax, 0 jge @@10 and

eax, 000000FFH push eax call GetSysColor @@10: end

; procedure

VDrawGradientRect(Canvas: TCanvas; Left, Top, Width, Height: Integer; NonGradientArea: Integer; FrameColor, Color1, Color2: TColor); var

Mid: Integer; Color: TColor; C1: array

[0..3] of

Byte absolute

Color1; C2: array

[0..3] of

Byte absolute

Color2; C: array

[0..3] of

Byte absolute

Color; i, j, X1, Y1, X2, Y2, Y0, L, X11, X21: Integer; begin

X1 := Left; Y1 := Top; X2 := Left + Width; Y2 := Top + Height; Color1 := GetColor(Color1); Color2 := GetColor(Color2); with

Canvas do

begin

if

NonGradientArea < 0 then

begin

Mid := Y2 + NonGradientArea; Y0 := Y1 + 1; L := Mid - Y0; X11 := X1 + 1; X21 := X2 - 1; for

i := Y1 + 1 to

Mid do

begin

for

j := 0 to

3 do

C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - Y0), L); Pen.Color := Color; MoveTo(X11, i); LineTo(X21, i); end

; Pen.Style := psClear; Brush.Color := Canvas.Pen.Color; Rectangle(X1 + 1, Mid, X2, Y2); end

else

begin

Mid := NonGradientArea; Pen.Style := psSolid; Y0 := Y2 - 2; L := Mid - Y0; X11 := X1 + 1; X21 := X2 - 1; for

i := Y2 - 2 downto

Mid do

begin

for

j := 0 to

3 do

C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - Y0), L); Pen.Color := Color; MoveTo(X11, i); LineTo(X21, i); end

; Pen.Style := psClear; Brush.Color := Canvas.Pen.Color; Rectangle(X1 + 1, Y1 + 1, X2, Mid + 1); end

; Pen.Color := FrameColor; Pen.Style := psSolid; MoveTo(X1, Y1); LineTo(X2 - 1, Y1); LineTo(X2 - 1, Y2 - 1); LineTo(X1, Y2 - 1); LineTo(X1, Y1); end

; end

; procedure

HDrawGradientRect(Canvas: TCanvas; Left, Top, Width, Height: Integer; NonGradientArea: Integer; FrameColor, Color1, Color2: TColor); var

Mid: Integer; Color: TColor; C1: array

[0..3] of

Byte absolute

Color1; C2: array

[0..3] of

Byte absolute

Color2; C: array

[0..3] of

Byte absolute

Color; i, j, X1, Y1, X2, Y2, X0, L, Y11, Y21: Integer; begin

X1 := Left; Y1 := Top; X2 := Left + Width; Y2 := Top + Height; Color1 := GetColor(Color1); Color2 := GetColor(Color2); with

Canvas do

begin

if

NonGradientArea < 0 then

begin

Mid := X2 + NonGradientArea; X0 := X1 + 1; L := Mid - X0; Y11 := Y1 + 1; Y21 := Y2 - 1; Pen.Style := psSolid; for

i := X0 to

Mid do

begin

for

j := 0 to

3 do

C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - X0), L); Pen.Color := Color; MoveTo(i, Y11); LineTo(i, Y21); end

; Pen.Style := psClear; Brush.Color := Canvas.Pen.Color; Rectangle(Mid, Y11, X2, Y2); end

else

begin

Mid := NonGradientArea; X0 := X2 - 2; L := Mid - X0; Y11 := Y1 + 1; Y21 := Y2 - 1; Pen.Style := psSolid; for

i := X0 downto

Mid do

begin

for

j := 0 to

3 do

C[j] := MulDiv(1, C2[j] * (Mid - i) + C1[j] * (i - X0), L); Pen.Color := Color; MoveTo(i, Y11); LineTo(i, Y21); end

; Pen.Style := psClear; Brush.Color := Canvas.Pen.Color; Rectangle(X1 + 1, Y1 + 1, Mid + 1, Y2); end

; Pen.Color := FrameColor; Pen.Style := psSolid; MoveTo(X1, Y1); LineTo(X2 - 1, Y1); LineTo(X2 - 1, Y2 - 1); LineTo(X1, Y2 - 1); LineTo(X1, Y1); end

; end

;

Пример использования:

procedure

TForm1.FormPaint(Sender: TObject); begin

VDrawGradientRect(Canvas, 0, 0, ClientWidth, ClientHeight, 0, clBtnFace, clHighlight); end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com