AL_PapirGL

Top  Previous  Next

unit AL_PapirGL;

 

interface

Uses

   Windows, SysUtils, Classes, Graphics, Controls, StdCtrls, ClipBrd, Math,

   Extctrls, Messages, Dialogs, NewGeom, DGrafik, B_Spline, Szoveg, Szamok,

   StObjects, Forms, AlType, AL_GL, AL_Paper, OpenGL;

 

Type

// Event fron changing drawmode

TChangeMode = procedure(Sender: TObject; ActionMode: TActionMode; DrawMode: TDrawMode) of object;

// Event fron changing window dimension

TChangeWindow = procedure(Sender: TObject; x0,y0,Zoom: real; MouseX,MouseY: real) of object;

TMouseEnter = procedure(Sender: TObject) of object;

TNewBeginPoint = procedure(Sender: TObject; Curve: integer) of object;

TChangeCurve = procedure(Sender: TObject; Curve: TCurve; Point: integer) of object;

TUndoRedoChangeEvent = procedure(Sender: TObject; Undo,Redo:boolean) of object;

TNewFile     = procedure(Sender: TObject; FileName:string) of object;

 

TALPapirGL = class(TAL_OpenGL)

private

   Hint1   : THintWindow;

   HintActive : boolean;

   fAutoUndo: boolean;

   fActLayer: integer;

   fActionMode: TActionMode;

   FSTOP: boolean;

   fPaper: T2DPoint;

   FPaperVisible: boolean;

   fPaperColor: TColor;

   FGraphTitle: Str32;

   fGrid: TGrid;

   fChanged: boolean;

   fDefaultLayer: Byte;

   FConturRadius: double;

   fCoordLabel: TLabel;

   fShowPoints: boolean;

   FSensitiveRadius: integer;

   fHinted: boolean;

   fWorking: boolean;

   FDemo: boolean;

   FSablonSzinkron: boolean;

   fLocked: boolean;

   fZoom: extended;

   FMMPerLepes: extended;

   fChangeCurve: TChangeCurve;

   fChangeSelected: TChangeCurve;

   fChangeMode: TChangeMode;

   fChangeWindow: TChangeWindow;

   fSelected: TCurve;

   FDrawMode: TDrawMode;

   FTitleFont: TFont;

   FMouseEnter: TMouseEnter;

   FMouseLeave: TMouseEnter;

   fNewBeginPoint: TNewBeginPoint;

   FUndoRedoChangeEvent: TUndoRedoChangeEvent;

   fWorkOrigo: TPoint2d;

   FOnBeforePaint: TNotifyEvent;

   FOnAfterPaint: TNotifyEvent;

   FAppend: boolean;

   FEditable: boolean;

   FOnInit: TNotifyEvent;

   FFilename: TFileName;

   FNewFile: TNewFile;

   fpFazis: integer;

   FLoading: boolean;

   FSelectedIndex: integer;

   Procedure CMChildkey( Var msg: TCMChildKey ); message CM_CHILDKEY;

   procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;

   procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;

   procedure Change(Sender: TObject);

   procedure SetActionMode(const Value: TActionMode);

   procedure SetPaperColor(const Value: TColor);

   procedure SetPaperVisible(const Value: boolean);

   procedure SetGraphTitle(const Value: Str32);

   procedure ChangePaperExtension(Sender: TObject);

   procedure SetDefaultLayer(const Value: Byte);

   procedure SetSensitiveRadius(const Value: integer);

   procedure SetShowPoints(const Value: boolean);

   procedure SetDrawMode(const Value: TDrawMode);

   procedure SetLocked(const Value: boolean);

   procedure SetSelected(const Value: TCurve);

   procedure SetTitleFont(const Value: TFont);

   procedure SetWorking(const Value: boolean);

   procedure SetZoom(const Value: extended);

   procedure SetWorkOrigo(const Value: TPoint2d);

   procedure SetEditable(const Value: boolean);

   procedure SetFilename(const Value: TFileName);

   procedure SetpFazis(const Value: integer);

   procedure On_Drawing;

   procedure SetLoading(const Value: boolean);

   procedure ChangeCursor;

   procedure SetSelectedIndex(const Value: integer);

protected

   UR                  : TUndoRedo;  // Undo-Redo object

   FCurve              : TCurve;     // Cuve for general purpose

   oldCentrum          : TPoint2d;   //

   Origin,MovePt       : TPoint;

   oldOrigin,oldMovePt : TPoint;

   MouseInOut          : integer;    // Egér belép:1, bent van:0, kilép:-1

   NCH                 : integer;    // New Curve handle

   rrect               : TRect2d;    // Rectangle for rect or window

   polygonContinue     : boolean;    // Polygon continue;

   MaxPointsCount      : integer;    // Max. point in Curve

   // Rotation variables

   RotCentrum          : TPoint2d;   // Centrum of rotation

   RotStartAngle       : TFloat;     // Rotate curves start angle

   _RotAngle           : TFloat;     // Rotation angle

   oldCursorCross      : boolean;

   Hintstr: string;

   oldHintStr: string;

   HintRect: TRect;

 

   Paning              : boolean;

   Zooming             : boolean;

   painting            : boolean;

   HClip               : HRgn;

   oldCursor           : TCursor;

 

   DXFOut              : TDXFOut;

 

   procedure ShowHintPanel(Show: Boolean);

   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

     X, Y: Integer); override;

   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

   procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

     X, Y: Integer); override;

   procedure KeyDown(var Key: Word;Shift: TShiftState); override;

   procedure KeyUp(var Key: Word;Shift: TShiftState); override;

public

   FCurveList    : TList;      // List of vectorial curves

   TempCurve     : TCurve;     // Temporary curve for not poligonized objects: Ex. Spline

   CPMatch       : Boolean;    // Matching point

   CurveMatch    : Boolean;    // Matching curve

   CurveIn       : boolean;    // point in curve

   CPCurve       : Integer;

   LastCPCurve   : Integer;

   CPIndex       : Integer;

   LastCPIndex   : Integer;

   CPx           : TFloat;

   CPy           : TFloat;

   ActText       : Str32;

   InnerStream   : TMemoryStream;     // memorystream for inner use

   oldFile       : boolean;

   WorkPosition  : TWorkPosition;

   WRect         : TRect;             {A munkapont alatti terület mentéséhez}

   WBmp          : TBitmap;

   newGraphic    : boolean;           {It must to generate new list}

   Moving        : boolean;

   pClosed,pOpened,pSelected : TPen;

 

   tegla     : T2Point2d;             // For drawing

 

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

 

   procedure Init(Sender: TObject);

   procedure Paint; override;

   procedure DoPaint;              // Forces the repaint with new generate of draw

 

   {Teljes papír az ablakban}

   procedure ZoomPaper;

   procedure ZoomDrawing;

   function GetDrawExtension: TRect2d;

   function IsRectInWindow(R: TRect2d): boolean;

   function IsPaperInWindow: boolean;

   function IsPointInWindow(p: TPoint2d): boolean;

 

   function LoadFile(fnev: string): boolean;

   function LoadGraphFromFile(const FileName: string): Boolean;

   procedure LoadGraphFromMemoryStream(stm: TMemoryStream);

   procedure SaveGraphToMemoryStream(var stm: TMemoryStream);

   function SaveGraphToFile(const FileName: string): Boolean;

   function LoadOldGraphFromFile(const FileName: string): Boolean;

   function LoadFromDXF(const FileName: string): Boolean;

   function SaveToDXF(const FileName: string):boolean;

   function LoadFromPLT(const FileName: string): Boolean;

   procedure LoadFromDAT(Filename: STRING);

   function SaveToDAT(Filename: STRING):boolean;

   procedure DXFCurves;

 

   function LoadCurveFromStream(FileStream: TStream): Boolean;

   function SaveCurveToStream(FileStream: TStream;

     Item: Integer): Boolean;

 

   { Curves and process}

   function MakeCurve(const AName: Str32; ID: integer; Shape: TDrawMode;

            AEnabled, AVisible, AClosed: Boolean): Integer;

   procedure Clear;

   function AddCurve(ACurve: TCurve):integer;

   procedure DeleteCurve(AItem: Integer);

   procedure DeleteSelectedCurves;

   procedure InsertCurve(AIndex: Integer; Curve: TCurve);

   function GetCurveName(H: Integer): Str32;

   function GetCurveHandle(AName: Str32): Integer;

 

   procedure AddPoint(AIndex: Integer; X, Y: TFloat); overload;

   procedure AddPoint(AIndex: Integer; P: TPoint2d); overload;

   procedure InsertPoint(AIndex,APosition: Integer; X,Y: TFloat); overload;

   procedure InsertPoint(AIndex,APosition: Integer; P: TPoint2d); overload;

   procedure DeletePoint(AIndex,APosition: Integer);

   procedure DeleteSamePoints(diff: TFloat);

   procedure ChangePoint(AIndex,APosition: Integer; X,Y: TFloat); overload;

   procedure ChangePoint(AIndex, APosition: Integer; P: TPoint2d); overload;

   procedure DoMove(Dx,Dy: Integer);  // Move a point in curve

   procedure GetPoint(AIndex,APosition: Integer; var X,Y: TFloat);

   function GetPoint2d(AIndex,APosition: Integer): TPoint2d;

   function GetNearestPoint(p: TPoint2d; var cuvIdx, pIdx: integer): TFloat;

   procedure SetBeginPoint(ACurve,AIndex: Integer);

 

   procedure MoveCurve(AIndex :integer; Ax, Ay: TFloat);

   procedure MoveSelectedCurves(Ax,Ay: TFloat);

   procedure RotateSelectedCurves(Cent : TPoint2d; Angle: TFloat);

   procedure InversSelectedCurves;

   procedure InversCurve(AIndex: Integer);

   procedure SelectCurveByName(aName: string);

   procedure SelectCurve(AIndex: Integer);

   procedure PoligonizeAll(PointCount: integer);

   procedure Poligonize(Cuv: TCurve; Count: integer);

   procedure VektorisationAll(MaxDiff: TFloat);

   procedure Vektorisation(MaxDiff: TFloat; Cuv: TCurve);

   procedure PontSurites(Cuv: TCurve; Dist: double);

   procedure PontSuritesAll(Dist: double);

 

   procedure CheckCurvePoints(X, Y: Integer);

 

   procedure SelectAll(all: boolean);

   procedure SelectAllInArea(R: TRect2D);

   procedure ClosedAll(all: boolean);

   procedure SelectAllPolylines;

   procedure SelectAllPolygons;

   procedure SelectParentObjects;

   procedure SelectChildObjects;

   procedure EnabledAll(all: boolean);

   procedure SignedAll(all: boolean);

   procedure SignedNotCutting;

 

   { Transformations }

   procedure Normalisation(Down: boolean);

   procedure Eltolas(dx,dy: double);

   procedure Nyujtas(tenyezo:double);

   procedure MagnifySelected(Cent: TPoint2d; Magnify: TFloat);

 

   { Virtual Clipboard procedures }

   procedure CopySelectedToVirtClipboard;

   procedure CutSelectedToVirtClipboard;

   procedure PasteSelectedFromVirtClipboard;

 

   {Undo,Redo}

   procedure UndoInit;

   procedure Undo;

   procedure Redo;

   procedure UndoSave;

   procedure UndoRedo(Sender:TObject; Undo,Redo:boolean);

 

   {Automatkus objektum sorrend képzés}

   procedure AutoSortObject(BasePoint: TPoint2d); overload;

   procedure AutoSortObject(BasePoint: TPoint2d; Connecting: boolean); overload;

   procedure AutoCutSequence(BasePoint: TPoint2d; Sorting: boolean);

   procedure InitParentObjects;

   function IsParent(AIndex: Integer): boolean; overload;

   function IsParent(x, y: TFloat): boolean; overload;

   function GetInnerObjectsCount(AIndex: Integer): integer;

   function GetParentObject(AIndex: Integer): integer; overload;

   function GetParentObject(x,y: TFloat): integer; overload;

   function OutLineObject(AIndex: Integer; delta: real): TCurve;

   function ObjectContour(Cuv: TCurve;OutCode:double): TCurve;

   procedure StripObj12(AParent,Achild: integer);

   procedure StripChildToParent(AIndex: integer);

   procedure StripAll;

   function IsCutObject(p1,p2: TPoint2d; var Aindex: integer): boolean;

   procedure Elkerules;

 

   { Working }

   procedure DrawWorkPoint(x,y:double);

   procedure ClearWorkPoint;

   procedure WorkpositionToCentrum;

   procedure TestVekOut(dx,dy:extended);

   procedure TestWorking(AObject,AItem:integer);

 

   { Paint routines for OpenGL }

   procedure GenerateList;

   procedure DrawGrid;

   procedure DrawCurve(Cuv: Tcurve);

   procedure DrawPoints(Cuv: Tcurve);

   procedure DrawBeginPoints(Cuv: Tcurve);

 

   property pFazis            : integer read fpFazis write SetpFazis;    // Drawing phase

   property Loading           : boolean read FLoading write SetLoading;

   property WorkOrigo         : TPoint2d read fWorkOrigo write SetWorkOrigo;

   property SelectedIndex     : integer read FSelectedIndex write SetSelectedIndex;

 

