unit a5_u;

interface

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

type
  TRectangle=TRect;(*record
    left,right:integer;
    top,bottom:integer;
  end;           *)
  TRaster=record
    fields: array of array of  boolean;
    uWidth,uHeight:integer;
  end;
  Ta5f = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    rwidthedit: TEdit;
    Label2: TLabel;
    rheightedit: TEdit;
    Label3: TLabel;
    parsedText: TEdit;
    parseFrom: TButton;
    Button1: TButton;
    Label4: TLabel;
    zoomedit: TEdit;
    Button2: TButton;
    ScrollBox1: TScrollBox;
    output: TPaintBox;
    StatusBar1: TStatusBar;
    einrasten: TCheckBox;
    search: TButton;
    Panel2: TPanel;
    Label5: TLabel;
    ListBox1: TListBox;
    Bevel1: TBevel;
    Label6: TLabel;
    minimalSizeCheckbox: TCheckBox;
    parseTo: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure outputPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure outputMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure outputMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure outputMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure searchClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure parseFromClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure parseToClick(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
    //Darstellung
    zoom:integer;
    buffer:TBitmap; //Doublebuffer
    rwidth,rheight:integer;
    //Steuerung
    makeNewRectangle:boolean;
    newRectangle: TRectangle;
    selectedFound,selectedMaked:integer;
    //Rechtecke
    rectangles:array of TRectangle;
    foundRectangles:array of TRectangle;

    procedure addNewRectangle(const rect:Trectangle);
    function CalculateRaster(const raster:TRaster):integer;
  end;


var
  a5f: Ta5f;


implementation

{$R *.DFM}
//Fügt die Rechtecke aus einem Mengenstring, in das rectangle-Array ein
procedure Ta5f.parseFromClick(Sender: TObject);
var menge:string;
    i:integer;
    ints:array[0..3] of integer;
    intpos:integer;
    readInt:boolean;
begin
  menge:=parsedText.Text;
  for i:=1 to length(menge) do //Trennzeichen durch #0 ersetzen
    if menge[i] in [',',')','}','(',';'] then menge[i]:=#0;

  readInt:=false;
  intpos:=0;
  for i:=1 to length(menge) do
    if readInt then begin //Zahl überspringen
      if not (menge[i] in ['0'..'9']) then readInt:=false; //fertig?
    end else begin
      if menge[i] in ['0'..'9'] then begin //Zahlbeginn?
        ints[intpos]:=StrToInt(string(@menge[i]));//Zahl in int konvertieren
        inc(intpos);
        if (intpos=4) then begin
          addNewRectangle(rect(ints[0],ints[1],ints[2],ints[3]));
          intpos:=0;
        end;
        readInt:=true;
      end;
    end;
    outputPaint(output);
end;


procedure Ta5f.searchClick(Sender: TObject);
var raster:TRaster;
  //achsenorientierte gerade Linie zeichen
  procedure drawRasterLine(x1,y1,x2,y2:integer);
  var i:integer;
  begin
    x1:=x1+1;//Schutzrahmen
    y1:=y1+1;
    x2:=x2+1;
    y2:=y2+1;
    if x1=x2 then begin    //y-Achse entlang laufen
      if y1<y2 then
        for i:=y1 to y2 do //runter
          raster.fields[x1,i]:=true
      else
        for i:=y1 downto y2 do //hoch
          raster.fields[x1,i]:=true;
    end else if y1=y2 then begin //x-Achse entlang
      if x1<x2 then
        for i:=x1 to x2 do //anch rechts
          raster.fields[i,y1]:=true
      else
        for i:=x1 downto x2 do //nach links
          raster.fields[i,y1]:=true;
    end else raise Exception.Create('Can''t paint Line');
  end;

  var
    i:integer;
begin
  SetLength(raster.fields,rwidth+2,rheight+2);
  for i:=0 to high(raster.fields) do
    ZeroMemory(@raster.fields[i,0],length(raster.fields[i]));//leeren
  raster.uWidth:=rwidth;
  raster.uHeight:=rheight;
  //Rechtecke in das Raster zeichnen
  for i:=0 to high(rectangles) do begin
    drawRasterLine(rectangles[i].Left,rectangles[i].top,rectangles[i].right,rectangles[i].top);
    drawRasterLine(rectangles[i].Left,rectangles[i].bottom,rectangles[i].right,rectangles[i].bottom);
    drawRasterLine(rectangles[i].Left,rectangles[i].top,rectangles[i].Left,rectangles[i].bottom);
    drawRasterLine(rectangles[i].right,rectangles[i].top,rectangles[i].right,rectangles[i].bottom);
  end;

  //Raster analysieren
  CalculateRaster(raster);
end;

//Sucht alle Rechteck im Raster
function Ta5f.CalculateRaster(const raster:TRaster):integer;
type TWinkel=record
  x,y:integer; //Koordinaten
  case typ:(wtLeftTop,wtRightBottom) of
    //Seitenlängen
    wtLeftTop: (lengthToRight, lengthToBottom:integer);
    wtRightBottom: (lengthToLeft, lengthToTop:integer);
end;
var winkel:array of TWinkel;
    x,y,i,k:integer;
    xdiff,ydiff:integer;
    minimalSize:boolean;
begin
  SetLength(winkel,0);
  SetLength(foundRectangles,0);
  result:=0;
  ListBox1.Clear;
  minimalSize:=minimalSizeCheckbox.Checked;
  //-------------Winkelecken suchen-------------
  for x:=1 to raster.uWidth do
    for y:=1 to raster.uHeight do begin
      if (raster.fields[x,y]) and (raster.fields[x+1,y])and (raster.fields[x,y+1]) then begin
        //Ecke für links oben
        SetLength(winkel,length(winkel)+1);
        winkel[high(winkel)].x:=x;
        winkel[high(winkel)].y:=y;
        winkel[high(winkel)].typ:=wtLeftTop;
        winkel[high(winkel)].lengthToRight:=1;
        winkel[high(winkel)].lengthToBottom:=1;
        //Seitenlängen finden
        for i:=x+2 to raster.uWidth do
          if raster.fields[i,y] then inc(winkel[high(winkel)].lengthToRight)
          else break;
        for i:=y+2 to raster.uHeight do
          if raster.fields[x,i] then inc(winkel[high(winkel)].lengthToBottom)
          else break;
      end;
      if (raster.fields[x,y]) and (raster.fields[x-1,y])and (raster.fields[x,y-1]) then begin
        //Ecke für rechts unten
        SetLength(winkel,length(winkel)+1);
        winkel[high(winkel)].x:=x;
        winkel[high(winkel)].y:=y;
        winkel[high(winkel)].typ:=wtRightBottom;
        winkel[high(winkel)].lengthToLeft:=1;
        winkel[high(winkel)].lengthToTop:=1;
        //Seitenlängen finden
        for i:=x-2 downto 1 do
          if raster.fields[i,y] then inc(winkel[high(winkel)].lengthToLeft)
          else break;
        for i:=y-2 downto 1 do
          if raster.fields[x,i] then inc(winkel[high(winkel)].lengthToTop)
          else break;
      end;
    end;

    //--------------Winkelecken mit einander vergleichen--------------
    for i:= 0 to high(winkel) do
      for k:= 0 to high(winkel) do
        if (winkel[i].typ=wtLeftTop)and(winkel[k].typ=wtRightBottom) then begin
          //Entfernung berechnen
          xdiff:=winkel[k].x-winkel[i].x;
          ydiff:=winkel[k].y-winkel[i].y;
          //Positionen vergleichen
          if minimalSize then begin //Mindest ein Abstand von 1
            if xdiff<=1 then continue;
            if ydiff<=1 then continue;
          end else begin
            if xdiff<=0 then continue;
            if ydiff<=0 then continue;
          end;
          //Entfernungen vergleichen
          if (xdiff>winkel[i].lengthToRight) or (xdiff>winkel[k].lengthToLeft) then continue;
          if (ydiff>winkel[i].lengthToBottom) or (ydiff>winkel[k].lengthToTop) then continue;

          //Juhu ein Rechteck
          SetLength(foundRectangles,length(foundRectangles)+1);
          with foundRectangles[high(foundRectangles)] do begin
            Left:=winkel[i].x-1; //Koordinaten umwandeln
            Top:=winkel[i].y-1;
            right:=winkel[k].x-1;
            bottom:=winkel[k].y-1;
            ListBox1.Items.add('('+IntToStr(left)+','+IntToStr(top)+') , ('+
                               '('+IntToStr(right)+','+IntToStr(bottom)+')');
          end;
          inc(result); //neues Rechteck zählen
        end;


  Label6.Caption:='Insgesamt: '+IntToStr(result);
end;

//Fügt ein neues Rechteck in rectangles ein
procedure Ta5f.addNewRectangle(const rect:Trectangle);
begin
  if ((rect.left-rect.right)=0) or ((rect.top-rect.bottom)=0) then exit;
  SetLength(rectangles,length(rectangles)+1);
  with rectangles[high(rectangles)] do begin
    left:=min(rect.left,rect.right);//Sicherstellen das links/oben... auch links/oben... ist
    top:=min(rect.top,rect.bottom);
    right:=max(rect.left,rect.right);
    bottom:=max(rect.top,rect.bottom);
  end;
end;

//Ausgeben
procedure Ta5f.outputPaint(Sender: TObject);
var i,rectAddX,rectAddY:integer;
    can:TCanvas; //Ausgabecanvas
  //Zeichnet ein Recteck, mit konvertierten Koordinaten
  procedure drawRect(const rectange:TRectangle);
  begin
    can.Rectangle(rectange.left*zoom+rectAddX,
                  buffer.height-(rectange.top*zoom+rectAddY),
                  rectange.right*zoom+rectAddX,
                  buffer.height-(rectange.bottom*zoom+rectAddY));
  end;
begin
  can:=buffer.Canvas;

  //Leeren
  can.brush.color:=clBtnFace;
  can.FillRect(rect(0,0,buffer.Width,buffer.Height));


  can.brush.Style:=bsClear;//kein Inhalt in Rechtecken
  can.pen.color:=clGray;   //Linien dunkelgrau
  can.pen.Width:=zoom;     //Eine Linie ist so breit wie ein Rasterfeld
  rectAddX:=zoom div 2;    //Verschiebung damit die Felder ganz ausgefüllt werden
  if (zoom>3) then
    inc(rectAddX);         //Wenn Rasterlinien da sind, um eins vergrößern
  rectAddY:=zoom div 2;
  //Rechtecke zeichnen
  for i:=0 to high(rectangles) do begin
    if i=selectedMaked then can.pen.color:=clRed  //wenn selektiert rot
    else if selectedMaked<>-1 then can.pen.color:=clGray; //sonst dunkelgrau
    drawRect(rectangles[i]);
  end;

  if selectedFound>=0 then                        //ein gefundes Rechteck hervorheben
    if selectedFound<=high(foundRectangles) then begin
      can.pen.color:=clLime;
      drawRect(foundRectangles[selectedFound]);
    end;

  if makeNewRectangle then begin                   //neues Recteck
    can.pen.color:=clBlue;
    drawRect(newRectangle);
  end;

  //Einfaches Raster drüber zeichnen, wenn genug Platz da ist
  if (zoom>3) then begin
    can.pen.color:=clBlack;
    can.pen.Width:=1;
    for i:=0 to rwidth do begin
      can.moveTo(i*zoom,0);
      can.lineTo(i*zoom,rheight*zoom);
    end;
    for i:=0 to rheight do begin
      can.moveTo(0,i*zoom);
      can.lineTo(rwidth*zoom,i*zoom);
    end;
  end;

  output.Canvas.draw(0,0,buffer);
end;

//Wandeln ein Rechteck-Array in einen Mengenstring um
procedure Ta5f.parseToClick(Sender: TObject);
var i:integer;
    s:string;
begin
  s:='{';
  for i:=0 to high(rectangles) do begin
    if i<>0 then s:=s+', ';
    s:=s+
       '(('+IntToStr(rectangles[i].Left)+';'+IntToStr(rectangles[i].top)+'), ('+
       IntToStr(rectangles[i].Right)+';'+IntToStr(rectangles[i].Bottom)+'))';
  end;
  parsedText.text:=s+'}';
end;
procedure Ta5f.Button3Click(Sender: TObject);
var i:integer;
    s:string;
begin
  s:='{';
  for i:=0 to high(foundrectangles) do begin
    if i<>0 then s:=s+', ';
    s:=s+
       '(('+IntToStr(foundrectangles[i].Left)+';'+IntToStr(foundrectangles[i].top)+'), ('+
       IntToStr(foundrectangles[i].Right)+';'+IntToStr(foundrectangles[i].Bottom)+'))';
  end;
  parsedText.text:=s+'}';
end;

//Startet das Zeichnen eines neuen Rechteckes
procedure Ta5f.outputMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
  newRectangle.left:=(x - zoom div 2)div zoom;                  //Mauskoord. -> Rasterkoord.
  newRectangle.top:=((output.height-y - zoom div 2))div zoom;   //Mauskoord. -> Rasterkoord.
  if (einrasten.Checked) then //Feststellen, ob irgendeine Seite in der Nähe ist
    for i:=0 to high(rectangles) do begin
      if (abs(rectangles[i].Left-newRectangle.Left)=1) then
        newRectangle.Left:=rectangles[i].Left;
      if (abs(rectangles[i].Right-newRectangle.Left)=1) then
        newRectangle.Left:=rectangles[i].Right;

      if (abs(rectangles[i].Top-newRectangle.Top)=1) then
        newRectangle.Top:=rectangles[i].Top;
      if (abs(rectangles[i].Bottom-newRectangle.Top)=1) then
        newRectangle.Top:=rectangles[i].Bottom;
    end;
end;

//Zu zeichnende Rechteck vergrößern/verkleinern
procedure Ta5f.outputMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i:integer;
begin
  if (ssLeft in shift) then begin
    newRectangle.right:=(x - zoom div 2)div zoom;                   //Mauskoord. -> Rasterkoord.
    newRectangle.bottom:=((output.height-y) - zoom div 2)div zoom;  //Mauskoord. -> Rasterkoord.
    makeNewRectangle:=(abs(newRectangle.right-newRectangle.left)>0)and//Ist das Rechteck groß geung?
                      (abs(newRectangle.bottom-newRectangle.top)>0);
    if makeNewRectangle then begin //Wenn ja
      if (newRectangle.right<0) then newRectangle.right:=0; //Ist es auch wirklich im Raster
      if (newRectangle.bottom<0) then newRectangle.bottom:=0;
      if (newRectangle.right>=rwidth) then newRectangle.right:=rwidth-1;
      if (newRectangle.bottom>=rheight) then newRectangle.bottom:=rheight-1;
      //Koordinaten ausgeben
      StatusBar1.Panels[0].text:='(('+IntToStr(newRectangle.left)+','+IntToStr(newRectangle.top)+
                                 '),('+IntToStr(newRectangle.right)+','+IntToStr(newRectangle.bottom)+')';

      if (einrasten.Checked) then  //Feststellen, ob irgendeine Seite in der Nähe ist
        for i:=0 to high(rectangles) do begin
          if (abs(rectangles[i].Left-newRectangle.right)=1) then
            newRectangle.right:=rectangles[i].Left;
          if (abs(rectangles[i].Right-newRectangle.right)=1) then
            newRectangle.right:=rectangles[i].Right;

          if (abs(rectangles[i].Top-newRectangle.bottom)=1) then
            newRectangle.bottom:=rectangles[i].Top;
          if (abs(rectangles[i].bottom-newRectangle.bottom)=1) then
            newRectangle.bottom:=rectangles[i].bottom;
        end;
      outputPaint(output);
    end;
  end else
    StatusBar1.Panels[0].text:='('+IntToStr((x - zoom div 2)div zoom)+','+
                                   IntToStr(((output.height-y) - zoom div 2)div zoom)+')';
end;

//Beendet das Einfügen eines neuen Rechteckes, oder wählt eines aus
procedure Ta5f.outputMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
  if (makeNewRectangle) then
    addNewRectangle(newRectangle)
   else begin
    selectedMaked:=-1;
    x:=(x - zoom div 2)div zoom;              //Mauskoord. -> Rasterkoord.
    y:=((output.height-y) - zoom div 2)div zoom;
    for i:=0 to high(rectangles) do
      if (((rectangles[i].Left<=x)and(rectangles[i].right>=x) //Ist es zwischen rechts und links?
             and((rectangles[i].top=y)or(rectangles[i].bottom=y)))) or //und auf einer Linie
         (((rectangles[i].top>=y)and(rectangles[i].bottom<=y) //oder zwischen oben und unten
             and((rectangles[i].left=x)or(rectangles[i].right=x)))) then //und auf einer Linie
               selectedMaked:=i; //speichern
   end;
  makeNewRectangle:=false; //keine neues Rechteck mehr
  StatusBar1.Panels[0].text:='';
  outputPaint(output);
end;

//Speichert den Index des angeklickten gefundenen Rechteckes
procedure Ta5f.ListBox1Click(Sender: TObject);
begin
  selectedFound:=ListBox1.ItemIndex; //Als markiert kennzeichnen
  outputPaint(output);
end;
//Rastergröße ändern
procedure Ta5f.Button1Click(Sender: TObject);
begin 
  rwidth:=StrToInt(rwidthedit.text);
  rheight:=StrToInt(rheightedit.text);
  buffer.Width:=rwidth*zoom+1;
  buffer.Height:=rheight*zoom+1;
  output.Width:=rwidth*zoom+1;
  output.Height:=rheight*zoom+1;
end;
//Zoomfaktor ändern
procedure Ta5f.Button2Click(Sender: TObject);
begin 
  zoom:=StrToInt(zoomedit.text);
  buffer.Width:=rwidth*zoom+1;
  buffer.Height:=rheight*zoom+1;
  output.Width:=rwidth*zoom+1;
  output.Height:=rheight*zoom+1;
end;

//Löschen
procedure Ta5f.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=vk_delete) and (selectedMaked<>-1) then
    if MessageBox(handle,'Wirklich löschen?',pchar(caption),MB_YESNO)=ID_YES then begin
      rectangles[selectedMaked]:=rectangles[high(rectangles)];
      SetLength(rectangles,length(rectangles)-1);
      selectedMaked:=-1;
      outputPaint(output);
    end;

end;

procedure Ta5f.FormCreate(Sender: TObject);
begin
  //Initialisierung
  SetLength(rectangles,0); //am Anfang noch kein Recteck
  rwidth:=30;              //Rasterbreite = 30
  rheight:=20;             //Rasterhöhe = 30
  zoom:=10;                //10 fach vergrößert
  buffer:=TBitmap.Create;  //Doublebuffer damit es nicht flackert
  buffer.Width:=rwidth*zoom+1; //So groß wie das Raster + Begrenzungslinie
  buffer.Height:=rheight*zoom+1;
  makeNewRectangle:=false; //Am Anfang kein neues Rechteck einfügen
  selectedFound:=-1;       //Am Anfang ist kein gefundenes Rechteck markiert (wie auch)
  selectedMaked:=-1;       //Am Anfang ist noch kein vorgegebenes Rechteck markiert
end;
procedure Ta5f.FormDestroy(Sender: TObject);
begin
  buffer.free;
end;


end.

