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

•  DeLiKaTeS Tetris (Тетрис)  222

•  TDictionary Custom Sort  3 381

•  Fast Watermark Sources  3 136

•  3D Designer  4 893

•  Sik Screen Capture  3 389

•  Patch Maker  3 592

•  Айболит (remote control)  3 798

•  ListBox Drag & Drop  3 059

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

•  Графические эффекты  3 992

•  Рисование по маске  3 293

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

•  Canvas Drawing  2 803

•  Рисование Луны  2 622

•  Поворот изображения  2 232

•  Рисование стержней  2 182

•  Paint on Shape  1 583

•  Генератор кроссвордов  2 260

•  Головоломка Paletto  1 783

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

•  Пазл Numbrix  1 696

•  Заборы и коммивояжеры  2 073

•  Игра HIP  1 293

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

•  Симулятор лифта  1 489

•  Программа укладки плитки  1 233

•  Генератор лабиринта  1 561

•  Проверка числового ввода  1 381

•  HEX View  1 509

•  Физический маятник  1 369

 
скрыть


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-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

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