açıklama

[samety81]

Kod: Tümünü seç

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    btnResim1Sec: TButton;
    btnBMPKaydet: TButton;
    btnJPGKaydet: TButton;
    btnResim2Sec: TButton;
    btnKatistir: TButton;
    SayacGoruntuOran: TTrackBar;
    EtiketGoruntuOran: TLabel;
    SolResim: TImage;
    OrtaResim: TImage;
    SagResim: TImage;
    ResimKaydet: TSavePictureDialog;
    ResimAc: TOpenPictureDialog;
    procedure btnResim1SecClick(Sender: TObject);
    procedure btnBMPKaydetClick(Sender: TObject);
    procedure btnJPGKaydetClick(Sender: TObject);
    procedure btnResim2SecClick(Sender: TObject);
    procedure btnKatistirClick(Sender: TObject);
    procedure SayacGoruntuOranChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure ResimNesneleriniOrtala;
    procedure ResimSec(EkranResmi: TImage; BellekResmi: TBitmap);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  BellekResim1,BellekResim2,BellekResimX: TBitmap;
implementation

{$R *.dfm}

//Resim dosyası açma penceresi için ilk dizin adı.
function UygulamaKlasoruGetir:string;
begin
  result:=ExtractFilePath(Application.ExeName);
  if copy(result,length(result),1)<>'\' then
     result:= result + '\';
end;

function ResimDosyaYukle(dosya:string; bmp:TBitmap):boolean;
var
  uzanti:string;
  jpg:TJPEGImage;
begin
  result:=false;
  //Resim JPEG türünde mi?
  uzanti:=Lowercase(ExtractFileExt(dosya));
  if ( uzanti='.jpg' ) or (uzanti='.jpeg') then
  begin
    jpg:=TJPEGImage.Create;
    jpg.LoadFromFile(dosya);
    bmp.Assign(jpg);
    jpg.free;
    result:=true;
  end else
  //Yoksa BMP türünde mi?
  if ( uzanti='.bmp' ) then
  begin
    bmp.LoadFromFile(dosya);
    result:=true;
  end;
end;

//Aşırı yüklenmiş (overloading) RenkKarıştır işlevi
function RenkKatistir(r1,g1,b1,r2,g2,b2:byte; oran:byte):TColor; overload;
begin
  result:= RGB (
       ( ( r1 * oran ) + ( r2 * (255-oran) ) ) div 255,
       ( ( g1 * oran ) + ( g2 * (255-oran) ) ) div 255,
       ( ( b1 * oran ) + ( b2 * (255-oran) ) ) div 255  );
end;

function RenkKatistir(renk1,renk2:TColor; oran:byte):TColor; overload;
begin
  result:= RenkKatistir(
             Byte(renk1), Byte(renk1 shr 8), Byte(renk1 shr 16),
             Byte(renk2), Byte(renk2 shr 8), Byte(renk2 shr 16),  oran );
end;

procedure TForm1.ResimSec(EkranResmi:TImage;BellekResmi:TBitmap);
begin
  if ResimAc.Execute then
  begin
    if ResimDosyaYukle(resimac.FileName,BellekResmi) then
    begin
      EkranResmi.Picture:=nil;
      EkranResmi.Width:=BellekResmi.Width;
      EkranResmi.Height:=BellekResmi.Height;
      EkranResmi.Picture.Bitmap.Assign(BellekResmi);
      ResimNesneleriniOrtala;
    end else
      ShowMessage('Geçersiz resim');
  end;
end;

//İlk resimler siyah olarak 320*240 boyutlarında oluşturuluyor.
procedure ilkResimleriOlustur;
begin
  BellekResim1:=TBitmap.Create;
  BellekResim2:=TBitmap.Create;
  BellekResimX:=TBitmap.Create;

  BellekResim1.PixelFormat:= pf24bit;
  BellekResim2.PixelFormat:= pf24bit;
  BellekResimX.PixelFormat:= pf24bit;

  BellekResim1.Width:=320;
  BellekResim2.Width:=320;
  BellekResimX.Width:=320;

  BellekResim1.Height:=240;
  BellekResim2.Height:=240;
  BellekResimX.Height:=240;


  Bellekresim1.Canvas.FillRect(Bellekresim1.Canvas.ClipRect);
  Bellekresim2.Canvas.FillRect(Bellekresim2.Canvas.ClipRect);
  BellekresimX.Canvas.FillRect(BellekresimX.Canvas.ClipRect);

end;

//Çıkışta resimler silinecek.
procedure ResimleriSil;
begin
  FreeAndNil(BellekResim1);
  FreeAndNil(BellekResim2);
  FreeAndNil(BellekResimX);
end;

//İki resmi belli oranda karıştırıp başka bir resmin üzerine yazar.
procedure ResimleriKatistir(resim1:TBitmap; resim2:TBitmap;
                            var sonuc:TBitmap; oran:byte);
var
  w,h:integer;
begin
  for h:=0 to sonuc.Height do
    for w:=0 to sonuc.Width do
      sonuc.Canvas.Pixels[w,h]:= RenkKatistir(resim1.Canvas.Pixels[w,h],
                                     resim2.Canvas.Pixels[w,h],
                                     oran );
end;

procedure ResimDosyaKaydet(dosya:string; resim:TBitmap);
var
  uzanti:string;
  jpg:TJPEGImage;
begin
  Screen.Cursor:= crHourGlass;
  uzanti:=Lowercase(ExtractFileExt(dosya));
  if ( uzanti='.jpg' ) or (uzanti='.jpeg') then
  begin
    jpg:=TJPEGImage.Create;
    jpg.Assign(resim);
    jpg.SaveToFile(dosya);
    jpg.free;
  end else
  //JPG değilse BMP türünde kaydediyor.
  begin
    resim.SaveToFile(dosya);
  end;
  Screen.Cursor:= crDefault;
end;



procedure TForm1.btnResim1SecClick(Sender: TObject);
begin
 ResimSec(SolResim,BellekResim1);
end;

procedure TForm1.btnBMPKaydetClick(Sender: TObject);
begin
ResimKaydet.DefaultExt:='*.bmp';
ResimKaydet.Filter:= 'Biteşlem (*.bmp)|*.bmp';
if ResimKaydet.Execute then
ResimDosyaKaydet(ResimKaydet.FileName, OrtaResim.Picture.Bitmap);


end;

procedure TForm1.btnJPGKaydetClick(Sender: TObject);
begin
ResimKaydet.DefaultExt:='*.jpg';
ResimKaydet.Filter:= 'JPEG Resmi (*.jpg)|*.jpg';
if ResimKaydet.Execute then
ResimDosyaKaydet(ResimKaydet.FileName, OrtaResim.Picture.Bitmap);

end;

procedure TForm1.btnResim2SecClick(Sender: TObject);
begin
ResimSec(SagResim,BellekResim2);
end;

procedure TForm1.btnKatistirClick(Sender: TObject);
var
  karisik: TBitmap;
begin
  screen.Cursor:=crHourGlass;
  karisik:=TBitmap.Create;
  karisik.PixelFormat:=pf24bit;//picsel format çeşiti
  karisik.Width:=SolResim.Width;
  karisik.Height:=SolResim.Height;

  Ortaresim.Picture:=nil; //içini boşaltıyor
  ResimleriKatistir(sagresim.picture.bitmap,solresim.picture.bitmap,karisik,byte((SayacGoruntuOran.Position*255) div 100));

  ortaresim.Picture.Bitmap.Assign(karisik);
  ortaresim.Width:=karisik.Width;
  OrtaResim.Height:=karisik.Height;
  karisik.Free;  //hafazadan atıyor

  ResimNesneleriniOrtala;
  Screen.Cursor:=crDefault;
end;

procedure TForm1.SayacGoruntuOranChange(Sender: TObject);
begin
EtiketGoruntuOran.caption:= '%' + inttostr(100-SayacGoruntuOran.Position) + ' - ' +
                              '%' + inttostr(SayacGoruntuOran.Position);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ResimAc.InitialDir:= UygulamaKlasoruGetir;
  ilkResimleriOlustur;
  SolResim.Picture.Bitmap.Assign( Bellekresim1);
  SagResim.Picture.Bitmap.Assign( Bellekresim2);
  OrtaResim.Picture.Bitmap.Assign(BellekresimX);
  btnKatistirClick(sender);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ResimleriSil;  //formu kapatırken bellek resimlerini boşalt
end;

procedure TForm1.ResimNesneleriniOrtala;
begin
SolResim.SetBounds( (SolResim.Parent.Width - SolResim.Width) div 2,
                     (SolResim.Parent.Height - SolResim.Height) div 2,
                     SolResim.Width,
                    SolResim.Height);
  SagResim.SetBounds( (SagResim.Parent.Width - SagResim.Width) div 2,
                    (SagResim.Parent.Height - SagResim.Height) div 2,
                     SagResim.Width,
                   SagResim.Height);
  OrtaResim.SetBounds((OrtaResim.Parent.Width - OrtaResim.Width) div 2,
                     (OrtaResim.Parent.Height -OrtaResim.Height) div 2,
                     OrtaResim.Width,
                    OrtaResim.Height);
end;

end.

burdaki procedure TForm1.btnKatistirClick(Sender: TObject); butonuna basınca katıştırma işlemini yapıyor ama burdaki procedure lerin çalışma sıralarını izledim ancak bu yaptığı işleri anlayamadım yardım ederseniz sevinirim.

[Kuri_YJ]

Selamlar,

Seçilen iki resmi, bir üçüncü resim nesnesi üzerinde Renkleri birbirine katıştırarak 3. bir resim elde ediyor.

Renkleri belli bir oranda (verilen oran oranında) birbirine Pixel Pixel birleştirerek ortalama elde ediyor (ortalama derken katıştırma sonucundan bahsediyorum) yeni bir resim elde ediyor.

Source'u çalıştırmadan okuduğumdan söylüyorum bunu.

Kolay Gelsin

NOT : RGB -> Red Green Blue Değerlerini elliyor.