StObjects.pas

(*
    StellaSOFT objektumok gyüjteménye
    ---------------------------------
    TUndoRedo:      UndoRedo folyamatokat megvalósító objektum;

*)
unit StObjects;

interface

uses Windows, Classes, Graphics;


Type

  T2DPoint = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    Fx : extended;
    Fy : extended;
    FID: integer;
    procedure Setx(Value:extended);
    procedure Sety(Value:extended);
    procedure Changed; dynamic;
  public
    constructor Create(AOwner:TObject; px,py: extended);
  published
    property ID          : integer  read FID write FID;
    property x           : extended read Fx write Setx;
    property y           : extended read Fy write Sety;
    property OnChange    : TNotifyEvent read FOnChange write FOnChange;
  end;

  T3DPoint = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FID: integer;
    Fx : extended;
    Fy : extended;
    Fz : extended;
    procedure Changed; dynamic;
    procedure Setx(Value:extended);
    procedure Sety(Value:extended);
    procedure Setz(const Value: extended);
  public
    constructor Create(AOwner:TObject; px,py,pz: extended);
  published
    property ID          : integer  read FID write FID;
    property x           : extended read Fx write Setx;
    property y           : extended read Fy write Sety;
    property z           : extended read Fz write Setz;
    property OnChange    : TNotifyEvent read FOnChange write FOnChange;
  end;

  TUndoRedoChangeEvent = procedure(Sender:TObject; Undo,Redo:boolean) of object;
  TUndoSaveEvent = procedure(Sender:TObject; MemSt:TMemoryStream) of object;
  TUndoSaveProcedure = procedure(var MemSt:TMemoryStream) of object;
  TUndoRedoProcedure = procedure(MemSt:TMemoryStream) of object;

  {---- UndoRedo objektum -----}
  TUndoRedo = class
  private
    fEnable: boolean;
    fUndoLimit: integer;
    FUndoRedo:TUndoRedoChangeEvent;
    FUndoSave: TUndoSaveEvent;
    fUndoSaveProcedure: TUndoSaveProcedure;
    fUndoRedoProcedure: TUndoRedoProcedure;
    procedure SetUndoLimit(const Value: integer);
    procedure SetEnable(const Value: boolean);
  protected
    UndoSaveCount : integer;
    UndoCount     : integer;
    UndoStart     : integer;
    UndoPointer   : integer;
    UndoEnable,RedoEnable : boolean;
    function GetIndex(us:integer): integer;
  public
    UndoStreams   : array[0..999] of TMemoryStream;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure UndoInit;
    procedure UndoSave;
    procedure Undo;
    procedure Redo;
    property Enable : boolean read fEnable write SetEnable;
    property UndoLimit : integer read fUndoLimit write SetUndoLimit;
    property UndoSaveProcedure: TUndoSaveProcedure read fUndoSaveProcedure write fUndoSaveProcedure;
    property UndoRedoProcedure: TUndoRedoProcedure read fUndoRedoProcedure write fUndoRedoProcedure;
    property OnUndoRedo : TUndoRedoChangeEvent read FUndoRedo write FUndoRedo;
    property OnUndoSave : TUndoSaveEvent read FUndoSave write FUndoSave;
  end;

   THRTimer = Class(TObject)
     Constructor Create;
     Function StartTimer : Boolean;
     Function ReadTimer : Double;
   private
   public
     Exists    : Boolean;
     StartTime : Double;
     ClockRate : Double;
     PROCEDURE Delay(ms: double);
   End;

  TLayerName = String[30];

  TLayer = class(TPersistent)
  private
    fVisible: Boolean;
    fHomogen: Boolean;
    fModified: Boolean;
    fActive: Boolean;
    fTag: LongInt;
    FNote: string;
    fBrush: TBrush;
    fName: TLayerName;
    fPen: TPen;
    fLayerId: Byte;
    procedure SetBrush(const Value: TBrush);
    procedure SetName(const Value: TLayerName);
    procedure SetPen(const Value: TPen);
  published
    constructor Create(Idx: Byte);
    destructor Destroy; override;
    procedure SaveToStream(const Stream: TStream); virtual;
    procedure LoadFromStream(const Stream: TStream); virtual;
    property Name: TLayerName read fName write SetName;
    property LayerID: Byte read fLayerId;
    property Pen: TPen read fPen write SetPen;
    property Brush: TBrush read fBrush write SetBrush;
    property Active: Boolean read fActive write FActive;
    property Modified: Boolean read fModified;
    property Homogen: Boolean read fHomogen write fHomogen;
    property Visible: Boolean read fVisible write fVisible;
    property Note: string read FNote write fNote;
    property Tag: LongInt read fTag write fTag;
  end;

  TMetric = (meMM,meInch);
  TGridStyle  = (gsNone,gsLine,gsDot,gsCross);

  TGrid = Class(TPersistent)
  private
    fVisible: boolean;
    fGridStyle: TGridStyle;
    fSubGridColor: TColor;
    fMainGridColor: TColor;
    FOnChange: TNotifyEvent;
    fMetric: TMetric;
    fMargin: integer;
    fOnlyOnPaper: boolean;
    procedure SetMainGridColor(Value: TColor);
    procedure SetGridStyle(const Value: TGridStyle);
    procedure SetSubGridColor(Value: TColor);
    procedure SetVisible(const Value: boolean);
    procedure Changed;
    procedure SetMetric(const Value: TMetric);
    procedure SetMargin(const Value: integer);
    procedure SetOnlyOnPaper(const Value: boolean);
  protected
  public
    constructor Create;
    procedure Change(Sender: TObject);
  published
    property MainGridColor: TColor read fMainGridColor write SetMainGridColor;
    property Margin: integer read fMargin write SetMargin;
    property SubGridColor: TColor read fSubGridColor write SetSubGridColor;
    property Style: TGridStyle read fGridStyle write SetGridStyle default gsNone;
    property Metric: TMetric read fMetric write SetMetric default meMM;
    property Visible: boolean read fVisible write SetVisible default True;
    property OnlyOnPaper: boolean read fOnlyOnPaper write SetOnlyOnPaper default True;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


