Görüntü ve ses işleme hakkında bir dll projesi

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
mkaderoglu
Üye
Mesajlar: 48
Kayıt: 04 Tem 2007 11:14
Konum: Konya
İletişim:
İletişim mkaderoglu

Görüntü ve ses işleme hakkında bir dll projesi

Mesaj gönderen mkaderoglu »

Herkese selam bu Delphi Türkiyedeki ilk mesajım öncelikle bu siteyi kuran ve geliştiren bütün arkadaşlarımızdan allah razı olsun. Bu paylaşım heycanına bende bir şeyler katmak istedim. Türksat bünyesinde çalıştığım zamanlarda yazdığım bir dll'li sizlerle paylaşmak istedim. Bazı fonksiyonlar alıntı bazıları ise kendi eserimdir. Asl olan paylaşmak.



Kod: Tümünü seç

library Kontrol;

uses
  Graphics,math,ExtCtrls,messages,dialogs,Windows,SysUtils,Classes,Controls;

type
    TDInt = array of array of integer;
    TDDbl = array of array of Double;
    TQInt = array of integer;
    TQDbl = array of Double;


{$R *.res}


function mov_filt (w_size:integer;input:TQDbl): TQDbl;export;
  var
	  temp_array:TQDbl;
	  t_sum:double;
	  i,j:integer;
  begin
	  SetLength(temp_array,Length(input));

    for i:=(w_size-1) downto 0 do
	    begin
		    t_sum:=0;
		    j:=i;
		    while (j>=0) do
		      begin
			      t_sum:=t_sum+input[j];
			      j:=j-1;
		      end;
		    temp_array[i]:=t_sum/w_size;
      end;
    for i:=(w_size) to (Length(input)-1) do
		  begin
			  t_sum:=0;
			  j:=w_size-1;
			  while (j>=0) do
			    begin
				    t_sum:=t_sum+input[i-j];
				    j:=j-1;
			    end;
			  temp_array[i]:=t_sum/w_size;
		  end;
    Result:= temp_array;
  end;

function abs_max (input:TQDbl): double;export;
  var
	  max,tmp:double;
	  i:integer;
  begin
	  max:=0;
	  for i:=0 to (Length(input)-1) do
	    begin
        tmp := Abs(input[i]);
  		  if(tmp>max) then
			    max := tmp;
	    end;

	  Result:=max;
end;

function find_rms (input:TQDbl): double;export;
  var
	  rms_val:double;
	  i:integer;
  begin
	  rms_val:=0;
	  for i:=0 to (Length(input)-1) do
	    begin
		    rms_val:=rms_val+Sqr(input[i]);
	    end;
	  rms_val:=rms_val/Sqrt(Length(input));
	  Result:=rms_val;
  end;



procedure sort(A : TQDbl);export;
  var
    tmp   : Double;
    size,k,i: integer;
  begin

    size := Length(A);

    for i := 0 to size-1 do
      begin
        if A[i] > A[i-1] then Continue;
        tmp := A[i];
        k   := i-1;
        while (k>=0) and (A[k]>tmp) do
          begin
            A[k+1] := A[k];
            k := k-1;
          end;
        A[k+1] := tmp;
      end;
  end;

function RgbToGray(RGBColor : TColor) : Double;export;
  begin
    Result := (0.299 * GetRValue(RGBColor)) +
              (0.587 * GetGValue(RGBColor)) +
              (0.114 * GetBValue(RGBColor));

  end;

function GetGrayImage(Resim:Timage):TDDbl;export;
  var
    width,height:integer;
    i,j:integer;
    grayimage:TDDbl;
    t1,t2 : double;
  begin
    width := Resim.Picture.Width;
    height:= Resim.Picture.Height;
    SetLength(grayimage,width,height);
    for i:=0 to width-1 do
      begin
          for j:=0 to height-1 do
            begin
              t1 := RgbToGray(Resim.Canvas.Pixels[i,j]);
              t2 :=  Floor(t1) + 0.5;
              if (t1 > t2) then
                grayimage[i,j] := Floor(t1) + 1
              else
                grayimage[i,j] := Floor(t1) ;
            end;
      end;
      Result := grayimage;
  end;

