Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 225

•  TDictionary Custom Sort  6 270

•  Fast Watermark Sources  6 067

•  3D Designer  8 973

•  Sik Screen Capture  6 391

•  Patch Maker  6 818

•  Айболит (remote control)  6 797

•  ListBox Drag & Drop  5 670

•  Доска для игры Реверси  96 369

•  Графические эффекты  7 010

•  Рисование по маске  6 298

•  Перетаскивание изображений  5 184

•  Canvas Drawing  5 552

•  Рисование Луны  5 257

•  Поворот изображения  4 802

•  Рисование стержней  3 402

•  Paint on Shape  2 657

•  Генератор кроссвордов  3 543

•  Головоломка Paletto  2 831

•  Теорема Монжа об окружностях  3 642

•  Пазл Numbrix  2 381

•  Заборы и коммивояжеры  3 065

•  Игра HIP  2 021

•  Игра Go (Го)  1 945

•  Симулятор лифта  2 305

•  Программа укладки плитки  2 008

•  Генератор лабиринта  2 464

•  Проверка числового ввода  2 146

•  HEX View  2 480

•  Физический маятник  2 095

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Смешивание цветов рисунка с другим цветом



Автор: Fenik

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Смешивание цветов рисунка с другим цветом

Зависимости: Graphics
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Автор Федоровских Николай
Дата:        5 июня 2002 г.
***************************************************** }

procedure Mixer(Bitmap: TBitmap; Value: Byte; Color: TColor);
  function BLimit(B: Integer): Byte;
  begin
    if B < 0 then
      Result := 0
    else if B > 255 then
      Result := 255
    else
      Result := B;
  end;
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
var
  x, y: Word;
  Dest: pRGB;
  DR, DG, DB, D: Double;
begin
  D := Value / 200;
  DR := Lo(Color) * (1.275 - D);
  DG := Lo(Color shr 8) * (1.275 - D);
  DB := Lo((Color shr 8) shr 8) * (1.275 - D);
  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with Dest^ do
      begin
        B := BLimit(Round(B * D + DB));
        G := BLimit(Round(G * D + DG));
        R := BLimit(Round(R * D + DR));
      end;
      Inc(Dest);
    end;
  end;

  { Неоптимизированный вариант.

    Value - процент цвета рисунка от конечного цвета,
    (255-Value) - процент цвета Color от конечного цвета,
    где 255 - это 100%;
    Новый цвет получается путём нахождения
    среднеарифметического значения каждого компонента
    цвета в точке (x, y) и цвета Color
    после процентного преобразования.

    DR := Lo(Color);//извлечение красного
    DG := Lo(Color shr 8);//извлечение зелёного
    DB := Lo((Color shr 8) shr 8);//извлечение синего
    for y := 0 to Bitmap.Height - 1 do begin
      Dest := Bitmap.ScanLine[y];
      for x := 0 to Bitmap.Width - 1 do begin
        with Dest^ do begin
          R := BLimit(Round((R/100 * Value + DR/100 * (255-Value)) / 2));
          G := BLimit(Round((G/100 * Value + DG/100 * (255-Value)) / 2));
          B := BLimit(Round((B/100 * Value + DB/100 * (255-Value)) / 2));
        end;
        Inc(Dest);
      end;
    end; }
end;

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

Mixer(FBitmap, 120, clRed); 




Похожие по теме исходники

Couleur (цветовая палитра)




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте