Language:

Gönderen Konu: Lazarus'ta formun üzerindeki kontrolün, altında kalan noktaları bulmak  (Okunma sayısı 703 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
Lazarus'ta formun üzerindeki shape'in üzerinde bulunduğu noktaları bulmak için şöyle bir kod yazdım:

Alıntı
uses
  SysUtils, FileUtil, Forms, Controls, Graphics,Classes,
  Dialogs, StdCtrls, ExtCtrls, unit2, video, LResources;

type
  dolukareler=array of trect;
  doluyerler=array of tpoint;

public
    { public declarations }
  var
 
  dolukareler1:dolukareler;
  doluyerler1:doluyerler;
  end;

procedure TForm1.FormActivate(Sender: TObject);
var
  i,j,k,l,m: integer;
begin
  j:=0;
  m:=0;
  for i:=0 to form1.ControlCount-1 do               
  begin
    if form1.Controls.tag=2 then                          //tag değeri 2 olan shape'leri tespit ediyoruz
    begin
      inc(j);
      setlength(dolukareler1,j);
      dolukareler1[j-1].Left:=form1.Controls.Left;
      dolukareler1[j-1].Top:=form1.Controls.top;
      dolukareler1[j-1].Right:=form1.Controls.Left+form1.Controls.Width;
      dolukareler1[j-1].Bottom:=form1.Controls.top+form1.Controls.Height;
      for k:=dolukareler1[j-1].Left to dolukareler1[j-1].Right do
      begin
        for l:=dolukareler1[j-1].Top to dolukareler1[j-1].Bottom do
        begin
          if canvas.Pixels[k,l]=clblack then              //Shepe içindeki siyah renkli noktaları buluyoruz
          begin
            inc(m);
            setlength(doluyerler1,m);
            doluyerler1[m-1]:=point(k,l);
          end;
        end;
      end;
    end;
  end;
  edit2.Text:=inttostr(m);
end;

Ancak shape1'in her form üzerindeki yerini değiştirip programı çalıştırdığımda (shape1'in boyutları  ve şekli aynı kaldığı halde) farklı sonuçlar buluyor(edit2.text:=inttostr(m)). Kod mu yanlış, Lazarus'mu yanlış yoksa çalıştırırken bir hata mı yapıyorum? (Lazarus 1.6.2, Sistem:windows)
« Son Düzenleme: 16 Ocak 2017, 23:28:52 Gönderen: halilkundakci »

mecazi1

  • Devamlı

  • Çevrimdışı
  • ***

  • 223
    • Profili Görüntüle
 Basit düşünürüm. Şöyle bir kod işini görmez mi?

procedure TForm1.Button1Click(Sender: TObject);
begin
  edit1.text:=inttostr(Shape1.Left)+','+inttostr(Shape1.top);//A köşesi
  edit2.text:=inttostr(Shape1.Left+Shape1.Width)+','+inttostr(Shape1.top);//B köşesi
  edit3.text:=inttostr(Shape1.Left)+','+inttostr(Shape1.top+Shape1.Height);//C köşesi
  edit4.text:=inttostr(Shape1.Left+Shape1.Width)+','+inttostr(Shape1.top+Shape1.Height);//D köşesi
end; 

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
Amacım siyah bölgeleri(Shape altında kalan noktaları) nokta nokta tespit etmek. Diyelim ki Shepe şekli yıldız olsun; sadece yıldız altında kalan bölgeler mesela.(Shepe.brush.color:=clblack)
Kodu aşağıdaki gibi kısalttım. Ama sonuç yine aynı: Her seferinde farklı hesaplıyor.(edit2.Text:=inttostr(l);), Bazen "0" bile buluyor.

Alıntı
procedure TForm1.FormActivate(Sender: TObject);
var
i,j,k,l:integer;
begin
  l:=0;
  for i:=0 to form1.ControlCount-1 do
  begin
    if form1.Controls.tag=2 then              //tag değeri 2 olan shape'leri tespit ediyoruz
    begin
      for j:=form1.Controls.Left to form1.Controls.Left+form1.Controls.Width do
      begin
        for k:=form1.Controls.top to form1.Controls.top+form1.Controls.Height do
        begin
          if canvas.Pixels[j,k]=clblack then    //Shape'in şeklinin(Örneğin siyah renkli yıldız) altında kalan noktaları buluyoruz
          begin
            inc(l);
            SetLength(engeller,l);
            engeller[l-1]:=point(j,k);
          end;
        end;
      end;
    end;
  end;
  edit2.Text:=inttostr(l);                        //Shape'in şeklinin(Örneğin siyah renkli yıldız) altında kalan yerlerin sayısı
end;
« Son Düzenleme: 17 Ocak 2017, 13:25:10 Gönderen: halilkundakci »

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
sonuç yine aynı: Her seferinde farklı hesaplıyor.(edit2.Text:=inttostr(l);), Bazen "0" bile buluyor.

Hatta tasarım aşamasında shape seçili vaziyetteyken hata ayıklamayı çalıştırırsam sonuç yine farklı çıkıyor. (edit2.Text:=inttostr(l);)

Bu yol6 içerisindeki çalışma; aşağıdaki köprüden indirip bakabilirsiniz.

https://drive.google.com/open?id=0B8zsg_8o2163NXRZakhwVFM1V00

