Skizze neu

7 files changed, 163 insertions, 28 deletions

diff --git a/filterBruteForce.lpi b/filterBruteForce.lpi
index 468913d..d88b0cb 100644
--- a/filterBruteForce.lpi
+++ b/filterBruteForce.lpi
@@ -33,7 +33,7 @@
         <PackageName Value="LCL"/>

       </Item1>

     </RequiredPackages>

-    <Units Count="3">

+    <Units Count="4">

       <Unit0>

         <Filename Value="filterBruteForce.lpr"/>

         <IsPartOfProject Value="True"/>

@@ -51,6 +51,13 @@
         <IsPartOfProject Value="True"/>

         <UnitName Value="Unit2"/>

       </Unit2>

+      <Unit3>

+        <Filename Value="unit3.pas"/>

+        <IsPartOfProject Value="True"/>

+        <ComponentName Value="Form2"/>

+        <ResourceBaseClass Value="Form"/>

+        <UnitName Value="Unit3"/>

+      </Unit3>

     </Units>

   </ProjectOptions>

   <CompilerOptions>

diff --git a/filterBruteForce.lpr b/filterBruteForce.lpr
index b8191a2..96157be 100644
--- a/filterBruteForce.lpr
+++ b/filterBruteForce.lpr
@@ -7,7 +7,7 @@ uses
   cthreads,

   {$ENDIF}{$ENDIF}

   Interfaces, // this includes the LCL widgetset

-  Forms, Unit1, Unit2

+  Forms, Unit1, Unit2, Unit3

   { you can add units after this };

 

 {$R *.res}

@@ -16,6 +16,7 @@ begin
   RequireDerivedFormResource := True;

   Application.Initialize;

   Application.CreateForm(TForm1, Form1);

+  Application.CreateForm(TForm2, Form2);

   Application.Run;

 end.

 

diff --git a/unit1.lfm b/unit1.lfm
index 218c186..7ef51fa 100644
--- a/unit1.lfm
+++ b/unit1.lfm
@@ -1,7 +1,7 @@
 object Form1: TForm1

-  Left = 270

+  Left = 1806

   Height = 544

-  Top = 334

+  Top = 161

   Width = 1018

   Caption = 'Form1'

   ClientHeight = 544

diff --git a/unit1.pas b/unit1.pas
index 86792d7..716c1ef 100644
--- a/unit1.pas
+++ b/unit1.pas
@@ -28,6 +28,8 @@ type
     procedure FormDestroy(Sender: TObject);

     procedure FormResize(Sender: TObject);

     procedure ListBox1Click(Sender: TObject);

+    procedure iterationsCallBack(Sender: TObject);

+    procedure loesungsCallBack(Sender: TObject);

   private

     { private declarations }

   public

@@ -43,6 +45,8 @@ implementation
 

 {$R *.lfm}

 

+uses unit3;

+

 { TForm1 }

 

 procedure TForm1.FormResize(Sender: TObject);

@@ -75,7 +79,7 @@ begin
   ListBox1.Items.Clear;

   ListBox2.Items.Clear;

 

-  loesungen:=bruteForcen(tps,hps,thps,Cs,Rs,20,@FormClick);

+  loesungen:=bruteForcen(tps,hps,thps,Cs,Rs,20,@iterationsCallBack,@loesungsCallBack);

   loesungen.indexVeroeffentlichen(Listbox1.Items);

 

   hps.free;

@@ -83,28 +87,32 @@ begin
   thps.free;

 end;

 

+procedure TForm1.FormClick(Sender: TObject);

+begin

+  form2.showModal;

+end;

+

 const

   c1: longint = 0;

   c2: longint = 0;

 

-procedure TForm1.FormClick(Sender: TObject);

+procedure TForm1.iterationsCallBack(Sender: TObject);

+begin

+  inc(c1);

+  if c1 > 1000000 then begin

+    c1:=0;

