{------------------------------------------------------------------------------}
{
   Unit Name: ksheet
   Purpose  : Sheet components
   Author   : Vesa Lappalainen
   Date     : 9.9.1996
   Changed  : 13.3.1998
     + TSheetMark, TCutMark, pellin ja merkkien talletus ini:iin.
     + TaSheet-pinon peltiin talletus tiedostoon
       TSheetStack talletus tiedostoon
   Changes: 18.4.1998
     + Marks taulukko on järjestetty paikan mukaan

   ToDo     :

  KSheet - This file includes Kave 2000 sheet Simulation components:

    TSheet
    TRollSheet
    TSheetStack

    TSheet      - yksittäinen pelti, joka voi liikuttaa yhtä anturia

    TSheetFromRoll  - yksittäinen pelti, joka tulee rullalta, eli liikkuessa
                  pitenee koko ajan.  Tarvitsee oman rulla-komponentin

    TSheetStack - kasa peltejä.  Yksittäisiä peltejä voidaan lisätä.
                  Lisäksi voidaan suorittaa kasaan kuuluvia laskuja.

}
{------------------------------------------------------------------------------}
unit ksheet;
interface

uses
  {Windows, }Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, kavesimu,ksimcomp,kscale,kinicomp;

const MAXSHEETS = 1000;
const cpNoCutPosition:double = 1e30;
const cpFirstMark:double = -1e30;
  {----------------------------------------------------------------------------}
