scanline ile alınan byte larde işlem yapma

[duraumsa]

scanline taradığım resimin pixellerini işlem yaparak yeni resim oluşturmak istiyorum.
uygulamam şu:
örneğin sarı zemin üzerine konulmuş bir parçanın sınırlarını belirlemek istiyorum. sarı rengin bittiği yerleri sınır çizgisi ile belirleme.
uygulamamın özü bu scanline ile resmi tarıyorum ama örneğin scanline[0] içindeki değer ile işlem yapamıyorum.
dip not:delphideki seviyemde daha 10 üzerinden 3

[anonymousdelphicoder]

http://stackoverflow.com/questions/1358 ... it-bitmaps
http://www.efg2.com/Lab/ImageProcessing/Scanline.htm
viewtopic.php?t=28078

[SimaWB]

Ben de Delphi'nin kendi örneğini paylaşayım:
http://docwiki.embarcadero.com/CodeExam ... e_(Delphi)

[duraumsa]

arkadaşlar cevaplar için teşekkür ederim.
örnekleri inceledim ve benim daha çok çalışmam işin temeline girmem gerektiğini anladım.
benim öncelikle pRGBTripleArray tipi gibideğişkenleri öğrenmem lazım.
buda demek oluyorki benim delphi bilgim 10 üzerinden 0,01
bu konuyla ilgili her türlü bilgiye açım yani.
daha çok yolum var ama projeyi bitirip burada kesin paylaşacağim inşallah. paylaşmayı seven bir gruba üye olduğum için mutluyum

herkese şimdiden teşekürler

[duraumsa]

selam arkadaşlar ben projemi biraz ilerlettim buraya olduğu gibi yüklemek istiyorum

[duraumsa]

code aşağıdaki şekilde

Kod: Tümünü seç

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.jpeg,
  Vcl.ExtCtrls,inifiles;

type
  TForm1 = class(TForm)
     Button2: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Label1: TLabel;

    procedure Button2Click(Sender: TObject);
    //procedure Button1Click(Sender: TObject);
   // procedure Button3Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
 //   procedure Button9Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
 r,g,b : integer;
 arkaters: array [0..64] of word;

{$R *.dfm}











procedure TForm1.Button2Click(Sender: TObject);
type
  TRGBTripleArray = ARRAY[Word] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray; // Use a PByteArray for pf8bit color.Pf8bit renk için bir PByteArray kullanın
var
  x,y,z,a,t : Integer;
  bx, by,renk,renk2,renk3,renk4 : Integer;
  resimilk, resimson : TBitMap;
  P, bigP : pRGBTripleArray;
  pixForm, bigpixForm : TPixelFormat;
  c1, c2: PByte;
  begin
  resimilk := TBitMap.create;
  resimson := TBitMap.create;
  try
    resimilk.LoadFromFile('resim10.bmp');
    pixForm := resimilk.PixelFormat;
    bigpixForm := resimson.PixelFormat;
    resimilk.PixelFormat := pf24bit;
    resimson.PixelFormat := pf24bit;
    resimson.Height := resimilk.Height * 1;
    resimson.Width := resimilk.Width * 1;
    renk := strtoint(edit1.Text);
    renk2 := (r);
    renk3 := (g);
    renk4 := (b);
    z := strtoint (edit8.Text);
    for y := 0 to resimilk.Height - 1 do
    begin
    t := 1 ;
      P := resimilk.ScanLine[y];
      for x := 0 to resimilk.Width - 1 do
      begin
        bx := x * 1;
        by := y * 1;
        bigP := resimson.ScanLine[by];
        bigP[bx] := P[x];
        bigP[bx + 1] := P[x];
           if ((bigp[bx].rgbtRed)< (renk2+z)) and ( (bigp[bx].rgbtRed)>(renk2-z)) and
              ((bigp[bx].rgbtGreen)< (renk3+z)) and  ((bigp[bx].rgbtGreen)>(renk3-z)) and
              ((bigp[bx].rgbtBlue) < (renk4+z)) and ((bigp[bx].rgbtBlue)>(renk4-z))then
           begin
            //if t=1 then
            //  begin
           bigp[bx].rgbtBlue := (renk);
           bigp[bx].rgbtGreen := (renk);
           bigp[bx].rgbtRed := (renk);
           bigp[bx+1].rgbtBlue :=(renk);
           bigp[bx+1].rgbtGreen := (renk);
           bigp[bx+1].rgbtRed := (renk);
           t := 0;
             // end;
           end;

        {bigP := resimson.ScanLine[by + 1];
        bigP[bx] := P[x];
        bigP[bx + 1] := P[x];
            if ((bigp[bx].rgbtRed)< (renk2+z)) and ( (bigp[bx].rgbtRed)>(renk2-z)) and
            ((bigp[bx].rgbtGreen)< (renk3+z)) and  ((bigp[bx].rgbtGreen)>(renk3-z)) and
            ((bigp[bx].rgbtBlue) < (renk4+z)) and ((bigp[bx].rgbtBlue)>(renk4-z))then
         begin
         bigp[bx].rgbtBlue := (renk);
         bigp[bx].rgbtGreen := (renk);
         bigp[bx].rgbtRed := (renk);
         bigp[bx+1].rgbtBlue :=(renk);
         bigp[bx+1].rgbtGreen := (renk);
         bigp[bx+1].rgbtRed := (renk);
         end;
            }
    // a:= a+1;
    // ListBox1.Items.Add('a='+inttostr(a)+' x='+inttostr(x)+' y='+inttostr(y));
      end;

    end;

    Canvas.Draw(0, 0, resimilk);
    Canvas.Draw(420, 0, resimson);
  finally
    resimilk.Free;
    resimson.Free;
  end;
