unit Bubbelz;
{V.0.2}
{Einige Stellen sind noch umständlich/ungenau in der Berechnung}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg, ExtDlgs, StdCtrls, PNGImage;
type Kreis =
record
X:Integer;
Y:Integer;
Radius:Integer;
Farbe:Integer;
end;
type
TForm1 =
class(TForm)
Hauptbild: TImage;
PIC_Load: TOpenPictureDialog;
BT_PIC_Load: TButton;
BT_Start: TButton;
BT_Save: TButton;
procedure FormCreate(Sender: TObject);
procedure BT_PIC_LoadClick(Sender: TObject);
procedure HauptbildClick(Sender: TObject);
procedure AnalysePIC;
procedure Progress(X:Integer;Y:Integer);
function KleinstAbstandZuLinie(X:Integer;Y:Integer):Integer;
function KleinstAbstandZuLinie2(X:Integer;Y:Integer):Integer;
function AbstandZuPunkt(X1:Integer;Y1:Integer;X2:Integer;Y2:Integer):Integer;
procedure BT_StartClick(Sender: TObject);
procedure BT_SaveClick(Sender: TObject);
private
{ Private-Deklarationen }
Var PIc_res:Tbitmap;
VAR PIC_RES2:TJpegImage;
Var PIC:
String ;
VAR Maxentf:Real;
Var PIC_Breite,PIC_Höhe,LinePTK,Kreisanzahl,Standartwahrscheinlichkeit,MaxRadius:Integer;
VAR Line:
Array[0..1600,0..1200]
of Boolean;
AbstLine:
Array[0..1600,0..1200]
of Integer;
Kreise:
Array[1..500000]
of Kreis;
KreisPTK:
Array[0..1600,0..1200]
of Boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BT_PIC_LoadClick(Sender: TObject);
begin
Pic_Load.Execute();
PIC:=Pic_Load.FileName;
Hauptbild.Picture.LoadFromFile(PIC);
PIC_Res2.LoadFromFile(PIC);
PIC_Breite:=PIc_res2.Width;
PIC_Höhe:=PIC_res2.Height;
end;
function TForm1.AbstandZuPunkt(X1:Integer;Y1:Integer;X2:Integer;Y2:Integer):Integer;
Var Dx,Dy:Integer;
begin
Dx:=abs(X1-X2);
Dy:=abs(Y1-Y2);
result:=round(sqrt((Dy*Dy)+(Dx*Dx)));
end;
function TForm1.kleinstAbstandZuLinie(X:Integer;Y:Integer):Integer;
Var Kleinst,I,J,Abstand:Integer;
Begin
{//Zu umständlich//
Kleinst:=10000;
for I := 0 to PIC_Breite do
Begin
for J := 0 to PIC_Höhe do
Begin
if Line[I,J] then
Begin
Abstand:=AbstandzuPunkt(X,Y,I,J);
if Abstand<=Kleinst then Kleinst:=Abstand;
End;
End;
End; }
End;
function TForm1.kleinstAbstandZuLinie2(X:Integer;Y:Integer):Integer;
Var I,J,Abstand,Zähler:Integer;
Begin
Abstand:=0;
if Line[X,Y]
then result:=0
else
Begin
while Abstand=0
do
Begin
Zähler:=Zähler+1;
for I:=X-Zähler
To X+Zähler
Do if Line[I,Y-Zähler]
then Abstand:=AbstandzuPunkt(X,Y,I,Y-Zähler);
for I:=X-Zähler
To X+Zähler
Do if Line[I,Y+Zähler]
then Abstand:=AbstandzuPunkt(X,Y,I,Y+Zähler);
for I:=Y-Zähler
To Y+Zähler
Do if Line[X+Zähler,I]
then Abstand:=AbstandzuPunkt(X,Y,X+Zähler,I);
for I:=Y-Zähler
To Y+Zähler
Do if Line[X-Zähler,I]
then Abstand:=AbstandzuPunkt(X,Y,X-Zähler,I);
End;
End;
result:=Abstand;
End;
Procedure TForm1.Progress(X:Integer;Y:Integer);
VAR Abst,Radius:Integer;
P:Real;
begin
P:=(Random(100)+1)*(MaxEntf/(AbstLine[X,Y]*10));
if P<=Standartwahrscheinlichkeit
then
Begin
//KREIS
Radius:=(Random(MaxRadius*100)
div 100);
//Nicht gewichtet
Kreisanzahl:=Kreisanzahl+1;
Kreise[Kreisanzahl].X:=X;
Kreise[Kreisanzahl].Y:=Y;
Kreise[Kreisanzahl].Radius:=Radius;
End;
end;
procedure TForm1.BT_SaveClick(Sender: TObject);
VAR Save:TJpegImage;
begin
Save:=TJpegimage.create;
Save.Assign(Hauptbild.Picture.Bitmap);
Save.SaveToFile('
C:\Users\Felix\Desktop\Ergebnis.jpg');
end;
procedure TForm1.BT_StartClick(Sender: TObject);
var x,y,kleinst,m,k,größterAbstand:Integer;
begin
GrößterAbstand:=0;
AnalysePIC;
//1.
for X := 0
to PIC_Breite
do
Begin
for Y := 0
to PIC_Höhe
do
Begin
if Line[X,Y]
then AbstLine[X,Y]:=0
else
Begin
AbstLine[X,Y]:=kleinstAbstandzuLinie2(X,Y);
if (AbstLine[X,Y]>GrößterAbstand)
then GrößterAbstand:=AbstLine[X,Y];
END;
End;
End;
For m:=1
to GrößterAbstand
Do
Begin
for X := 0
to PIC_Breite
do
Begin
for Y := 0
to PIC_Höhe
do
Begin
if (AbstLine[X,Y]=M)
then
Begin
Progress(X,Y);
End;
End;
End;
End;
for X := 0
to PIC_Breite
do
Begin
for Y := 0
to PIC_Höhe
do
Begin
Hauptbild.Canvas.Pixels[X,Y]:=clWhite;
End;
End;
for X:=1
To Kreisanzahl
Do Hauptbild.Canvas.Ellipse(Kreise[X].X,Kreise[X].Y,Kreise[X].X+Kreise[X].Radius,Kreise[X].Y+Kreise[X].Radius);
end;
procedure TForm1.AnalysePIC;
VAR I,J:Integer;
begin
for I := 0
to PIC_Breite
do
Begin
for J := 0
to PIC_Höhe
do
Begin
Line[I,J]:=False;
End;
End;
PIC_res.Assign(PIc_res2);
for I := 0
to PIC_Breite
do
Begin
for J := 0
to PIC_Höhe
do
Begin
if Pic_Res.Canvas.Pixels[I,J] = clBlack
then
Begin
Line[I,J]:=True;
LinePTK:=LinePTK+1;
End
else Pic_res.Canvas.Pixels[I,J]:=clWhite;
End;
End;
Hauptbild.Picture.Assign(Pic_res);
MaxEntf:=sqrt(PIC_Breite*PIC_Breite+PIC_Höhe*PIC_Höhe);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MaxRadius:=PIC_Breite
div 20;
Standartwahrscheinlichkeit:=90;
//90%
PIC_Höhe:=1200;
PIC_Breite:=1600;
Form1.Top:=0;
Form1.Left:=0;
form1.width := screen.width;
form1.height := screen.height;
PIc_Res:=Tbitmap.Create;
PIC_res2:=TjpegImage.create;
end;
procedure TForm1.HauptbildClick(Sender: TObject);
begin
Pic_Load.Execute();
PIC:=Pic_Load.FileName;
Hauptbild.Picture.LoadFromFile(PIC);
PIC_Res2.LoadFromFile(PIC);
PIC_Breite:=PIc_res2.Width;
PIC_Höhe:=PIC_res2.Height;
end;
end.