function image_test_21( im : TDDbl) : Double;export;
  var
    frame_width,err_threshold,blur_threshold,noise_count,tmp,L,W :integer;
		threshold,med,dif,fnc,mu,distortion_ratio,cur_pix :Double;
		med_array : TQDbl;
    i,j :integer;
    str : String;
  begin

    frame_width := 3;
		threshold   := 0.9;
		err_threshold := 50;
		blur_threshold:= 10;
		noise_count := 0;

    tmp := frame_width*frame_width;
    SetLength(med_array,tmp);

		L  := Length(im[0]);
		W  := Length(im);

    for i := 1 to W-2 do
      begin
        for j := 1 to L-2 do
          begin
            cur_pix := im[i,j];

            med_array[0] := im[i-1,j-1];
            med_array[1] := im[i-1,j];
            med_array[2] := im[i-1,j+1];

            med_array[3] := im[i+1,j-1];
            med_array[4] := im[i+1,j];
            med_array[5] := im[i+1,j+1];

            med_array[6] := im[i,j-1];
            med_array[7] := im[i,j+1];

            med_array[8] := cur_pix;

            Sort(med_array);

            med := med_array[4];

            dif := Abs(cur_pix-med);

            fnc := (1-Exp(-dif))/(1+Exp(-dif));
            if (fnc <= 0.5) then
              begin
                mu := 2*Sqr(fnc);
              end
            else
              begin
                mu := 1-2*Sqr(1-fnc);
              end;

            if (mu >= threshold) then
              noise_count := noise_count+1;
          end;
      end;

      distortion_ratio := (noise_count*100.0)/((W-2)*(L-2));

      str := '';
      if (distortion_ratio >= err_threshold) then
        str  := '-------------Görüntü gürültülü------------' + #13#10
      else if (distortion_ratio <= blur_threshold) then
        str  := '-------------Görüntü Bulanık------------' + #13#10
      else
        str  := '-------------Görüntü Temiz------------'+ #13#10;
      str := str + #13#10 + 'Bozulma Oranı:  ' + floattostr(distortion_ratio);

      Result := distortion_ratio;
  end;


function sum2(input : TDDbl) : Double;export;
  var
    t_sum : double;
    L,W,i,j : integer;
  begin
    L := Length(input[0]);
    W := Length(input);
    t_sum := 0;
    for i := 0 to W-1 do
      begin
        for j := 0 to L-1 do
          begin
            t_sum := t_sum + input[i,j];
          end;
      end;
    Result := t_sum;
  end;

function ewise_product (input1 : TDDbl ; input2 : TDDbl) :TDDbl;export;
  var
    L,W,i,j : integer;
    t_array : TDDbl;
  begin
    L := Length(input1[0]);
    W := Length(input1);
    SetLength(t_array,W,L);

    for i := 0 to W-1 do
      begin
        for j := 0 to L-1 do
          begin
            t_array[i,j] := input1[i,j] * input2[i,j];
          end;
      end;

    Result := t_array;
  end;

function blank_screen_check(im1 : TDDbl;im2 : TDDbl) : Double;export;
  var
    L,W,i,j : integer;
    t_res,mean1,mean2 : Double;
  begin
    L := Length(im1[0]);
    W := Length(im1);

    mean1 := sum2(im1) / L*W;
    mean2 := sum2(im2) / L*W;

    for i := 0 to W-1 do
      begin
        for j := 0 to L-1 do
          begin
            im1[i,j] := im1[i,j] - mean1;
            im2[i,j] := im2[i,j] - mean2;
          end;
      end;

    t_res := sum2(ewise_product(im1,im2)) / Sqrt(sum2(ewise_product(im1,im1))*sum2(ewise_product(im2,im2))) ;
    Result := t_res;

  end;