end;
procedure TForm1.Button4Click(Sender: TObject);

var
inf:tinifile;
pik :TColor;
x,y,k,s,m,N,t: integer;

begin
for x := 430 to 803 do
begin
t := 1;
  for y := 0 to 200 do
    begin
   pik :=form1.canvas.pixels[x,y];
   k := (getRvalue(pik));
   s := (getGvalue(pik));
   m := (getBvalue(pik));
     if ((k) <> (255)) and
        ((s) <> (242)) and
        ((m) <> (0)) then
     begin
      N := 0 ;
      if t=1 then
      begin
      form1.canvas.pixels[x,y]:= 0;
      t := 0;
      end;
     end;
   end;

end;
showmessage('üst çizim tamamlandı');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
inf:tinifile;
pik :TColor;
x,y,k,s,m,N,t,a,b,c,d: integer;

begin
a:=400;
b:=200;
for x := 430 to 803 do
begin
c := x;
t := 1;
  for y := 0 to 200 do
    begin
    d:= b-y;
   pik :=form1.canvas.pixels[c,d];
   k := (getRvalue(pik));
   s := (getGvalue(pik));
   m := (getBvalue(pik));
    if ((k) <> (255)) and
        ((s) <> (242)) and
        ((m) <> (0)) then
     begin
      N := 0 ;
      if t=1 then
      begin
      form1.canvas.pixels[c,d]:= 0;
      t := 0;
      end;
       end;
   end;

end;
showmessage('alt çizim tamamlandı');
end;

procedure TForm1.Button6Click(Sender: TObject);
var
inf:tinifile;
pik :TColor;
x,y,k,s,m,N,t,a,b,c,d: integer;

begin
a:=200;
b:=803;
for x := 0 to 200 do
begin
c := a-x;
t := 1;
  for y := 0 to 380 do
    begin
    d:= b-y;
   pik :=form1.canvas.pixels[d,c];
   k := (getRvalue(pik));
   s := (getGvalue(pik));
   m := (getBvalue(pik));
    if ((k) <> (255)) and
        ((s) <> (242)) and
        ((m) <> (0)) then
     begin
      N := 0 ;
      if t=1 then
      begin
      form1.canvas.pixels[d,c]:= 0;
      t := 0;
      end;

     end;
   end;

end;
showmessage('sağ çizim tamamlandı');
end;

procedure TForm1.Button7Click(Sender: TObject);
var
inf:tinifile;
pik :TColor;
x,y,k,s,m,N,t,a,b,c,d: integer;

begin
a:=200;
b:=380;
for x := 0 to 200 do
begin
c := a-x;
t := 1;
  for y := 430 to 803 do
    begin
    d:= b-y;
   pik :=form1.canvas.pixels[y,x];
   k := (getRvalue(pik));
   s := (getGvalue(pik));
   m := (getBvalue(pik));
       if ((k) <> (255)) and
        ((s) <> (242)) and
        ((m) <> (0)) then
     begin
      N := 0 ;
      if t=1 then
      begin
      form1.canvas.pixels[y,x]:= 0;
      t := 0;
      end;

     end;
    end;