type

  TSheetMark = class(TObject)
  private
    FPos : double;
  public
    constructor Create1(APos:double);
    constructor CreateS(s:string); virtual;
    procedure Draw(canvas:TCanvas; scale:TScale; dx,dy:integer); virtual;
    property Pos : double read FPos write FPos;
    function  GetAsString : string; virtual;
    procedure SetAsString(value:string); virtual;
    procedure ExtAsString(var value:string); virtual;
    function SType : string; virtual;
    property AsString : string read GetAsString write SetAsString;
  end;

  TPressPunchMark = class(TSheetMark)
  public
    function SType : string; override;
  end;

  TPressMark = class(TSheetMark)
  private
    FPressNr: integer;
    FFShrink: double;
    FBShrink: double;
    procedure SetPressNr(const Value: integer);
    procedure SetFShrink(const Value: double);
    procedure SetBShrink(const Value: double);
  public
    constructor Create4(APos:double; nr:integer; fs,bs:double);
    function  GetAsString : string; override;
    procedure ExtAsString(var value:string); override;
    function SType : string; override;
    property FShrink : double read FFShrink write SetFShrink;
    property BShrink : double read FBShrink write SetBShrink;
    property PressNr : integer read FPressNr write SetPressNr;
  end;

  TSheetMarkType = class of TSheetMark;

  TCutMark = class(TSheetMark)
  private
    FShouldBe: double;
    FOrderNr : string;
    FNr      : longint;
  public
    constructor Create4(APos,ASb:double;const AOrderNr:string;ANr:longint);
    function  GetAsString : string; override;
    function SType : string; override;
    procedure ExtAsString(var value:string); override;
    property OrderNr : string read FOrderNr write FOrderNr;
    property Nr : longint read FNr write FNr;
    property ShouldBe : double read FShouldBe write FShouldBe;
  end;


  TSheetMarks = class(TList)
  public
    destructor Destroy; override;
    function GetMItems(i:integer) : TSheetMark; virtual;
    procedure SetMItems(i:integer;m:TSheetMark); virtual;
    procedure Cut(pos,diff:double; marks:TSheetMarks); virtual;
{$ifdef VER120}
    procedure Clear; override; // virtual;
{$else}
{$ifdef VER130}
    procedure Clear; override; // virtual;
{$else}
{$ifdef VER140}
    procedure Clear; override; // virtual;
{$else}
    procedure Clear; virtual;
{$endif}
{$endif}
{$endif}
    procedure Take(marks:TSheetMarks); virtual;
    procedure Add(AObject:TSheetMark); virtual;
    function  GetAsString : string; virtual;
    procedure SetAsString(value:string); virtual;
    procedure ExtAsString(var value:string); virtual;
    function FindMarkPosition(typ:TSheetMarkType; after:double) : double;  virtual;
    function FindMark(typ:TSheetMarkType; after:double):TSheetMark; virtual;
    function FindMarkNearPosition(typ:TSheetMarkType;x,dx:double) : TSheetMark; virtual;
    function CountMarksAfter(d:double;typ:TSheetMarkType):integer; virtual;
    function FindLastMark(typ:TSheetMarkType):TSheetMark; virtual;
    function MoveMarksAfterPosition(typ:TSheetMarkType;dp,dx:double) : integer; virtual;
    function CountInSheet(const onr:string;nr:longint;d,dm,dp,wic:double):integer; virtual;
    function CountInOrderNr(const onr:string;dm,dp:double):integer; virtual;
    function GetMarksAsString(const sep:string): string; virtual;
    property MItems[i:integer] : TSheetMark read GetMItems write SetMItems; default;
  published
    property AsString : string read GetAsString write SetAsString stored false;
  end;


  TSheet = class(TaSimuObject)
  private
    FFromRoll : Double; {  }
    FEncoder : TsEncoder;
    FEncoderAllways : Boolean;
    FMarks : TSheetMarks;
  protected
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    function Advance(dx:Double) : boolean; override;
    function Drop(dy:Double) : boolean;    virtual;
    function Cut(pos,diff:Double) : TSheet;     virtual;
    procedure AddMark(typ:TSheetMarkType;APos:double);  overload; virtual;
    procedure AddMark(mark: TSheetMark);  overload; virtual;
    procedure AddCutMark(APos,Asb:double;const AOrderNr:string;ANr:longint); virtual;
    property Marks : TSheetMarks read FMarks write FMarks;
    function  GetAsString : string; override;
    procedure ExtAsString(var value:string); override;
    function FindMarkPosition(typ:TSheetMarkType; after:double) : double; virtual;
    function FindMarkNearPosition(typ:TSheetMarkType;x,dx:double) : TSheetMark; virtual;
    function FindMark(typ:TSheetMarkType; after:double):TSheetMark; virtual;
    function FindLastMark(typ:TSheetMarkType):TSheetMark; virtual;
    function MoveMarksAfterPosition(typ:TSheetMarkType;dp,dx:double) : integer; virtual;
    function CountMarksAfter(d:double;typ:TSheetMarkType):integer; virtual;
    function CountInSheet(const onr:string;nr:longint;d,dm,dp,wic:double):integer; virtual;
    function CountInOrderNr(const onr:string;dm,dp:double):integer; virtual;
    function GetMarksAsString(const sep:string): string; virtual;
  published
    property Encoder : TsEncoder read FEncoder write FEncoder;
    property EncoderAllways : Boolean read FEncoderAllways
                                      write FEncoderAllways default False;

  end; 

  {----------------------------------------------------------------------------}
  TSheetFromRoll = class(TSheet)
  private
    FFromRoll : Double; {  }
  protected
  public
    constructor Create(AOwner:TComponent); override;
    function Advance(dx:Double) : boolean; override;
    procedure SetFromRoll(fr:Double);
    procedure ShowChange;                  override;
{$ifdef Left}
    procedure SetWidth(AWidth:integer);    override;
{$endif}
    procedure SetX(value:double);          override;
    procedure MySetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property FromRoll : Double Read FFromRoll Write SetFromRoll;
  end; // TSheetFromRoll

  {----------------------------------------------------------------------------}
   TaSheet = class
   private
     FColor : TColor;
     FLen   : Double;
     Fx     : double;
     Fy     : double;
   public
     constructor Create3(c:TColor;il,ix:Double); virtual;
     function IsNext(const s:TaSheet;const scale:TScale;dy:double):boolean;
     function Hit(const s:TaSheet):boolean;
     procedure Move(dx,dy:double);
     function  GetAsString : string; virtual;
     procedure SetAsString(value:string); virtual;
     procedure ExtAsString(var value:string); virtual;
   published
     property Color : TColor read FColor;
     property x     : Double read Fx;
     property y     : Double read Fy;
     property Len   : Double Read FLen;
   end; // TaSheet


  {----------------------------------------------------------------------------}
  TSheetStack = class(TSheet)
  private
    FSheetHeight : Double;
    FNrOfSheets : integer;
    FEmptyLimit : Double;
    FEmptyLimitR : Double;
    FStartX     : Double;
    Sheets : array [0..MAXSHEETS-1] of TaSheet;
    FOnStackChange: TNotifySimuEvent;
    procedure ReshapeStackArea;
  protected

    procedure SetSheetHeight(sh:Double);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Reset; virtual;
    procedure Paint; override;
    function Advance(dx:Double) : boolean; override;
    function Add(var sh:TSheet; kill:boolean = true):boolean;  virtual;
    function AddaSheet(var sh:TaSheet):boolean;
    function AddCxl(shCol:TColor; shx,shLen:double):boolean; virtual;
    function CoG:Double;  virtual;
    function IsEmpty : boolean; virtual;
    function  GetAsString : string; override;
    procedure ExtAsString(var value:string); override;
    procedure DeleteAllSheets; virtual;
    function PopLastSheet:TaSheet; virtual;
  published
    property SheetHeight : Double read FSheetHeight write SetSheetHeight;
    property NrOfSheets : integer read FNrOfSheets;
    property EmptyLimit : Double read FEmptyLimit write FEmptyLimit;
    property EmptyLimitR : Double read FEmptyLimitR write FEmptyLimitR;
    property StartX     : Double read FStartX write FStartX;
    property OnStackChange : TNotifySimuEvent read FOnStackChange write FOnStackChange;  
  end; // TSheetStack 

  {----------------------------------------------------------------------------}
  TSheetTile = class(TaSimuObject)
  private
  protected
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  published

  end; // TSheetTile 



procedure Register;