procedure sound_test(data : TQDbl);export;
  var
	  window_size,err1_threshold,err2_threshold, sn_count, nos_count,i: integer;
	  no_sound_threshold,rms_data,nos_rate,sn_rate, threshold, threshold_ratio: double;
	  sample_filt: TQDbl;
	  print_string:string;
  begin
	  window_size:=3;
	  sn_count:=0;
	  nos_count:=0;
	  threshold_ratio:=0.1;
	  SetLength(sample_filt,Length(data));
	  sample_filt:=mov_filt(window_size, data);
	  threshold:=abs_max(sample_filt)*threshold_ratio;
	  no_sound_threshold:=0.01;
	  err1_threshold:=10;
	  err2_threshold:=50;
	  rms_data:=find_rms(data);
	  for i:=0 to (Length(data)-1) do
	    begin
		    if (Abs(data[i]-sample_filt[i]) >= threshold) then
		      begin
			      sn_count:=sn_count+1;
		      end;
	    end;

	  for i:=0 to (Length(data)-1) do
	    begin
		    if (Abs(Abs(data[i])-rms_data) >= no_sound_threshold) then
		      begin
			      nos_count:=nos_count+1;
		      end;
	    end;

	  nos_rate:=(nos_count*100.0)/Length(sample_filt);
	  sn_rate:=(sn_count*100.0)/Length(sample_filt);

	  print_string:='*************************************'
	                +#13#10+ 'Gürültü Hızı : '+FormatFloat('0.000',sn_rate)+'%' +#13#10+
	                'Anlamlı Ses Hızı : '+FormatFloat('0.000',nos_rate)+'%';

	  if (sn_rate>=err1_threshold)  then
		  print_string:=print_string+#13#10+'Hata 1 : Ses Gürültülü!';

	  if (nos_rate<=err2_threshold) then
		  print_string:=print_string+#13#10+'Hata 2 : Anlamsız Ses Tespit Edildi!';

    ShowMessage(print_string);
  end;




end.
Hayat öldüğünde diplomanı alacağın bir okuldur. Önemli olan doğru hocaları bulmak.
Başa dön
Kullanıcı avatarı
sadettinpolat
Moderator
Mesajlar: 2131
Kayıt: 07 Ara 2003 02:51
Konum: Ankara
İletişim:
İletişim sadettinpolat

Mesaj gönderen sadettinpolat »

hosgeldiniz ve tesekkurler :)
"Sevmek, ne zaman vazgececegini bilmektir." dedi, bana.

---
http://sadettinpolat.blogspot.com/
Başa dön
Kullanıcı avatarı
mudipasa
Üye
Mesajlar: 169
Kayıt: 13 Tem 2004 02:25
Konum: Batman

Mesaj gönderen mudipasa »

Allah razı olsun. Kodlar güzel ama nasıl veya nerde kullanabiliriz birde onu benim gibi acemiler için açıklasan sevinirim.
Başa dön
Kullanıcı avatarı
mkaderoglu
Üye
Mesajlar: 48
Kayıt: 04 Tem 2007 11:14
Konum: Konya
İletişim:
İletişim mkaderoglu

Mesaj gönderen mkaderoglu »

estafurullah acemilik ne demek. ben bu kodları türksat bünyesinde çalışırken uydudan gelen görüntüleri kontrol edip görüntüde karlanma bozukluk yada seste bozukluk varmı diye analiz eden sonuçtada belli bi bozukluk yüzdesinin üstündeki kanalların reciver'ına kapat komutunu gönderen bi program için geliştirmiştim fonksiyonları incelerseniz zaten parametre ile verilen bi stream'i kontrol ediyor genelde
Hayat öldüğünde diplomanı alacağın bir okuldur. Önemli olan doğru hocaları bulmak.
Başa dön
Cevapla

“Makale ve İpucu” sayfasına dön