published

   property ActionMode        : TActionMode read fActionMode write SetActionMode;

   property ActLayer          : integer read fActLayer write fActLayer default 0;

   property Append            : boolean read FAppend write FAppend default False;

   property AutoUndo          : boolean read fAutoUndo write fAutoUndo;

   property Changed           : boolean read fChanged write fChanged;

   property CoordLabel        : TLabel read fCoordLabel write fCoordLabel;

   // Kontúr vonal távolsága az objektumtól

   property ConturRadius      : double read FConturRadius write FConturRadius;

   property DefaultLayer      : Byte read fDefaultLayer write SetDefaultLayer default 0;

   property Demo              : boolean read FDemo write FDemo default False;

   property DrawMode          : TDrawMode read FDrawMode write SetDrawMode;

   property Editable          : boolean read FEditable write SetEditable;

   property Filename          : TFileName read FFilename write SetFilename;

   property GraphTitle        : Str32 read FGraphTitle write SetGraphTitle;

   property Grid              : TGrid read fGrid Write fGrid;

   property Hinted            : boolean read fHinted write fHinted;

   property Locked            : boolean read fLocked write SetLocked;  // Editable?

   property MMPerLepes        : extended read FMMPerLepes write FMMPerLepes;

   property Paper             : T2dPoint read fPaper write fPaper;

   property PaperColor        : TColor read fPaperColor write SetPaperColor;

   property PaperVisible      : boolean read FPaperVisible write SetPaperVisible;

   property SablonSzinkron    : boolean read FSablonSzinkron write FSablonSzinkron;

   property Selected          : TCurve read fSelected write SetSelected;

   // Cursor sensitive radius of circle around of curves' points

   property SensitiveRadius   : integer read FSensitiveRadius write SetSensitiveRadius;

   property ShowPoints        : boolean read fShowPoints write SetShowPoints;

   property STOP              : boolean read FSTOP write fSTOP;

   property TitleFont         : TFont read FTitleFont write SetTitleFont;

   property Working           : boolean read fWorking write SetWorking;

   property OnChangeCurve     : TChangeCurve read fChangeCurve write fChangeCurve;

   property OnChangeMode      : TChangeMode read fChangeMode write fChangeMode;

   property OnChangeSelected  : TChangeCurve read fChangeSelected write fChangeSelected;

   property OnNewFile         : TNewFile read FNewFile write FNewFile;

   property OnNewBeginPoint   : TNewBeginPoint read fNewBeginPoint write fNewBeginPoint;

   property OnUndoRedoChange  : TUndoRedoChangeEvent read FUndoRedoChangeEvent

            write FUndoRedoChangeEvent;

   property OnBeforePaint     : TNotifyEvent read FOnBeforePaint write FOnBeforePaint;

   property OnAfterPaint      : TNotifyEvent read FOnAfterPaint write FOnAfterPaint;

   property CentralCross;

   Property ClearColor;

   property RotAngle;

   property ShadeModel;

   property Zoom;

   property OnChangeWindow;

   property OnMouseEnter;

   property OnMouseLeave;

   property OnPaint;

   property Align;

   property Enabled;

   property Font;

   property OnClick;

   property OnDockDrop;

   property OnDockOver;

   property OnEnter;

   property OnExit;

   property OnGetSiteInfo;

   property OnKeyDown;

   property OnKeyPress;

   property OnKeyUp;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

   property OnMouseWheel;

   property OnMouseWheelDown;

   property OnMouseWheelUp;

   property OnResize;

   property OnUnDock;

end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL', [TALPapirGL]);

end;

 

{ TALPapirGL }

 

constructor TALPapirGL.Create(AOwner: TComponent);

begin

inherited;

Screen.Cursors[crKez1]     :=  LoadCursor(HInstance, 'SKEZ_1');

Screen.Cursors[crKez2]     :=  LoadCursor(HInstance, 'SKEZ_2');

Screen.Cursors[crRealZoom] :=  LoadCursor(HInstance, 'SREAL_ZOOM');

Screen.Cursors[crNyilUp]   :=  LoadCursor(HInstance, 'SNYIL_UP');

Screen.Cursors[crNyilDown] :=  LoadCursor(HInstance, 'SNYIL_DOWN');

Screen.Cursors[crNyilLeft] :=  LoadCursor(HInstance, 'SNYIL_LEFT');

Screen.Cursors[crNyilRight]:=  LoadCursor(HInstance, 'SNYIL_RIGHT');

Screen.Cursors[crZoomIn]   :=  LoadCursor(HInstance, 'SZOOM_IN');

Screen.Cursors[crZoomOut]  :=  LoadCursor(HInstance, 'SZOOM_OUT');

Screen.Cursors[crKereszt]  :=  LoadCursor(HInstance, 'SKERESZT');

Screen.Cursors[crHelp]     :=  LoadCursor(HInstance, 'SHELP_CUR');

Screen.Cursors[crPolyline]     :=  LoadCursor(HInstance, 'SPOLYLINE');

Screen.Cursors[crPolygon]      :=  LoadCursor(HInstance, 'SPOLYGON');

Screen.Cursors[crInsertPoint]  :=  LoadCursor(HInstance, 'SINSERTPOINT');

Screen.Cursors[crDeletePoint]  :=  LoadCursor(HInstance, 'SDELETEPOINT');

Screen.Cursors[crNewbeginPoint]:=  LoadCursor(HInstance, 'SNEWBEGINPOINT');

Screen.Cursors[crRotateSelected]:=  LoadCursor(HInstance,'SROTATESELECTED');

Screen.Cursors[crFreeHand]:=  LoadCursor(HInstance,'SFREEHAND');

 

WBmp       := TBitMap.Create;   // Memory Bitmap for Working Pointer

WBmp.Width := 8;

WBmp.Height:= 8;

// Creates pens

pClosed := TPen.Create;

pClosed.Width := 2;

pClosed.Color := clBlack;

pClosed.Style := psSolid;

 

pOpened := TPen.Create;

pOpened.Width := 1;

pOpened.Color := clGray;

pOpened.Style := psDot;

 

pSelected := TPen.Create;

pSelected.Width := 2;

pSelected.Color := clBlue;

pSelected.Style := psSolid;

 

//  DrawBmp           := TBitMap.Create;

FCurveList        := TList.Create;

fPaper            := T2DPoint.Create(Self,100,100);

fPaper.x          := 1000;

fPaper.y          := 1500;

fPaperColor       := clAqua;

fPaperVisible     := True;

fGrid             := TGrid.Create;

fGrid.OnChange    := Change;

fPaper.OnChange   := ChangePaperExtension;

oldCursorCross    := True;

fShowPoints       := True;

MouseInOut        := 1;

Origin            := Point(0,0);

MovePt            := Origin;

oldMovePt         := MovePt;

Hinted            := True;

Hint1             := THintWindow.Create(Self);

painting          := False;

fDefaultLayer     := 0;

SensitiveRadius   := 2;

DrawMode          := dmNone;

FTitleFont        := TFont.Create;

With FTitleFont do begin

      Name := 'Times New Roman';

      Color:= clNavy;

      Size := 8;

end;

innerStream       := TMemoryStream.Create;

fAutoUndo         := True;

UR:= TUndoRedo.Create;

Ur.UndoLimit      := 100;

Ur.UndoSaveProcedure := SaveGraphToMemoryStream;

Ur.UndoRedoProcedure := LoadGraphFromMemoryStream;

Ur.OnUndoRedo        := UndoRedo;

Changed          := False;

FWorkOrigo       := Point2d(0,0);

FMMPerLepes      := 0.05;

TempCurve        := TCurve.Create;

FConturRadius    := 4;

FDemo            := False;

FAppend          := False;

newGraphic       := False;

STOP             := False;

FEditable        := False;

Width            := 200;

height           := 200;

OnInitGl         := Init;

end;

 

destructor TALPapirGL.Destroy;

begin

UR.Free;

fPaper.Free;

inherited;

end;

 

function TALPapirGL.LoadGraphFromFile(const FileName: string): Boolean;

var

FileStream: TFileStream;

GraphData: TNewGraphData;

N: Integer;

au: boolean;

begin

Result  := False;

oldFile := False;

if not FileExists(FileName) then Exit;

try

   au := AutoUndo;

   AutoUndo := False;

   Loading := True;

   if not FAppend then Clear;

   FileStream:=TFileStream.Create(FileName,fmOpenRead);

   try

     FileStream.Position:=0;

     FileStream.Read(GraphData,SizeOf(GraphData));

     FGraphTitle:=GraphData.GraphTitle;

 

     for N:=0 to Pred(GraphData.Curves) do

         if not LoadCurveFromStream(FileStream) then

         begin

            FileStream.Free;

            Clear;

            exit;

         end;

 

     Result:=True;

   except

     Result:=False;

   end;

finally

   FileStream.Free;

   AutoUndo := au;

   Loading := False;

   If AutoUndo then begin

      UR.UndoSave;

   end;

   NewGraphic := True;

   ZoomDrawing;

end;

end;

 

procedure TALPapirGL.SaveGraphToMemoryStream(var stm: TMemoryStream);

var

GraphData: TNewGraphData;

N: Integer;