implementation
uses kdouble, kini;
{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Kave2000', [TSheet,TSheetFromRoll,TSheetStack,TSheetTile]);
end;

//-----------------------------------------------------------------------------
// TSheetMark & TCutMark
//-----------------------------------------------------------------------------

{ TSheetMark }

//-----------------------------------------------------------------------------
constructor TSheetMark.Create1(APos:double);
begin
  inherited Create;
  FPos := APos;
end;

//-----------------------------------------------------------------------------
procedure TSheetMark.Draw(canvas:TCanvas; scale:TScale; dx,dy:integer); //  virtual;
var ix:integer;
begin
  if ( scale = nil ) then exit;
  ix := scale.DownScaleDX(pos);
  if ( pos > 0 ) and ( ix < 0 ) then ix := dx + ix;
  with canvas do begin
    MoveTo(ix,0); LineTo(ix,dy);
  end;
end;


//-----------------------------------------------------------------------------
procedure TSheetMark.SetAsString(value:string); //  virtual;
begin
  ExtAsString(value);
end;


//-----------------------------------------------------------------------------
procedure TSheetMark.ExtAsString(var value:string); //  virtual;
begin
  Delete(value,1,1);
  FPos := ExtractIniDouble(value,',',FPos);
end;


//-----------------------------------------------------------------------------
function  TSheetMark.GetAsString : string; //  virtual;
begin
  Result := SType+DoubleToIniStr(FPos,2);
end;

//-----------------------------------------------------------------------------
constructor TSheetMark.CreateS(s:string); //  virtual;
begin
  inherited;
  AsString := s;
end;


//-----------------------------------------------------------------------------
function TSheetMark.SType : string; //  virtual;
begin
  Result := 'M';
end;

{ TPressPunchMark }

function TPressPunchMark.SType: string;
begin
  Result := 'U';
end;


{ TCutMark }

//-----------------------------------------------------------------------------
function TCutMark.SType : string; //  override;
begin
  Result := 'C';
end;

//-----------------------------------------------------------------------------
constructor TCutMark.Create4(APos,Asb:double;const AOrderNr:string;ANr:longint);
begin
  Create1(APos);
  FShouldBe := Asb;
  FOrderNr := AOrderNr;
  FNr := ANr;
end;

//-----------------------------------------------------------------------------
procedure TCutMark.ExtAsString(var value:string); //  virtual;
begin
  inherited ExtAsString(value);
  FOrderNr := ExtractString(value,',',FOrderNr);
  FNr      := ExtractInt(value,',',FNr);
  FShouldBe:= ExtractIniDouble(value,',;',FNr);
end;

//-----------------------------------------------------------------------------
function  TCutMark.GetAsString : string; //  virtual;
begin
  Result := inherited GetAsString
            + ',' + FOrderNr + ',' + IntToStr(FNr)
            + ',' + DoubleToIniStr(ShouldBe,1);
end;

{ TPressMark }

//-----------------------------------------------------------------------------
constructor TPressMark.Create4(APos: double; nr: integer; fs, bs: double);
begin
  Create1(APos);
  FPressNr := nr;
  FFShrink := fs;
  FBShrink := bs;
end;

procedure TPressMark.ExtAsString(var value: string);
begin
  inherited;
  FPressNr := ExtractInt(value,',',PressNr);
  FFShrink := ExtractIniDouble(value,',;',FShrink);
  FBShrink := ExtractIniDouble(value,',;',BShrink);

end;

function TPressMark.GetAsString: string;
begin
  Result := inherited GetAsString
            + ',' + IntToStr(PressNr)
            + ',' + DoubleToIniStr(FShrink,3)
            + ',' + DoubleToIniStr(BShrink,3)
         ;   
end;

procedure TPressMark.SetBShrink(const Value: double);
begin
  FBShrink := Value;
end;

procedure TPressMark.SetFShrink(const Value: double);
begin
  FFShrink := Value;
end;

procedure TPressMark.SetPressNr(const Value: integer);
begin
  FPressNr := Value;
end;

function TPressMark.SType : string; //  override;
begin
  Result := 'P';
end;



//-----------------------------------------------------------------------------
// TSheetMarks
//-----------------------------------------------------------------------------

{ TSheetMarks }


destructor TSheetMarks.Destroy; //  override;
begin
  Clear;
  inherited;
end;


//-----------------------------------------------------------------------------
function TSheetMarks.GetMItems(i:integer) : TSheetMark; //  virtual;
begin
  Result := TSheetMark(Items[i]);
end;


//-----------------------------------------------------------------------------
procedure TSheetMarks.SetMItems(i:integer;m:TSheetMark); //  virtual;
begin
  Items[i] := m;
end;


//-----------------------------------------------------------------------------
procedure TSheetMarks.Clear; //  virtual;
var i:integer;
begin
  for i := 0 to Count-1 do
    MItems[i].Free;
  inherited Clear;
end;


//-----------------------------------------------------------------------------
procedure TSheetMarks.Cut(pos,diff:double; marks:TSheetMarks); //  virtual;
// Mieti tähän toleranssin vaikutus
var i:integer;
begin
  for i:=0 to Count-1 do
    if (MItems[i].pos <= pos + diff ) then begin
      if ( marks <> nil ) then marks.Add(MItems[i]) else MItems[i].Free;
      MItems[i] := nil;
    end;
  Pack;
  for i:=0 to Count-1 do begin
    MItems[i].Pos := MItems[i].Pos - pos;
  end;

end;


//-----------------------------------------------------------------------------
procedure TSheetMarks.Take(marks:TSheetMarks); //  virtual;
// Takes all marks from marks
var i:integer;
begin
  for i:=0 to marks.Count-1 do begin
    Add(marks[i]);
    marks[i] := nil;
  end;
  marks.Pack;
end;


//-----------------------------------------------------------------------------
procedure TSheetMarks.Add(AObject:TSheetMark); //  virtual;
var i:integer;  sm : TSheetMark;
begin
  if ( AObject = nil ) then exit;
  if ( AObject.pos < 0 ) then exit; // Ei lisätä merkkejä pellin ulkopuolelle
  for i:=0 to Count-1 do begin
    sm := Items[i];
    if ( sm.Pos > AObject.pos ) then begin
      Insert(i,AObject);
      Exit;
    end;
  end;
  inherited Add(AObject);
end;



//-----------------------------------------------------------------------------
procedure TSheetMarks.SetAsString(value:string); //  virtual;
begin
  ExtAsString(value);
end;

//-----------------------------------------------------------------------------
procedure TSheetMarks.ExtAsString(var value:string); //  virtual;
var val,s:string;
begin
  Clear;
  val := ExtractString(value,'|','');
  while ( val <> '' ) do begin
    s := ExtractString(val,';','');
    if ( s = '' ) then continue;
    case s[1] of
      'M' : Add(TSheetMark.CreateS(s));
      'C' : Add(TCutMark.CreateS(s));
      'P' : Add(TPressMark.CreateS(s));
      'U' : Add(TPressPunchMark.CreateS(s));
    end;
  end;
end;



//-----------------------------------------------------------------------------
function TSheetMarks.GetMarksAsString(const sep:string): string; //  virtual;
var i:integer;
begin
  Result := '';
  for i:=0 to Count-1 do begin
    Result := Result + Mitems[i].AsString + sep;
  end;
end;


//-----------------------------------------------------------------------------
function  TSheetMarks.GetAsString : string; //  virtual;
//var i:integer;
begin

  Result := GetMarksAsString(';') + '|';
end;


//-----------------------------------------------------------------------------
function TSheetMarks.FindMark(typ:TSheetMarkType; after:double):TSheetMark; //  virtual;
var i:integer; pmin : double;
begin
  Result := nil;
  pmin := cpNoCutPosition;
  for i:=0 to Count-1 do
    if ( Mitems[i] is typ ) and ( Mitems[i].pos < pmin ) and
       ( Mitems[i].pos > after ) then begin
      pmin := Mitems[i].pos;
      Result := Mitems[i];
    end;
end;

function TSheetMarks.FindMarkNearPosition(typ: TSheetMarkType; x,
  dx: double): TSheetMark;
var i:integer;
begin
  Result := nil;
  for i:=0 to Count-1 do
    if ( Mitems[i] is typ ) and
       ( x - dx <= Mitems[i].pos ) and ( Mitems[i].pos <= x + dx ) then begin
      Result := Mitems[i];
    end;
end;

//-----------------------------------------------------------------------------
function TSheetMarks.FindLastMark(typ:TSheetMarkType):TSheetMark; //  virtual;
var i:integer; pmax : double;
begin
  Result := nil;
  pmax := -10000000.0;
  for i:=0 to Count-1 do
    if ( Mitems[i] is typ ) and ( Mitems[i].pos > pmax ) then begin
      pmax := Mitems[i].pos;
      Result := Mitems[i];
    end;
end;

//-----------------------------------------------------------------------------
function TSheetMarks.CountMarksAfter(d:double;typ:TSheetMarkType):integer; // virtual;
var i:integer;
begin
  Result := 0;
  for i:=0 to Count-1 do
    if ( Mitems[i] is typ ) and ( Mitems[i].pos >= d ) then inc(Result);
end;

function TSheetMarks.MoveMarksAfterPosition(typ: TSheetMarkType; dp,
  dx: double): integer;
var i:integer;
begin
  Result := 0;
  for i:=0 to Count-1 do
    if ( Mitems[i] is typ ) and ( Mitems[i].pos >= dp ) then begin
      Mitems[i].pos := Mitems[i].pos + dx;
      inc(Result);
    end;
end;


//-----------------------------------------------------------------------------
function TSheetMarks.FindMarkPosition(typ:TSheetMarkType; after:double) : double; //  virtual;
var sm : TSheetMark;
begin
  Result := cpNoCutPosition;
  sm := FindMark(typ,after);
  if ( sm <> nil ) then Result := sm.pos;
end;


//-----------------------------------------------------------------------------
function TSheetMarks.CountInSheet(const onr:string;nr:longint;d,dm,dp,wic:double):integer; //  virtual;
var i:integer; cm : TCutMark; lwic,len,lpos : double;
begin
  Result := 0;
  lpos := 0;
  lwic := 0;
  for i:=0 to Count-1 do
    if ( Mitems[i] is TCutMark ) then begin
      cm := Mitems[i] as TCutMark;
      len := cm.Pos -lpos - lwic;
      if  ( cm.OrderNr = onr ) and ( cm.nr = nr ) and
          ( cm.ShouldBe >= d - dm ) and
          ( cm.ShouldBe <= d + dp ) and
          ( len >= cm.ShouldBe - dm ) and
          ( len <= cm.ShouldBe + dp )
        then
        inc(Result);
      lpos := cm.Pos;
      lwic := wic;
    end;
end;

//-----------------------------------------------------------------------------
function TSheetMarks.CountInOrderNr(const onr:string;dm,dp:double):integer; //  virtual;
var i:integer; cm : TCutMark; len,lpos : double;
begin
  Result := 0;
  lpos := 0;
  for i:=0 to Count-1 do
    if ( Mitems[i] is TCutMark ) then begin
      cm := Mitems[i] as TCutMark;
      len := cm.Pos -lpos;
      if  ( cm.OrderNr = onr ) and
          ( len >= cm.ShouldBe - dm ) and
          ( len <= cm.ShouldBe + dp )
        then
        inc(Result);
      lpos := cm.Pos;
    end;
end;



{------------------------------------------------------------------------------}
{ TSheet ======================================================================}
{------------------------------------------------------------------------------}

{ TSheet }

//-----------------------------------------------------------------------------
procedure TSheet.Paint;
var
  i, iWid, ix, iy, iw, ih: Integer;
begin
  with Canvas do begin
    Canvas.Pen := Self.Pen;
    Canvas.Brush := Self.Brush;
    ix := Pen.Width div 2;
    iy := ix;
    iWid := Width;
    iw := iWid - Pen.Width + 1;
    ih := Height - Pen.Width + 1;
    if Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Rectangle(ix, iy, ix + iw, iy + ih);
    for i:=0 to Marks.Count-1 do begin
      Marks[i].Draw(Canvas,Scale,iw,ih);
    end;
  end;
end;

{------------------------------------------------------------------------------}
function TSheet.Drop(dy:Double) : boolean;
begin
  Box.p.y := Box.p.y + dy;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TSheet.Cut(pos,diff:Double) : TSheet;
var s:TSheet;
begin
  Result := NIL;

  if ( x >= pos ) then begin Marks.Cut(-x+pos,diff,nil);
    Marks.Cut(-x+pos,diff,nil);  // Voiko syödä tarpeellisia merkkejä???
    exit;
  end;

  s := TSheet.Create(Owner);
  if ( s <> NIL ) then begin
    s.Scale := Scale;
    s.Parent := Parent;
    s.x := x;
    s.Box.p.y := Box.p.y;
    s.Box.dp.y := Box.dp.y;
    s.len := -x + Pos;
    s.Brush.Color := Brush.Color;
    s.Visible := True;
    Marks.Cut(-x+pos,diff,s.Marks);
  end else begin
    Marks.Cut(-x+pos,diff,nil);
  end;
  len := len - (-x + Pos); { Koska s voi olla NIL, ei käyt. s.len }
  x := pos;
  Result := s;
end;

{------------------------------------------------------------------------------}
function TSheet.Advance(dx:Double) : boolean;
begin
  inherited Advance(dx);

  Result := True;
  if ( Encoder = NIL ) then exit;     { Anturi ei ota peltiin kiinni           }

  if ( EncoderAllways ) then begin
    Encoder.increment(dx);
    exit;
  end;

  if ( Encoder.x < x ) then begin    { Anturi pellin vas. puolella           }
    if ( dx < 0 ) and ( x+dx <= Encoder.x ) then { Jos liikkuu vasemmalle    }
      Encoder.increment( Encoder.x - (x+dx) );
    exit;
  end;

  if ( x+Len < Encoder.x ) then begin { Anturi pellin oik.pään oik. puol}
    if ( dx > 0 ) and ( Encoder.x <= x+Len+dx ) then  { Jos liikkuu oikealle }
      Encoder.increment( x+Len+dx - Encoder.x );
    exit;
  end;

                                           { Anturi pellin alalla            }
  { Vielä jäi käsittelemättä jos siirron aikana pelti menee pois anturin
    kohdalta, mutta pyöriköön tämän verran tyhjää                            }
  Encoder.increment(dx);

end;

{------------------------------------------------------------------------------}
constructor TSheet.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FFromRoll := 0;
  Height := 5;
  FFromRoll := 0.0;
  FEncoder := NIL;
  FEncoderAllways := False;
  Marks := TSheetMarks.Create;
end;

//-----------------------------------------------------------------------------
destructor TSheet.Destroy; //  override;
begin
  FreeIni;
  Marks.Free;
  inherited;
end;


//-----------------------------------------------------------------------------
procedure TSheet.AddCutMark(APos,Asb:double;const AOrderNr:string;ANr:longint); //  virtual;
begin
  Marks.Add(TCutMark.Create4(APos,Asb,AOrderNr,ANr));
  Hint := Marks.AsString;
end;


//-----------------------------------------------------------------------------
procedure TSheet.AddMark(typ:TSheetMarkType;APos:double); //  virtual;
begin
  Marks.Add(typ.Create1(APos));
  Hint := Marks.AsString;
end;

//-----------------------------------------------------------------------------
procedure TSheet.AddMark(mark:TSheetMark); //  virtual;
begin
  Marks.Add(mark);
  Hint := Marks.AsString;
end;


//-----------------------------------------------------------------------------
procedure TSheet.ExtAsString(var value:string); //  virtual;
var val : string;
begin
  if ( value = '' ) then exit;
  val := ExtractString(value,'|','');
  x := ExtractIniDouble(val,',',x);
  len := ExtractIniDouble(val,';',len);
  Marks.AsString := val;
end;

//-----------------------------------------------------------------------------
function  TSheet.GetAsString : string; //  virtual;
begin
  Result := DoubleToIniStr(x,2) + ',' + DoubleToIniStr(len,2) + ';' + Marks.AsString;
end;

//-----------------------------------------------------------------------------
function TSheet.FindMarkPosition(typ:TSheetMarkType; after:double) : double; //  virtual;
begin
  Result := Marks.FindMarkPosition(typ,after);
end;

//-----------------------------------------------------------------------------
function TSheet.FindMarkNearPosition(typ: TSheetMarkType; x,
  dx: double): TSheetMark; // virtual;
begin
  Result := Marks.FindMarkNearPosition(typ,x,dx);
end;

//-----------------------------------------------------------------------------
function TSheet.FindMark(typ:TSheetMarkType; after:double):TSheetMark; //  virtual;
begin
  Result := Marks.FindMark(typ,after);
end;

//-----------------------------------------------------------------------------
function TSheet.FindLastMark(typ:TSheetMarkType):TSheetMark; //  virtual;
begin
  Result := Marks.FindLastMark(typ);
end;

//-----------------------------------------------------------------------------
function TSheet.CountInSheet(const onr:string;nr:longint;d,dm,dp,wic:double):integer; //  virtual;
begin
  Result := Marks.CountInSheet(onr,nr,d,dm,dp,wic);
end;

//-----------------------------------------------------------------------------
function TSheet.CountInOrderNr(const onr:string;dm,dp:double):integer; //  virtual;
begin
  Result := Marks.CountInOrderNr(onr,dm,dp);
end;

function TSheet.CountMarksAfter(d:double;typ:TSheetMarkType):integer; // virtual;
begin
  Result := Marks.CountMarksAfter(d,typ);
end;

//-----------------------------------------------------------------------------
function TSheet.GetMarksAsString(const sep:string): string; //  virtual;
begin
  Result := Marks.GetMarksAsString(sep);
end;

//-----------------------------------------------------------------------------
function TSheet.MoveMarksAfterPosition(typ: TSheetMarkType; dp,
  dx: double): integer;
begin
  Result := Marks.MoveMarksAfterPosition(typ,dp,dx);
end;



{------------------------------------------------------------------------------}
{ TSheetFromRoll ==============================================================}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

{ TSheetFromRoll }

{$ifdef Left}
procedure TSheetFromRoll.SetWidth(AWidth:integer);
begin
  FFromRoll := UpScale(AWidth) + x;
  inherited SetWidth(AWidth);
end;
{$endif}

{------------------------------------------------------------------------------}
procedure TSheetFromRoll.ShowChange;
begin
 if ( Len <> FromRoll - x ) then 
  Len := FromRoll - x;
end;

{------------------------------------------------------------------------------}
procedure TSheetFromRoll.SetFromRoll(fr:Double);
begin
  FFromRoll := fr;
  Len := fr - x;
end;

{------------------------------------------------------------------------------}
function TSheetFromRoll.Advance(dx:Double) : boolean;
begin
//  Len := FromRoll - x -dx;
  Box.dp.SetXYnu(FromRoll - x -dx,Box.dp.y);
  inherited Advance(dx);
//  Len := FromRoll - x;
  Result := True;
end;

//-----------------------------------------------------------------------------
procedure TSheetFromRoll.SetX(value:double); //           override;
begin
  Box.dp.SetXYnu(FromRoll - value,Box.dp.y);
  inherited;
//  Len := FromRoll - x;
end;

{------------------------------------------------------------------------------}
constructor TSheetFromRoll.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FromRoll := 0.0;
end;

{------------------------------------------------------------------------------}
procedure TSheetFromRoll.MySetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;

end;

{------------------------------------------------------------------------------}
{ TaSheet =====================================================================}
{------------------------------------------------------------------------------}

{ TaSheet }

{------------------------------------------------------------------------------}
constructor TaSheet.Create3(c:TColor;il,ix:Double);
begin
  inherited Create;
  FColor := c;
  FLen := il;
  Fx := ix;
  Fy := 0;
end;

{------------------------------------------------------------------------------}
function TaSheet.IsNext(const s:TaSheet;const scale:TScale; dy:Double):boolean;
begin
  Result := False;
  if ( s = NIL ) then exit;
  if ( scale = NIL ) then exit;
  if ( Color <> s.Color ) then exit;
  if ( scale.DownScaleDX(x) <> scale.DownScaleDX(s.x) ) then exit;
  if ( abs(scale.DownScaleDY(y)-scale.DownScaleDY(s.y-dy)) > 2 ) then exit;
  if ( scale.DownScaleDX(len) <> scale.DownScaleDX(s.len) ) then exit;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TaSheet.Hit(const s:TaSheet):boolean;
{
  hit     ----          ----        ----    -----
            =======    ========    =====     ===

 no hit   ----                     -----
               ======       ======
}

begin
  Result := False;
  if ( x + len      <= s.x ) then exit;
  if ( s.x + s.len  <= x   ) then exit;
  Result := True;
end;

{------------------------------------------------------------------------------}
procedure TaSheet.Move(dx,dy:double);
begin
  Fx := x + dx;
  Fy := y + dy;
end;

//-----------------------------------------------------------------------------
procedure TaSheet.ExtAsString(var value:string); //  virtual;
begin
  fcolor := ExtractInt(value,',',0);
  fx     := ExtractIniDouble(value,',',0);
  flen   := ExtractIniDouble(value,';',0);
end;

//-----------------------------------------------------------------------------
function  TaSheet.GetAsString : string; //  virtual;
begin
  Result := format('$%x',[color])+','+DoubleToIniStr(x,1)+','+DoubleToIniStr(len,1);
end;


//-----------------------------------------------------------------------------
procedure TaSheet.SetAsString(value:string); //  virtual;
begin
  ExtAsString(value);
end;


{------------------------------------------------------------------------------}
{ TSheetStack =================================================================}
{------------------------------------------------------------------------------}

{ TSheetStack }

{------------------------------------------------------------------------------}
function TSheetStack.IsEmpty : boolean;
begin
  Result := FNrOfSHeets = 0;
end;

//------------------------------------------------------------------------------
procedure TSheetStack.DeleteAllSheets;
var i:integer;
begin
  for i:=0 to NrOfSheets-1 do begin
    Sheets[i].Free;
    Sheets[i] := NIL;
  end;
  FNrOfSHeets := 0;
end;

//------------------------------------------------------------------------------
procedure TSheetStack.ReshapeStackArea;
var i:integer; x1,dx : double;
begin
  x1 := -1; dx := -1;
  for i:=0 to NrOfSheets-1 do begin
    if ( x1 < Sheets[i].Fx ) then x1 := Sheets[i].Fx;
    if ( dx < Sheets[i].Fx + Sheets[i].FLen ) then dx := Sheets[i].Fx + Sheets[i].FLen;
  end;
  if ( x1 > 0 ) then begin
    for i:=0 to NrOfSheets-1 do Sheets[i].Fx  := Sheets[i].Fx - x1;
    x := x + x1;
    len := dx;
  end
  else begin
//    x := x + (len-dx);
    len := dx;
  end;

end;

//------------------------------------------------------------------------------
function TSheetStack.PopLastSheet:TaSheet;
begin
  Result := nil;
  if ( NrOfSheets <= 0 ) then exit;
  dec(FNrOfSheets);
  Result := Sheets[NrOfSheets];
  Sheets[NrOfSheets] := nil;
  if ( NrOfSheets = 0 ) then Reset
  else ReshapeStackArea;
  Invalidate;
  if ( Assigned(OnStackChange) ) then OnStackChange(self);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TSheetStack.Reset;
begin
  Visible := false;
  DeleteAllSheets;

  x := StartX;
  Len := 2000;
  Box.dp.y := 100;
  Hint := 'Empty Stack';
  Visible := true;
  if ( Assigned(Encoder) ) then Encoder.Count := 0;
  if ( Assigned(OnStackChange) ) then OnStackChange(self);
end;

{------------------------------------------------------------------------------}
Procedure StackRectangle(Canvas:TCanvas; xLen,yLen,x,y,dx,dy:Double;scale:TScale);
var ix, iy, iw, ih: Integer;
begin
  if ( scale = NIL ) then exit;
  with Canvas do begin
    if ( scale.Fac.X > 0 ) then ix := scale.DownScaleDX(x)
                             else ix := -scale.DownScaleDX(xLen-x-dx);
    ix := Pen.Width div 2 + ix;
    if ( scale.Fac.Y > 0 ) then iy := scale.DownScaleDY(yLen-y-dy)
                             else iy := -scale.DownScaleDY(y);
    iy := Pen.Width div 2 + iy;
    iw := Abs(scale.DownScaleDX(dx)) - Pen.Width + 1;
    ih := Abs(scale.DownScaleDY(dy)) - Pen.Width + 1;
    if ( ih <= 1 ) then ih := 2;
    if Canvas.Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Canvas.Rectangle(ix, iy, ix + iw, iy + ih);
  end;
end;

{------------------------------------------------------------------------------}
procedure TSheetStack.Paint;
var
  i, n: Integer; dy,yh : Double;
begin
  if ( NrOfSheets = 0 ) then begin inherited Paint; exit; end;

  i := 0; yh := Box.dp.y;
  Canvas.Pen := Self.Pen;
  Canvas.Pen.Style := psSolid;
  Canvas.Brush := Self.Brush;
  Canvas.Brush.Style := bsSolid;
  while ( i < NrOfSheets ) do begin
    n := 1; { Etsitään samankokoiset pellit }
    while ( Sheets[i+n-1].IsNext(Sheets[i+n],Scale,SheetHeight) ) do inc(n);

    Canvas.Brush.Color := Sheets[i].Color;

    dy := SheetHeight*n;
    StackRectangle(Canvas,Len,yh,Sheets[i].x,Sheets[i].y,Sheets[i].len,dy,Scale);
    i := i + n;
  end;

end;

{------------------------------------------------------------------------------}
function TSheetStack.Advance(dx:Double) : boolean;
begin
  Result := false;
  if ( NrOfSheets = 0 ) then exit;
  if ( not inherited Advance(dx) ) then exit;
  if ( xr < EmptyLimit ) then Reset
  else if ( x  > EmptyLimitR ) then Reset
  else if ( Left + Width < 0 ) or ( Left > Parent.Width ) then Reset;
  Result := True;
end;

{------------------------------------------------------------------------------}
constructor TSheetStack.Create(AOwner:TComponent);
var i:integer;
begin
  inherited Create(AOwner);
  for  i := 0 to MAXSHEETS-1 do Sheets[i] := NIL;
  FSheetHeight := 30.0;
  FNrOfSheets := 0;
  FEmptyLimit := -20000.0;
  FEmptyLimitR := 20000.0;
  FStartX := -2000.0;
  EncoderAllways := True;
  Reset;
end;

{------------------------------------------------------------------------------}
destructor TSheetStack.Destroy;
begin
  FreeIni;
  DeleteAllSheets;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TSheetStack.SetSheetHeight(sh:Double);
var s:string;
begin
  if ( sh = FSheetHeight ) then exit;
  s := AsString;
  FSheetHeight := sh;
  DeleteAllSheets;
  AsString := s;
  Invalidate;
  if ( Assigned(OnStackChange) ) then OnStackChange(self);
end;

//-----------------------------------------------------------------------------
function TSheetStack.AddCxl(shCol:TColor; shx,shLen:double):boolean;
{                              dx = sh.x - x ( huom. kuvassa mol < 0 )
           -------------       dx < 0  => nx = 0,  kaikille x += -dx
              =======          x = sh.x
                               len = sh.len

               ---------       dx >= 0  => nx = dx
              =======          x OK
                               len = dx + sh.len
           ------
              =======          x = sh.x
                               len = -dx + len

                 ---
              =======          x  OK
                               len OK

}
var nas : TaSheet;
    dx,nx,ny,nl : double;
    i : integer;
begin
  Result := False;
  if ( NrOfSheets >= MAXSHEETS-1 ) then exit;
  nl := Len;
  if ( NrOfSheets = 0 ) then begin x := shx; nl := shLen; Box.dp.y := 0; end;
  dx := shx - x; nx := dx;
  if ( dx < 0 ) then nx := 0;
  nas := TaSheet.Create3(shCol,shLen,nx);
  if ( nas = NIL ) then exit;

  if ( dx < 0 ) then begin
    for i:=0 to NrOfSheets-1 do Sheets[i].Move(-dx,0);
    x := shx; nl := Len - dx;
    if ( shLen > nl ) then nl := shLen;
  end
  else if ( shLen + dx > nl ) then nl := shLen + dx;

  ny := 0;  { Putoaako pohjaan asti }
  for i := NrOfSheets-1 downto 0  do
    if (  Sheets[i].hit(nas) ) then begin
       ny := Sheets[i].y + SheetHeight;
       break;
    end;

  Sheets[NrOfSheets] := nas;  inc(FNrOfSheets);

  nas.Move(0,ny);
  Hint := Format('Last: %2.1f, Total %d',[shLen,NrOfSheets]);
  Len := nl;
  if ( Box.dp.y < nas.y + SheetHeight*2 ) then Box.dp.y := nas.y + SheetHeight*2;
  Result := true;
  if ( Assigned(OnStackChange) ) then OnStackChange(self);
end;

{------------------------------------------------------------------------------}
function TSheetStack.Add(var sh:TSheet; kill:boolean):boolean;
begin
  Result := AddCxl(sh.Brush.Color,sh.x,sh.Len);
  if ( not Result ) then exit;

  if ( kill ) then begin sh.Free; sh := NIL; end;

  Invalidate;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TSheetStack.AddaSheet(var sh:TaSheet):boolean;
begin
  Result := AddCxl(sh.Color,sh.x,sh.Len);
  if ( not Result ) then exit;

  sh.Free; sh := NIL;

  Result := True;
end;

{------------------------------------------------------------------------------}
function TSheetStack.CoG:Double;
{
Teoriaa:


Painopiste ( c  = kappaleen i painopisteen paikka ja
              i
             m  = kappaleen i massa):
              i


         Sum(c m )           Sum(c m )
              i i                 i i
   c = ------------------- = ----------
          Sum(m )                M
               i

  Kun tähän lisätään uusi kappale n, niin


             Sum(c m ) + c m      c M + c m
                  i i     n n            n n
   c   =  -------------------- = ------------
    u        Sum(m ) + m            M + m
                  i     n                n


  Jos c  == c, niin c  <- c, eli painopisteen säilyttämiseksi
       n             u

  tarvitsee lisätä vain massaa M.

  Peltien tapauksessa massa m voidaan korvata pellin
  pituudella l. Pellin tapauksessa c = l/2, eli

                             2
         Sum(l /2 l     Sum(l )
              i    i)        i
   c  = ------------- = ----------
          Sum(l )       2 Sum(l )
               i               i
  Jos kokonaista kasaa siirretään matka d eteenpäin,
  muuttuu painopisteen paikka:



}
var i:integer;
    SumCiMi,SumMi:double;
begin
   Result := 0;
   SumCiMi := 0;
   SumMi := 0;
   for i:=0 to NrOfSheets-1 do begin
     SumCiMi := SumCiMi + (Sheets[i].x+Sheets[i].len/2)*Sheets[i].len;
     SumMi := SumMi + Sheets[i].len;
   end;
   if ( SumMi <> 0 ) then Result := x + SumCiMi/SumMi;
end;


//-----------------------------------------------------------------------------
procedure TSheetStack.ExtAsString(var value:string); //  override;
var sa : TaSheet; val,s : string; ox:double;
begin
  inherited ExtAsString(value);
  ox := x;
  val := ExtractString(value,'|','');
  while ( val <> '' ) do begin
    s := ExtractString(val,';','');
    if ( s = '' ) then continue;
    sa := TaSheet.Create;
    sa.SetAsString(s);
    if ( not AddaSheet(sa) ) then sa.Free;
  end;
  x := ox;
  invalidate;
end;


//-----------------------------------------------------------------------------
function  TSheetStack.GetAsString : string; //  override;
var i:integer;
begin
  Result := inherited GetAsString;
  for i:=0 to NrOfSheets-1 do begin
    Result := Result + Sheets[i].GetAsString + ';';
  end;
  Result := Result + '|';
end;


{------------------------------------------------------------------------------}
{ TSheetTile ==================================================================}
{------------------------------------------------------------------------------}

{ TSheetTile }

procedure TSheetTile.Paint;
var
  iWid, ix, iy, iw, ih: Integer;
begin
  with Canvas do
  begin
    Canvas.Pen := Self.Pen;
    Canvas.Brush := Self.Brush;
    ix := Pen.Width div 2;
    iy := ix;
    iWid := Width;
    iw := iWid - Pen.Width + 1;
    ih := Height - Pen.Width + 1;
    if Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Canvas.Polygon([Point(ix, iy+ih), Point(ix, iy),
      Point(ix+iw, iy+ih), Point(ix, iy+ih)]);
  end;
end;

//-----------------------------------------------------------------------------
constructor TSheetTile.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Height := 15;
end;











//-----------------------------------------------------------------------------

end.