implementation

{ -----------  TUndoRedo --------- }

constructor TUndoRedo.Create;
var i: integer;
begin
  Inherited Create;
  UndoLimit := 1000;
  Enable    := True;
  UndoInit;
end;

destructor TUndoRedo.Destroy;
var i: integer;
begin
  for i:=0 to fUndoLimit-1 do
      if  UndoStreams[i]<>nil then UndoStreams[i].Destroy;
  Inherited Destroy;
end;

{Az Undo stream-eket alapra hozza}
procedure TUndoRedo.UndoInit;
var i: integer;
begin
  UndoSaveCount := 0;
  UndoCount     := 0;
  UndoStart     := 0;
  UndoPointer   := 0;
  UndoEnable    := False;
  RedoEnable    := False;
  for i:=0 to fUndoLimit-1 do
      if UndoStreams[i]=nil then UndoStreams[i].Create
      else UndoStreams[i].Clear;
  If Assigned(FUndoRedo) then FUndoRedo(Self,False,False);
end;

{Undo mentés az sbl stream tartalmát menti az UndoStreams n. streamjére;
 az undopointer és undoCount értékét 1-el növeli }
procedure TUndoRedo.UndoSave;
begin
If Enable then begin
  UndoStart := UndoPointer;
  UndoStreams[UndoPointer].Clear;
  If Assigned(fUndoSaveProcedure) then
     fUndoSaveProcedure(UndoStreams[UndoPointer]);
  Inc(UndoPointer);
  UndoPointer := UndoPointer mod UndoLimit;
  Inc(UndoSaveCount);
  UndoCount := 0;
  UndoEnable    := UndoSaveCount>0;
  RedoEnable    := False;
  If Assigned(FUndoRedo) then FUndoRedo(Self,UndoEnable,RedoEnable);
end;
end;

function TUndoRedo.GetIndex(us:integer): integer;
begin
  Result := us;
  If us>(Undolimit-1) then Result:=us mod Undolimit;
  if us<0 then Result:=UndoLimit-(Trunc(Abs(us)) mod Undolimit)
end;

procedure TUndoRedo.Undo;
var UC,IDX: integer;
begin
If Enable then begin
   UC := UndoPointer-1;
   If UndoSaveCount>=UndoLimit then UC:=UndoLimit-1;
   UndoEnable := UndoCount<UC;
   if UndoEnable then begin
        Dec(UndoStart);
        IDX := GetIndex(UndoStart);
        UndoStreams[IDX].Seek(0,0);
        If Assigned(fUndoRedoProcedure) then
           fUndoRedoProcedure(UndoStreams[IDX]);
        Inc(UndoCount);
        UndoEnable := UndoCount<UC;
        RedoEnable := UndoCount>0;
   end;
   If Assigned(FUndoRedo) then FUndoRedo(Self,UndoEnable,RedoEnable);
end;
end;

procedure TUndoRedo.Redo;
var UC,IDX: integer;
begin
If Enable then begin
   RedoEnable := UndoCount>0;
   if RedoEnable then begin
        Inc(UndoStart);
        IDX := GetIndex(UndoStart);
        UndoStreams[IDX].Seek(0,0);
        If Assigned(fUndoRedoProcedure) then
           fUndoRedoProcedure(UndoStreams[IDX]);
        Dec(UndoCount);
        RedoEnable := UndoCount>0;
        UndoEnable := True;
   end;
   If Assigned(FUndoRedo) then FUndoRedo(Self,UndoEnable,RedoEnable);
end;
end;

procedure TUndoRedo.SetUndoLimit(const Value: integer);
var i: integer;
begin
  If fUndoLimit <> Value then begin
     fUndoLimit := Value;
     If fUndoLimit>High(UndoStreams) then fUndoLimit:=High(UndoStreams);
     for i:=0 to fUndoLimit-1 do
       if UndoStreams[i]=nil then UndoStreams[i]:=TMemoryStream.Create;
     for i:=fUndoLimit to High(UndoStreams) do
       if UndoStreams[i]<>nil then UndoStreams[i].Destroy;
  end;
