Плавный переход одного цвета в другойDelphi , Графика и Игры , Цвета и Палитра
Автор: Dimka Maslov { **** 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; Перевод кода на русский язык: Это код Delphi, который рисует прямоугольник с градиентом с плавным переходом от одного цвета к другому. Код включает в себя два процедура: VDrawGradientRect и HDrawGradientRect для вертикальных и горизонтальных градиентов соответственно. Разбивка кода:
Обратите внимание, что этот код использует некоторые функции Delphi-специфические, такие как использование массивов с абсолютными адресами ( Плавный переход одного цвета в другой - процедуры рисования прямоугольников с плавным переходом цветов. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Цвета и Палитра ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |