From 49fee96ef76bec25b627a0326fdf3f93935ba1cf Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Wed, 5 Dec 2018 10:08:22 +0100 Subject: Initial commit --- .gitignore | 3 + terminer.ico | Bin 0 -> 137040 bytes terminer.lpi | 77 ++++++++++++++++++++++++ terminer.lpr | 21 +++++++ terminer.lps | 91 ++++++++++++++++++++++++++++ terminer.res | Bin 0 -> 138932 bytes unit1.lfm | 63 ++++++++++++++++++++ unit1.pas | 190 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 445 insertions(+) create mode 100644 .gitignore create mode 100644 terminer.ico create mode 100644 terminer.lpi create mode 100644 terminer.lpr create mode 100644 terminer.lps create mode 100644 terminer.res create mode 100644 unit1.lfm create mode 100644 unit1.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0408443 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +backup +lib +terminer diff --git a/terminer.ico b/terminer.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/terminer.ico differ diff --git a/terminer.lpi b/terminer.lpi new file mode 100644 index 0000000..3b5ced3 --- /dev/null +++ b/terminer.lpi @@ -0,0 +1,77 @@ + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="terminer.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="terminer"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../units"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/terminer.lpr b/terminer.lpr new file mode 100644 index 0000000..eba2769 --- /dev/null +++ b/terminer.lpr @@ -0,0 +1,21 @@ +program terminer; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/terminer.lps b/terminer.lps new file mode 100644 index 0000000..e8daf48 --- /dev/null +++ b/terminer.lps @@ -0,0 +1,91 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="10"/> + <BuildModes Active="Default"/> + <Units Count="3"> + <Unit0> + <Filename Value="terminer.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="20"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + <IsVisibleTab Value="True"/> + <TopLine Value="111"/> + <CursorPos X="22" Y="145"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit1> + <Unit2> + <Filename Value="../units/mystringlistunit.pas"/> + <EditorIndex Value="-1"/> + <TopLine Value="8"/> + <CursorPos X="15" Y="28"/> + <UsageCount Value="10"/> + </Unit2> + </Units> + <JumpHistory Count="13" HistoryIndex="12"> + <Position1> + <Filename Value="unit1.pas"/> + </Position1> + <Position2> + <Filename Value="unit1.pas"/> + <Caret Line="26" TopLine="8"/> + </Position2> + <Position3> + <Filename Value="unit1.pas"/> + <Caret Line="30" Column="15" TopLine="16"/> + </Position3> + <Position4> + <Filename Value="unit1.pas"/> + <Caret Line="28" TopLine="15"/> + </Position4> + <Position5> + <Filename Value="unit1.pas"/> + <Caret Line="26" Column="30" TopLine="7"/> + </Position5> + <Position6> + <Filename Value="unit1.pas"/> + <Caret Line="57" Column="28" TopLine="41"/> + </Position6> + <Position7> + <Filename Value="unit1.pas"/> + <Caret Line="126" Column="3" TopLine="91"/> + </Position7> + <Position8> + <Filename Value="unit1.pas"/> + <Caret Line="95" Column="29" TopLine="55"/> + </Position8> + <Position9> + <Filename Value="unit1.pas"/> + <Caret Line="102" Column="29" TopLine="82"/> + </Position9> + <Position10> + <Filename Value="unit1.pas"/> + <Caret Line="42" Column="3" TopLine="18"/> + </Position10> + <Position11> + <Filename Value="unit1.pas"/> + <Caret Line="112" Column="43" TopLine="93"/> + </Position11> + <Position12> + <Filename Value="unit1.pas"/> + <Caret Line="9" Column="19"/> + </Position12> + <Position13> + <Filename Value="unit1.pas"/> + <Caret Line="144" TopLine="111"/> + </Position13> + </JumpHistory> + </ProjectSession> +</CONFIG> diff --git a/terminer.res b/terminer.res new file mode 100644 index 0000000..877868c Binary files /dev/null and b/terminer.res differ diff --git a/unit1.lfm b/unit1.lfm new file mode 100644 index 0000000..bb60d3d --- /dev/null +++ b/unit1.lfm @@ -0,0 +1,63 @@ +object Form1: TForm1 + Left = 444 + Height = 543 + Top = 283 + Width = 728 + Caption = 'Form1' + ClientHeight = 543 + ClientWidth = 728 + OnActivate = FormActivate + OnCreate = FormCreate + OnDestroy = FormDestroy + OnResize = FormResize + LCLVersion = '1.8.4.0' + object Memo1: TMemo + Left = 0 + Height = 104 + Top = 56 + Width = 96 + Lines.Strings = ( + 'Mo' + 'Di' + 'Mi' + 'Do' + 'Fr' + ) + OnChange = Memo1Change + ScrollBars = ssAutoVertical + TabOrder = 0 + end + object SpinEdit1: TSpinEdit + Left = 0 + Height = 27 + Top = 0 + Width = 96 + OnChange = Memo1Change + TabOrder = 1 + Value = 8 + end + object SpinEdit2: TSpinEdit + Left = 0 + Height = 27 + Top = 28 + Width = 96 + OnChange = Memo1Change + TabOrder = 2 + Value = 18 + end + object Memo2: TMemo + Left = 96 + Height = 160 + Top = 0 + Width = 576 + OnChange = Memo1Change + ScrollBars = ssAutoBoth + TabOrder = 3 + end + object Image1: TImage + Left = 0 + Height = 90 + Top = 160 + Width = 90 + end +end diff --git a/unit1.pas b/unit1.pas new file mode 100644 index 0000000..962682c --- /dev/null +++ b/unit1.pas @@ -0,0 +1,190 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + Spin, ExtCtrls, mystringlistunit; + +type + + { TForm1 } + + TForm1 = class(TForm) + Image1: TImage; + Memo1: TMemo; + Memo2: TMemo; + SpinEdit1: TSpinEdit; + SpinEdit2: TSpinEdit; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure Memo1Change(Sender: TObject); + private + personen,tage: tMyStringList; + zeiten: array of longint; + kannNicht: array of array of array of longint; + inhaltOk: boolean; + procedure clearArrays; + procedure schreibeNach(x,y: longint; s: string); + public + procedure zeichnen; + procedure interpretiereInhalt; + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + math; + +{ TForm1 } + +procedure TForm1.FormResize(Sender: TObject); +begin + memo2.width:=form1.clientWidth-memo1.left; + image1.free; + image1:=tImage.create(form1); + image1.parent:=form1; + image1.left:=0; + image1.top:=160; + image1.width:=form1.clientWidth-image1.left; + image1.height:=form1.clientHeight-image1.top; + zeichnen; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + personen:=tMyStringList.create; + tage:=tMyStringList.create; + setLength(kannNicht,0); + setLength(zeiten,0); + inhaltOk:=false; +end; + +procedure TForm1.FormActivate(Sender: TObject); +begin + interpretiereInhalt; + zeichnen; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + clearArrays; + personen.free; + tage.free; +end; + +procedure TForm1.Memo1Change(Sender: TObject); +begin + interpretiereInhalt; + zeichnen; +end; + +procedure tForm1.clearArrays; +var + i,j: longint; +begin + personen.clear; + tage.clear; + for i:=0 to length(kannNicht)-1 do begin + for j:=0 to length(kannNicht[i])-1 do + setLength(kannNicht[i,j],0); + setLength(kannNicht[i],0); + end; + setLength(kannNicht,0); + setLength(zeiten,0); +end; + +procedure tForm1.schreibeNach(x,y: longint; s: string); +begin + image1.canvas.textOut( + round(image1.width/(tage.count+1)*(x+0.5) - image1.canvas.textWidth(s)/2), + round(image1.height/(length(zeiten)+1)*(y+0.5) - image1.canvas.textHeight(s)/2), + s + ); +end; + +procedure tForm1.zeichnen; +var + i,j,k: longint; + ma,mi: longint; + guete: extended; + s: string; +begin + if not inhaltOk then + exit; + image1.canvas.brush.color:=$ffffff; + image1.canvas.rectangle(-1,-1,image1.width+1,image1.height+1); + ma:=-1; + mi:=-1; + for i:=0 to length(zeiten)-1 do + for j:=0 to tage.count-1 do begin + if (ma<0) or (ma < length(kannNicht[i,j])) then + ma:=length(kannNicht[i][j]); + if (mi<0) or (mi > length(kannNicht[i,j])) then + mi:=length(kannNicht[i][j]); + end; + for i:=0 to length(zeiten)-1 do + schreibeNach(0,i+1,intToStr(zeiten[i])); + for j:=0 to tage.count-1 do + schreibeNach(j+1,0,tage[j]); + for i:=0 to length(zeiten)-1 do + for j:=0 to tage.count-1 do begin + guete:=min(1,max(0,1-(length(kannNicht[i,j])-mi)/(ma-mi+byte(ma=mi)))); + if guete<0.5 then + image1.canvas.brush.color:=$ff or (round($ff*(2*guete)) shl 8) + else + image1.canvas.brush.color:=$ff00 or round($ff*(2-2*guete)); + image1.canvas.pen.color:=image1.canvas.brush.color; + image1.canvas.rectangle( + round(image1.width/(tage.count+1)*(j+1)), + round(image1.height/(length(zeiten)+1)*(i+1)), + round(image1.width/(tage.count+1)*(j+2))-1, + round(image1.height/(length(zeiten)+1)*(i+2))-1 + ); + image1.canvas.pen.color:=$000000; + s:=''; + for k:=0 to length(kannNicht[i,j])-1 do + s:=s+personen[kannNicht[i,j,k]]+', '; + delete(s,length(s)-1,2); + schreibeNach(j+1,i+1,s); + end; +end; + +procedure tForm1.interpretiereInhalt; +var + i,j,k: longint; +begin + inhaltOk:=false; + clearArrays; + setLength(zeiten,spinEdit2.value - spinEdit1.value); + for i:=spinEdit1.value to spinEdit2.value-1 do + zeiten[i-spinEdit1.value]:=i; + tage.text:=memo1.lines.text; + tage.grep('^$',true); + personen.add('EE'); + setLength(kannNicht,length(zeiten)); + for i:=0 to length(kannNicht)-1 do begin + setLength(kannNicht[i],tage.count); + for j:=0 to length(kannNicht[i])-1 do begin + setLength(kannNicht[i,j],round(5*random)); + for k:=0 to length(kannNicht[i,j])-1 do + kannNicht[i,j,k]:=0; + end; + end; + inhaltOk:= + (personen.count>0) and + (tage.count>0) and + (length(zeiten)>0); +end; + +end. + -- cgit v1.2.3