////////////////////////////////////////////////////////////////////////////////
// 28.3.2018  
////////////////////////////////////////////////////////////////////////////////
var
  I, C, TI, KID: Integer;
  X, Y, XS, YS, XE, YE, XMin, YMin, XMax, YMax: Double;
  ATB: Boolean;
  Points: Variant;
  procedure ClearATBCMM; begin ATB := FALSE; C := 0; XMin := MAXDOUBLE; YMin := MAXDOUBLE; XMax := -MAXDOUBLE; YMax := -MAXDOUBLE; end;
  function AddToBuf: Boolean; begin Result := (C>1) and (XS=XE) and (YS=YE); if Result then begin BufferAddCoord((XMax+XMin)/2, (YMax+YMin)/2); ATB := TRUE; end; end;
begin
  LMClear; ClearSelect; BufferClear; BufferSetMode(0);
  TI := GetEDTI('znaky KA', 1);
  for KID := 1 to GetCount(TI) do begin
    Points := GetPoints(TI, KID);
    ClearATBCMM;
    for I := 0 to Length(Points)-1 do begin
      X := Points[I, 1]; Y := Points[I, 2];
      if IsNaN(X) then begin
        if AddToBuf then Break;
        ClearATBCMM; Continue;
      end else if C=0 then begin
        XS := X; YS := Y;
      end;
      XE := X; YE := Y; Inc(C); if X<XMin then XMin := X; if Y<YMin then YMin := Y; if X>XMax then XMax := X; if Y>YMax then YMax := Y;
    end;
    if not ATB then AddToBuf;
    if not ATB then AddToSelect(TI, KID, TRUE);
    //LM(Format('KID: %d, ATB: %s', [KID, BoolToStrFix(ATB)]));
    Status('KID: '+IntToStr(KID));
  end;
  MapsInvalidate;
end.



////////////////////////////////////////////////////////////////////////////////
// 27.3.2018  
////////////////////////////////////////////////////////////////////////////////
const
  DBO = 0;
  TABLE = 'SILNOPROUD_KABELY_POPIS';
  TABLE_EDIT = 'ATABLE79';
var
  I, J, K, L, C, ISEL, IXY, SC, TI, TIE, KType, KID, KIDE, I_, SLA_I, ELA_I, J_, SLA_J, ELA_J: Integer;
  X, Y, DX, DY, D, D1: Double;
  Points: Variant;
  XA, YA: array of Double; SA, EA, SLA, ELA: array of Integer;
  SL: TStringList;
  KText: string;
  function Distance(const I1, I2: Integer): Double; begin DX := XA[I1]-XA[I2]; DY := YA[I1]-YA[I2]; Result := Sqrt((DX*DX)+(DY*DY)); end;
  procedure Clear_; begin SLA_I := -1; ELA_I := -1; SLA_J := -1; ELA_J := -1; end;