end;
showmessage('sol çizim tamamlandı');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
 Button4Click(sender);
 Button5Click(sender);
 Button6Click(sender);
 Button7Click(sender);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
   var
  cl : TColor;
  yatay,dikey : integer;
  fare:TMouse;
  begin
 yatay:= fare.CursorPos.X;
 dikey:= fare.CursorPos.Y;
 edit6.Text:=IntToStr(yatay);
 edit7.Text:=IntToStr(dikey);
 cl:=form1.canvas.pixels[yatay,dikey];
 r:= getRvalue(cl) ;
 g:= getGvalue(cl) ;
 b:= getbvalue(cl) ;
 label1.Caption := 'R('+IntToStr(r)+') G('+IntToStr(g)+') B('+IntToStr(b)+')';
 edit2.Text := inttostr(r);
 edit3.Text := inttostr(g);
 edit4.Text := inttostr(b);
end;

end.

[duraumsa]

kusura bakmayın parça parça oldu ama projenin tamamı ekte
şimdi benim iki sorunum var
1: çerçeve çizme hızı (çalıştırınca göreceksiniz çk yavaş)
2: çerçeve çizerken dik eksenlerde boşlukların olması

resim sade.rar

(58.85 KiB) 81 kere indirildi

[mrmarman]

Özel mesaj ile sormana gerek yoktu.
Forumda resim işleme üzerine çalışan bir sürü arkadaş var. Uygun olan kimse cevap yazardı.

Kodları inceledim.
Canvas işlemini Pixels ile noktalar bazında yürütmenin sonucu yavaşlama olması tümüyle doğal.
Scanline ile okuduğunuz pointer array üzerine eğilirseniz hız sorunu daha az yaşarsınız.

Sizin kodlar üzerinden örnek:
NOT: Direkt canvas üzerinde yapabilirsiniz. Özellikle farkı anlaşılsın diye copyrect ile bir Bitmap'e çekip sonra aynı kaynak canvas'a gerisin geriye bastım. Kaynağı önce kaydedip, sonra düzenleneni kaydedebilesiniz diye..

Anladığım o ki bu bir sınama projesi, asıl projenizde söylediğim şekilde olduğunu değerlendiriyorum ancak yine de başlığı okuyanlar için tavsiyem, işlemleri bir Bitmap üzerinden yürütün, gerekiyorsa sonucu canvas'a basın.

Kod: Tümünü seç

procedure Resim_UstKisimCiz( aCanvas: TCanvas; aLeft, aRight, aTop, aBottom: Integer; aR, aB, aG : Integer );
type
  TRGBTripleArray = ARRAY[Word] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;
Var
  x, y     : integer;
  aBitmap  : TBitMap;
  pSat     : pRGBTripleArray;
  aRect    : TRect;
  aDizi    : array of word;
begin
  aRect.Left   := aLeft;
  aRect.Top    := aTop;
  aRect.Right  := aRight;
  aRect.Bottom := aBottom;

  aBitmap             := TBitMap.create;
  aBitmap.PixelFormat := pf24bit;
  aBitmap.Width       := aRight-aLeft + 1;
  aBitmap.Height      := aBottom-aTop + 1;
  aBitmap.Canvas.CopyRect( aBitmap.Canvas.ClipRect, aCanvas, aRect);
  setlength( aDizi, aBitmap.width );
  for y := 0 to aBitmap.Height-1 do begin
    pSat := aBitmap.ScanLine[y];
    for x := 0 to aBitmap.Width do begin
     if ( aDizi[x] = 0 )
        and ((pSat[x].rgbtRed)  <> aR)
        and ((pSat[x].rgbtBlue) <> aB)
        and ((pSat[x].rgbtGreen)<> aG) then
        begin
          aDizi[x] := 1;
             pSat[x].rgbtBlue  := 0;
             pSat[x].rgbtGreen := 0;
             pSat[x].rgbtRed   := 0;
        end;
    end;
  end;
  aCanvas.CopyRect( aRect, aBitmap.Canvas, aBitmap.Canvas.ClipRect);
  aBitmap.Free;
end;

kullanımı
Sizin Button4Click kısmının alternatifidir.

Kod: Tümünü seç

  Resim_UstKisimCiz( self.Canvas, 430, 803, 0, 200, 255, 242, 0);

[duraumsa]

özelden yazdığım için özür dilerim hocam. forumda vermiş olduğunuz cevaplar ve sıcak tavra güvenerek yazdım.
Çok şükür bana yazan olmadı ama bazı arkadaşların biz acemileri aşağılayıcı cevaplarını gördüm böyle bir durumdan çekindiğim için size yazdım.
cevabınız için ve cevap veren arkadaşlara çok teşekkür ederim.