From af27d71dff86ca1f21a242f05b00852f3fa59e2f Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Wed, 21 Sep 2016 15:29:25 +0200 Subject: weiteres fertig --- raetsel.lpi | 7 +- raetsel.lpr | 3 +- raetsel.lps | 200 ++++++++++++++++++++++++++--------- raetselunit.pas | 319 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ unit1.lfm | 11 +- unit1.pas | 36 +++++-- unit2.lfm | 20 ++-- unit2.pas | 12 --- 8 files changed, 523 insertions(+), 85 deletions(-) create mode 100644 raetselunit.pas diff --git a/raetsel.lpi b/raetsel.lpi index 4f62b02..4ed092d 100644 --- a/raetsel.lpi +++ b/raetsel.lpi @@ -32,7 +32,7 @@ - + @@ -48,9 +48,14 @@ + + + + + diff --git a/raetsel.lpr b/raetsel.lpr index 22187bf..839a24b 100644 --- a/raetsel.lpr +++ b/raetsel.lpr @@ -7,7 +7,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, unit1, Unit2 + Forms, unit1, Unit2, raetselunit { you can add units after this }; {$R *.res} @@ -16,7 +16,6 @@ begin RequireDerivedFormResource:=True; Application.Initialize; Application.CreateForm(TForm1, Form1); - Application.CreateForm(TForm2, Form2); Application.Run; end. diff --git a/raetsel.lps b/raetsel.lps index d287696..0cfa3ac 100644 --- a/raetsel.lps +++ b/raetsel.lps @@ -3,15 +3,13 @@ - + - - - - + + @@ -19,31 +17,44 @@ - - - + + + + + + + + + + + + + + + + - - - + + + - - - + + + - - - + + + @@ -51,62 +62,153 @@ - - - - + + + + - - - + - - - + + + - - + + + + + + + + + + + + + + + + + - + - - + + - - + - - + + - - + + - - + + - + + - - + + - - + - - + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/raetselunit.pas b/raetselunit.pas new file mode 100644 index 0000000..bdeb19b --- /dev/null +++ b/raetselunit.pas @@ -0,0 +1,319 @@ +unit raetselunit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls; + +type + tAlphabetFunktion = function(i: longint): string; + + tRaetsel = class + private + besitzer: tForm; + zeichenflaeche: tImage; + function besitzerHoehe: longint; dynamic; + function besitzerBreite: longint; dynamic; + procedure zeichenFlaecheNeuKreieren; + public + constructor create(aOwner: tForm); + destructor destroy; override; + procedure zeichnen; dynamic; abstract; + end; + + tFelderRaetsel = class(tRaetsel) + spinEdits: array of tSpinEdit; + diagonalenCB: tCheckBox; + groeszen: array of longint; + felder,rand: array of longint; + dim,schriftGroesze: longint; + zellGroesze: extended; + uebersetze: tAlphabetFunktion; + procedure anzSEsOnChange(sender: tObject); + procedure aktualisiereGroesze; + procedure aktualisiereZeichenflaechenGroesze; + function besitzerHoehe: longint; override; + function besitzerBreite: longint; override; + procedure schreibeZentriert(x,y,i: longint); + public + constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); + destructor destroy; override; + procedure zeichnen; override; + end; + + tBuchstabenRaetsel = class(tFelderRaetsel) + private + public + constructor create(aOwner: tForm); + destructor destroy; override; + end; + + tHochhausRaetsel = class(tFelderRaetsel) + private + public + constructor create(aOwner: tForm); + destructor destroy; override; + end; + +const + spacing = 2; + +function buchstabenAlphabetFunktion(i: longint): string; +function zahlenAlphabetFunktion(i: longint): string; + +implementation + +uses + math; + +// tRaetsel ******************************************************************** + +constructor tRaetsel.create(aOwner: tForm); +begin + inherited create; + besitzer:=aOwner; + zeichenflaeche:=tImage.create(besitzer); + zeichenflaeche.parent:=besitzer; +end; + +destructor tRaetsel.destroy; +begin + zeichenflaeche.free; + inherited destroy; +end; + +function tRaetsel.besitzerHoehe: longint; +begin + result:=zeichenflaeche.height+zeichenflaeche.top+spacing; +end; + +function tRaetsel.besitzerBreite: longint; +begin + result:=zeichenflaeche.width+zeichenflaeche.left+spacing; +end; + +procedure tRaetsel.zeichenFlaecheNeuKreieren; +var + i: tImage; +begin + i:=tImage.create(besitzer); + i.parent:=zeichenflaeche.parent; + i.left:=zeichenflaeche.left; + i.top:=zeichenflaeche.top; + i.width:=zeichenflaeche.width; + i.height:=zeichenflaeche.height; + i.canvas.font.size:=zeichenflaeche.canvas.font.size; + zeichenflaeche.free; + zeichenflaeche:=i; +end; + +// tFelderRaetsel ************************************************************** + +constructor tFelderRaetsel.create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); +var + i: longint; +begin + inherited create(aOwner); + uebersetze:=alphabetFunktion; + setlength(spinEdits,anzInhTypen+1); + setlength(groeszen,length(spinEdits)-1); + for i:=0 to length(spinEdits)-1 do begin + spinEdits[i]:=tSpinEdit.create(besitzer); + with spinEdits[i] do begin + parent:=besitzer; + top:=spacing; + if i>0 then + left:=spinEdits[i-1].left + spinEdits[i-1].width; + left:=left+spacing; + onChange:=@anzSEsOnChange; + tag:=i; + end; + if i>0 then + groeszen[i-1]:=-1; + end; + spinEdits[0].showHint:=true; + spinEdits[0].hint:='Schriftgröße'; + spinEdits[0].value:=7; + diagonalenCB:=tCheckBox.create(besitzer); + diagonalenCB.parent:=besitzer; + diagonalenCB.caption:='Diagonalen'; + diagonalenCB.top:=spacing; + diagonalenCB.left:=spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing; + zeichenflaeche.left:=spacing; + zeichenflaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; + aktualisiereGroesze; +end; + +destructor tFelderRaetsel.destroy; +begin + inherited destroy; +end; + +procedure tFelderRaetsel.anzSEsOnChange(sender: tObject); +begin + if ((sender as tSpinEdit).tag = 0) and + ((sender as tSpinEdit).value <> schriftGroesze) then begin + schriftGroesze:=(sender as tSpinEdit).value; + aktualisiereZeichenflaechenGroesze + end + else if (sender as tSpinEdit).value <> groeszen[(sender as tSpinEdit).tag-1] then + aktualisiereGroesze; +end; + +procedure tFelderRaetsel.aktualisiereGroesze; +var + i: longint; +begin + dim:=0; + schriftGroesze:=spinEdits[0].value; + for i:=0 to length(groeszen)-1 do begin + groeszen[i]:=spinEdits[i+1].value; + dim:=dim+groeszen[i]; + end; + setlength(felder,dim*dim); + for i:=0 to length(felder)-1 do + felder[i]:=random(dim+1)-1; // 0; + setlength(rand,4*dim); + for i:=0 to length(rand)-1 do + rand[i]:=random(dim+1)-1; // 0; + aktualisiereZeichenflaechenGroesze; +end; + +procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze; +begin + zeichenflaeche.canvas.font.size:=schriftGroesze; + zellGroesze:= + 2*spacing + zeichenflaeche.canvas.pen.width + + max( + zeichenflaeche.canvas.textWidth(uebersetze(dim)), + zeichenflaeche.canvas.textHeight(uebersetze(dim)) + ); + zeichenflaeche.height:=(dim+2)*round(2*zellGroesze); + zeichenflaeche.width:=zeichenflaeche.height; + zeichenFlaecheNeuKreieren; + besitzer.height:=besitzerHoehe; + besitzer.width:=besitzerBreite; + zeichnen; +end; + +function tFelderRaetsel.besitzerHoehe: longint; +var + i: longint; +begin + result:=max(inherited besitzerHoehe,diagonalenCB.top+diagonalenCB.height+spacing); + for i:=0 to length(spinEdits)-1 do + result:=max(result,spinEdits[i].top+spinEdits[i].height+spacing); +end; + +function tFelderRaetsel.besitzerBreite: longint; +var + i: longint; +begin + result:=max(inherited besitzerBreite,diagonalenCB.left+diagonalenCB.width+spacing);; + for i:=0 to length(spinEdits)-1 do + result:=max(result,spinEdits[i].left+spinEdits[i].width+spacing); +end; + +procedure tFelderRaetsel.schreibeZentriert(x,y,i: longint); +var + br,ho: longint; + s: string; +begin + s:=uebersetze(i); + with zeichenflaeche.canvas do begin + br:=textWidth(s); + ho:=textHeight(s); + textOut( + round(2*(x+1.5)*zellGroesze-br/2), + round(2*(y+1.5)*zellGroesze-ho/2), + s + ); + end; +end; + +procedure tFelderRaetsel.zeichnen; +var + i: longint; +begin + zeichenflaeche.canvas.brush.color:=$ffffff; + zeichenflaeche.canvas.rectangle(-10,-10,zeichenflaeche.width+10,zeichenflaeche.height+10); + zeichenflaeche.canvas.pen.width:=3; + for i:=0 to dim do + with zeichenflaeche.canvas do begin + moveTo(round((i+1)*2*zellGroesze),round(2*zellGroesze)); + lineTo(round((i+1)*2*zellGroesze),round((dim+1)*2*zellGroesze)); + moveTo(round(2*zellGroesze),round((i+1)*2*zellGroesze)); + lineTo(round((dim+1)*2*zellGroesze),round((i+1)*2*zellGroesze)); + end; + for i:=0 to dim-1 do begin + schreibeZentriert(i,-1,rand[i]); + schreibeZentriert(dim,i,rand[dim+i]); + schreibeZentriert(i,dim,rand[2*dim+i]); + schreibeZentriert(-1,i,rand[3*dim+i]); + end; + for i:=0 to length(felder)-1 do + schreibeZentriert(i mod dim,i div dim,felder[i]); +end; + +// tBuchstabenRaetsel ********************************************************** + +constructor tBuchstabenRaetsel.create(aOwner: tForm); +begin + inherited create(aOwner,2,@buchstabenAlphabetFunktion); + spinEdits[1].showHint:=true; + spinEdits[1].hint:='Anzahl Buchstaben'; + spinEdits[1].value:=5; + spinEdits[2].showHint:=true; + spinEdits[2].hint:='Anzahl Leerfelder'; + spinEdits[2].value:=1; + aktualisiereGroesze; +end; + +destructor tBuchstabenRaetsel.destroy; +begin + inherited destroy; +end; + +// tHochhausRaetsel ************************************************************ + +constructor tHochhausRaetsel.create(aOwner: tForm); +begin + inherited create(aOwner,1,@zahlenAlphabetFunktion); + spinEdits[1].showHint:=true; + spinEdits[1].hint:='Anzahl Spalten'; + spinEdits[1].value:=5; + aktualisiereGroesze; +end; + +destructor tHochhausRaetsel.destroy; +begin + inherited destroy; +end; + +// allgemeine Funktionen ******************************************************* + +function buchstabenAlphabetFunktion(i: longint): string; +begin + if i<0 then result:='' + else if i=0 then result:='-' + else begin + result:=''; + while i>0 do begin + dec(i); + result:=char(ord('A')+(i mod 26))+result; + i:=i div 26; + end; + end; +end; + +function zahlenAlphabetFunktion(i: longint): string; +begin + if i<0 then result:='' + else if i=0 then result:='-' + else result:=inttostr(i); +end; + +end. + diff --git a/unit1.lfm b/unit1.lfm index 8ec305b..9d5b43d 100644 --- a/unit1.lfm +++ b/unit1.lfm @@ -1,9 +1,12 @@ object Form1: TForm1 - Left = 1690 - Height = 240 - Top = 197 - Width = 320 + Left = 1722 + Height = 313 + Top = 389 + Width = 426 + BorderStyle = bsSingle Caption = 'Rätsel' OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow LCLVersion = '1.6.0.4' end diff --git a/unit1.pas b/unit1.pas index c1584cb..795ecf3 100644 --- a/unit1.pas +++ b/unit1.pas @@ -5,18 +5,22 @@ unit unit1; interface uses - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, raetselFileUnit; + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + raetselunit; type - { TForm1 } + { tForm1 } - TForm1 = class(TForm) + tForm1 = class(tForm) procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); private { private declarations } public { public declarations } + raetsel: tRaetsel; end; var @@ -29,15 +33,33 @@ implementation uses unit2; -{ TForm1 } +// tForm1 ********************************************************************** -procedure TForm1.FormCreate(Sender: TObject); +procedure tForm1.formCreate(sender: tObject); begin + application.createForm(tForm2, form2); case form2.showmodal of - mrBuchstabenraetsel: ; - mrHochhausraetsel: ; + mrBuchstabenraetsel: + raetsel:=tBuchstabenRaetsel.create(form1); + mrHochhausraetsel: + raetsel:=tHochhausRaetsel.create(form1); + else begin + raetsel:=nil; + application.terminate; + end; end; end; +procedure tForm1.FormDestroy(Sender: TObject); +begin + raetsel.free; +end; + +procedure tForm1.FormShow(Sender: TObject); +begin + if assigned(raetsel) then + raetsel.zeichnen; +end; + end. diff --git a/unit2.lfm b/unit2.lfm index d067523..381f031 100644 --- a/unit2.lfm +++ b/unit2.lfm @@ -1,28 +1,28 @@ object Form2: TForm2 Left = 1690 - Height = 240 + Height = 94 Top = 197 - Width = 320 + Width = 192 Caption = 'Form2' - ClientHeight = 240 - ClientWidth = 320 + ClientHeight = 94 + ClientWidth = 192 LCLVersion = '1.6.0.4' object Button1: TButton - Left = 80 + Left = 16 Height = 25 - Top = 16 + Top = 56 Width = 160 Caption = 'Hochhausrätsel' - OnClick = Button1Click + ModalResult = 314 TabOrder = 0 end object Button2: TButton - Left = 80 + Left = 16 Height = 25 - Top = 76 + Top = 16 Width = 160 Caption = 'Buchstabenrätsel' - OnClick = Button2Click + ModalResult = 315 TabOrder = 1 end end diff --git a/unit2.pas b/unit2.pas index 9403550..11e7551 100644 --- a/unit2.pas +++ b/unit2.pas @@ -14,8 +14,6 @@ type TForm2 = class(TForm) Button1: TButton; Button2: TButton; - procedure Button1Click(Sender: TObject); - procedure Button2Click(Sender: TObject); private { private declarations } public @@ -35,15 +33,5 @@ implementation { TForm2 } -procedure TForm2.Button1Click(Sender: TObject); -begin - modalResult:=mrHochhausraetsel; -end; - -procedure TForm2.Button2Click(Sender: TObject); -begin - modalResult:=mrBuchstabenraetsel; -end; - end. -- cgit v1.2.3-70-g09d2