Lazarus : Membuat Grayscale Image / Citra

 Another program iseng,tutor, sekaligus nostalgia plus asah otak kembali yang penulis buat. Nah, pada  program contoh ini mengajarkan bagaimana membuat suatu gambar menjadi grayscale dengan memakai berbagai macam cara / menthod serta memakai Lazarus 1.4.4, sedangkan bila hendak memakai Delphi maka hanya di perlukan sedikit perubahan saja. Apabila menginginkan full source code + exe file bisa langsung menghubungi penulis di karenakan sampai sekarang belum menemukan space penyimpanan yang cocok.

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  ExtDlgs, StdCtrls,math;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    GroupBox1: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure RadioButtonClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
   If OpenPictureDialog1.Execute Then
          Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);

   Function GrayscaleAverage (Color : TColor) : TColor;
   var
     Temp : TColor;
   Begin
      Temp := TColor ( (Red (Color)+Green (Color)+Blue (Color)) div 3);
      result := RgbToColor (temp,temp,temp);
   end;

var
  TempBitmap : TBitmap;
  X,Y : Integer;
  TempColor : TColor;
  RR : TRect;
begin
   If Not Image1.Picture.Graphic.Empty Then
       Begin
          TempBitmap := TBitmap.Create;
          TempBitmap.SetSize(250,250);
          TempBitmap.Canvas.Clear;
          RR.Top:=0;
          RR.Left := 0;
          RR.Bottom:= 250;
          RR.Right:= 250;
          TempBitmap.Canvas.StretchDraw(RR,Image1.Picture.Graphic);
          For Y := 0 To TempBitmap.Height - 1 Do
          Begin
             For X := 0 To TempBitmap.Width - 1 Do
             Begin
                TempColor := GrayscaleAverage(TempBitmap.Canvas.Pixels[X,Y]);
                TempBitmap.Canvas.Pixels[X,Y] := TempColor;
             end;
          end;
          Image2.Picture.Assign(TempBitmap);
          TempBitmap.free;
       end;
end;

procedure TForm1.Button3Click(Sender: TObject);
   Function GrayscaleLightness (Color : TColor) : TColor;
   var
     Temp : TColor;
     rval,gval,bval,maxval,minval : Integer;
   Begin
      rval := Red (Color);
      gval := Green(Color);
      bval := Blue (Color);
      maxval := max (Max ( rval,gval),bval);
      minval := min (min ( rval,gval),bval);
      Temp :=  TColor ( (maxval + minval) div 2);
      result := RgbToColor (temp,temp,temp);
   end;
var
  TempBitmap : TBitmap;
  X,Y : Integer;
  TempColor : TColor;
  RR : TRect;
begin
   If Not Image1.Picture.Bitmap.Empty Then
       Begin
          TempBitmap := TBitmap.Create;
          TempBitmap.SetSize(250,250);
          TempBitmap.Canvas.Clear;
          RR.Top:=0;
          RR.Left := 0;
          RR.Bottom:= 250;
          RR.Right:= 250;
          TempBitmap.Canvas.StretchDraw(RR,Image1.Picture.Graphic);

          For Y := 0 To TempBitmap.Height - 1 Do
          Begin
             For X := 0 To TempBitmap.Width - 1 Do
             Begin
                TempColor := GrayscaleLightness(TempBitmap.Canvas.Pixels[X,Y]);
                TempBitmap.Canvas.Pixels[X,Y] := TempColor;
             end;
          end;
          Image3.Picture.Assign(TempBitmap);
          TempBitmap.free;
       end;
end;

procedure TForm1.Button4Click(Sender: TObject);
Function GrayscaleLuminance (Color : TColor) : TColor;
var
  Temp : TColor;
  rval,gval,bval : Integer;

Begin
   case GroupBox1.Tag Of
      1 : Begin
             rval := round (Red (Color)*0.299);
             gval := round (Green(Color)*0.587);
             bval := round (Blue (Color)*0.114);
          end;
      2 : Begin
             rval := round (Red (Color)*0.2125);
             gval := round (Green(Color)*0.7154);
             bval := round (Blue (Color)*0.0721);
          end;
      3 : Begin
             rval := round (Red (Color)*0.2126);
             gval := round (Green(Color)*0.7152);
             bval := round (Blue (Color)*0.0722);
          end;
      4 : Begin
             rval := round (Red (Color)*0.2126);
             gval := round (Green(Color)*0.7152);
             bval := round (Blue (Color)*0.0722);
          end;
      5 : Begin
             rval := round (Red (Color)*0.2225);
             gval := round (Green(Color)*0.7169);
             bval := round (Blue (Color)*0.0606);
          end;
   end;
   Temp :=  TColor (rval+gval+bval);
   result := RgbToColor (temp,temp,temp);
end;

var
   TempBitmap : TBitmap;
   X,Y : Integer;
   TempColor : TColor;
   RR : TRect;
begin
    If Not Image1.Picture.Bitmap.Empty Then
       Begin
          TempBitmap := TBitmap.Create;
          TempBitmap.SetSize(250,250);
          TempBitmap.Canvas.Clear;
          RR.Top:=0;
          RR.Left := 0;
          RR.Bottom:= 250;
          RR.Right:= 250;
          TempBitmap.Canvas.StretchDraw(RR,Image1.Picture.Graphic);

          For Y := 0 To TempBitmap.Height - 1 Do
          Begin
             For X := 0 To TempBitmap.Width - 1 Do
             Begin
                TempColor := GrayscaleLuminance(TempBitmap.Canvas.Pixels[X,Y]);
                TempBitmap.Canvas.Pixels[X,Y] := TempColor;
             end;
          end;
          Image4.Picture.Assign(TempBitmap);
          TempBitmap.free;
       end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
   Image1.Picture.Clear;
   Image2.Picture.Clear;
   Image3.Picture.Clear;
   Image4.Picture.Clear;
end;

procedure TForm1.RadioButtonClick(Sender: TObject);
begin
   GroupBox1.Tag:= (Sender As TRadioButton).Tag;
end;

end.



***** SEMOGA BERMANFAAT *****