Membuat effect RGB pada gambar menggunakan delphi

Langsung aja ya ..
Berikut ini contoh aplikasi untuk merubah intensitas warna (RGB) pada sebuah gambar bitmap (bmp/jpg).
Klik Load Picture untuk memuat gambar dari file (jpg/bmp) yang akan di proses.

Setelah itu atur Trackbar (Red, Green, Blue) sesuai keinginan sehingga akan memperoleh hasil seperti gambar berikut.

Untuk mengembalikan gambar pada warna asli kita cukup menekan Reset.
Untuk menyimpan hasilnya Klik Save Picture.

Berikut ini kode selengkapnya ..

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    tbRed: TTrackBar;
    imgFoto: TImage;
    btLoad: TButton;
    tbGreen: TTrackBar;
    tbBlue: TTrackBar;
    btReset: TButton;
    opd: TOpenPictureDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Panel1: TPanel;
    btSave: TButton;
    SavePictureDialog1: TSavePictureDialog;
    procedure TrackBarAllChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btLoadClick(Sender: TObject);
    procedure btResetClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bAsli: TBitmap;
  bEffect: TBitmap;

implementation

{$R *.dfm}

procedure TForm1.btLoadClick(Sender: TObject);
begin
     if opd.Execute then
     begin
          imgFoto.Picture.LoadFromFile(opd.FileName);
          bAsli.Assign(imgFoto.Picture.Graphic);
          bAsli.PixelFormat:=pf24bit;
          bEffect.Assign(bAsli);
          tbRed.Enabled:=True;
          tbGreen.Enabled:=True;
          tbBlue.Enabled:=True;
          btSave.Enabled:=True;
     end else
     begin
          imgFoto.Picture:=nil;
          tbRed.Enabled:=False;
          tbGreen.Enabled:=False;
          tbBlue.Enabled:=False;
          btSave.Enabled:=False;
     end;
end;

procedure TForm1.btResetClick(Sender: TObject);
begin
     tbRed.Position:=tbRed.Max;
     tbGreen.Position:=tbGreen.Max;
     tbBlue.Position:=tbBlue.Max;
end;

procedure TForm1.btSaveClick(Sender: TObject);
var
   jpg: TJPEGImage;
begin
     if SavePictureDialog1.Execute then
     begin
          jpg:=TJPEGImage.Create;
          jpg.Assign(imgFoto.Picture.Graphic);
          jpg.SaveToFile(SavePictureDialog1.FileName);
          jpg.Free;
          ShowMessage('Done');
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     bAsli:=TBitmap.Create;
     bEffect:=TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     bAsli.Free;
     bEffect.Free;
end;

procedure TForm1.TrackBarAllChange(Sender: TObject);
var
   x,y: Integer;
   baAsli,baEffect: PByteArray;
begin
     for y:=0 to bEffect.Height-1 do
     begin
          baAsli:=bAsli.ScanLine[y];
          baEffect:=bEffect.ScanLine[y];
          for x:=0 to bEffect.Width-1 do
          begin
               baEffect[x*3]:=Trunc(baAsli[x*3]*tbBlue.Position/tbBlue.Max);
               baEffect[x*3+1]:=Trunc(baAsli[x*3+1]*tbGreen.Position/tbGreen.Max);
               baEffect[x*3+2]:=Trunc(baAsli[x*3+2]*tbRed.Position/tbRed.Max);
          end;
     end;
     imgFoto.Picture.Bitmap.Assign(bEffect);
end;

end.

Contoh aplikasi dapat didownload di https://www.box.com/s/u18279aflcnb4pc2lysk

Leave a Reply

Your email address will not be published.