begin

   try

     GraphData.GraphTitle:=FGraphTitle;

     GraphData.Curves:=FCurveList.Count;

     stm.Clear;

     stm.Write(GraphData,SizeOf(GraphData));

 

     for N:=0 to Pred(GraphData.Curves) do

         SaveCurveToStream(stm,N);

 

   except

     exit;

   end;

end;

 

procedure TALPapirGL.SetActionMode(const Value: TActionMode);

begin

fActionMode := Value;

DrawMode    := dmNone;

end;

 

function TALPapirGL.SaveCurveToStream(FileStream: TStream; Item: Integer): Boolean;

var

CurveData: TNewCurveData;

pp : ppoint;

p : TPointRec;

N: Integer;

begin

Result:=False;

if not InRange(Item,0,Pred(FCurveList.Count)) or not Assigned(FileStream) then Exit;

FCurve:=FCurveList.Items[Item];

try

   CurveData := FCurve.GetCurveData;

 

   FileStream.Write(CurveData,SizeOf(TNewCurveData));

 

   for N:=0 to Pred(FCurve.FPoints.Count) do begin

     pp := FCurve.FPoints.Items[N];

     p.x := pp^.x;

     p.y := pp^.y;

     FileStream.Write(FCurve.FPoints.Items[N]^,SizeOf(TPointRec));

   end;

 

   Result:=True;

except

   ShowMessage('Error writing stream!');

end;

end;

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

 

function TALPapirGL.LoadCurveFromStream(FileStream: TStream): Boolean;

var

CurveData: TNewCurveData;

oldCurveData: TCurveData;

oShape      : TDrawMode;

PointRec: TPointRec;

H,N,P: Integer;

XOfs: TFloat;

YOfs: TFloat;

begin

Result:=False;

if not Assigned(FileStream) then Exit;

try

   if oldFile then begin

      FileStream.Read(oldCurveData,SizeOf(TCurveData));

      if oldCurveData.Closed then oShape:=dmPolygon else oShape:=dmPolyline;

      P := oldCurveData.Points-1;

      H:=MakeCurve(oldCurveData.Name,-1,oShape,oldCurveData.Enabled,True,oldCurveData.Closed);

      XOfs:=oldCurveData.XOfs;

      YOfs:=oldCurveData.YOfs;

   end else begin

      FileStream.Read(CurveData,SizeOf(TNewCurveData));

      P := CurveData.Points-1;

      H:=MakeCurve(CurveData.Name,-1,CurveData.Shape,CurveData.Enabled,CurveData.Visible,CurveData.Closed);

      XOfs:=0;

      YOfs:=0;

   end;

   FCurve := FCurvelist.Items[H];

   FCurve.Selected := False;

 

   for N:=0 to P do

   begin

     if FileStream.Read(PointRec,SizeOf(TPointRec))<SizeOf(TPointRec) then

        Exit;

     AddPoint(H,PointRec.x+XOfs,PointRec.y+YOfs);

   end;

 

   Result:=True;

except

   ShowMessage('Error reading stream!');

end;

end;

 

procedure TALPapirGL.LoadGraphFromMemoryStream(stm: TMemoryStream);

var

GraphData: TNewGraphData;

N: Integer;

begin

if stm=nil then Exit;

try

     Loading := True;

     stm.Seek(0,0);

     stm.Read(GraphData,SizeOf(GraphData));

     FGraphTitle:=GraphData.GraphTitle;

 

     for N:=0 to Pred(GraphData.Curves) do begin

         LoadCurveFromStream(stm);

         TCurve(FCurveList.Items[FCurveList.Count-1]).Selected := True;

     end;

except

     exit;

end;

Loading := False;

DoPaint;

end;

 

procedure TALPapirGL.SetPaperColor(const Value: TColor);

begin

fPaperColor := Value;

invalidate;

end;

 

procedure TALPapirGL.SetPaperVisible(const Value: boolean);

begin

FPaperVisible := Value;

invalidate;

end;

 

procedure TALPapirGL.SetGraphTitle(const Value: Str32);

begin

FGraphTitle := Value;

invalidate;

end;

 

procedure TALPapirGL.Change(Sender: TObject);

begin

DoPaint;

end;

 

procedure TALPapirGL.ChangePaperExtension(Sender: TObject);

begin

ZoomPaper;

end;

 

procedure TALPapirGL.SetDefaultLayer(const Value: Byte);

begin

fDefaultLayer := Value;

end;

 

procedure TALPapirGL.SetSensitiveRadius(const Value: integer);

begin

FSensitiveRadius := Value;

end;

 

procedure TALPapirGL.SetShowPoints(const Value: boolean);

begin

fShowPoints := Value;

invalidate;

end;

 

procedure TALPapirGL.SetDrawMode(const Value: TDrawMode);

begin

if Locked then FDrawMode := dmNone else FDrawMode := Value;

if Value <> dmNone then

    FActionMode := amDrawing;

pFazis    := 0;

MaxPointsCount := High(integer);

Case Value of

      dmNone     : Cursor := crDefault;

      dmPolyline : Cursor := crPolyline;

      dmPolygon  : Cursor := crPolygon;

      dmPoint    : MaxPointsCount := 1;

      dmLine,dmCircle,dmEllipse : MaxPointsCount := 2;

      dmArc      : MaxPointsCount := 3;

      dmRectangle: MaxPointsCount := 4;

      dmText :

        begin

          ActText := InputBox('Text','',ActText);

          if ActText<>'' then

             pFazis    := 1;

             MaxPointsCount := 2;

             NCH:=MakeCurve('Text',-1,DrawMode,True,True,False);

             Selected.Name := ActText;

        end;

      dmFreeHand : Cursor := crFreeHand;

else MaxPointsCount := High(integer);

end;

if Assigned(fChangeMode) then fChangeMode(Self,ActionMode,Value);

invalidate;

end;

 

procedure TALPapirGL.SetLocked(const Value: boolean);

begin

fLocked := Value;

DoPaint;

end;

 

procedure TALPapirGL.SetSelected(const Value: TCurve);

begin

if Enabled {and (FSelected <> Value)} then begin

  FSelected := Value;

    fSelected := Value;

    fCurve := Value;

    if FCurve<>nil then

       SelectedIndex := GetCurveHandle(Value.Name)

    else

       SelectedIndex := -1;

//     if Assigned(fChangeSelected) then fChangeSelected(Self,fSelected,CPIndex);

    if Assigned(fChangeCurve) then fChangeCurve(Self,fSelected,CPIndex);

    DoPaint;

end;

end;

 

procedure TALPapirGL.SetTitleFont(const Value: TFont);

begin

FTitleFont := Value;

end;

 

procedure TALPapirGL.SetWorking(const Value: boolean);

begin

fWorking := Value;

invalidate;

end;

 

procedure TALPapirGL.SetZoom(const Value: extended);

begin

fZoom := Value;

end;

 

procedure TALPapirGL.Redo;

begin

if not Locked then begin

Loading := True;

Clear;

UR.Redo;

DoPaint;

Loading := False;

end;

end;

 

procedure TALPapirGL.Undo;

begin

Loading := True;

Clear;

UR.Undo;

DoPaint;

Loading := False;

end;

 

procedure TALPapirGL.UndoInit;

begin

UR.UndoInit;     // Initialize UndoRedo system

UndoSave;        // Saves this situation

end;

 

procedure TALPapirGL.UndoRedo(Sender: TObject; Undo, Redo: boolean);

begin

If Assigned(FUndoRedoChangeEvent) then

    FUndoRedoChangeEvent(Self,Undo,Redo);

end;

 

procedure TALPapirGL.UndoSave;

begin

if not Locked then

UR.UndoSave;  // Felhasználói mentés undo-hoz

end;

 

procedure TALPapirGL.SetWorkOrigo(const Value: TPoint2d);

begin

fWorkOrigo := Value;

invalidate;

end;

 

procedure TALPapirGL.ZoomDrawing;

var nagyx,nagyy : extended;

   I,J: integer;

   BR: TRect2d;

   x1,x2,y1,y2: TFloat;

begin

if FCurveList.Count=0 then ZoomPaper;

J:=Pred(FCurveList.Count);

if J>-1 then begin

   x1:=1e+10; y1:=1e+10;

   x2:=-1e+10; y2:=-1e+10;

   for I:=0 to J do

   begin

     FCurve:=FCurveList.Items[I];

     BR := FCurve.BoundsRect;

     if BR.x1<x1 then x1:=BR.x1;

     if BR.y1<y1 then y1:=BR.y1;

     if BR.x2>x2 then x2:=BR.x2;

     if BR.y2>y2 then y2:=BR.y2;

   end;

Try

    nagyx := Width /(x2-x1);

    nagyy := Height/(y2-y1);

except

    nagyx:=1; nagyy:=1;

end;

If nagyx > nagyy Then nagyx:= nagyy;

Centrum := Point2d((x2+x1)/2,(y2+y1)/2);

Zoom:= 0.9*nagyx;

end;

end;

 

procedure TALPapirGL.ZoomPaper;

var nagyx,nagyy : extended;

begin

If PaperVisible then begin

Try

    nagyx := Width /(Paper.x +20);

    nagyy := Height/(Paper.y +20);

except

    nagyx:=1; nagyy:=1;

end;

If nagyx > nagyy Then nagyx:= nagyy;

Centrum := Point2d(Paper.x/2,Paper.y/2);

Zoom:= nagyx;

end;

end;

 

function TALPapirGL.AddCurve(ACurve: TCurve): integer;

begin

Try

FCurveList.Pack;

FCurveList.Add(ACurve);

Result := FCurveList.Count-1;

DoPaint;

except

Result := -1;

end;

end;

 

