Developing.ru

Код: Выделить всё

Автор: Den Bedard 

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

Итак, немного теории: 
Каждый из трёх основных цветов (Красный,Зелёный,Синий) могут иметь значение от 0 до 255, соответственно скомбинировав их мы можем получить 16,777,216 возможных цветов. Визуально это можно предствить как три оси куба, в котором направления x, y и z отвечают за цвета красный, зелёный и синий. В сочетании эти направления дают точку в кубе, представляющую один цвет из 16 миллионов. Точка куба, в которой значение равняется 0 (0,0,0) соответствует чёрному цвету, значение (255,255,255) - белому цвету, (255,0,0) - чисто красному, и т.д. 

Если визуально провести линию между каким-либо цветом (r,g,b) и белым цветом (255,255,255), то получится, что на этой линии будут лежать все значения данного цвета (r,g,b). Если мы будем двигаться по линии в сторону белого цвета, то яркость будет увеличиваться до тех пор пока не получим чисто белый цвет. 

То же самое можно сделать и для уменьшения яркости цвета. Достаточно провести линию из цвета (r,g,b) в чёрный (0,0,0). То есть при движении по линии к чёрному цвету мы будем уменьшать яркость до тех пор, пока не получим чёрный цвет. 

Функция "Darker" возвращает новое значение цвета, которое будет на сколько-то процентов темнее. Естевственно, что при 100% мы получим чёрный цвет. 
Функция "Lighter" возвращает цвет, который светлее на сколько-то процентов исходного. 100% - белый цвет. 

Функции Darker и Lighter требуют 2 параметра и используются примерно так: 
Panel1.Color := Darker(clBlue,20); 
Получется панель цветов, которая на 20% темнее обычного синего цвета. 

Теперь давайте посмотрим, как выглядят внутри наши функции: 

function Darker(Color:TColor; Percent:Byte):TColor;  
var  
  r,g,b:Byte;  
begin  
Color:=ColorToRGB(Color);  
r:=GetRValue(Color);  
g:=GetGValue(Color);  
b:=GetBValue(Color);  
r:=r-muldiv(r,Percent,100);  //процент% уменьшения яркости 
g:=g-muldiv(g,Percent,100);  
b:=b-muldiv(b,Percent,100);  
result:=RGB(r,g,b);  
end;  

function Lighter(Color:TColor; Percent:Byte):TColor;  
var  
  r,g,b:Byte;  
begin  
Color:=ColorToRGB(Color);  
r:=GetRValue(Color);  
g:=GetGValue(Color);  
b:=GetBValue(Color);  
r:=r+muldiv(255-r,Percent,100); //процент% увеличения яркости 
g:=g+muldiv(255-g,Percent,100);  
b:=b+muldiv(255-b,Percent,100);  
result:=RGB(r,g,b);  
end;  

Так же я добавил некоторые функции, в которых уже добавлены стандартные значения процентов. Это для тех, кому некогда задумываться над процентами :) 

Panel1.Color := Light(clBlue);  
Panel1.Color := SlightlyDark(clRed);  
Panel1.Color := VeryLight(clMagenta);  
etc.  

function SlightlyDark(Color:TColor):TColor;  
begin  
  Result := Darker(Color,25);  
end;  

function Dark(Color:TColor):TColor;  
begin  
  Result := Darker(Color,50);  
end;  

function VeryDark(Color:TColor):TColor;  
begin  
  Result := Darker(Color,75);  
end;  

function SlightlyLight(Color:TColor):TColor;  
begin  
  Result := Lighter(Color,25);  
end;  

function Light(Color:TColor):TColor;  
begin  
  Result := Lighter(Color,50);  
end;  

function VeryLight(Color:TColor):TColor;  
begin  
  Result := Lighter(Color,75);  
end; 

Код: Выделить всё

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtDlgs, StdCtrls, ExtCtrls, JPEG,Spin,Map, Menus;

type
  TForm1 = class(TForm)
    SBox: TScrollBox;
    PBox: TPaintBox;
    Opd: TOpenPictureDialog;
    Spd: TSavePictureDialog;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    procedure PBoxPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure spZoomChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);



    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
   { procedure N5Click(Sender: TObject);}

  private
    { Private declarations }
    procedure InitAllMap;
    procedure FreeAllMap;
    procedure LoadImage(FileName:string);
    

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  Pic:TBitmap;

  PicRect:TRect;
  ZoomRect:TRect;

  kz:integer;  // koefficient zooming
  w,h:integer; // Øèðèíà è Âûñîíà

  FileName:string;

  m0:TMap;
  m1,m2,m3:TMap;

implementation
uses Filtres;

