/* 01 */ {------------------------------------------------------------------------------}
/* 02 */ {
/* 03 */    Unit Name: astia
/* 04 */    Purpose  : Astian toteutus
/* 05 */    Author   : Vesa Lappalainen
/* 06 */    Date     : 6.12.2000
/* 07 */    Changed  :
/* 08 */ 
/* 09 */    Astia on luokka, johon voidaan laittaa nestettä maksimissaan
/* 10 */    Tilavuuden verran.
/* 11 */    Astiaan voidaan kaataa nestettä toiseta astiasta.
/* 12 */    Astian kokonaan tyhjenemisestä tai täyttymisestä saadaan tapahtuma.
/* 13 */    Astian sisusta piirretään aina sinisellä värillä suhteessa astian
/* 14 */    korkeuteen.  Eli täysi astia on kokonaan sininen ja tyhjä kokonaan
/* 15 */    valkoinen.
/* 16 */ 
/* 17 */ }
/* 18 */ {------------------------------------------------------------------------------}
/* 19 */ 
/* 20 */ 
/* 21 */ unit astia;
/* 22 */ 
/* 23 */ interface
/* 24 */ uses extctrls,Graphics;
/* 25 */ 
/* 26 */ type
/* 27 */   TAstia = class;
/* 28 */   TAstiaEvent = procedure (sender:TAstia; const viesti:string) of object;
/* 29 */ 
/* 30 */   TAstia = class(TPaintBox)
/* 31 */   private
/* 32 */     FTilavuus: double;
/* 33 */     FAinetta: double;
/* 34 */     viesti : string;
/* 35 */     FOnFull: TAstiaEvent;
/* 36 */     FOnEmpty: TAstiaEvent;
/* 37 */     procedure SetTilavuus(const Value: double);
/* 38 */     function GetMahtuu: double;
/* 39 */     procedure SetAinetta(const Value: double);
/* 40 */     procedure SetMahtuu(const Value: double);
/* 41 */     procedure CheckEvents;
/* 42 */   public
/* 43 */     procedure Paint; override;
/* 44 */     function Kaada(a:TAstia) : double;
/* 45 */   published
/* 46 */     property Tilavuus : double read FTilavuus write SetTilavuus;
/* 47 */     property Ainetta : double read FAinetta write SetAinetta;
/* 48 */     property Mahtuu : double read GetMahtuu write SetMahtuu;
/* 49 */     property OnFull : TAstiaEvent read FOnFull write FOnFull;
/* 50 */     property OnEmpty : TAstiaEvent read FOnEmpty write FOnEmpty;
/* 51 */   end;
/* 52 */ 
/* 53 */   function eq(d1,d2:double):boolean;
/* 54 */ 
/* 55 */ implementation
/* 56 */ 
/* 57 */ const EPS = 0.001;
/* 58 */ 
/* 59 */ function eq(d1,d2:double):boolean;
/* 60 */ // Verrataan onko kaksi reaalilukua yhtäsuuria EPS:in tarkkuudella
/* 61 */ begin
/* 62 */   Result := false;
/* 63 */   if ( d1 < d2 - EPS ) then exit;
/* 64 */   if ( d1 > d2 + EPS ) then exit;
/* 65 */   Result := true;
/* 66 */ end;
/* 67 */ 
/* 68 */ { TAstia }
/* 69 */ 
/* 70 */ function TAstia.GetMahtuu: double;
/* 71 */ begin
/* 72 */   Result := Tilavuus - Ainetta;
/* 73 */ end;
/* 74 */ 
/* 75 */ procedure TAstia.Paint;
/* 76 */ begin
/* 77 */   inherited;
/* 78 */   Canvas.Brush.Color := clWhite;
/* 79 */   Canvas.Rectangle(0,0,Width,Height);
/* 80 */   if ( eq(Tilavuus,0) ) then exit;
/* 81 */   Canvas.Brush.Color := clBlue;
/* 82 */   Canvas.Rectangle(0,Round(Height*Mahtuu/Tilavuus),Width,Height);
/* 83 */ end;
/* 84 */ 
/* 85 */ procedure TAstia.CheckEvents;
/* 86 */ begin
/* 87 */   if ( eq(Ainetta,0) and Assigned(OnEmpty) ) then OnEmpty(self,viesti);
/* 88 */   if ( eq(Ainetta,Tilavuus) and Assigned(OnFull) ) then OnFull(self,viesti);
/* 89 */ end;
/* 90 */ 
/* 91 */ procedure TAstia.SetAinetta(const Value: double);
/* 92 */ begin
/* 93 */   if ( eq(Ainetta,Value) ) then exit;
/* 94 */   FAinetta := Value;
/* 95 */   invalidate;
/* 96 */   CheckEvents;
/* 97 */   viesti := '';
/* 98 */ end;
/* 99 */ 
/* 100 */ procedure TAstia.SetMahtuu(const Value: double);
/* 101 */ begin
/* 102 */   Ainetta := Tilavuus - Value;
/* 103 */   invalidate;
/* 104 */ end;
/* 105 */ 
/* 106 */ procedure TAstia.SetTilavuus(const Value: double);
/* 107 */ begin
/* 108 */   FTilavuus := Value;
/* 109 */   invalidate;
/* 110 */ end;
/* 111 */ 
/* 112 */ function TAstia.Kaada(a: TAstia): double;
/* 113 */ // Kaataa astiaan (self) nestettä toisesta astiasta (a).
/* 114 */ // Jos kaikki a:n neste mahtuu, niin se käytetään ja a menee tyhjäksi.
/* 115 */ // Jos kaikki ei mahdu, niin laitetaan sen verran kuin mahtuu
/* 116 */ // eli self tulee täyteen ja a:sta vähenee neste.
/* 117 */ // Palautetaan a:han jäljelle jääneen nesteen määrä.
/* 118 */ // Sijoituksissa pitää olla tarkkana, jotta tapahtuman (tyhjä/täysi)
/* 119 */ // tullessa tilanne on kummankin astia kohdalta oikein.
/* 120 */ // Kummankin astian apuattribuuttiin viesti laitetaan merkkijonona
/* 121 */ // tieto mistä astiasta ollaan kaatamassa ja mihin (esim. a5 -> a8 ).
/* 122 */ begin
/* 123 */   Result := a.Ainetta - Mahtuu;
/* 124 */   viesti := a.Name + ' -> ' + name;
/* 125 */   a.viesti := viesti;
/* 126 */   if ( Result <= 0 ) then begin
/* 127 */     Result := 0;
/* 128 */     FAinetta := Ainetta + a.Ainetta;
/* 129 */     a.Ainetta := 0;
/* 130 */     invalidate;
/* 131 */     CheckEvents;
/* 132 */     exit;
/* 133 */   end;
/* 134 */ 
/* 135 */   a.Ainetta := Result;
/* 136 */   Mahtuu := 0;
/* 137 */ end;
/* 138 */ 
/* 139 */ end.