end;

procedure TUndoRedo.SetEnable(const Value: boolean);
begin
  fEnable := Value;
  if Value then begin
   If Assigned(FUndoRedo) then FUndoRedo(Self,UndoEnable,RedoEnable)
  end else
   If Assigned(FUndoRedo) then FUndoRedo(Self,False,False);
end;

{ -----------  T2DPoint --------- }

procedure T2DPoint.Changed;
begin
  if Assigned(FOnChange) then
     FOnChange(Self);
end;

constructor T2DPoint.Create(AOwner:TObject; px,py: extended);
begin
  inherited Create;
  x := px; y := py;
  ID := 0;
end;

procedure T2DPoint.Setx(Value:extended);
begin
  If Fx<>Value then begin
     Fx:=Value;
     Changed;
  end;
end;

procedure T2DPoint.Sety(Value:extended);
begin
  If Fy<>Value then begin
     Fy:=Value;
     Changed;
  end;
end;

//-----------THRTimer-----------------

Constructor THRTimer.Create;
Var  QW : _Large_Integer;
BEGIN
   Inherited Create;
   Exists := QueryPerformanceFrequency(TLargeInteger(QW));
   ClockRate := QW.QuadPart;
END;

Function THRTimer.StartTimer : Boolean;
Var
  QW : _Large_Integer;
BEGIN
   Result := QueryPerformanceCounter(TLargeInteger(QW));
   StartTime := QW.QuadPart;
END;

Function THRTimer.ReadTimer : Double;
Var
  ET : _Large_Integer;
BEGIN
   QueryPerformanceCounter(TLargeInteger(ET));
   Result := 1000.0*(ET.QuadPart - StartTime)/ClockRate;
END;

PROCEDURE THRTimer.Delay(ms: double);
Var
  QW,ET : _Large_Integer;
  Start_Time, dt : double;
BEGIN
   QueryPerformanceCounter(TLargeInteger(QW));
   Start_Time := QW.QuadPart;
   repeat
         QueryPerformanceCounter(TLargeInteger(ET));
         dt := 1000.0*(ET.QuadPart - Start_Time)/ClockRate;
   Until dt>=ms;
END;

{------------------------------------------------------------------------------}

{ TLayer }

constructor TLayer.Create(Idx: Byte);
begin
  fPen := TPen.Create;
  fBrush := TBrush.Create;
  fLayerID := Idx;
  Tag := 0;
end;

destructor TLayer.Destroy;
begin
  fPen.Free;
  fBrush.Free;
  inherited;
end;

procedure TLayer.LoadFromStream(const Stream: TStream);
begin

end;

procedure TLayer.SaveToStream(const Stream: TStream);
begin

end;

procedure TLayer.SetBrush(const Value: TBrush);
begin
  fBrush := Value;
end;

procedure TLayer.SetName(const Value: TLayerName);
begin
  fName := Value;
end;

procedure TLayer.SetPen(const Value: TPen);
begin
  fPen := Value;
end;

{ TGrid }

constructor TGrid.Create;
begin
  inherited;
  fMainGridColor := clGray;
  fSubGridColor  := clSilver;
  fOnlyOnPaper   := True;
  fMetric        := meMM;
  fVisible       := True;
end;

procedure TGrid.Change(Sender: TObject);
begin
    Changed;
end;

procedure TGrid.Changed;
begin if Assigned(FOnChange) then FOnChange(Self); end;

procedure TGrid.SetOnlyOnPaper(const Value: boolean);
begin
  fOnlyOnPaper := Value;
  Changed;
end;

procedure TGrid.SetMargin(const Value: integer);
begin
  fMargin := Value;
  Changed;
end;

procedure TGrid.SetMainGridColor(Value: TColor);
begin
  fMainGridColor:=Value;
  Changed;
end;

procedure TGrid.SetGridStyle(const Value: TGridStyle);
begin
  fGridStyle := Value;
  Changed;
end;

procedure TGrid.SetSubGridColor(Value: TColor);
begin
 fSubGridColor := Value;
  Changed;
end;

procedure TGrid.SetMetric(const Value: TMetric);
begin
  fMetric := Value;
  Changed;
end;

procedure TGrid.SetVisible(const Value: boolean);
begin
  fVisible := Value;
  Changed;
end;


{ T3DPoint }

procedure T3DPoint.Changed;
begin
  if Assigned(FOnChange) then
     FOnChange(Self);
end;

constructor T3DPoint.Create(AOwner: TObject; px, py, pz: extended);
begin
  inherited Create;
  x := px; y := py; z := pz;
  ID := 0;
end;

procedure T3DPoint.Setx(Value: extended);
begin
  If Fx<>Value then begin
     Fx:=Value;
     Changed;
  end;
end;

procedure T3DPoint.Setz(const Value: extended);
begin
  If Fz<>Value then begin
     Fz:=Value;
     Changed;
  end;
end;

procedure T3DPoint.Sety(Value: extended);
begin
  If Fy<>Value then begin
     Fy:=Value;
     Changed;
  end;
end;

end.