procedure TALPapirGL.AddPoint(AIndex: Integer; X, Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   FCurve.AddPoint(X,Y);

   DoPaint;

end;

end;

 

procedure TALPapirGL.AddPoint(AIndex: Integer; P: TPoint2d);

begin

AddPoint(AIndex, P.X, P.Y);

DoPaint;

end;

 

 

procedure TALPapirGL.ChangePoint(AIndex, APosition: Integer; X, Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   if APosition < FCurve.FPoints.Count then FCurve.ChangePoint(APosition,X,Y);

   Selected := FCurve;

   DoPaint;

end;

end;

 

procedure TALPapirGL.ChangePoint(AIndex, APosition: Integer; P: TPoint2d);

begin

ChangePoint(AIndex, APosition,p.x,p.y);

end;

 

procedure TALPapirGL.CheckCurvePoints(X, Y: Integer);

var i,J,K,L,H: integer;

   Lx,Ly : TFloat;

   xx,yy : TFloat;

   WP    : TPoint2d;

   InCode : TInCode;

begin

   CPMatch:=False;

   CPIndex:=0;

   CurveMatch:=False;

   CurveIn:=False;

 

   WP := SToW(Point(x,Height-y));

   xx := WP.x;

   yy := WP.y;

 

   Delta := 4/zoom;

   if SensitiveRadius>3 then

      delta := SensitiveRadius/zoom;

 

   // Ha van kiválasztott obj, => az ő vizsgálata elsődleges

   H:=-1;

   IF Selected<>nil then begin

      H:=GetCurveHandle(Selected.name);

      if Selected.IsInBoundsRect(xx,yy) then begin

         L := Selected.IsOnPoint(xx, yy, delta);

         if L>-1 then begin

            GetPoint(H,L,Lx,Ly);

            CPMatch:=True;

            CPx:=Lx;

            CPy:=Ly;

            CPCurve:=H;

            CPIndex:=L;

            Exit;

         end;

      end;

   end;

 

   J:=Pred(FCurveList.Count);

 

   for I:=0 to J do

   begin

     FCurve:=FCurveList.Items[I];

       InCode := FCurve.IsInCurve(xx,yy);

       if InCode=icOnLine then begin

          CurveMatch:=True;

          CPCurve:=I;

       end;

       if InCode=icIn then begin

          CurveIn:=True;

          CPCurve:=I;

       end;

 

       L:=FCurve.IsOnPoint(xx, yy, delta);

       if L>-1 then

       begin

          CPMatch:=True;

          FCurve.GetPoint(L,Lx,Ly);

          CPx:=Lx;

          CPy:=Ly;

          CPCurve:=I;

          CPIndex:=L;

          Exit;

       end;

 

(*

//        if inCode=icOnPoint then begin

          K:=Pred(FCurve.FPoints.Count);

          for L:=K downto 0 do

          begin

               FCurve.GetPoint(L,Lx,Ly);

//                GetPoint(I,L,Lx,Ly);

//                CPMatch:=(Abs(xx-Lx)<delta) and (Abs(yy-Ly)<delta);

               CPMatch:=FCurve.IsOnPoint(xx, yy, delta)>-1;

               if CPMatch then

               begin

                  CPx:=Lx;

                  CPy:=Ly;

                  CPCurve:=I;

                  CPIndex:=L;

                  Exit;

           end;

//        end;

       end;

*)

   end;

end;

 

procedure TALPapirGL.Clear;

begin

FCurveList.Clear;

DoPaint;

end;

 

procedure TALPapirGL.ClosedAll(all: boolean);

var i: integer;

   cuv: TCurve;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     if cuv.Selected then

        Cuv.Closed := all;

end;

DoPaint;

end;

 

procedure TALPapirGL.DeleteCurve(AItem: Integer);

begin

if AItem < FCurveList.Count then

begin

   if AutoUndo then UndoSave;

   FCurve:=FCurveList.Items[AItem];

   FCurveList.Delete(AItem);

   FCurve.Destroy;

   DoPaint;

end;

end;

 

procedure TALPapirGL.DeletePoint(AIndex, APosition: Integer);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   if AutoUndo then UndoSave;

   FCurve:=FCurveList.Items[AIndex];

   FCurve.DeletePoint(APosition);

   if FCurve.FPoints.Count=0 then

      FCurveList.Delete(AIndex);

   DoPaint;

end;

Selected := FCurve;

end;

 

procedure TALPapirGL.DeleteSamePoints(diff: TFloat);

// Deletes all same points in range of diff: only one point remains

// Azonos vagy nagyon közeli pontok kiejtése

var i,j,k  : integer;

   x,y    : TFloat;

   x1,y1  : TFloat;

begin

for i:=0 to Pred(FCurveList.Count) do begin

   FCurve:=FCurveList.Items[i];

   if FCurve.FPoints.Count>=1 then begin

   j:=0;

   repeat

         FCurve.GetPoint(j,x,y);

         Inc(j);

         repeat

               FCurve.GetPoint(j,x1,y1);

               if (Abs(x-x1)<diff) and (Abs(y-y1)<diff) then

                  FCurve.DeletePoint(j)

               else

                  Break;

         until (j>=FCurve.FPoints.Count-1);

   until j>=FCurve.FPoints.Count-1;

   end;

end;

DoPaint;

end;

 

procedure TALPapirGL.DeleteSelectedCurves;

var i: integer;

begin

i:=0;

if FCurveList.Count>0 then begin

if AutoUndo then UndoSave;

While i<=FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[i];

     if FCurve.Selected then begin

        FCurveList.Delete(i);

        Dec(i);

        Changed := True;

     end;

     Inc(i);

end;

if AutoUndo then UndoSave;

end;

DoPaint;

end;

 

procedure TALPapirGL.DoMove(Dx, Dy: Integer);

begin

   CPx:=XToW(Dx);

   CPy:=YToW(Dy);

   ChangePoint(CPCurve,CPIndex,CPx,CPy);

   Changed := True;

   DoPaint;

end;

 

procedure TALPapirGL.Eltolas(dx, dy: double);

var n,i,j: integer;

   x,y: double;

begin

  For n:=0 to FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[n];

     J:=Pred(FCurve.FPoints.Count);

     FCurve.MoveCurve(dx,dy);

  end;

if AutoUndo then UndoSave;

DoPaint;

end;

 

procedure TALPapirGL.EnabledAll(all: boolean);

var i: integer;

   cuv: TCurve;

begin

For i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     Cuv.Enabled:=all;

end;

Invalidate;

end;

 

function TALPapirGL.GetCurveHandle(AName: Str32): Integer;

var

I,J: Integer;

begin

Result:=-1;

J:=FCurveList.Count;

I:=0;

AName:=AnsiUpperCase(AName);

while I < J do

begin

   FCurve:=FCurveList.Items[I];

   if AnsiUpperCase(FCurve.Name) = AnsiUpperCase(AName) then

   begin

     Result:=I;

     Break;

   end;

   Inc(I);

end;

end;

 

function TALPapirGL.GetCurveName(H: Integer): Str32;

begin

Result:='';

if (H < 0) or (H > Pred(FCurveList.Count)) then Exit;

FCurve:=FCurveList.Items[H];

Result:=FCurve.Name;

end;

 

function TALPapirGL.GetNearestPoint(p: TPoint2d; var cuvIdx,

pIdx: integer): TFloat;

var

I,J : Integer;

d   : Double;

x,y : double;

Cuv : TCurve;

p0,p1,p2,mp : TPoint2d;

begin

Result := 10e+10;

cuvIdx := -1;

pIdx   := -1;

for I:=0 to Pred(FCurveList.Count) do

begin

   Cuv:=FCurveList.Items[I];

   if Cuv.Visible then

   For J:=0 to Pred(Cuv.FPoints.Count) do

   begin

       Cuv.GetPoint(j,x,y);

       d:=KetPontTavolsaga(p.x,p.y,x,y);

       if d<Result then begin

          cuvIdx := I;

          pIdx   := J;

          Result := d;

       end;

   end;

end;

// Ha talál objektumot, meg kell vizsgálni, hogy nem metszi-e:

// Ha igen, akkor a metszett közeli vonalszakasz legközelebbi végpontja kell.

if CuvIdx>-1 then begin

    Cuv := FCurveList.Items[CuvIdx];

    p0:=Cuv.GetPoint2d(pIdx);

    if Cuv.IsCutLine(p,p0) then begin

       For J:=0 to Cuv.FPoints.Count-2 do begin

           p1:=Cuv.GetPoint2d(j);

           p2:=Cuv.GetPoint2d(j+1);

           if SzakaszSzakaszMetszes(p,p0,p1,p2,mp) then begin

              if KetPontTavolsaga(p.x,p.y,p1.x,p1.y)<=

                 KetPontTavolsaga(p.x,p.y,p2.x,p2.y)

              then begin

                 pIdx   := J;

                 d:=KetPontTavolsaga(p.x,p.y,p1.x,p1.y);

              end else begin

                 pIdx   := J+1;

                 d:=KetPontTavolsaga(p.x,p.y,p2.x,p2.y);

              end;

              Break;

           end;

       end;

    end;

end;

// Ha nem talál, akkor a távolság -1; CuvIdx=-1; pIdx=-1;

if cuvIdx=-1 then Result := -1;

end;

 

procedure TALPapirGL.GetPoint(AIndex, APosition: Integer; var X,

Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   if InRange(APosition,0,Pred(FCurve.FPoints.Count)) then

     FCurve.GetPoint(APosition,X,Y);

end;

end;

 

function TALPapirGL.GetPoint2D(AIndex, APosition: Integer): TPoint2d;

var x,y : double;

begin

  GetPoint(AIndex, APosition,x,y);

  Result := Point2d(x,y);

end;

 

procedure TALPapirGL.InsertCurve(AIndex: Integer; Curve: TCurve);

begin

if (AIndex > -1) and (AIndex < FCurveList.Count-1) then

begin

   FCurveList.Insert(AIndex,Curve);

   Changed := True;

end;

end;

 

procedure TALPapirGL.InsertPoint(AIndex, APosition: Integer; X, Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   FCurve.InsertPoint(APosition,X,Y);

   Selected := FCurve;

end;

DoPaint;

end;

 

procedure TALPapirGL.InsertPoint(AIndex,APosition: Integer; P: TPoint2d);

begin

InsertPoint(AIndex,APosition,P.X,P.Y);

DoPaint;

end;

 

 

procedure TALPapirGL.InversCurve(AIndex: Integer);

var

I,H,N: Integer;

X,Y: TFloat;

Size: Word;

PA: Array[0..1000] of TPoint;

p0: TPoint;

R : HRgn;

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

Try

     FCurve:=FCurveList.Items[AIndex];

     N := FCurve.FPoints.Count+1;

     for I:=0 to Pred(N) do

     begin

       FCurve.GetPoint(I,X,Y);

       PA[I].x:=Trunc(X);

       PA[I].y:=Trunc(Y);

     end;

       FCurve.GetPoint(0,X,Y);

       PA[i+1].x:=Trunc(X);

       PA[i+1].y:=Trunc(Y);

       R := CreatePolygonRgn(PA,N,ALTERNATE);

       InvertRgn(Canvas.Handle,R);

finally

    DeleteObject(R);

end;

end;

end;

 

procedure TALPapirGL.InversSelectedCurves;

var i: integer;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     FCurve:=FCurveList.Items[i];

     FCurve.Selected := not FCurve.Selected;

end;

Invalidate;

end;

 

procedure TALPapirGL.MagnifySelected(Cent: TPoint2d; Magnify: TFloat);

var n,i,j: integer;

   x,y: double;

begin

  If AutoUndo then UR.UndoSave;

  For n:=0 to FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[n];

     J:=Pred(FCurve.FPoints.Count);

     if FCurve.Selected then begin

        FCurve.MagnifyCurve(Cent, Magnify);

        Changed := True;

     end;

  end;

  DoPaint;

end;

 

function TALPapirGL.MakeCurve(const AName: Str32; ID: integer;

Shape: TDrawMode; AEnabled, AVisible, AClosed: Boolean): Integer;

begin

Try

Result := ID;

IF ID<0 then Result:=FCurveList.IndexOf(FCurve)+1;

FCurve:=TCurve.Create;

if Pos('_',Aname)>0 then

    FCurve.Name:=AName

else

    FCurve.Name:=AName+'_'+IntToStr(Result);

FCurve.ID      := Result;

FCurve.Font.Assign(Font);

FCurve.Enabled := AEnabled;

FCurve.Layer   := actLayer;

FCurve.Visible := AVisible;

FCurve.Closed  := AClosed;

FCurve.Shape   := Shape;

FCurve.OnChange:= Change;

FCurveList.Add(FCurve);

Selected := FCurve;

Result:=FCurveList.IndexOf(FCurve);

except

Result := -1;

end;

end;

 

procedure TALPapirGL.MoveCurve(AIndex: integer; Ax, Ay: TFloat);

var i: integer;

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then begin

     FCurve:=FCurveList.Items[AIndex];

     FCurve.MoveCurve(Ax/Zoom, Ay/Zoom);

     if SelectedIndex<>AIndex then

        Selected := FCurve;

     Changed := True;

end;

DoPaint;

end;

 

procedure TALPapirGL.MoveSelectedCurves(Ax, Ay: TFloat);

var i: integer;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     FCurve:=FCurveList.Items[i];

     if FCurve.Selected then FCurve.MoveCurve(Ax/Zoom, Ay/Zoom);

end;

Changed := True;

DoPaint;

end;

 

procedure TALPapirGL.Normalisation(Down: boolean);

var r: TRect2d;

   margo: integer;

begin

margo:=20;

r := GetDrawExtension;

if down then Eltolas(-r.x1+Grid.margin,-r.y1+Grid.margin)

else Eltolas(-r.x1+Grid.margin,Paper.y-r.y2-Grid.margin);

DoPaint;

end;

 

procedure TALPapirGL.Nyujtas(tenyezo: double);

var n,i,j: integer;

   x,y: double;

begin

  For n:=0 to FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[n];

     If FCurve.Enabled then begin

     J:=Pred(FCurve.FPoints.Count);

     for I:=0 to J do

     begin

       FCurve.GetPoint(i,X,Y);

       x := tenyezo * x;

       y := tenyezo * y;

       FCurve.ChangePoint(i,x,y);

     end;

     end;

  end;

if AutoUndo then UndoSave;

DoPaint;

end;

 

procedure TALPapirGL.Poligonize(Cuv: TCurve; Count: integer);

var x,y,x1,y1,ArcU,ArcV: TFloat;

   szog, arcR,R1,R2,arcEAngle,deltaFI : extended;

   szog1,szog2,szog3: double;

   i,j,k   : integer;

   pp,pp1,pp2 : pPoints;

   Size    : integer;

   dd      : CurveDataArray;

   PA,pPA  : PCurveDataArray;

   arcCirc : TPoint3d;

begin

//if Ord(Cuv.Shape)>5 then

Try

  If AutoUndo then UR.UndoSave;

  Loading := True;

  // Store the Cuv points in dPoints list

  InitdPoints;

  For i:=0 to Pred(Cuv.FPoints.Count) do begin

      pp := Cuv.Fpoints[i];

      dPoints.Add(pp);

  end;

  // First point <> Last point

  If Cuv.Closed then

  if dPoints[0]=dPoints[Cuv.FPoints.Count-1]

  then dPoints.Delete(Cuv.FPoints.Count-1);

 

  Case Cuv.Shape of

  dmRectangle:

    if Count>4 then begin

       if (Count Mod 4)=0 then begin

          pp := Cuv.Fpoints[0];

          dPoints.Add(pp);

          Cuv.ClearPoints;

          Cuv.Shape := dmPolygon;

          Cuv.Closed := True;

          k := Count div 4;

          for i:=0 to 3 do begin

              pp := dPoints[i];

              pp1:= dPoints[i+1];

              x  := pp1^.x - pp^.x;

              y  := pp1^.y - pp^.y;

              for j:=0 to k-1 do begin

                  Cuv.AddPoint(pp^.x+x*j/k,pp^.y+y*j/k);

              end;

          end;

       end;

    end;

  dmCircle:

    begin

      Cuv.ClearPoints;

      Cuv.Shape := dmPolygon;

      Cuv.Closed := True;

      pp := dPoints[0];

      ArcU := pp^.x;

      ArcV := pp^.y;

      pp := dPoints[1];

      arcR := sqrt(sqr(ArcU-pp^.x)+sqr(ArcV-pp^.y));

      szog := 0;

      if Count<2 then begin

         deltaFI := (2*PI*2)/(2*arcR*PI);

         if deltaFi>pi/180 then deltaFi:=pi/180;

      end else

         deltaFI := (2*PI)/Count;

      While (szog>=0) and (szog<=(2*pi)) do begin

            x := ArcU + ArcR * cos(szog);

            y := ArcV + ArcR * sin(szog);

            Cuv.AddPoint(x,y);

            szog := szog+deltaFI;

      end;

    end;

  dmEllipse:

    begin

      Cuv.ClearPoints;

      Cuv.Shape := dmPolygon;

      Cuv.Closed := True;

      pp := dPoints[0];

      ArcU := pp^.x;

      ArcV := pp^.y;

      pp := dPoints[1];

      R1 := Abs(ArcU-pp^.x);

      R2 := aBS(ArcV-pp^.y);

      szog := 0;

      if Count<2 then begin

         deltaFI := (2*PI*2)/(2*R1*PI);

         if deltaFi>pi/180 then deltaFi:=pi/180;

      end else

         deltaFI := (2*PI)/Count;

      While (szog>=0) and (szog<=(2*pi)) do begin

            x := ArcU + R1 * cos(szog);

            y := ArcV + R2 * sin(szog);

            Cuv.AddPoint(x,y);

            szog := szog+deltaFI;

      end;

    end;

  dmArc:

    begin

      Cuv.ClearPoints;

      Cuv.Shape := dmPolygon;

      Cuv.Closed := False;

      pp := dPoints[0];

      pp1:= dPoints[1];

      pp2:= dPoints[2];

      arcCirc := HaromPontbolKor(Point2d(pp^.x,pp^.y),

                                 Point2d(pp1^.x,pp1^.y),

                                 Point2d(pp2^.x,pp2^.y));

      ArcU := arcCirc.x;

      ArcV := arcCirc.y;

      arcR := arcCirc.z;

      szog1:= SzakaszSzog(ArcU,ArcV,pp^.x,pp^.y);

      szog2:= SzakaszSzog(ArcU,ArcV,pp1^.x,pp1^.y);

      szog3:= SzakaszSzog(ArcU,ArcV,pp2^.x,pp2^.y);

      szog := RelSzogdiff(szog1,szog2,szog3);

      if Count<2 then begin

         deltaFI := Sgn(szog)*(2*PI*2)/(2*arcR*PI);

      end else

         deltaFI := szog/Count;

      j := Abs(Trunc(szog/deltaFI));

      for i:=0 to j do begin

//       While (szog1<=szog3) do begin

            x := ArcU + arcR * cos(szog1);

            y := ArcV + arcR * sin(szog1);

            Cuv.AddPoint(x,y);

            szog1 := szog1+deltaFI;

      end;

//       Cuv.AddPoint(pp1^.x,pp1^.y);

    end;

  dmSpline:

    begin

      j := Pred(Cuv.FPoints.Count);

      for I:=0 to j do

      begin

       Cuv.GetPoint(I,X,Y);

       dd[i+1] := Point3d(x,y,0);

      end;

      Cuv.ClearPoints;

      Cuv.Shape := dmPolygon;

      Cuv.Closed := False;

      InitdPoints;

      GetSplinePoints(dd,J+1,100,Cuv.Closed);

      for I:=0 to Pred(dPoints.Count) do begin

        pp := dPoints[i];

        Cuv.AddPoint(pp^.x,pp^.y);

      end;

    end;

  dmBSpline:

    begin

      TempCurve.Shape := dmPolygon;

    end;

  end;

finally

  If AutoUndo then UR.UndoSave;

  InitdPoints;

  Loading := False;

end;

end;

 

procedure TALPapirGL.PoligonizeAll(PointCount: integer);

// Total graphic vectorisation

Var

   i    : integer;

begin

For i:=0 to Pred(FCurveList.Count) do

     Poligonize(TCurve(FCurveList.Items[i]),PointCount);

DoPaint;

end;

 

procedure TALPapirGL.PontSurites(Cuv: TCurve; Dist: double);

var x,y         : TFloat;

   d           : TFloat;

   i,j,k       : integer;

   pp,pp1      : pPoints;

   dx,dy       : TFloat;

   Angle       : TFloat;

begin

Try

  If AutoUndo then UR.UndoSave;

  Loading := True;

  // Store the Cuv points in dPoints list

  InitdPoints;

  For i:=0 to Pred(Cuv.FPoints.Count) do begin

      pp := Cuv.Fpoints[i];

      dPoints.Add(pp);

  end;

  // First point <> Last point

  If Cuv.Closed then

  if dPoints[0]=dPoints[Cuv.FPoints.Count-1]

  then dPoints.Delete(Cuv.FPoints.Count-1);

 

  Case Cuv.Shape of

  dmPolygon,dmPolyLine:

    begin

       Cuv.Closed := False;

       if Cuv.Shape = dmPolygon then begin

          pp := Cuv.Fpoints[0];

          dPoints.Add(pp);

          Cuv.Closed := True;

       end;

       Cuv.ClearPoints;

 

       For i:=0 to dPoints.Count-2 do begin

           pp    := dPoints[i];

           pp1   := dPoints[i+1];

           d     := KeTPontTavolsaga(pp^.x,pp^.y,pp1^.x,pp1^.y);

           x     := pp^.x;

           y     := pp^.y;

           k     := Trunc(d/Dist);

           Angle := RelAngle2D(Point2d(x,y),Point2d(pp1^.x,pp1^.y));

           dx    := Dist * cos(Angle);

           dy    := Dist * sin(Angle);

           if d>Dist then begin

              For j:=0 to k do begin

                Cuv.AddPoint(x,y);

                x := x + dx;

                y := y + dy;

              end;

           end else begin

              Cuv.AddPoint(pp^.x,pp^.y);

           end;

       end;

      end;

    end;

finally

  If AutoUndo then UR.UndoSave;

  InitdPoints;

  Loading := False;

end;

end;

 

procedure TALPapirGL.PontSuritesAll(Dist: double);

Var

   i    : integer;

begin

For i:=0 to Pred(FCurveList.Count) do

     PontSurites(TCurve(FCurveList.Items[i]),Dist);

DoPaint;

end;

 

procedure TALPapirGL.RotateSelectedCurves(Cent: TPoint2d; Angle: TFloat);

var i: integer;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     FCurve:=FCurveList.Items[i];

     if FCurve.Selected then FCurve.RotateCurve(Cent, Angle);

end;

Changed := True;

DoPaint;

end;

 

procedure TALPapirGL.SelectAll(all: boolean);

var i: integer;

   cuv: TCurve;

begin

Loading := True;

for i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     Cuv.Selected := all;

end;

Loading := False;

Invalidate;

end;

 

procedure TALPapirGL.SelectAllInArea(R: TRect2D);

var i: integer;

   cuv: TCurve;

   RR,RC : TRect2d;

begin

Loading := True;

RR := CorrectRealRect(R);

for i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     RC := CorrectRealRect(Cuv.BoundsRect);

     If (RR.X1<=RC.X1) and (RR.X2>=RC.X2) and

        (RR.Y1<=RC.Y1) and (RR.Y2>=RC.Y2) then

        Cuv.Selected := True;

end;

Loading := False;

Invalidate;

end;

 

procedure TALPapirGL.SelectAllPolygons;

var i: integer;

   cuv: TCurve;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     cuv.Selected := Cuv.Shape = dmPolygon;

end;

Invalidate;

end;

 

procedure TALPapirGL.SelectAllPolylines;

var i: integer;

   cuv: TCurve;

begin

for i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     cuv.Selected := Cuv.Shape = dmPolyLine;

end;

Invalidate;

end;

 

procedure TALPapirGL.SelectChildObjects;

var i: integer;

begin

Loading := True;

for i:=0 to Pred(FCurveList.Count) do

     TCurve(FCurveList.Items[i]).Selected := not IsParent(i);

Loading := False;

Invalidate;

end;

function TALPapirGL.GetDrawExtension: TRect2d;

var n,i,j: integer;

   x,y: double;

   R: TRect2d;

begin

  Result := Rect2d(10e+10,10e+10,-10e+10,-10e+10);

  For n:=0 to FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[n];

     J:=Pred(FCurve.FPoints.Count);

     R := FCurve.BoundsRect;

       if R.x1<Result.x1 then Result.x1:=R.x1;

       if R.x2>Result.x2 then Result.x2:=R.x2;

       if R.y2>Result.y2 then Result.y2:=R.y2;

       if R.y1<Result.y1 then Result.y1:=R.y1;

  end;

end;

 

function TALPapirGL.IsPaperInWindow: boolean;

begin

 

end;

 

function TALPapirGL.IsPointInWindow(p: TPoint2d): boolean;

begin

 

end;

 

function TALPapirGL.IsRectInWindow(R: TRect2d): boolean;

begin

 

end;

 

procedure TALPapirGL.AutoCutSequence(BasePoint: TPoint2d;

Sorting: boolean);

begin

 

end;

 

procedure TALPapirGL.AutoSortObject(BasePoint: TPoint2d;

Connecting: boolean);

begin

 

end;

 

procedure TALPapirGL.AutoSortObject(BasePoint: TPoint2d);

begin

 

end;

 

procedure TALPapirGL.Elkerules;

begin

 

end;

 

function TALPapirGL.GetInnerObjectsCount(AIndex: Integer): integer;

begin

 

end;

 

function TALPapirGL.GetParentObject(x, y: TFloat): integer;

begin

 

end;

 

function TALPapirGL.GetParentObject(AIndex: Integer): integer;

begin

 

end;

 

procedure TALPapirGL.InitParentObjects;

begin

 

end;

 

function TALPapirGL.IsCutObject(p1, p2: TPoint2d;

var Aindex: integer): boolean;

begin

 

end;

 

function TALPapirGL.IsParent(AIndex: Integer): boolean;

begin

 

end;

 

function TALPapirGL.IsParent(x, y: TFloat): boolean;

begin

 

end;

 

function TALPapirGL.ObjectContour(Cuv: TCurve; OutCode: double): TCurve;

begin

 

end;

 

function TALPapirGL.OutLineObject(AIndex: Integer; delta: real): TCurve;

begin

 

end;

 

procedure TALPapirGL.StripAll;

begin

 

end;

 

procedure TALPapirGL.StripChildToParent(AIndex: integer);

begin

 

end;

 

procedure TALPapirGL.StripObj12(AParent, Achild: integer);

begin

 

end;

 

procedure TALPapirGL.SelectCurve(AIndex: Integer);

begin

  FCurve:=FCurveList.Items[AIndex];

  Selected := FCurve;

  SelectedIndex := AIndex;

  Invalidate;

end;

 

procedure TALPapirGL.SelectCurveByName(aName: string);

var n: integer;

begin

  For n:=0 to FCurveList.Count-1 do begin

     FCurve:=FCurveList.Items[n];

     if FCurve.Name = aName then begin

        Selected := FCurve;

        SelectedIndex := n;

     end;

  end;

  Invalidate;

end;

 

procedure TALPapirGL.SelectParentObjects;

var i: integer;

begin

Loading := True;

for i:=0 to Pred(FCurveList.Count) do

     TCurve(FCurveList.Items[i]).Selected := IsParent(i);

Loading := False;

Invalidate;

end;

 

procedure TALPapirGL.SetBeginPoint(ACurve, AIndex: Integer);

var NewPoints: TList;

   i,j1,j2: integer;

   PPoint: PPointRec;

begin

   FCurve:=FCurveList.Items[ACurve];

if InRange(ACurve,0,Pred(FCurveList.Count)) then

if InRange(AIndex,0,Pred(fCurve.FPoints.Count)) then

begin

Try

   NewPoints:=TList.Create;

   For i:=AIndex to Pred(FCurve.fPoints.Count) do begin

       PPoint:=FCurve.fPoints.Items[i];

       NewPoints.Add(PPoint);

   end;

   if FCurve.Closed then begin

      j1 := 0; j2 := AIndex-1;

      For i:=j1 to j2 do begin

       PPoint:=FCurve.fPoints.Items[i];

       NewPoints.Add(PPoint);

   end;

   end else begin

      j2 := 0; j1 := AIndex-1;

      For i:=j1 downto j2 do begin

       PPoint:=FCurve.fPoints.Items[i];

       NewPoints.Add(PPoint);

   end;

   end;

   finally

       FCurve.fPoints.Clear;

       For i:=0 to Pred(NewPoints.Count) do begin

           PPoint:=NewPoints.Items[i];

           FCurve.fPoints.Add(PPoint);

       end;

       NewPoints.Free;

       Selected := FCurve;

       Changed := True;

       if Assigned(fNewBeginPoint) then fNewBeginPoint(Self,ACurve);

   end;

end;

DoPaint;

end;

 

procedure TALPapirGL.SignedAll(all: boolean);

var i: integer;

   cuv: TCurve;

begin

For i:=0 to Pred(FCurveList.Count) do begin

     Cuv:=FCurveList.Items[i];

     Cuv.Signed:=all;

end;

DoPaint;

end;

 

procedure TALPapirGL.SignedNotCutting;

var i,j,k: integer;

   BaseCurve,Cuv: TCurve;

   p,p0: TPoint2d;

begin

SignedAll(False);

// Signed=True, ha valamely objektum át van vágva (rajzon szürke szín)

For i:=0 to Pred(FCurveList.Count) do begin

     BaseCurve:=FCurveList.Items[i];

     if BaseCurve.Shape=dmPolygon then

        For j:=0 to Pred(FCurveList.Count) do begin

            Cuv:=FCurveList.Items[j];

            if Cuv.Shape=dmPolyline then

            For k:=0 to Cuv.Count-2 do

            begin

               p:=Cuv.GetPoint2d(k);

               p0:=Cuv.GetPoint2d(k+1);

               if BaseCurve.IsCutLine(p0,p) then begin

                  BaseCurve.Signed:=True;

                  Break;

               end;

            end;

        end;

end;

DoPaint;

end;

 

procedure TALPapirGL.Vektorisation(MaxDiff: TFloat; Cuv: TCurve);

(* A vektorizálás során a kezdőpontot összekötjük a további pontokkal mindaddig

  amíg a következő pont eltérése nagyobb lessz egy diff-erenciánál

*)

 

var diff    : double;          // eltérés

   i       : integer;

   pp      : pPoints;

   kp,vp   : TPoint2D;        // vektor kezdő és végpontja

   n0,n    : integer;         // n futóindex

   e       : TEgyenesfgv;

   p2d     : TPoint2D;

begin

Try

  If (not Loading) and AutoUndo then UR.UndoSave;

  // Store the Cuv points in dPoints list

  InitdPoints;

  For i:=0 to Pred(Cuv.FPoints.Count) do begin

      pp := Cuv.Fpoints[i];

      dPoints.Add(pp);

  end;

 

  If Cuv.Closed then

  if dPoints[0]<>dPoints[Cuv.FPoints.Count-1]

  then begin

    pp := dPoints[0];

    dPoints.Add(pp);

  end;

 

  // Push vector points into the Cuv

  Cuv.ClearPoints;

  n0 := 0;

  n  := 1;

 

  // Ujmódszer

  While (n<dPoints.Count) do begin

  Try

    pp := dPoints[n0];

    kp := Point2d(pp^.x,pp^.y);

    Cuv.AddPoint(pp^.x,pp^.y);

    Inc(n0);

 

    While n<dPoints.Count do begin

       pp := dPoints[n];

       vp := Point2d(pp^.x,pp^.y);

       e := KeTPontonAtmenoEgyenes(kp.x,kp.y,vp.x,vp.y);

       // Vizsgáljuk a közbülső pontok eltéréseit az egyenestől

       For i:=n0 to n do begin

           pp   := dPoints[i];

           p2d  := Point2d(pp^.x,pp^.y);

           diff := PontEgyenesTavolsaga(e,p2d);

           if diff>MaxDiff then break;

       end;

       if diff>MaxDiff then begin

          n0 := n-1;      // Az n-1. pont eltérése már jelentős

          break;

       end;

       Inc(n);

    end;

  except

    Break;

  end;

  end;

  If not Cuv.Closed then begin

     n0 := dPoints.Count-1;

     pp := dPoints[n0];

     Cuv.AddPoint(pp^.x,pp^.y);

  end;

Finally

if (not Loading) and AutoUndo then UndoSave;

end;

 

end;

 

procedure TALPapirGL.VektorisationAll(MaxDiff: TFloat);

// Total graphic vectorisation

Var

   i    : integer;

begin

If AutoUndo then UR.UndoSave;

Loading := True;

For i:=0 to Pred(FCurveList.Count) do begin

     Vektorisation(MaxDiff,TCurve(FCurveList.Items[i]));

end;

if AutoUndo then UndoSave;

DoPaint;

Loading := False;

end;

 

procedure TALPapirGL.DrawGrid;

var

   kp,kp0: TPoint2d;

   tav,kpy,mar,marx,mary: extended;

   i: integer;

   GridTav : integer;     // Distance between lines

   R : TRect;

begin

(*

If Grid.Visible then begin

GridTav := 1;

 

if Grid.OnlyOnPaper then begin

For i:=0 to 2 do begin

     tav  := Gridtav;

     if (Zoom*tav)>5 then begin

 

     Pen.Color := Grid.SubgridColor;

     Case GridTav of

     1:  Pen.Width := 1;

     10: Pen.Width := 2;

     100: Pen.Color := Grid.MaingridColor;

     end;

 

     kp.x := 0;

     kp.y := 0; kp0:=kp;

 

     if Grid.Style=gsLine then begin

     While kp.x<=Paper.x do begin

           MoveTo(XToS(kp.x),YToS(0));

           LineTo(XToS(kp.x),YToS(Paper.y-0.1));

           kp.x:=kp.x+tav;

     end;

     While kp.y<=Paper.y do begin

           MoveTo(XToS(0),YToS(kp.y));

           LineTo(XToS(Paper.x-0.1),YToS(kp.y));

           kp.y:=kp.y+tav;

     end;

     end;

 

   end;

   GridTav := GridTav * 10;

 

end;

 

end else

begin

For i:=0 to 2 do begin

     tav  := Zoom * Gridtav;

     if tav>5 then begin

 

     Pen.Color := Grid.SubgridColor;

     Case GridTav of

     1:  Pen.Width := 1;

     10: Pen.Width := 2;

     100: Pen.Color := Grid.MaingridColor;

     end;

 

     marx := -Maradek(origo.x,GridTav);

     mary := -Maradek(origo.y,GridTav);

     kp.x := tav*marx;

     kp.y := tav*mary; kp0:=kp;

 

     if Grid.Style in [gsDot,gsCross] then

     While kp.x<=Width do begin

     While kp.y<=Height do begin

      Case Grid.Style of

      gsDot: begin

          Pixels[Trunc(kp.x),Height-Trunc(kp.y)]:= clGreen;

         end;

      gsCross: begin

          MoveTo(Trunc(kp.x)-4,Height-Trunc(kp.y));

          LineTo(Trunc(kp.x)+5,Height-Trunc(kp.y));

          MoveTo(Trunc(kp.x),Height-Trunc(kp.y)-4);

          LineTo(Trunc(kp.x),Height-Trunc(kp.y)+4);

         end;

      end;

      kp.y := kp.y+tav;

     end;

      kp.x:=kp.x+tav;

      kp.y := kp0.y;

     end;

 

     if Grid.Style=gsLine then begin

     While kp.x<=Width do begin

           MoveTo(Trunc(kp.x),0);

           LineTo(Trunc(kp.x),Height);

           kp.x:=kp.x+tav;

     end;

     While kp.y<=Height do begin

           MoveTo(0,Height-Trunc(kp.y));

           LineTo(Width,Height-Trunc(kp.y));

           kp.y:=kp.y+tav;

     end;

     end;

 

     end; //if tav>3

 

   GridTav := GridTav * 10;

 

end;

end;

 

end;

// Margin draws

if (Grid.Margin>0) and PaperVisible then begin

      DrawBmp.Canvas.Brush.Style:=bsClear;

      DrawBmp.Canvas.Pen.Style := psDot;

      DrawBmp.Canvas.Pen.Color := clSilver;

      R:=Rect(XToS(Grid.Margin),YToS(Grid.Margin),XToS(Trunc(Paper.x-Grid.Margin)),

              YToS(Trunc(Paper.y-Grid.Margin)));

      DrawBmp.Canvas.Rectangle(R);

end;

*)

end;

 

procedure TALPapirGL.DrawCurve(Cuv: Tcurve);

var i       : integer;

   x,y     : double;

   P1,P2   : TPoint2d;

   Radius  : double;

   Sel     : boolean;

begin

Sel := GetCurveHandle(Cuv.Name)=SelectedIndex;

if Cuv.Visible and (Cuv.Count > 0) then

Try

     if Sel then begin

        glLineWidth(2);

        glColor(clRed)

     end

     else

     if Cuv.Selected then glColor(clBlue)

        else glColor(clBlack);

     Case Cuv.Shape of

     dmPolygon,dmPolyLine,dmPoint,dmLine,dmRectangle:

     begin

            If Cuv.Closed then

               glBegin(GL_LINE_LOOP)

            else

               glBegin(GL_LINE_STRIP);

            if not Sel then begin

            if Cuv.Shape=dmPolyLine then

               glColor3f(0.5,0.5,0.5);

            if Cuv.Selected then glColor3f(0,0,1);

            end;

            for I:=0 to Pred(Cuv.Count) do

            begin

               Cuv.GetPoint(I,X,Y);

               glVertex2d(x,y);

            end;

            glEnd;

     end;

     dmCircle:

       begin

          P1 := Cuv.GetPoint2d(0);

          P2 := Cuv.GetPoint2d(1);

          Radius:= Trunc( SQRT( SQR(P2.x-P1.x) + SQR(P2.y-P2.y) ) );

          glCircle(P1,Radius);

       end;

     dmEllipse:

       begin

          P1 := Cuv.GetPoint2d(0);

          P2 := Cuv.GetPoint2d(1);

          glEllipse(P1,p2);

       end;

     end;

except

   exit;

end;

end;

 

procedure TALPapirGL.DrawPoints(Cuv: Tcurve);

var i       : integer;

   x,y     : double;

begin

if Cuv.Visible and (Cuv.Count > 0) then

Try

            glBegin(GL_POINTS);

            for I:=Pred(Cuv.Count) downto 0 do

            begin

               if I=0 then

                  glColor3f(1,0,0)

               else

            if Cuv.Shape=dmPolyLine then

               glColor3f(0.5,0.5,0.5)

            else

               glColor3f(0,0,0);

            if Cuv.Selected then glColor3f(0,0,1);

               Cuv.GetPoint(I,X,Y);

               glVertex2d(x,y);

            end;

            glEnd;

except

   exit;

end;

end;

 

procedure TALPapirGL.DrawBeginPoints(Cuv: Tcurve);

Var x,y     : double;

begin

if Cuv.Visible and (Cuv.Count > 0) then

Try

            glBegin(GL_POINTS);

            Cuv.GetPoint(0,X,Y);

            glColor(clFuchsia);

            glVertex2d(x,y);

            glEnd;

except

   exit;

end;

end;

 

 

procedure TALPapirGL.GenerateList;

var

R       : TRect;

H,I,J,K : Integer;

Radius  : integer;

X,Y     : TFloat;

Angle   : TFloat;

Size    : Word;

p       : TPoint;

pp      : Array[0..2] of TPoint2D;

RE      : TRect2d;

sz      : TSzin;

begin

glLineWidth(2);

glNewList(1000,GL_COMPILE);

for H:=0 to Pred(FCurveList.Count) do

begin

   FCurve:=FCurveList.Items[H];

   DrawCurve(FCurve);

end;

glEndList();

    glPointSize(4);

    glNewList(2000,GL_COMPILE);

    for H:=0 to Pred(FCurveList.Count) do

    begin

         FCurve:=FCurveList.Items[H];

         DrawPoints(FCurve);

    end;

    glEndList();

    glPointSize(4);

    glNewList(3000,GL_COMPILE);

    for H:=0 to Pred(FCurveList.Count) do

    begin

         FCurve:=FCurveList.Items[H];

         DrawBeginPoints(FCurve);

    end;

    glEndList();

    // Paper

    glNewList(1001,GL_COMPILE);

    glColor3f(0,0,0);

    glRectd(10,-10,Paper.x+10,Paper.y-10);

    sz:=ColorToSzin(paperColor);

    glColor3f(sz.r,sz.g,sz.b);

    glRectd(0,0,Paper.x,Paper.y);

    glEndList();

 

Changed := False;

end;

 

procedure TALPapirGL.Paint;

var

   ps : TPaintStruct;

   sz : TSzin;

begin

//  inherited;

BeginPaint(Handle, ps);

glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT);

glPushMatrix;

 

glLoadIdentity;

 

If Assigned(FOnBeforePaint) then FOnBeforePaint(Self);

 

if NewGraphic then GenerateList;

glTranslated(Centrum.x,Centrum.y,0);

glRotated(RotAngle,0,0,1);

glTranslated(-Centrum.x,-Centrum.y,0);

 

if PaperVisible then glCallList(1001);

glCallList(1000);

if fShowPoints then

    glCallList(2000);

glCallList(3000);

 

On_Drawing;

 

If Assigned(FOnAfterPaint) then FOnAfterPaint(Self);

if CentralCross then DrawCentralCross;

if CursorCross then DrawCursorCross(CursorPos);

 

glPopMatrix;

SwapBuffers(DC);

EndPaint(Handle, ps);

NewGraphic := False;

end;

 

//  Drawing in process

procedure TALPapirGL.On_Drawing;

Var xx,yy: double;

   ps : TPaintStruct;

   TP1,TP2 : TPoint2d; // Tegla elforgatott csúcspontjainak

begin

if not Editable then Exit;

 

glPushMatrix;

glColor3f(1,0.2,0.8);

glLineWidth(1);

 

Case DrawMode of

 

dmLine,dmPolyline,dmPolygon:

if pFazis>0 then begin

    glBegin(GL_LINE_STRIP);

     glVertex2d(Tegla.P1.x,Tegla.P1.y);

     glVertex2d(Tegla.P2.x,tegla.P2.y);

     if DrawMode=dmPolygon then begin

        TP1:=GetPoint2D(NCH,0);

        glVertex2d(TP1.x,TP1.y);

     end;

    glEnd;

    invalidate;

end;

 

dmRectangle:

if pFazis>0 then begin

    glPushMatrix;

    glLoadIdentity;

    tP1 := tegla.p1;

    tP2 := tegla.p2;

    RelRotate2d(TP1,Centrum,Rad(RotAngle));

    RelRotate2d(TP2,Centrum,Rad(RotAngle));

//     glRectd(tp1.x,tp1.y,tp2.x,tp2.y);

    glBegin(GL_LINE_STRIP);

     glVertex2d(TP1.x,TP1.y);

     glVertex2d(TP2.x,TP1.y);

     glVertex2d(TP2.x,TP2.y);

     glVertex2d(TP1.x,TP2.y);

     glVertex2d(TP1.x,TP1.y);

    glEnd;

    glPopMatrix;

    invalidate;

end;

 

dmCircle:

if pFazis>0 then begin

    glCircle(Tegla.P1,Tegla.P2);

    invalidate;

end;

 

dmEllipse:

if pFazis>0 then begin

    glEllipse(Tegla.P1,Tegla.P2);

    invalidate;

end;

 

end;

 

Case ActionMode of

amSelectArea:

if pFazis=1 then begin

    glPushMatrix;

    glLoadIdentity;

    tP1 := tegla.p1;

    tP2 := tegla.p2;

    RelRotate2d(TP1,Centrum,Rad(RotAngle));

    RelRotate2d(TP2,Centrum,Rad(RotAngle));

    glBegin(GL_POLYGON);

     glVertex2d(TP1.x,TP1.y);

     glVertex2d(TP2.x,TP1.y);

     glVertex2d(TP2.x,TP2.y);

     glVertex2d(TP1.x,TP2.y);

     glVertex2d(TP1.x,TP1.y);

    glEnd;

    glPopMatrix;

    invalidate;

end;

end;

 

if Selected<>nil then begin

    glColor(clRed);

    DrawCurve(Selected);

end;

 

 

// Drawing WorkPosition

glColor(clRed);

glPointSize(6);

glBegin(GL_POINTS);

   glVertex2d(WorkPosition.WorkPoint.x,WorkPosition.WorkPoint.y);

glEnd;

 

glPopMatrix;

 

end;

 

procedure TALPapirGL.CMMouseEnter(var msg: TMessage);

begin

inherited;

end;

 

procedure TALPapirGL.CMMouseLeave(var msg: TMessage);

begin

ShowHintPanel(False);

inherited;

end;

 

procedure TALPapirGL.KeyDown(var Key: Word; Shift: TShiftState);

begin

inherited;

Case Key of

VK_RETURN : ZoomDrawing;

end;

end;

 

procedure TALPapirGL.KeyUp(var Key: Word; Shift: TShiftState);

begin

if (ActionMode = amSelectArea) then

     ActionMode := amNone;

inherited;

end;

 

procedure TALPapirGL.CMChildkey(var msg: TCMChildKey);

var dx,dy: integer;

   k:integer;

begin

k:=16;

dx := 0; dy:=0;

msg.result := 1; // declares key as handled

Case msg.charcode of

   VK_RETURN  : ZoomDrawing;

   VK_LEFT    : dx:=-k;

   VK_RIGHT   : dx:=k;

   VK_UP      : dy:=-k;

   VK_DOWN    : dy:=k;

Else

   msg.result:= 0;

   inherited;

End;

if (dx<>0) or (dy<>0) then

    ShiftWindow(dx,dy);

end;

 

procedure TALPapirGL.ShowHintPanel(Show: Boolean);

begin

If Show then begin

    Hint1.ActivateHint(HintRect,Hintstr);

    HintActive:=True;

end else begin

    If HintActive then begin

       Hint1.ReleaseHandle;

       HintActive := False;

    end;

end;

end;

 

procedure TALPapirGL.SetEditable(const Value: boolean);

begin

FEditable := Value;

DoPaint;

end;

 

procedure TALPapirGL.Init(Sender: TObject);

begin

ZoomPaper;

if Assigned(FOnInit) then FOnInit(Self);

end;

 

procedure TALPapirGL.SetFilename(const Value: TFileName);

begin

FFilename := Value;

Changed := True;

LoadFile(FFilename);

end;

 

function TALPapirGL.LoadFile(fnev: string): boolean;

var fn ,ext   : string;

   filetipus : string;

   i         : integer;

   ures      : boolean;

   oldCur    : TCursor;

begin

   Result := False;

   If not FAppend then Clear;

 

   fn := UpperCase(fnev);

   If not FileExists(fn) then begin

      MessageDlg('Nem létező file!',mtError,[mbOk],0);

      exit;

   end;

 

  oldCur := Screen.Cursor;

  Screen.Cursor := crHourGlass;

  ext := UpperCase(ExtractFileExt(fnev));

   if ext = '.SBN' then LoadGraphFromFile(fnev);

   if ext = '.SB' then LoadOldGraphFromFile(fnev);

   if ext = '.PLT' then LoadFromPLT(fnev);

   if ext = '.DXF' then LoadFromDXF(fnev);

 

ZoomPaper;

UndoInit;

if Assigned(FnewFile) then FNewFile(Self,fn);

Screen.Cursor := oldCur;

DoPaint;

end;

 

procedure TALPapirGL.DXFCurves;

begin

 

end;

 

procedure TALPapirGL.LoadFromDAT(Filename: STRING);

var D: Textfile;

   S,s1,s2: String;

   H,N: Integer;

   x,y: real;

   nCuv  : integer;

BEGIN

if not FileExists(Filename) then exit;

Try

Loading := True;

nCuv := 0;

AssignFile(D,Filename);

   Reset(D);

   // Read first line for text file examination

   Readln(D, S);

 

   H:=MakeCurve('DAT0',0,dmPolyline,True,True,False);

 

   // Ebben a text fileban csak soremelés karakterek vannak

   // azaz az első felolvasással az egész file-t beolvassa

   if Length(s)>15 then begin

      s := trim(s);

      S := Stuff(s,#9,' ');

      S := Stuff(s,#10,' ');

      N := (StrCount(s,' ')+1) div 2;

      if N>0 then

      repeat

        s1 := StrCountD(s,' ',1);

        s2 := StrCountD(s,' ',2);

        x := strtofloat(s1);

        If s2='0.000' then y:=0 else

        y := strtofloat(s2);

        AddPoint(H,x,y);

        N  := CountPos(s,' ',2);

        s  := Trim(Copy(s,N,Length(s)));

      until N<1;

   end

 

   else

 

   repeat

     s := trim(s);

 

     if (Copy(s,1,1)<>';') and (s<>'') then begin

        S := Stuff(s,#9,' ');

        S := Stuff(s,#10,' ');

        s1 := StrCountD(s,' ',1);

        s2 := StrCountD(s,' ',2);

        If s1='0.000' then x:=0 else

        x := strtofloat(s1);

        If s2='0.000' then y:=0 else

        y := strtofloat(s2);

        AddPoint(H,x,y);

     end;

 

     if eof(D) then Break;

 

     Readln(D, S);

 

       if Trim(s)='' then begin

          s1 := ''+IntToStr(nCuv);

          H:=MakeCurve(s1,0,dmPolyline,True,True,False);

          Inc(nCuv);

       end;

   until False;

 

FINALLY

   CloseFile(D);

   Loading := False;

END;

END;

 

function TALPapirGL.LoadFromDXF(const FileName: string): Boolean;

begin

 

end;

 

function TALPapirGL.LoadFromPLT(const FileName: string): Boolean;

var f     : TEXTFILE;

   sor,S : string;

   k,N,i,pv,vpoz  : integer;

   x,y            : double;

   oldPLT: Boolean;

   KOD   : string;

   xx,yy : string;

   pd    : Boolean;  // Pen down = True; Pen up = False

   FirstPoint,EndPoint : TPointRec;

   elso  : boolean;

   Shape : TDrawMode;

begin

Try

Loading := True;

k := 0;

Shape:=dmPolygon;

AssignFile(f,FileName);

system.Reset(f);

ReadLn(f,sor);

pv := StrCount(sor,';');

oldPLT:=pv>1;

if oldPLT then      // Régebbi tipusú PLT file

BEGIN

    i:=1;

    While i<pv do begin

       vpoz := Pos(';',sor);

 

       if vpoz>0 then begin

 

       s := UpperCase(Copy(sor,1,vpoz-1));

       sor := Copy(sor,vpoz+1,Length(sor));

 

       KOD := UpperCase(Copy(s,1,2));

       if (KOD='SP0') or (s='EC') then break;

       if (KOD='PU') then pd:=False;

       if (KOD='PD') then pd:=True;

       if (KOD='PA') then

       begin

            if not pd then begin

               if k>0 then begin

                  FCurve := FCurveList.Items[N];

                  FCurve.Closed := (Abs(FirstPoint.x-EndPoint.x)<0.5) and (Abs(FirstPoint.y-EndPoint.y)<0.5);

                  FCurveList.Items[N]:=FCurve;

                  if FCurve.Closed then Shape:=dmPolygon else Shape:=dmPolyline;

               end;

               N:=MakeCurve('Object',-1,Shape,True,True,True);

               elso := True;

               Inc(k);

            end;

            S := Copy(s,3,100);

            xx := StrCountD(s,',',1);

            yy := StrCountD(s,',',2);

            Try

            Try

               x := strtoFloat(xx)/39.37;

               y := strtoFloat(yy)/39.37;

            finally

               If elso then begin

                  FirstPoint.x := x;

                  FirstPoint.y := y;

                  elso := False;

               end;

               FCurve.AddPoint(x,y);

               EndPoint.x := x;

               EndPoint.y := y;

            end;

            except

               Continue;

            end;

       end;

 

       end;

 

       Inc(i);

    end;

END

else           // Új tipusú PLT file (CorelDraw 12)

Repeat

   KOD := UpperCase(Copy(sor,1,2));

   if (KOD='SP0') then break;

   if (KOD='PU') or (KOD='PD') then

   begin

     if KOD='PU' then begin

        if k>0 then begin

              FCurve := FCurveList.Items[N];

              FCurve.Closed := (Abs(FirstPoint.x-EndPoint.x)<0.5) and (Abs(FirstPoint.y-EndPoint.y)<0.5);

              if FCurve.Closed then Shape:=dmPolygon else Shape:=dmPolyline;

        end;

        N:=MakeCurve('Object',-1,Shape,True,True,True);

        elso := True;

        Inc(k);

     end;

     S := Copy(sor,3,100);

     s := DelSub(s,';');

     If Pos(' ',s)>0 then begin

     xx := Copy(s,1,Pos(' ',s)-1);

     yy := Copy(s,Pos(' ',s)+1,Length(s));

     Try

     Try

        x := strtoFloat(xx)/39.37;

        y := strtoFloat(yy)/39.37;

     finally

        If elso then begin

           FirstPoint.x := x;

           FirstPoint.y := y;

           elso := False;

        end;

        FCurve.AddPoint(x,y);

        EndPoint.x := x;

        EndPoint.y := y;

     end;

     except

        Continue;

     end;

     end;

   end;

   ReadLn(f,sor);

Until EOF(f);

finally

CloseFile(f);

Normalisation(True);

Loading := False;

DoPaint;

end;

end;

 

function TALPapirGL.LoadOldGraphFromFile(const FileName: string): Boolean;

var

FileStream: TFileStream;

GraphData: TGraphData;

N: Integer;

au: boolean;

begin

Result:=False;

if FileExists(FileName) then

try

   oldFile := True;

   If AutoUndo then UR.UndoSave;

   au := AutoUndo;

   AutoUndo := False;

   Loading := True;

   FileStream:=TFileStream.Create(FileName,fmOpenRead);

   try

     FileStream.Position:=0;

     FileStream.Read(GraphData,SizeOf(GraphData));

 

     for N:=0 to Pred(GraphData.Curves) do

         if not LoadCurveFromStream(FileStream) then

         begin

            FileStream.Free;

            Clear;

            Exit;

         end;

 

   except

     Result:=False;

   end;

finally

   Result:=True;

   FileStream.Free;

   oldFile := False;

   Repaint;

   AutoUndo := au;

   Loading := False;

end;

end;

 

function TALPapirGL.SaveGraphToFile(const FileName: string): Boolean;

var

FileStream: TFileStream;

GraphData: TNewGraphData;

N: Integer;

begin

Result:=False;

try

   FileStream:=TFileStream.Create(FileName,fmCreate);

   try

     GraphData.Copyright := 'StellaFactory Obelisc Sablon Ver 1';

     GraphData.Version   := 1;

     GraphData.GraphTitle:=FGraphTitle;

     GraphData.Curves:=FCurveList.Count;

     FileStream.Position:=0;

     FileStream.Write(GraphData,SizeOf(GraphData));

 

     for N:=0 to Pred(GraphData.Curves) do

           SaveCurveToStream(FileStream,N);

 

     Result:=True;

   except

     Result:=False;

   end;

finally

   FileStream.Free;

   Changed := False;

end;

end;

 

function TALPapirGL.SaveToDAT(Filename: STRING): boolean;

var D: Textfile;

   r: TRect2d;

   szorzo: double;

   dx,dy: double;

   H,I,N: Integer;

   xx,yy: TFloat;

   s,s0: string;

   FCurve : TCurve;

BEGIN

 

Try

Result := False;

Loading := True;

H := 0;

AssignFile(D,Filename);

   Rewrite(D);

   r := GetDrawExtension;

   dx := r.x2-r.x1;

   dy := r.y2-r.y1;

   Eltolas(-r.x1,-r.y1);

   szorzo:= 1/dx;

//    if dx>dy then szorzo:= 1/dx else szorzo:= 1/dy;

   for i:=0 to Pred(FCurveList.Count) do begin

     FCurve:=FCurveList.Items[I];

   for N:=0 to Pred(FCurve.FPoints.Count) do begin

     FCurve.GetPoint(N,xx,yy);

     xx := szorzo * xx;

     yy := szorzo * yy;

     s := Ltrim(format('%6.5f',[xx]))+' '+LTrim(format('%6.5f',[yy]));

     WriteLn(D,s);

     if N=0 then s0 := s;               // Save 0. point

     Inc(H);

     if Demo and (H>500) then exit;

   end;