Izvorna Koda

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math, ComCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit5: TEdit;
    Label7: TLabel;
    Memo2: TMemo;
    Edit6: TEdit;
    Label8: TLabel;
    Button3: TButton;
    StatusBar1: TStatusBar;
    Label9: TLabel;
    Label10: TLabel;
    Button4: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const MAX_DALJIC = 4000000;
      MAX_TOCK = 2000;

type tockiT = record
  kot : Real;
  odmik : Real;
end;

type
  tockaT = record
    x, y : Integer;
  end;

  premicaT = record
    kot, odmik : Integer;
  end;

  premicaRT = record
    kot, odmik : Real;
  end;


var tabela : Array[1..MAX_DALJIC] of tockiT;
    tocka  : Array[1..MAX_TOCK] of tockaT;
    p_tabela : Array[-2000..2000,0..180] of LongInt;
    k_tabela : Array[0..180] of Longint;
    premica : Array[1..1000] of PremicaT;
    p_premica : Array[1..100] of PremicaRT;

function toString(I: Longint): string;
var
  S: string[11];
begin
  Str(I, S);
  toString:= S;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  visina, sirina : Integer;
  a, b, aa, bb : Integer;

  piksel, piksel2, barva : TColor;

  i : Integer;
  i2 : LongInt;

  la, lb, lc : LongInt;
  c : Integer;

  kot : Integer;
  n : LongInt;

  odmik_navp, odmik_vodo : Real;

  stevec1, stevec : Integer;
  povprecje : Real;
  faktor : Integer;
  faktor_R : Real;

  kotR, odmikR : Real;

  tolerancaKot, tolerancaOdmik : Integer;

  max_koti : Array[1..181] of Integer;
  kotP : LongInt;
  odmikP : LongInt;


Procedure IskanjeDaljice(kotI, odmik : Real);
var
  zx, zy : Integer;
  zx_r, zy_r : Real;
  t : Integer;
  kot : Real;
  tI : Integer;
  stanje : Integer;

  tx, ty : Integer;
  zac_x, zac_y : Integer;

  tolerancaDolzine : Integer;

Function IsciRumeno : Boolean;
Var
  i, j : Integer;
  Ja : Boolean;
Begin
  Ja := False;
  for i:=1 to 2*tI+1 do
    for j:=1 to 2*tI+1 do
      begin
        if Image1.Canvas.Pixels[-(tI) + zx + i, -(ti) + zy + j]=clYellow then
          begin
            Ja:=True;
            tx := -(tI) + zx + i;
            ty := -(ti) + zy + j;
          end;
      end;
  IsciRumeno := Ja;
End;


Function IsciRdece : Boolean;
Var
  i, j : Integer;
  Ja : Boolean;
Begin
  Ja := True;
  for i:=1 to 2*tI+1 do
    for j:=1 to 2*tI+1 do
      begin
        if Image1.Canvas.Pixels[-(tI) + zx + i, -(ti) + zy + j]=clYellow then
        begin
          Ja:=False;
          tx := -(tI) + zx + i;
          ty := -(ti) + zy + j;
        end;
      end;
  IsciRdece := Ja;
End;


Begin
  if odmik>=0 then
    begin
      zx_r := 1;
      zy_r := odmik;
      if kotI<90 then kot := -kotI
                 else kot := 180 - kotI;

    end
      else
    begin
      zx_r := -odmik;
      zy_r := 1;
      kot := 180-kotI;
      if kot <0 then kot:=kot+180;
      if kot > 180 then kot:=kot-180;
    end;

    t:=0;

    Val(Edit5.Text,tI,C);
    Val(Edit6.Text,tolerancaDolzine,C);
    stanje := 1;

    repeat
      inc(t);
      zx := round(zx_r + cos(kot*pi/180)*(t));
      zy := round(zy_r + sin(kot*pi/180)*(t));

      if stanje=1 then
        if IsciRumeno then
          begin
            stanje:=2;
            zac_x:=tx; zac_y:=ty;
          end;

      if stanje=2 then
        if IsciRdece then
          begin
            stanje:=1;
            if Sqrt(Sqr(tx-zac_x)+Sqr(ty-zac_y))>tolerancaDolzine then
            begin
              Memo2.Lines.Add('Z: X='+IntToStr(zac_x)+',Y='+IntToStr(zac_y));
              Memo2.Lines.Add('K: X='+IntToStr(tx)+',Y= '+IntToStr(ty));
            end;
          end;

      if (t mod 100 = 0) then Application.ProcessMessages;

      if stanje=1 then Image1.Canvas.Pixels[zx,zy]:=clBlue;

    until (zx>Image1.Width) or (zy>Image1.Height) or (zx<0) or (zy<0);

End;

