Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.05.2013, 21:32   #1
ArsGo
Пользователь
 
Регистрация: 10.10.2010
Сообщений: 17
Вопрос Редактирование картинки формата bmp

Уважаемые добрые и умные программисты, требуется ваша помощь, столкнулся с проблемами при написании программы, которая должна редактировать насыщенность, яркость и тон картинки, при попытке редактирования, картинка темнеет и все.
Алгоритм такой, открываем картинку, двигаем трэкбар для изменения нужного парметра, далее попиксельно считываем цвет, переводим из rgb в hsb, редактируем, переводим обратно, красим пиксель.
При написании частично использовался код из темы http://programmersforum.ru/showthread.php?t=144183

Код:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ExtDlgs, Math, ComCtrls;
type
   TRGBColor = record
      R,
      G,
      B : Byte;
    end;

    THSBColor = record
      Hue,
      Sat,
      Br : Double;
    end;
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);

  end;

var
  Form1: TForm1;
  R,G,B,i,j: Integer;
  Hue,Sat,Br,Hue1,Sat1,Br1:Double;

implementation

{$R *.DFM}

{Функция для конвертации rgb-цвета в hsb.}
function RGBToHSB(rgb : TRGBColor) : THSBColor;
 var
    minRGB, maxRGB, delta : Double;
    h , s , b : Double ;
 begin
    H := 0.0 ;
    minRGB := Min(Min(rgb.R, rgb.G), rgb.B) ;
    maxRGB := Max(Max(rgb.R, rgb.G), rgb.B) ;
    delta := ( maxRGB - minRGB ) ;
    b := maxRGB ;
    if (maxRGB <> 0.0) then s := 255.0 * Delta / maxRGB
    else s := 0.0;
    if (s <> 0.0) then
     begin
      if rgb.R = maxRGB then h := (rgb.G - rgb.B) / Delta
      else
        if rgb.G = maxRGB then h := 2.0 + (rgb.B - rgb.R) / Delta
        else
          if rgb.B = maxRGB then h := 4.0 + (rgb.R - rgb.G) / Delta
     end
    else h := -1.0;
    h := h * 60 ;
    if h < 0.0 then h := h + 360.0;
    with result do
     begin
      Hue := h;
      Sat := s * 100 / 255;
      Br := b * 100 / 255;
     end;
 end;

function HuetoRGB(m1,m2,h: double): double; {Функция, использующаяся далее при переводе из hsb в rgb }
begin
 if (h < 0) then h := h + 1.0;
 if (h > 1) then h := h - 1.0;
 if (6.0 * h < 1) then
    result := (m1+(m2-m1)*h*6.0)
 else
    if (2.0 * h < 1) then
       result := m2
    else
       if (3.0*h < 2.0) then
         result := (m1+(m2-m1)*((2.0/3.0)-h)*6.0)
       else 
        result := m1;
end;   

{Процедура для конвертации hsb-цвета в rgb.}
procedure HSBtoRGB(Hue,Sat,Br: double; var R,G,B: double);
var
  m1,m2: double;
begin
 if (Sat = 0.0) then
  begin
    r := Br;
    g := Br;
    b := Br;
  end else
 begin
    if (Br <= 0.5) then m2 := Br*(1.0+Sat) else m2 := Br+Sat-(Br*Sat);
    m1 := 2.0 * Br - m2;

    R := HuetoRGB(m1,m2,Hue+1.0/3.0);
    G := HuetoRGB(m1,m2,Hue);
    B := HuetoRGB(m1,m2,Hue-1.0/3.0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    Button2.Enabled:= true;
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 Hue1:=0;
 Hue1:=Hue1+TrackBar1.Position-50;
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
 Sat1:=0;
 Sat1:=Sat1+TrackBar2.Position-50;
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
 Br1:=0;
 Br1:=Br1+TrackBar2.Position-50;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x,y : Integer;
  P : PByteArray;
  i,j: Integer;
  R1,G1,B1:double;
  c: TColor;
  col: TRGBColor; //объявляем переменную для хранения rgb-цвета
  colhsb: THSBColor; //аналогично для hsb-цвета
begin
  for i:=0 to Image1.Picture.Width do
    for j:=0 to Image1.Picture.Height do
      begin
        c:= Image1.Canvas.Pixels[i, j]; // попиксельно считываем цвет
        col.R:=GetRValue(c); //берем красную составляющую
        col.G:=GetGValue(c); //берем зеленую составляющую
        col.B:=GetBValue(c); //берем синюю составляющую
        colhsb:=RGBToHSB(col); //преобразуем цвет
        colhsb.Hue:=colhsb.Hue+Hue1;

        if colhsb.Hue>359 then colhsb.Hue:=359;
        if colhsb.Hue<0 then colhsb.Hue:=0;
        colhsb.Sat:=colhsb.Sat+sat1;
        if colhsb.Sat>100 then colhsb.Hue:=100;
        if colhsb.Sat<0 then colhsb.Hue:=0;
        colhsb.Br:=colhsb.Br+br1;
        if colhsb.Br>100 then colhsb.Br:=100;
        if colhsb.Br<0 then colhsb.Br:=0;
        HSBtoRGB(colhsb.Hue,colhsb.Sat,colhsb.Br,R1,G1,B1); {преобразуем обратно}
        Image1.Picture.Bitmap.Canvas.Pixels[i,j]:=RGB(Round(R1), Round(G1), Round(B1));
      end;
end;
end.

Последний раз редактировалось Stilet; 17.05.2013 в 21:53.
ArsGo вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск файлов формата bmp по заданным параметрам LinaSh Помощь студентам 17 18.04.2011 21:08
Разработать программу для обработки растровых изображений, хранящихся в файлах формата BMP (BitMaP). yeskin Фриланс 5 19.12.2010 15:06
bmp картинки B@R@B@$HK@ Общие вопросы C/C++ 0 09.06.2009 23:08
Спрятать от пользователя BMP картинки из программы. Alex Cones Общие вопросы Delphi 9 22.04.2009 01:06