Überprüfung eines Image

[MisterScary]

Na gut dann poste ich am besten mal alles *G*

Delphi-Quellcode:

unit mBebauung;

interface

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

type
  TBebauung = class(TForm)
    ImBebauung: TImage;
    BtStrasse: TButton;
    BtRotes_Haus: TButton;
    BtSchwarzes_Haus: TButton;
    BtGelbes_Haus: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edxstelle: TEdit;
    Edystelle: TEdit;
    Edbreite: TEdit;
    Edhoehe: TEdit;
    BtZuruecksetzen: TButton;
    BtBeenden: TButton;
    Label5: TLabel;
    procedure BtBeendenClick(Sender: TObject);
    procedure BtZuruecksetzenClick(Sender: TObject);
    procedure BtGelbes_HausClick(Sender: TObject);
    procedure BtRotes_HausClick(Sender: TObject);
    procedure BtSchwarzes_HausClick(Sender: TObject);
    procedure BtStrasseClick(Sender: TObject);
  private
    { Private declarations }
    var xstelle : Integer;
    var ystelle : Integer;
    var breite : Integer;
    var hoehe : Integer;
    var abstand : Integer;
    var i : Integer;
    var j : Integer;
  public
    { Public declarations }
  end;

var
  Bebauung: TBebauung;

implementation

{$R *.dfm}

procedure TBebauung.BtStrasseClick(Sender: TObject);
begin
 with ImBebauung.Canvas do
  begin
   abstand:= 20;
   MoveTo (0,480);
   Brush.Color:=clBlack;
   Rectangle (0,480,1000,420);
   Pen.Color:=clWhite;
   MoveTo (abstand-20,450);
   LineTo (abstand,450);
   repeat
   begin
   abstand:= abstand +20;
   MoveTo (abstand,450);
   abstand:= abstand + 20;
   LineTo (abstand,450)
   end
   until abstand > 1000;
   Brush.Color:=clWhite;
   Pen.Color:=clBlack;
   Pen.Width:=0
  end;
end;

procedure TBebauung.BtSchwarzes_HausClick(Sender: TObject);
begin

try
  strtoint(Edxstelle.text);
  strtoint(Edystelle.text);
  strtoint(Edhoehe.text);
  strtoint(Edbreite.text)
except
  showmessage('Bitte geben sie jeweils eine Zahl für Xstelle, Ystelle, Breite und Hoehe an!');
  exit
end;

xstelle:= StrToInt(Edxstelle.text);
ystelle:= StrToInt(Edystelle.text);
breite:= StrToInt(Edbreite.text);
hoehe:= StrToInt(Edhoehe.text);

For i := xstelle to xstelle+breite do
begin
  For j := ystelle to ystelle - hoehe - (breite div 2) do
  begin
    If ImBebauung.Canvas.Pixels[i,j]<> clwhite then showmessage ('Bauplatz ist nicht frei! Das Haus konnte nicht gebaut werden!');
  end;
end;


 with ImBebauung.Canvas do
  begin
   Brush.COlor:=clBlack;
   Pen.COlor:=clBlack;
   Pen.Width:=2;
   Rectangle(xstelle,ystelle,xstelle+breite,ystelle-hoehe);
   MoveTo(xstelle,ystelle-hoehe);
   LineTo(xstelle+breite div 2,ystelle-hoehe-breite div 2);
   LineTo(xstelle+breite,ystelle -hoehe);
   Brush.Color:=clWhite;
   Pen.Color:=clBlack;
   Pen.Width:=0
  end

end;

procedure TBebauung.BtRotes_HausClick(Sender: TObject);
begin

try
  strtoint(Edxstelle.text);
  strtoint(Edystelle.text);
  strtoint(Edhoehe.text);
  strtoint(Edbreite.text)
except
  showmessage('Bitte geben sie jeweils eine Zahl für Xstelle, Ystelle, Breite und Hoehe an!');
  exit
end;

xstelle:= StrToInt(Edxstelle.text);
ystelle:= StrToInt(Edystelle.text);
breite:= StrToInt(Edbreite.text);
hoehe:= StrToInt(Edhoehe.text);

For i := xstelle to xstelle+breite do
begin
  For j := ystelle to ystelle - hoehe - (breite div 2) do
  begin
    ImBebauung.Canvas.Pixels[i,j]<> clwhite;
  end;
end;


 with ImBebauung.Canvas do
  begin
   Brush.COlor:=clRed;
   Pen.COlor:=clRed;
   Pen.Width:=2;
   Pen.Width:=2;
   Rectangle(xstelle,ystelle,xstelle+breite,ystelle-hoehe);
   MoveTo(xstelle,ystelle-hoehe);
   LineTo(xstelle+breite div 2,ystelle-hoehe-breite div 2);
   LineTo(xstelle+breite,ystelle -hoehe);
   Brush.Color:=clWhite;
   Pen.Color:=clBlack;
   Pen.Width:=0
  end;

end;

procedure TBebauung.BtGelbes_HausClick(Sender: TObject);
begin

try
  strtoint(Edxstelle.text);
  strtoint(Edystelle.text);
  strtoint(Edhoehe.text);
  strtoint(Edbreite.text)
except
  showmessage('Bitte geben sie jeweils eine Zahl für Xstelle, Ystelle, Breite und Hoehe an!');
  exit
end;

xstelle:= StrToInt(Edxstelle.text);
ystelle:= StrToInt(Edystelle.text);
breite:= StrToInt(Edbreite.text);
hoehe:= StrToInt(Edhoehe.text);

For i := xstelle to xstelle+breite do
begin
  For j := ystelle to ystelle - hoehe - (breite div 2) do
  begin
    ImBebauung.Canvas.Pixels[i,j]<> clwhite;
  end;
end;


 with ImBebauung.Canvas do
  begin
   Brush.COlor:=clYellow;
   Pen.COlor:=clYellow;
   Pen.Width:=2;
   Pen.Width:=2;
   Rectangle(xstelle,ystelle,xstelle+breite,ystelle-hoehe);
   MoveTo(xstelle,ystelle-hoehe);
   LineTo(xstelle+breite div 2,ystelle-hoehe-breite div 2);
   LineTo(xstelle+breite,ystelle -hoehe);
   Brush.Color:=clWhite;
   Pen.Color:=clBlack;
   Pen.Width:=0
  end;

end;

procedure TBebauung.BtZuruecksetzenClick(Sender: TObject);
begin
 with ImBebauung.Canvas do
  begin
   Brush.Color:=clWhite;
   Pen.Color:=clWhite;
   Rectangle(0,500,1000,0);
   Pen.Color:=clBlack; 
  end;
end;

procedure TBebauung.BtBeendenClick(Sender: TObject);
begin
 close
end;

end.