{$R *.DFM}
procedure TForm1.InitAllMap;
// èíèöèàëèçàöèÿ ðàáî÷èõ ìàññèâîâ
begin
   InitMap(m0,w,h);
   InitMap(m1,w,h);
   InitMap(m2,w,h);
   InitMap(m3,w,h);
end;

procedure TForm1.FreeAllMap;
// îñâîáîæäåíèå ðàáî÷èõ ìàññèâîâ
begin
   FreeMap(m0);
   FreeMap(m1);
   FreeMap(m2);
   FreeMap(m3);
end;

procedure TForm1.LoadImage(FileName:string);
               // çàãðóçêà èçîáðàæåíèÿ
var bmp:TBitmap;
    ww,hh,pw,ph:integer;
    jpg:TJpegImage;
    ext:string;
begin
if FileName='' then Exit;
bmp:=TBitmap.Create;
try
       ext:=ExtractFileExt(FileName);
        if (ext='.jpg') or (ext='.jpeg') then
        begin
          jpg:=TJpegImage.Create;
            try
                jpg.LoadFromFile(FileName);

                bmp.Assign (jpg);
            finally
              jpg.Free; end
        end
        else

        bmp.LoadFromFile(FileName);

    w:=bmp.Width;
    h:=bmp.Height;

    kz:=1;
    PicRect:=Rect(0,0,w,h);
    ZoomRect:=Rect(0,0,w*kz,h*kz);

    if pic<>nil then begin pic.Free; pic:=nil; end;
    pic:=TBitmap.Create;
    pic.Width:=w;
    pic.Height:=h;
    pic.PixelFormat:=pf24bit;
  //êîíâåðòàöèÿ â TrueColor
    pic.Canvas.CopyRect(PicRect,bmp.Canvas,PicRect);
    InitAllMap;
    GetLightness(pic,m0);

finally  bmp.Free;
 end;
end;

procedure TForm1.PBoxPaint(Sender: TObject);
      //îòðèñîâêà
begin
   PBox.Canvas.StretchDraw(ZoomRect,pic);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   kz:=1;
   FileName:='';
end;

{äëÿ ïðîêðóòêè}
procedure TForm1.spZoomChange(Sender: TObject);
var x,y,x0,y0,kz0:integer;
begin
  kz0:=kz;
  x0:=SBox.HorzScrollBar.Position;
  y0:=SBox.VertScrollBar.Position;

  x:=Round(x0*(kz/kz0));
  y:=Round(y0*(kz/kz0));

  ZoomRect:=Rect(0,0,w*kz,h*kz);
  SBox.AutoScroll:=false;
  PBox.height:=h*kz;
  PBox.width:=w*kz;
  SBox.AutoScroll:=true;
  SBox.HorzScrollBar.Position:=x;
  SBox.VertScrollBar.Position:=y;
end;

//ïðè âûõîäå î÷èùàåì
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
        FreeAllMap;
        pic.Free;
end;


procedure TForm1.N4Click(Sender: TObject);
begin
   Close;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  try
 if  Opd.Execute  then
  begin
      FileName:=Opd.FileName;
      LoadImage(FileName);

      Pbox.refresh;
      PboxPaint(nil);


      spZoomChange(nil);

      Form1.Caption:=ExtractFileName(FileName)+
      ' ['+IntToStr(w) + ' * ' + IntToStr(h)+']';

     Opd.InitialDir:=Opd.GetNamePath;
  end;
 except
  Application.MessageBox(
        'Error Load from File','Error',MB_OK);
 end;
end;

{ñîõðàíåíèå èçìåíåíèé}
procedure TForm1.N3Click(Sender: TObject);

 var jpg:TJpegImage;
    sn,f:string;
    n:integer;
     label inp;
begin
if Spd.Execute then
begin
       f:=spd.FileName;
       Case  Spd.FilterIndex of
     // Ñîõðàíåíè â ÁÌÐ
     1:  begin
          spd.DefaultExt:='bmp';
          f:=ChangeFileExt(f,'.bmp');
          pic.SaveToFile(f);
         end;
     //  èëè ñîõðàíåíèå â JPEG
     2:  begin
           jpg:=TJpegImage.Create;
           spd.DefaultExt:='jpg';
           f:=ChangeFileExt(f,'.jpg');
           try
           n:=100;
             jpg.CompressionQuality:=n;
             jpg.Assign(pic);
             jpg.SaveToFile(f);
           finally jpg.Free; end;
         end;
    end;
 end;
end;
end.

Тут конечно много закоментировано, так как переделывал немного, но в принципе работает... а вот со вставкой функции затруднения...

Код: Выделить всё

