From 49fee96ef76bec25b627a0326fdf3f93935ba1cf Mon Sep 17 00:00:00 2001
From: Erich Eckner <git@eckner.net>
Date: Wed, 5 Dec 2018 10:08:22 +0100
Subject:  Initial commit

---
 unit1.pas | 190 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 190 insertions(+)
 create mode 100644 unit1.pas

(limited to 'unit1.pas')

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-54-g00ecf