Shape 'i kare, pan.style:=pssolid, pan.width:=1, brush.style:=bsclear seçince boyutlarını da 100x100 ayarlayınca: edit2.Text:='400'(Çevre uzunluğu) çıkması gerekmez mi?

Sanki lazarus'ta bir sorun varmış gibi geliyor bana veya programı derlerken benim yapmam gereken bir ince ayar...  ???
« Son Düzenleme: 17 Ocak 2017, 23:25:40 Gönderen: halilkundakci »

mecazi1

  • Devamlı

  • Çevrimdışı
  • ***

  • 223
    • Profili Görüntüle
Parametreler değişmeden sonuç değişmez.
Aynı kodları bir de delphi de dene.

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
Embarcadero® Delphi 10.1 Berlin ile denedim. Hiç bir ayarla oynamadan hata ayıklamayı çalıştırıyorum; Sonuç yine aynı: her çalıştırmada farklı sonuç veriyor. Yanlış algoritma mı kullanıyorum acaba? Ekran görüntüsü anlık olarak farklı renk tonlarını mı döndürür? Tıkandım.

mecazi1

  • Devamlı

  • Çevrimdışı
  • ***

  • 223
    • Profili Görüntüle
doluyerler1, dolukareler1, bunlar global değişkenler. Her defasında sıfırlanmayacaktır.Üzerine bindirme yapabilir.Sıkıntı bundan kaynaklanabilir.
« Son Düzenleme: 19 Ocak 2017, 09:17:44 Gönderen: mecazi1 »

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
"doluyerler1", "dolukareler1". Bunlar sadece program açılıp kapandığında sıfırlanmazlar mı?(Program içerisinde farklı bir kod yazmadığımız sürece).

Kodları farklı bir Yordam içerisine yazdığımızda(Örneğin mouseenter) sorun çözülüyor.
Ancak activite yordamında sorun çözülebilir mi? Sorunu çözmek için bu yordamın işleyiş mantığına uygun bir çözüm mü bulmak gerekiyor? Veya boşa mı kürek sallıyorum?...

Bu arada kendimce bir şey keşfettim(Pek çok programcı diyecek ki amerikayı daha yeni keşfediyor ;D): 100x100'lük shape çevresi 400. Her nokta sadece 1 kere tarandığı için bulunan nokta sayısı 396 çıkıyor. Tüm dikdörtgenler için geçerli. Örneğin aşağıda 7x4 lük dikdörtgende çevresi 22 yapar. Ancak nokta sayısı 18'dir. Fark 4, sabit.

*******
*         *
*         *
*******


İlkokul mantığıyla çözdüm ;D
« Son Düzenleme: 19 Ocak 2017, 16:28:27 Gönderen: halilkundakci »

mecazi1

  • Devamlı

  • Çevrimdışı
  • ***

  • 223
    • Profili Görüntüle
Doluyerler1 ile dolukareler1 i formactivate yordamının içine tanımlayarak dener misin?
« Son Düzenleme: 19 Ocak 2017, 17:33:12 Gönderen: mecazi1 »

halilkundakci

  • Yeni

  • Çevrimdışı
  • *

  • 22
    • Profili Görüntüle
Doluyerler1 ile dolukareler1'i formactivate yordamının içine tanımlansa da tutarsız sonuçlar veriyor. Ama activate; komutuyla başka bir yordam içerisinden formactivate yordamı tetiklenirse veya başka bir yordam içerisinden doğrudan kod yazılırsa(onclick gibi) sonuç doğru çıkıyor. onshow,on paint, oncreate işe yaramadı.

Birde artık aşağıdaki kodu kullanıyorum. Bu daha kısa; shape'lerin bulunduğu kareleri bulmaya çalışmak gereksiz. Doluyerler1 ve dolukareler1 içinde gereksiz tip tanımlaması yapmışım.

Alıntı
public
    { public declarations }
  var 
  engeller:array of tpoint;
  end;

procedure TForm1.FormClick(Sender: TObject);
var
i,j,k,l:integer;
begin
  l:=0;
  for i:=0 to form1.ControlCount-1 do
  begin
    if form1.Controls.tag=2 then          //tag değeri 2 olan shape'leri tespit ediyoruz
    begin
      for j:=form1.Controls.Left to form1.Controls.Left+form1.Controls.Width do
      begin
        for k:=form1.Controls.top to form1.Controls.top+form1.Controls.Height do
        begin
          if canvas.Pixels[j,k]=clblack then //Shape'in şeklinin(Örneğin yıldız) altında kalan siyah renkli noktaları buluyoruz
          begin
            inc(l);
            SetLength(engeller,l);
            engeller[l-1]:=point(j,k);
          end;
        end;
      end;
    end;
  end;
  edit2.Text:=inttostr(l);                   //Shape'in şeklinin(Örneğin yıldız) altında kalan siyah renkli yerlerin sayısı
end;

Bu arada bu kodları onactivate, onshow, onpaint, oncreate dışında bir yordama yazdığımızda alanı da doğru hesaplıyor.(brush.style:=bssolid yapılırsa) Yani sorun kodu hangi yordama yazacağımızda.
« Son Düzenleme: 19 Ocak 2017, 23:55:25 Gönderen: halilkundakci »

 

Yukarı Çık & Back to Up