begin
  TI := GetDBTI(TABLE, DBO);
  TIE := GetDBTI(TABLE_EDIT, DBO);
  SC := SelectCount(TI);
  if SC=0 then begin MsgInf('Výběr je prázdný.'); Exit; end;
  LMClear;
  IXY := -1; ISEL := -1; KText := '';
  if SC>0 then for I := 0 to SC-1 do begin
    KID := SelectKID(TI, I);
    SelectFirstRow('select KTYPE from '+TABLE+' where KID=:0', KType, KID, FALSE, DBO);
    if KType=30 then begin
      Points := GetPoints(TI, KID);
      for J := 0 to Length(Points)-1 do begin
        if (J=0) or IsNaN(Points[J, 1]) then begin
          Inc(ISEL); SetLength(SA, ISEL+1); SetLength(EA, ISEL+1); SetLength(SLA, ISEL+1); SetLength(ELA, ISEL+1);
          SA[ISEL] := IXY+1; SLA[ISEL] := -1; ELA[ISEL] := -1;
          if J>0 then Continue;
        end;
        Inc(IXY); SetLength(XA, IXY+1); XA[IXY] := Points[J, 1]; SetLength(YA, IXY+1); YA[IXY] := Points[J, 2];
        EA[ISEL] := IXY;
      end;
    end else if KType=70 then begin
      SelectFirstRow('select KTEXT from '+TABLE+' where KID=:0', KText, KID, FALSE, DBO);
    end;
  end;
  ///////////////////////
  for I := 0 to ISEL do begin
    for J := 0 to ISEL do if J<>I then begin
      if (SLA[I]=-1) and (SLA[J]=-1) and (Distance(SA[I], SA[J])<0.01) then begin SLA[I] := SA[J]; SLA[J] := SA[I]; Break; end;
      if (SLA[I]=-1) and (ELA[J]=-1) and (Distance(SA[I], EA[J])<0.01) then begin SLA[I] := EA[J]; ELA[J] := SA[I]; Break; end;
      if (ELA[I]=-1) and (SLA[J]=-1) and (Distance(EA[I], SA[J])<0.01) then begin ELA[I] := SA[J]; SLA[J] := EA[I]; Break; end;
      if (ELA[I]=-1) and (ELA[J]=-1) and (Distance(EA[I], EA[J])<0.01) then begin ELA[I] := EA[J]; ELA[J] := EA[I]; Break; end;
    end;
  end;
  //for I := 0 to ISEL do begin LM(I); LMA(SA[I]); LMA(XA[SA[I]]); LMA(YA[SA[I]]); LMA(EA[I]); LMA(XA[EA[I]]); LMA(YA[EA[I]]); LMA(SLA[I]); LMA(ELA[I]); end;
  //////////////////////
  C := 0;
  for I := 0 to ISEL do begin if SLA[I]=-1 then Inc(C); if ELA[I]=-1 then Inc(C); end;
  C := C div 2;
  //LM('-');
  //////////////////////
  while C>1 do begin
    D := MAXDOUBLE; Clear_;
    for I := 0 to ISEL do begin
      for J := 0 to ISEL do if J<>I then begin
        if (SLA[I]=-1) and (SLA[J]=-1) then begin D1 := Distance(SA[I], SA[J]); if D>D1 then begin D := D1; Clear_; I_ := I; SLA_I := SA[J]; J_ := J; SLA_J := SA[I]; end; end;
        if (SLA[I]=-1) and (ELA[J]=-1) then begin D1 := Distance(SA[I], EA[J]); if D>D1 then begin D := D1; Clear_; I_ := I; SLA_I := EA[J]; J_ := J; ELA_J := SA[I]; end; end;
        if (ELA[I]=-1) and (SLA[J]=-1) then begin D1 := Distance(EA[I], SA[J]); if D>D1 then begin D := D1; Clear_; I_ := I; ELA_I := SA[J]; J_ := J; SLA_J := EA[I]; end; end;
        if (ELA[I]=-1) and (ELA[J]=-1) then begin D1 := Distance(EA[I], EA[J]); if D>D1 then begin D := D1; Clear_; I_ := I; ELA_I := EA[J]; J_ := J; ELA_J := EA[I]; end; end;
      end;
    end;
    if SLA_I>-1 then SLA[I_] := SLA_I; if ELA_I>-1 then ELA[I_] := ELA_I; if SLA_J>-1 then SLA[J_] := SLA_J; if ELA_J>-1 then ELA[J_] := ELA_J;
    Dec(C);
  end;
  //for I := 0 to ISEL do begin LM(I); LMA(SA[I]); LMA(XA[SA[I]]); LMA(YA[SA[I]]); LMA(EA[I]); LMA(XA[EA[I]]); LMA(YA[EA[I]]); LMA(SLA[I]); LMA(ELA[I]); end;
  //////////////////////
  SL := TStringList.Create;
  SL.Values['KType'] := '30';
  //BufferClear; BufferSetMode(1);
  J := -1; L := -1; C := 0; X := NaN;
  for I := 0 to ISEL do begin
    if SLA[I]=-1 then begin J := SA[I]; K := EA[I]; L := ELA[I]; Break; end;
    if ELA[I]=-1 then begin J := EA[I]; K := SA[I]; L := SLA[I]; Break; end;
  end;
  while J>-1 do begin
    I := J;
    while TRUE do begin
      //if (X<>XA[I]) or (Y<>YA[I]) then begin X := XA[I]; Y := YA[I]; BufferAddCoord(X, Y); Inc(C); end;
      if (X<>XA[I]) or (Y<>YA[I]) then begin X := XA[I]; Y := YA[I]; SL.Values['X'+IntToStr(C)] := FloatToStr(X); SL.Values['Y'+IntToStr(C)] := FloatToStr(Y); Inc(C); end;
      if J<K then begin Inc(I); if I>K then Break; end else begin Dec(I); if I<K then Break; end;
    end;
    J := -1;
    if L>-1 then for I := 0 to ISEL do begin
      if SA[I]=L then begin J := SA[I]; K := EA[I]; L := ELA[I]; Break; end;
      if EA[I]=L then begin J := EA[I]; K := SA[I]; L := SLA[I]; Break; end;
    end;
  end;
  SL.Values['Count'] := IntToStr(C);
  if C>1 then begin
    KIDE := CreateNewObject(TIE, SL); Post(DBO);
    if KText<>'' then ExecSQL('update '+TABLE_EDIT+' set TEXT=:0 where KID=:1', [KText, KIDE], DBO);
    DesktopInvalidate;
  end else begin
    MsgInf('Nový objekt nebyl vytvořen.');
  end;
  SL.Free;