+    Form1.Caption:=inttostr(c2)+' '+(sender as tLoesung).dumpWeite;

+    Application.ProcessMessages;

+  end;

+end;

+

+procedure TForm1.loesungsCallBack(Sender: TObject);

 begin

-  if assigned(sender) and

-     (sender is tLoesung) then begin

-    inc(c1);

-    if c1>=1000000 then begin

-      c1:=0;

-      Form1.Caption:=inttostr(c2)+' '+(sender as tLoesung).dumpWeite;

-      Application.ProcessMessages;

-    end;

-  end

-  else begin

-    inc(c2);

-    if c2 mod 100 = 0 then begin

-      Form1.Color:=random($1000000);

-      Form1.Caption:=inttostr(c2)+' '+rightstr(Form1.Caption,length(Form1.Caption)-pos(' ',Form1.Caption));

-      Application.ProcessMessages;

-    end;

+  inc(c2);

+  if c2 mod 100 = 0 then begin

+    Form1.Color:=random($1000000);

+    Form1.Caption:=inttostr(c2)+' '+rightstr(Form1.Caption,length(Form1.Caption)-pos(' ',Form1.Caption));

+    Application.ProcessMessages;

   end;

 end;

 

diff --git a/unit2.pas b/unit2.pas
index 984a849..e75d847 100644
--- a/unit2.pas
+++ b/unit2.pas
@@ -84,7 +84,7 @@ type
     procedure initFilter(tps,hps,thps: tMyExtendedArray);

     function ordnung: longint;

     function ordnungsSchritt: boolean;

-    function auswahlSchritt(minNutzen: extended; callback: tNotifyEvent): boolean;

+    function auswahlSchritt(minNutzen: extended; callBack: tNotifyEvent): boolean;

     procedure anzeigen(sl: tStrings);

     function dump: string;

     function dumpWeite: string;

@@ -107,7 +107,7 @@ procedure liesExtendedArray(sl: tStrings; suf: string; var arr: tMyExtendedArray
 function dumpArray(arr: tLongintArray): string; overload;

 function dumpArray(arr: tLongintArray; werte: tMyExtendedArray): string; overload;

 function dumpArray(arr: tExtendedLongintArray; werte: tMyExtendedArray): string; overload;

-function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; callback: tNotifyEvent): tLoesungArray;

+function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; iterationsCallBack,loesungsCallBack: tNotifyEvent): tLoesungArray;

 

 implementation

 

@@ -866,7 +866,7 @@ begin
   delete(result,1,2);

 end;

 

-function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; callback: tNotifyEvent): tLoesungArray;

+function bruteForcen(tps,hps,thps,rs,cs: tMyExtendedArray; cutoff: longint; iterationsCallBack,loesungsCallBack: tNotifyEvent): tLoesungArray;

 var

   cLsg:      tLoesung;

   cLsgn:     tLoesungArray;

@@ -889,12 +889,12 @@ begin
   repeat

 

     cLsgn:=tLoesungArray.create;

-    while cLsg.auswahlSchritt(cLsgn.minNutzen(cutoff),callBack) do begin

+    while cLsg.auswahlSchritt(cLsgn.minNutzen(cutoff),iterationsCallBack) do begin

       cLsgn.add(cLsg);

       cLsg:=tLoesung.create(cLsg);

       cLsgn.cutItOff(cutoff);

-      if assigned(callBack) then

-        callBack(nil);

+      if assigned(loesungsCallBack) then

+        loesungsCallBack(nil);

     end;

     result.einfuegen(cLsgn);

     cLsgn.free;

