Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Графика и Игры , Цвета и Палитра



Автор: Dimka Maslov
WEB-сайт: http://delphibase.endimus.com

{ **** 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 для вертикальных и горизонтальных градиентов соответственно.

Разбивка кода:

  1. Функция GetColor: эта функция принимает целое число как входной параметр, которое считается индексом цвета, и возвращает соответствующее значение цвета. Она использует функцию Windows API GetSysColor для получения системного цвета с указанным индексом.
  2. Процедура VDrawGradientRect: эта процедура рисует вертикальный градиент прямоугольника с плавным переходом от одного цвета к другому. Параметры:
    • Canvas: объект канваса, на котором будет нарисован прямоугольник.
    • Left, Top, Width и Height: координаты прямоугольника.
    • NonGradientArea: ширина области без градиента сверху или снизу прямоугольника (отрицательное для верхней части, положительное для нижней).
    • FrameColor: цвет рамки вокруг прямоугольника.
    • Color1 и Color2: начальный и конечный цвета градиента. Процедура использует цикл для расчета промежуточных цветов между Color1 и Color2, а затем рисует линии с этими цветами, чтобы создать градиент. Она также рисует рамку вокруг прямоугольника.
  3. Процедура HDrawGradientRect: эта процедура похожа на VDrawGradientRect, но она рисует горизонтальный градиент прямоугольника вместо вертикального.
  4. Пример использования: код предоставляет пример использования процедур в событии FormPaint формы. Он вызывает VDrawGradientRect для рисования вертикального градиентного прямоугольника, который покрывает всю клиентскую область.

Обратите внимание, что этот код использует некоторые функции Delphi-специфические, такие как использование массивов с абсолютными адресами (C1, C2 и C) и функцию MulDiv для расчета промежуточных цветов. Он также предполагает, что входные цвета являются валидными индексами цветов.

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


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Цвета и Палитра ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-01-29 02:25:29/0.0035781860351562/0