You must change the RBG values of the pixels. For 1, 4 and 8 bit bitmaps, you must edit the palette. For 15 - 32 bit bitmaps, you must edit the pixel direct. For larger bitmaps you should precalulate a table and set the RGB values from this table. 

Red := BCTable[Red]; 
Green := BCTable[Green]; 
Blue := BCTable[Blue]; 

You can find the calculation of the table below. The rest is standard source code, look at EFG's Computer Lab for any solution. 

I define the brightness and contrast value between 0..255. Other definitions are possible, change BMax, CMax, BNorm and CNorm. 


type 
  TBCTable = array[Byte] of Byte; 

const 
  RGBCount = 256; 
  RGBMax = 255; 
  RGBHalf = 128; 
  RGBMin = 0; 
  BMax = 128; { Maximal value brightness 100% - 0% = 0% - - 100% } 
  CMax = 128; { Maximal value contrast 100% - 0% = 0% - - 100% } 
  BNorm = 128; { Normal value brightness 0% } 
  CNorm = 128; { Normal value contrast 0% } 

procedure CalcBCTable(var ABCTable: TBCTable; ABrightness, AContrast: Integer); 
var 
  i, v: Integer; 
  BOffset: Integer; 
  M, D: Integer; 
begin 
  Dec(ABrightness, BNorm); 
  Dec(AContrast, CNorm); 
  { precalculation brightness assistance values } 
  BOffset := ((ABrightness) * RGBMax div BMax); 
  { precalculation contrast assistance values } 
  if AContrast < CMax then 
  begin { because Division by 0 on 100% } 
    if AContrast <= 0 then 
    begin { decrement contrast } 
      M := CMax + AContrast; 
      D := CMax; 
    end 
    else 
    begin { increment contrast } 
      M := CMax; 
      D := CMax - AContrast; 
    end; 
  end 
  else 
  begin 
    M := 0; 
    D := 1; 
  end; 
  for i := RGBMin to RGBMax do 
  begin 
    { calculate contrast } 
    if AContrast < CMax then 
    begin 
      v := ((i - RGBHalf) * M) div D + RGBHalf; 
      { restrict to byte range } 
      if v < RGBMin then 
        v := RGBMin 
      else if v > RGBMax then 
        v := RGBMax; 
    end 
    else 
    begin { contrast = 100% } 
      if i < RGBHalf then 
        v := RGBMin 
      else 
        v := RGBMax; 
    end; 
    { calculate brightness } 
    Inc(v, BOffset); 
    { restrict to byte range } 
    if v < RGBMin then 
      v := RGBMin 
    else if v > RGBMax then 
      v := RGBMax; 
    ABCTable[i] := v; 
  end; 
end; 




--------------------------------------------------------------------------------


Add a fixed value and clip it to the range. I have used a LUT, which is faster for larger bitmaps. The range of Brightness is -255 (-100%) to 255 (+100%). You can use a 32 or 24 Bit calculation depending on the compiler setting ChangeBrightness24Bit. 


procedure ChangeBrightness(Bitmap: TBitmap; Brightness: Integer); 
var 
  LUT: array[Byte] of Byte; 
  v, i: Integer; 
{$IFDEF ChangeBrightness24Bit} 
  w, h, x, y: Integer; 
  LineSize: LongInt; 
  pLineStart: PByte; 
{$ENDIF} 
  p: PByte; 
begin 
  { create LUT } 
  for i := 0 to 255 do 
  begin 
    v := i + Brightness; 
    if v < 0 then 
      v := 0 
    else if v > 255 then 
      v := 255; 
    LUT[i] := v; 
  end; 

{$IFDEF ChangeBrightness24Bit} 
  { edit bitmap } 
  w := Bitmap.Width; 
  h := Bitmap.Height - 1; 
  Bitmap.PixelFormat := pf24Bit; 
  pLineStart := PByte(Bitmap.ScanLine[h]); 
  { pixel line is aligned to 32 Bit } 
  LineSize := ((w * 3 + 3) div 4) * 4; 
  w := w * 3 - 1; 
  for y := 0 to h do 
  begin 
    p := pLineStart; 
    for x := 0 to w do 
    begin 
      p^ := LUT[p^]; 
      Inc(p); 
    end; 
    Inc(pLineStart, LineSize); 
  end; 
{$ELSE} 
  { edit bitmap } 
  Bitmap.PixelFormat := pf32Bit; 
  p := PByte(Bitmap.ScanLine[Bitmap.Height - 1]); 
  for i := 0 to Bitmap.Width * Bitmap.Height - 1 do 
  begin 
    p^ := LUT[p^]; 
    Inc(p); 
    p^ := LUT[p^]; 
    Inc(p); 
    p^ := LUT[p^]; 
    Inc(p, 2); 
  end; 
{$ENDIF} 
end;