summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--filterBruteForce.lpi9
-rw-r--r--filterBruteForce.lpr3
-rw-r--r--unit1.lfm4
-rw-r--r--unit1.pas44
-rw-r--r--unit2.pas12
-rw-r--r--unit3.lfm17
-rw-r--r--unit3.pas102
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.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 10:44:03 +0000