algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Zmiana barwy / nasycenia / jasności - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
Nadesłany przez Dariusz Rorat, 16 sierpnia 2010 20:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

delphi/Unit1.pas:
// zmiany barwy/nasycenia/jasnosci obrazu
// koloryzacja obrazu
// Dariusz Rorat
// www.algorytm.org

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    CheckBox1: TCheckBox;
    Button1: TButton;
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses rgbhsv;
{$R *.dfm}
function IntToByte(v: integer): byte;
begin
if v>255 then result:=255
else if v<0 then result:=0
else result:=v;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Edit1.Text:=IntToStr(TrackBar1.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
Edit2.Text:=IntToStr(TrackBar2.Position);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
Edit3.Text:=IntToStr(TrackBar3.Position);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
TrackBar1.Position:=StrToInt(Edit1.Text);
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
TrackBar2.Position:=StrToInt(Edit2.Text);
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
TrackBar3.Position:=StrToInt(Edit3.Text);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
  begin
    TrackBar1.Min:=0;
    TrackBar1.Max:=360;
    TrackBar2.Min:=0;
    TrackBar2.Max:=100;
  end
else
  begin
    TrackBar1.Min:=-180;
    TrackBar1.Max:=180;
    TrackBar2.Min:=-100;
    TrackBar2.Max:=100;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
r, g, b: byte;
r1, g1, b1: integer;
h, s, v: single;
col: TColor;
begin
for j:=0 to Image1.Height-1 do
  begin
    for i:=0 to Image1.Width-1 do
      begin
        col:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];
        r:=GetRValue(col);
        g:=GetGValue(col);
        b:=GetBValue(col);
        //---------- konwersja RGB na HSV --------------
        RGBTOHSV(r,g,b,h,s,v);
        if CheckBox1.Checked then //koloryzuj
          begin
            h:=TrackBar1.Position/360;
            s:=TrackBar2.Position/100;
            v:=v+TrackBar3.Position;
          end
        else
          begin
            h:=h+TrackBar1.Position/360;
            s:=s+TrackBar2.Position/100;
            v:=v+TrackBar3.Position;
          end;
            if v>255 then v:=255   //ograniczenie V
            else if v<0 then v:=0;
            if S>1 then s:=1   //ograniczenie nasycenia
            else if s<0 then s:=0;
            if h>1 then h:=h-1   //ograniczenie barwy
            else if h<0 then h:=h+1;

        HSVToRGB(h,s,v,r1,g1,b1);
        r:=IntToByte(r1);
        g:=IntToByte(g1);
        b:=IntToByte(b1);
        col:= r + (g shl 8) + (b shl 16);
        Image2.Canvas.Pixels[i,j]:=col;
      end;
  end;
end;

end.
Dodaj komentarz