end.



////////////////////////////////////////////////////////////////////////////////
// 23.3.2018 znaky-mif-buffer
////////////////////////////////////////////////////////////////////////////////
var
  I, J, L, LXM, TI, KID: Integer;
  X, Y, DX, DY: Double;
  Points: Variant;
  T: Char;
  XMins, YMins, XMaxs, YMaxs: array of Double;
  function Distance(const I1, I2: Integer): Double; begin DX := Points[I1, 1]-Points[I2, 1]; DY := Points[I1, 2]-Points[I2, 2]; Result := Sqrt((DX*DX)+(DY*DY)); end;
begin
  BufferClear; BufferSetMode(0);
  TI := GetEDTI('znaky', 0);
  for KID := 1 to GetCount(TI) do begin
//if Kid<>262 then Continue;
    Points := GetPoints(1, KID); L := Length(Points);
    J := -1;
    for I := 0 to L-1 do begin
      if (I=0) or IsNaN(Points[I, 1]) then begin
        Inc(J, 2); SetLength(XMins, J); SetLength(YMins, J); SetLength(XMaxs, J); SetLength(YMaxs, J);
        Dec(J); XMins[J] := MAXDOUBLE; YMins[J] := MAXDOUBLE; XMaxs[J] := -MAXDOUBLE; YMaxs[J] := -MAXDOUBLE;
      end;
      if IsNaN(Points[I, 1]) then Continue;
      if Points[I, 1]<XMins[J] then XMins[J] := Points[I, 1];
      if Points[I, 2]<YMins[J] then YMins[J] := Points[I, 2];
      if Points[I, 1]>XMaxs[J] then XMaxs[J] := Points[I, 1];
      if Points[I, 2]>YMaxs[J] then YMaxs[J] := Points[I, 2];
    end;
//for I := 0 to Length(XMins)-1 do begin LM(XMaxs[I]-XMins[I]); LMA(YMaxs[I]-YMins[I]); end;
    X := NaN; T := ' '; LXM := Length(XMins);
    for I := 0 to Length(XMins)-1 do begin
      //A
      if (RoundTo(XMaxs[I]-XMins[I], -3)=0.05) and (RoundTo(YMaxs[I]-YMins[I], -3)=0.05) then begin
        X := (XMaxs[I]+XMins[I])/2; Y := (YMaxs[I]+YMins[I])/2; T := 'A'; Break;
      end;
      //B
      if (RoundTo(XMaxs[I]-XMins[I], -2)=0.75) and (RoundTo(YMaxs[I]-YMins[I], -2)=0.75) and IsNaN(Points[L-3, 1]) and IsNaN(Points[2, 1]) and IsNaN(Points[L-3, 1]) then begin
        X := Points[L-1, 1]; Y := Points[L-1, 2]; T := 'B'; Break;
      end;
      //C
      if (RoundTo(XMaxs[I]-XMins[I], -2)=0.75) and (RoundTo(YMaxs[I]-YMins[I], -2)=0.75) and IsNaN(Points[2, 1]) then begin
        X := Points[1, 1]; Y := Points[1, 2]; T := 'C'; Break;
      end;
      //D
      if (RoundTo(XMaxs[I]-XMins[I], -2)=0.25) and (RoundTo(YMaxs[I]-YMins[I], -2)=0.25) and (LXM=1) then begin
        X := (XMaxs[0]+XMins[0])/2; Y := (YMaxs[0]+YMins[0])/2; T := 'D'; Break;
      end;
      //E
      if (RoundTo(XMaxs[I]-XMins[I], -3)=0.037) and (RoundTo(YMaxs[I]-YMins[I], -3)=0.037) then begin
        X := (XMaxs[I]+XMins[I])/2; Y := (YMaxs[I]+YMins[I])/2; T := 'E'; Break;
      end;
      //F
      if (LXM=1) and (L>3) then begin
        X := (XMaxs[0]+XMins[0])/2; Y := (YMaxs[0]+YMins[0])/2; T := 'F'; Break;
      end;
      //G
      if (LXM=6) and (RoundTo(Distance(0, 1), -3)=0.05) and (RoundTo(Distance(3, 4), -3)=0.05) and (RoundTo(Distance(6, 7), -3)=1) and (RoundTo(Distance(9, 10), -3)=1) and (RoundTo(Distance(12, 13), -3)=1) and (RoundTo(Distance(15, 16), -3)=1) then begin
        X := (XMaxs[0]+XMins[0])/2; Y := (YMaxs[0]+YMins[0])/2; T := 'G'; Break;
      end;
    end;
    if IsNaN(X) then Continue;
    BufferAddCoord(X, Y);
    LM(Format('KID: %d, Type: %s', [KID, T]));
  end;
  MapsInvalidate;
end.