From 042b7edeabf0cc5e0168bbfdbf18363ccb9391e5 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Mon, 25 Jan 2016 17:25:58 +0100 Subject: Skizze neu --- filterBruteForce.lpi | 9 ++++- filterBruteForce.lpr | 3 +- unit1.lfm | 4 +- unit1.pas | 44 +++++++++++++--------- unit2.pas | 12 +++--- unit3.lfm | 17 +++++++++ unit3.pas | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 163 insertions(+), 28 deletions(-) create mode 100644 unit3.lfm create mode 100644 unit3.pas diff --git a/filterBruteForce.lpi b/filterBruteForce.lpi index 468913d..d88b0cb 100644 --- a/filterBruteForce.lpi +++ b/filterBruteForce.lpi @@ -33,7 +33,7 @@ - + @@ -51,6 +51,13 @@ + + + + + + + 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. + -- cgit v1.2.3-54-g00ecf