diff --git a/unit3.lfm b/unit3.lfm
new file mode 100644
index 0000000..2c8de64
--- /dev/null
+++ b/unit3.lfm
@@ -0,0 +1,17 @@
+object Form2: TForm2
+  Left = 2315
+  Height = 240
+  Top = 223
+  Width = 320
+  Caption = 'Form2'
+  ClientHeight = 240
+  ClientWidth = 320
+  OnResize = FormResize
+  LCLVersion = '1.4.4.0'
+  object Image1: TImage
+    Left = 113
+    Height = 90
+    Top = 69
+    Width = 90
+  end
+end
diff --git a/unit3.pas b/unit3.pas
new file mode 100644
index 0000000..87d7e0b
--- /dev/null
+++ b/unit3.pas
@@ -0,0 +1,102 @@
+unit Unit3;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
+
+type
+
+  { TForm2 }
+
+  TForm2 = class(TForm)
+    Image1: TImage;
+    procedure FormResize(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end;
+
+var
+  Form2: TForm2;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm2 }
+
+procedure TForm2.FormResize(Sender: TObject);
+var
+  w,h: longint;
+begin
+  image1.free;
+  image1:=tImage.create(self);
+  image1.left:=0;
+  image1.top:=0;
+  image1.height:=form2.clientHeight;
+  image1.width:=form2.clientWidth;
+  image1.parent:=self;
+  w:=image1.width;
+  h:=image1.height;
+  with image1.canvas do begin
+    rectangle(-10,-10,w+10,h+10);
+
+    moveTo(round(0.05*w),round(0.65*h));
+    lineTo(round(0.15*w),round(0.65*h));
+    rectangle(round(0.15*w),round(0.675*h),round(0.25*w),round(0.625*h));
+    textout(round(0.15*w),round(0.675*h),'R1');
+    moveTo(round(0.25*w),round(0.65*h));
+    lineTo(round(0.35*w),round(0.65*h));
+    rectangle(round(0.35*w),round(0.675*h),round(0.45*w),round(0.625*h));
+    textout(round(0.35*w),round(0.675*h),'R2');
+    moveTo(round(0.45*w),round(0.65*h));
+    lineTo(round(0.55*w),round(0.65*h));
+
+    moveTo(round(0.5*w),round(0.65*h));
+    lineTo(round(0.5*w),round(0.75*h));
+
+    moveTo(round(0.47*w),round(0.75*h));
+    lineTo(round(0.53*w),round(0.75*h));
+    moveTo(round(0.47*w),round(0.775*h));
+    lineTo(round(0.53*w),round(0.775*h));
+    textout(round(0.53*w),round(0.75*h),'C2');
+
+    moveTo(round(0.5*w),round(0.775*h));
+    lineTo(round(0.5*w),round(0.875*h));
+
+    moveTo(round(0.475*w),round(0.875*h)); // Masse
+    lineTo(round(0.525*w),round(0.875*h));
+
+    moveTo(round(0.27*w),round(0.525*h));
+    lineTo(round(0.33*w),round(0.525*h));
+    moveTo(round(0.27*w),round(0.55*h));
+    lineTo(round(0.33*w),round(0.55*h));
+    textout(round(0.33*w),round(0.525*h),'C1');
+
+    moveTo(round(0.3*w),round(0.55*h));
+    lineTo(round(0.3*w),round(0.65*h));
+
+    moveTo(round(0.3*w),round(0.525*h));
+    lineTo(round(0.3*w),round(0.425*h));
+    lineTo(round(0.8*w),round(0.425*h));
+    lineTo(round(0.8*w),round(0.6*h));
+
+    moveTo(round(0.85*w),round(0.6*h));
+    lineTo(round(0.75*w),round(0.6*h));
+    lineTo(round(0.55*w),round(0.5*h));
+    lineTo(round(0.55*w),round(0.7*h));
+    lineTo(round(0.75*w),round(0.6*h));
+
+    moveTo(round(0.5*w),round(0.425*h));
+    lineTo(round(0.5*w),round(0.55*h));
+    lineTo(round(0.55*w),round(0.55*h));
+  end;
+  image1.visible:=true;
+end;
+
+end.
+