begin
     Memo1.Clear;
     Memo2.Clear;
  fillchar(p_tabela,sizeof(p_tabela),0);
  fillchar(k_tabela,sizeof(k_tabela),0);
  fillchar(max_koti,sizeof(max_koti),0);

  visina := Image1.Height;
  sirina := Image1.Width;

  i := 0;

  Form1.Caption:='Pregledujem tocke';
  { pregledam in si zapomnim crne tocke }

  For a:=0 to visina do
    begin
    if a mod 10=0 then Application.ProcessMessages;
    For b:=0 to sirina do
      begin
        piksel := Image1.Canvas.Pixels[b,a];
        Image1.Canvas.Pixels[b,a] := clRed;
        if piksel = clBlack then
        begin
          inc(i);
          tocka[i].x := b;
          tocka[i].y := a;
        end; {if}
        Label1.Caption := toString(i);
      end; {for}
    end; {for}

  (********************************************)

  Form1.Caption:='Racunanje transformacije...';
  { transformacija x/y -> kot/odmik }

  i2 := 0;

  for a:=1 to i-1 do
    begin
    Image1.Canvas.Pixels[tocka[a].x, tocka[a].y]:=clYellow;
    Label2.Caption:=toString(i2);
    Application.ProcessMessages;
    for b:=a+1 to i do
      begin
        inc(i2);
        tabela[i2].kot := ArcTan2(tocka[a].x - tocka[b].x, tocka[a].y - tocka[b].y);
        {koti bodo od -pi do pi }
        odmik_navp := tocka[a].y - CoTan(tabela[i2].kot) * tocka[a].x;
        odmik_vodo := tocka[a].x - Tan(tabela[i2].kot) * tocka[a].y;

        { izracunam odmik na osi x in osi y - vrzrok: pri navpicnih premicah
          odmik na y gre proti y, pa tudi skala pri porazdelitveni tabeli se pri
          n -> neskoncno prevec popaci }

        if (odmik_navp<0) or ((odmik_vodo>0) and (odmik_navp>odmik_vodo)) then
        tabela[i2].odmik := -odmik_vodo
          else
        tabela[i2].odmik := odmik_navp;
      end;
    end;

  (******************************************)

  Form1.Caption:='Graditev pogostostne tabele...';
  {graditev pogostostne tabele}

  fillchar(p_tabela,sizeof(p_tabela),0);

  for la:=1 to i2 do
    begin
      {if abs(tabela[la].odmik)<=2000 then}
      begin
        n := round(tabela[la].odmik);
        kot := (Round(radToDeg(tabela[la].kot)) + 270) mod 180;
        inc(p_tabela[n,kot]);
        inc(k_tabela[kot]);
        if (la mod 1000=0) then
          begin
            Application.ProcessMessages;
            label1.caption:=toString(la);
          end;
      end;
    end;

  (****************************************************)
  { iskanje maximumov }

  { iskanje po kotih }

  faktor:=0;
  povprecje := i2 / 180;
  val(edit1.text,faktor,c);
  faktor_r := faktor / 100;

  stevec := 0;

  for la:=0 to 180 do
    begin
      if k_tabela[la]>(povprecje * faktor_r) then
        begin
         inc(stevec);
         max_koti[stevec]:=la;
        end;
    end;

  faktor:=0;
  val(edit1.text,faktor,c);
  faktor_r := faktor / 100;
  // memo1.lines.add(Floattostr(faktor_r));
  stevec1 := 0;

  for la:=1 to stevec do
    begin
      povprecje := k_tabela[max_koti[la]] / 100;

      for lb:=-2000 to 2000 do
        begin
         if p_tabela[lb,max_koti[la]]>(povprecje * faktor_r) then
           begin
             inc(stevec1);
             premica[stevec1].kot := max_koti[la];
             premica[stevec1].odmik := lb;
           end;
        end;
    end;


  { povprecenje podobnih premic }

  lc := 0;
  for la:=1 to stevec1 do
    begin
      if premica[la].kot <> -999 then
        begin
          kotP := premica[la].kot;
          odmikP := premica[la].odmik;

          Val(Edit3.Text,tolerancaKot,c);
          Val(Edit4.Text,tolerancaOdmik,c);

          stevec := 1;

          For lb:=la+1 to stevec1 do
            begin
              if ((abs(premica[lb].kot-premica[la].kot)<=tolerancaKot) and
                 (abs(premica[lb].odmik - premica[la].odmik)<=tolerancaOdmik)) then
                 begin
                   inc(stevec);
                   kotP:=kotP + premica[lb].kot;
                   odmikP := odmikP + premica[lb].odmik;
                   premica[lb].kot := -999;
                 end;
            end;
          kotR := kotP / stevec;
          odmikR := odmikP / stevec;
          inc(lc);
          p_premica[lc].kot := kotR;
          p_premica[lc].odmik := odmikR;
        end;

    end;
  { iskanje daljic }

  for la:=1 to lc do
  begin
    memo1.Lines.add('a='+IntToStr(Round(p_premica[la].kot))+', b='+IntToStr(Round(p_premica[la].odmik)));
  end;


  For la:=1 to lc do
    begin
      IskanjeDaljice(p_premica[la].kot, p_premica[la].odmik);
    end;

  { iskanje po n }

  Form1.Caption:='Program';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if (OpenDialog1.Execute) then
  Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;



procedure TForm1.Button3Click(Sender: TObject);
begin
  Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 if SaveDialog1.Execute then
 begin
  Memo1.Lines.SaveToFile(ExtractFileDir(SaveDialog1.FileName)+'a-b.txt');
  Memo2.Lines.SaveToFile(ExtractFileDir(SaveDialog1.FileName)+'Koordinate.txt');
 end;
end;

end.