FACTORY

Top  Previous  Next

{ TMotorok      : x,y léptetőmotorokat és megmunkálást az LPTn porton keresztűl

                vezérlő DELPHI 1.0 komponens.

Szerző        : Agócs László - StellaSOFT

}

 

unit Factory;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, ExtCtrls,

Graphics, Controls, Forms, Dialogs, stdctrls, Szamok, Geom, mmKep;

 

type

 

TLPTPort = (LPT1,LPT2,LPT3);

SLPTPorts = Set of TLPTPort;

 

TMoveOption     = (moAuto, moManual);        {Mozgatási mód:auto vagy kézi}

TSebessegOption = (soNone, soQuick, soWork); {Gyors vagy lassú a mozgás}

TStepDirection  = (sdNone, sdPoz, sdNeg);    {A mozgás iránya: + vagy -}

 

  {Gyártási mód:

     Tesztmód   = wmTest : csak szimulálja a gyártást, de a motorok nem mozognak;

     Vágási mód = wmCut  : a pozícionálások kivételével a fejet leengedi és vág;

     Gravir mód = wmGravir : Glavírozás során a fej magassága folyamatosan változtatható;

  }

TWorkingMode    = (wmTest, wmCut, wmGravir);

 

TActPositionChangeEvent = procedure(Sender: TObject; ActPosition : TPoint3D) of object;

TWorkOnOffChangeEvent = procedure(Sender: TObject; WorkOn : boolean) of object;

TWorkingModeChangeEvent = procedure(Sender: TObject; WorkMode : TWorkingMode) of object;

 

TMotorok = class(TComponent)

private

  FLPTPort : TLPTPort;          {LPT port sorszáma = 1..3}

  FActPosition : TPoint3D;        {Aktuális potjció a munkadarabon}

  FActPositionLabel : TLabel;     {Aktuális potjció kijelezésére}

  FActPosPrecision : integer;     {Megjelenités: 0..3 = egész,0.1,0.01,0.001}

  FSourcePosition : TPoint3D;     {A mozgás kezdő pozíciója}

  FDestPosition : TPoint3D;       {A mozgás végső pozíciója}

  FFolytonosVagas : boolean;      {Folytonos vágás vagy pozícionálásokkal}

  FKesleltetesMIN : longint;      {Léptetőmotorok két léptetése közötti

                                   minimális időintervallum}

  FKesleltetesMINz : longint;      {z Léptetőmotor két léptetése közötti...}

  FLapmeretHEIGHT : integer;    {A munkaablak hossza: y}

  FLapmeretWIDTH : integer;     {A munkaablak hossza: x}

  FLepesX : extended;           {x motor lepes/1 mm}

  FLepesY : extended;           {y motor lepes/1 mm}

  FLepesZ : extended;           {z motor lepes/1 mm}

  FQuickVelocity : integer;     {Gyors mozgás sebessége mm/sec}

  FWorkVelocity : integer;      {Lassú mozgás: megmunkálás sebessége mm/sec}

  FSebesseg : integer;          {A haladás sebessége: lepes/sec

                                   pl 2 lepes/sec minden 0.5 sec-ban lép egyet}

  FKiemeles   : integer;        {Fej kiemeles lepesszama}

  FHeadStatus : boolean;        {Fej állapota: le=True; fel=False}

  FMoveOption : TMoveOption;    {A mozgástipus beállítása: Auto vagy manual}

  FSebessegOption : TSebessegOption; {Sebesség opció beállítás}

  FMMPerLepesX : extended;      {1 x lépés mm-ben}

  FMMPerLepesY : extended;      {1 y lépés mm-ben}

  FMMPerLepesZ : extended;      {1 z lépés mm-ben}

  fSTOP : boolean;              {STOP = Vészleállás}

  FWorkOn : boolean;            {jelzi, hogy a megmunkálás be van-e kapcsolva}

  FOnActPosition : TActPositionChangeEvent; {Esemény, ha változik az akt. pozíció}

  FOnWorkOnOff : TWorkOnOffChangeEvent;     {Megmunkálás be/kikapcsolása esetén}

  FWorkingMode : TWorkingMode;  {Gyártási mód}

  FOnWorkingMode : TWorkingModeChangeEvent;  {Gyártási mód váltás esetén}

  procedure SetActPosition(Value:TPoint3D);

  procedure SetActPositionLabel(Value:TLabel);

  procedure SetLPTPort(Value:TLPTPort);

  function GetLPTPorts:SLPTPorts;

  procedure SetkesleltetesMIN(Value:longint);

  procedure SetLapmeretHEIGHT(Value:integer);

  procedure SetLapmeretWIDTH(Value:integer);

  procedure SetQuickVelocity(Value:integer);

  procedure SetWorkVelocity(Value:integer);

  procedure SetSablonImage(Value:TSablonImage);

  procedure SetSebesseg(Value:integer);

  procedure SetSebessegOption(Value:TSebessegOption);

  procedure SetMMPerLepesX(Value:extended);

  procedure SetMMPerLepesY(Value:extended);

  procedure SetMMPerLepesZ(Value:extended);

  procedure SetWorkOn(Value:boolean);

  procedure SetWorkingMode(Value:TWorkingMode);

  procedure SetSTOP(Value:boolean);

protected

  alfa : extended;               {Az aktuális mozgás iránya radiánban}

  kesleltetes,Quickkesleltetes,Workkesleltetes : longint;

  H_Next,V_Next,Z_Next: integer;        {Vizszintes,függőleges számláló léptetéshez}

public

  _LPT            : Word;        {LPT port fizikai címe}

  FSablonImage    : TSablonImage;

  toll            : boolean;     {Toll lent=True, fent=False}

  SourcePosition  : TPoint3D;

  DestPosition    : TPoint3D;

  StepDirectionX  : TStepDirection;      {Az X tengely mentén mozgás iránya}

  StepDirectionY  : TStepDirection;      {Az Y tengely mentén mozgás iránya}

  StepDirectionZ  : TStepDirection;      {Az Z tengely mentén mozgás iránya}

  StepX,StepY     : longint;             {x,y irányú lépések száma}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

 

  Procedure Mout( Out_Val:Byte);

  Procedure Pen_down;

  Procedure Pen_Up;

  Procedure HeadUp;

  Procedure HeadDown;

  Procedure Up;

  Procedure Down;

  Procedure Left;

  Procedure Right;

  procedure Wait;

    {Fej relatív mozgatása: dz>0 felfelé; dz<0 lefelé dz számú lépéssel}

  procedure LoopZ(dz:integer);

    {Fej abszolut mozgatása z[mm] pozícióba}

  procedure GoHead(z:extended);

  procedure VekOut(dx,dy:extended;PENDOWN:boolean);

  procedure CircleOut(u,v,r:extended;PENDOWN:boolean);

  procedure ArcOut(p1,p2,p3:TPoint2d;PENDOWN:boolean);

  procedure EllipseOut(u,v,r1,r2:extended;PENDOWN:boolean);

 

    {Az időzítő eseménye}

{    procedure Timer(Sender : TObject);}

    {Kiinduló null-pozícióba mozgás}

  Procedure GotoNullPosition(actPosition:TPoint3D);

    {X,Y pozícióba mozgás}

  Function GotoXYPosition(x,y:extended): boolean;

    {X,Y,Z irányú léptetések a megadott sebességgel}

  Procedure LeptetesX(lepes:integer);

  Procedure LeptetesY(lepes:integer);

  Procedure LeptetesZ(lepes:integer);

    {Megmunkálás bekapcsolása}

  Function Work_On : boolean;

    {Megmunkálás kikapcsolása}

  Function Work_Off : boolean;

  procedure SendToPort(Bit:integer);

  procedure TotalWorking;

  procedure WorkingFromPoint(ap:longint);

  procedure Working;

  Property ActPosition : TPoint3D read FActPosition write SetActPosition;

  Property LepesX : extended read FMMPerLepesX ;

  Property LepesY : extended read FMMPerLepesY ;

  Property LepesZ : extended read FMMPerLepesZ ;

published

  Property LPTPort : TLPTPort read FLPTPort write SetLPTPort;

  Property LPTPorts : SLPTPorts read GetLPTPorts;

  Property ActPositionLabel : TLabel read FActPositionLabel write SetActPositionLabel;

  Property ActPosPrecision : integer read FActPosPrecision write FActPosPrecision;

  Property FolytonosVagas : boolean read FFolytonosVagas write FFolytonosVagas;

  Property KesleltetesMIN : longint read FkesleltetesMIN write SetkesleltetesMIN;

  Property KesleltetesMINz : longint read FkesleltetesMINz write FkesleltetesMINz;

  Property LapmeretHEIGHT : integer read FLapmeretHEIGHT write SetLapmeretHEIGHT;

  Property LapmeretWIDTH : integer read FLapmeretWIDTH write SetLapmeretWIDTH;

  Property MMPerLepesX : extended read FMMPerLepesX write FMMPerLepesX ;

  Property MMPerLepesY : extended read FMMPerLepesY write FMMPerLepesY ;

  Property MMPerLepesZ : extended read FMMPerLepesZ write FMMPerLepesZ ;

  Property QuickVelocity : integer read FQuickVelocity write SetQuickVelocity;

  Property WorkVelocity : integer read FWorkVelocity write SetWorkVelocity;

  Property Sebesseg : integer read FSebesseg write SetSebesseg default 1;

  Property MoveOption : TMoveOption read FMoveOption write FMoveOption;

  Property SebessegOption : TSebessegOption read FSebessegOption

                          write SetSebessegOption;

  Property Kiemeles : integer read FKiemeles write FKiemeles;

  Property HeadStatus : boolean read FHeadStatus write FHeadStatus;

  Property STOP : boolean read FSTOP write SetSTOP;

  Property WorkOn : boolean read FWorkOn write SetWorkOn;

  Property WorkingMode : TWorkingMode read FWorkingMode write SetWorkingMode;

  Property OnActPosition : TActPositionChangeEvent read FOnActPosition write FOnActPosition;

  Property OnWorkOnOff : TWorkOnOffChangeEvent read FOnWorkOnOff write FOnWorkOnOff;

  Property OnWorkingMode : TWorkingModeChangeEvent read FOnWorkingMode write FOnWorkingMode;

  Property SablonImage : TSablonImage read FSablonImage write SetSablonImage;

end;

 

CONST   TLPTPortName : Array[1..3] of String[4]= ('LPT1','LPT2','LPT3');

      MOTTAB:  Array[0..7] of Byte = ($27,$2D,$1C,$0D,$03,$09,$38,$29);

 

procedure Register;

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TMotorok]);

end;

 

constructor TMotorok.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FkesleltetesMIN  := 5000;

   FActPosition     := Point3D(0,0,0);

   FActPosPrecision := 2;

   FWorkingMode     := wmTest;

   FWorkVelocity    := 50;

   FQuickVelocity   := 100;

   FWorkOn          := False;

   FFolytonosVagas  := False;

   StepX            := 0;

   StepY            := 0;

   H_Next           := 0;

   V_Next           := 0;

   Z_Next           := 0;

   LPTPort          := LPT1;

   Kiemeles         := 100;

   HeadStatus       := False;

end;

 

destructor TMotorok.Destroy;

begin

   inherited Destroy;

end;

 

procedure TMotorok.SetSablonImage(Value:TSablonImage);

begin

If FSablonImage<>Value then begin

   FSablonImage:=Value;

   If Value<>nil then begin

      LapmeretWIDTH   := FSablonImage.PaperWidth;

      LapmeretHEIGHT  := FSablonImage.PaperHeight;

   end;

end;

end;

 

procedure TMotorok.SetLapmeretHEIGHT(Value:integer);

begin

FLapmeretHEIGHT := Value;

If SablonImage<>nil then begin

   SablonImage.PaperHeight := Value;

end;

end;

 

procedure TMotorok.SetLapmeretWIDTH(Value:integer);

begin

FLapmeretWIDTH := Value;

If SablonImage<>nil then begin

   SablonImage.PaperWidth := Value;

end;

end;

 

function TMotorok.GetLPTPorts:SLPTPorts;

begin

end;

 

procedure TMotorok.SetLPTPort(Value:TLPTPort);

begin

   FLPTPort := Value;

   Case Value of

   LPT1: _LPT:=$378;

   LPT2: _LPT:=$379;

   LPT3: _LPT:=$37A;

   end;

end;

 

procedure TMotorok.SetkesleltetesMIN(Value:longint);

begin

If FkesleltetesMIN <> Value then begin

   FkesleltetesMIN := Value;

   Quickkesleltetes := Trunc(FKesleltetesMIN * (100-QuickVelocity));

   Workkesleltetes  := Trunc(FKesleltetesMIN * (100-WorkVelocity));

end;

end;

 

{Gyor mozgás sebessége mm/sec}

procedure TMotorok.SetQuickVelocity(Value:integer);

begin

   FQuickVelocity := Value;

   Quickkesleltetes := Trunc(KesleltetesMIN * (100-Value));

   If SablonImage<>nil then SablonImage.FactoryConfig.PosSebesseg:=Value;

end;

 

{Lassú mozgás: megmunkálás sebessége mm/sec}

procedure TMotorok.SetWorkVelocity(Value:integer);

begin

   FWorkVelocity := Value;

   Workkesleltetes := Trunc(KesleltetesMIN * (100-Value));

   If SablonImage<>nil then SablonImage.FactoryConfig.WorkSebesseg:=Value;

end;

 

procedure TMotorok.SetSebesseg(Value:integer);

begin

If FSebesseg <> Value then begin

   FSebesseg := Value;

   kesleltetes := Trunc(KesleltetesMIN * (100/Sebesseg));

end;

end;

 

procedure TMotorok.SetSebessegOption(Value:TSebessegOption);

begin

If FSebessegOption <> Value then begin

   FSebessegOption := Value;

{     Case Value of

   soNone  : Ora.Interval := 0;

   soQuick : Ora.Interval := Trunc(1000 * LepesX / QuickVelocity);

   soWork  : Ora.Interval := Trunc(1000 * LepesX / WorkVelocity);

   end;}

end;

end;

 

procedure TMotorok.SetSTOP(Value:boolean);

begin

   FSTOP := Value;

   WorkOn := not Value;

   HeadUp;

end;

 

procedure TMotorok.SetActPosition(Value:TPoint3D);

begin

   FActPosition := Value;

   If FActPositionLabel<>nil then begin

      ActPositionLabel.Caption := Format('%6.'+IntToStr(ActPosPrecision)+'f',[FActPosition.x])+' : '+

                                  Format('%6.'+IntToStr(ActPosPrecision)+'f',[FActPosition.y])+' ['+

                                  Format('%4.'+IntToStr(ActPosPrecision)+'f',[FActPosition.z])+']';

   end;

   If SablonImage<>nil then begin

{        SablonImage.LineTo(FActPosition.x,FActPosition.y);}

      SablonImage.ActPosition:=FActPosition;

   end;

   If Assigned(FOnActPosition) then FOnActPosition(Self,Value);

end;

 

procedure TMotorok.SetActPositionLabel(Value:TLabel);

begin

If FActPositionLabel<>Value then begin

   FActPositionLabel:=Value;

   ActPosition := FActPosition;

end;

end;

 

{1 x irányú lépés hossza mm-ben: pl. 0.0023 mm}

procedure TMotorok.SetMMPerLepesX(Value:extended);

begin

FMMPerLepesX := Value;

FLepesX := 1/Value;

end;

 

{1 y irányú lépés hossza mm-ben: pl. 0.0023 mm}

procedure TMotorok.SetMMPerLepesY(Value:extended);

begin

FMMPerLepesY := Value;

FLepesY := 1/Value;

end;

 

{1 z irányú lépés hossza mm-ben: pl. 0.0023 mm}

procedure TMotorok.SetMMPerLepesZ(Value:extended);

begin

FMMPerLepesZ := Value;

FLepesZ := 1/Value;

end;

 

{ A megmunkáló fej be/ki kapcsolása }

procedure TMotorok.SetWorkOn(Value:boolean);

begin

FWorkOn := Value;

If Value then Pen_Down else Pen_Up;

If Assigned(FOnWorkOnOff) then FOnWorkOnOff(Self,Value);

end;

 

{ A gyártási mód beállítás }

procedure TMotorok.SetWorkingMode(Value:TWorkingMode);

begin

If FWorkingMode <> Value then begin

   FWorkingMode := Value;

   Case Value of

   wmTest   : WorkOn:=False;

   wmCut    : WorkOn:=True;

   wmGravir : WorkOn:=True;

   end;

   If Assigned(FOnWorkingMode) then FOnWorkingMode(Self,Value);

end;

end;

 

Procedure TMotorok.GotoNullPosition(actPosition:TPoint3D);

begin

If (actPosition.z<>0) then

   HeadUp;

If (actPosition.x<>0) or (actPosition.y<>0) then

   VekOut(-actPosition.x,-ActPosition.y,False);

end;

 

Function TMotorok.GotoXYPosition(x,y:extended) : boolean;

var dx,dy: extended;

begin

{A fejet nem szabad kipozícionálni a munkadarabról}

{  If Sablonimage<>nil then begin

   LapmeretWIDTH := SablonImage.PaperWidth;

   LapmeretHEIGHT := SablonImage.PaperHeight;

end;

If LapmeretWIDTH<x then x:=LapmeretWIDTH;

If x<0 then x:=0;

If LapmeretHEIGHT<y then y:=LapmeretHEIGHT;

If y<0 then y:=0;}

{  If actPosition.x < x then StepDirectionX:=sdPoz else StepDirectionX:=sdNeg;

If actPosition.y < y then StepDirectionY:=sdPoz else StepDirectionY:=sdNeg;

If actPosition.x = x then StepDirectionX:=sdNone;

If actPosition.y = y then StepDirectionY:=sdNone;}

SourcePosition := actPosition;

DestPosition := Point3D(x,y,actPosition.z);

dx:=DestPosition.x - SourcePosition.x;

dy:=DestPosition.y - SourcePosition.y;

VekOut(dx,dy,WorkOn);

end;

 

Procedure TMotorok.LeptetesX(lepes:integer);

begin

If lepes>0 then StepDirectionX:=sdPoz else StepDirectionX:=sdNeg;

SourcePosition.x := actPosition.x;

DestPosition.x := actPosition.x+lepes*MMPerLepesX;

 

end;

 

Procedure TMotorok.LeptetesY(lepes:integer);

begin

If lepes>0 then StepDirectionY:=sdPoz else StepDirectionY:=sdNeg;

SourcePosition.y := actPosition.y;

DestPosition.y := actPosition.y+lepes*MMPerLepesY;

end;

 

Procedure TMotorok.LeptetesZ(lepes:integer);

begin

If lepes>0 then StepDirectionZ:=sdPoz else StepDirectionZ:=sdNeg;

SourcePosition.z := actPosition.z;

DestPosition.z := actPosition.z+lepes*MMPerLepesZ;

end;

 

{Megmunkálás bekapcsolása}

Function TMotorok.Work_On : boolean;

begin

FWorkOn := True;

end;

 

{Megmunkálás kikapcsolása}

Function TMotorok.Work_Off : boolean;

begin

FWorkOn := False;

end;

 

{Az aktuális LPT portra adatot küld a megfelelő Bit-et bekapcsolva = 1}

procedure TMotorok.SendToPort(Bit:integer);

begin

end;

 

(* KIEGÉSZITŐ RUTINOK *)

Procedure TMotorok.Mout( Out_Val:Byte);

Var _STB : word;

begin

_STB := _LPT +2;

Port[_LPT] := Out_Val;

Port[_STB] := 1;

Port[_STB] := 0;

end;

 

procedure TMotorok.Wait;

var k: longint;

begin

 k:=0;

 Repeat

    Inc(k);

 until k>=kesleltetes;

end;

 

Procedure TMotorok.Pen_down;

Var Next_Value  : byte;

begin

Next_Value := $87;

Mout( Next_Value );

toll := True;

ActPosition:=Point3d(ActPosition.x,ActPosition.y,ActPosition.z+MMPerLepesZ);

{ WorkOn := True;}

end;

 

Procedure TMotorok.Pen_up;

Var Next_Value  : byte;

begin

Next_Value := $9B;

Mout( Next_Value );

toll := False;

ActPosition:=Point3d(ActPosition.x,ActPosition.y,ActPosition.z-MMPerLepesZ);

{ WorkOn := False;}

end;

 

Procedure TMotorok.HeadUp;

Var ii,k,l: longint;

begin

If HeadStatus or (ActPosition.z<>0) then begin

  l := Round(ActPosition.z/lepesZ);

For ii:=1 to l do begin

Z_Next:=Z_Next+1;

Z_Next:=Z_Next mod 8;

Mout(Mottab[Z_Next]+128);

 k:=0;

 Repeat

    Inc(k);

 until k>=kesleltetesMINz;

 ActPosition:=Point3d(ActPosition.x,ActPosition.y,ActPosition.z-MMPerLepesZ);

end;

end;

HeadStatus := False;

end;

 

Procedure TMotorok.HeadDown;

Var ii,k,l: longint;

begin

If not HeadStatus then begin

  l := Round((kiemeles-ActPosition.z)/lepesZ);

For ii:=1 to l do begin

Z_Next:=Z_Next-1;

If Z_Next=-1 then Z_Next:=7;

Z_Next:=Z_Next mod 8;

Mout(Mottab[Z_Next]+128);

ActPosition:=Point3d(ActPosition.x,ActPosition.y,ActPosition.z+MMPerLepesZ);

 k:=0;

 Repeat

    Inc(k);

 until k>=kesleltetesMINz;

end;

end;

HeadStatus := True;

end;

 

Procedure TMotorok.Up;

begin

V_Next:=V_Next+1;

V_Next:=V_Next mod 8;

Mout(Mottab[V_Next]+64);

{  If ActPosition.y<LapmeretHEIGHT then begin}

ActPosition:=Point3d(ActPosition.x,ActPosition.y+MMPerLepesY,ActPosition.z);

{  end;}

Wait;

end;

 

Procedure TMotorok.Down;

begin

V_Next:=V_Next-1;

If V_Next=-1 then V_Next:=7;

V_Next:=V_Next mod 8;

Mout(Mottab[V_Next]+64);

{  If ActPosition.y>0 then begin}

ActPosition:=Point3d(ActPosition.x,ActPosition.y-MMPerLepesy,ActPosition.z);

{  end;}

Wait;

end;

 

Procedure TMotorok.Left;

begin

H_Next:=H_Next+1;

H_Next:=H_Next mod 8;

Mout(Mottab[H_Next]);

{  If ActPosition.x>0 then begin}

ActPosition:=Point3d(ActPosition.x-MMPerLepesX,ActPosition.y,ActPosition.z);

{  end;}

Wait;

end;

 

Procedure TMotorok.Right;

begin

H_Next:=H_Next-1;

If H_Next=-1 then H_Next:=7;

H_Next:=H_Next mod 8;

Mout(Mottab[H_Next]);

{  If ActPosition.x<LapmeretWIDTH then begin}

ActPosition:=Point3d(ActPosition.x+MMPerLepesX,ActPosition.y,ActPosition.z);

{  end;}

Wait;

end;

 

{dz lepesszámot lép a z motor, az aktuális poz-hoz képest;

  dz>0 then lefelé, egyébként felfelé viszi a fejet}

procedure TMotorok.LoopZ(dz:integer);

var i:integer;

begin

If dz<>0 then

For i:=0 to Abs(dz) do begin

    If dz>0 then Pen_Up

    else Pen_Down;

end;

end;

 

{z abszolut pozícióba mozgatja a fejet}

procedure TMotorok.GoHead(z:extended);

var i,dz:integer;

begin

dz := Round((ActPosition.z-z)/MMPerLepesZ);

If dz<>0 then begin

For i:=0 to Abs(dz) do begin

    If dz>0 then Pen_Up

    else Pen_Down;

end;

end

end;

 

procedure TMotorok.VekOut(dx,dy:extended;PENDOWN:boolean);

var i,x,y,lepesszam: longint;

  d,xr,yr,s,c,lepeskoz : extended;

  alfa : double;

begin

d := sqrt((dx*dx)+(dy*dy));

If MMPerLepesX<MMPerLepesY then begin

   lepeskoz  := MMPerLepesX;

end else begin

   lepeskoz  := MMPerLepesY;

end;

If PENDOWN then begin

   Kesleltetes:=WorkKesleltetes;

   If WorkingMode=wmCut then HeadDown;

end else begin

   Kesleltetes:=QuickKesleltetes;

   If WorkingMode=wmCut then HeadUp;

end;

lepesszam := Trunc(Round(d/lepeskoz));

alfa := SzakaszSzog(0,0,dx,dy);

Application.ProcessMessages;

xr := 0;

yr := 0;

s := lepeskoz*sin(alfa); c := lepeskoz*cos(alfa);

For i:=1 to lepesszam do begin

    x:=Trunc(Round(xr/MMPerLepesX)); y:=Trunc(Round(yr/MMPerLepesY));

    xr := xr+c;

    yr := yr+s;

    If x<>Trunc(Round(xr/MMPerLepesX)) then begin

       If dx>0 then Right;

       If dx<0 then Left;

    end;

    If y<>Trunc(Round(yr/MMPerLepesY)) then begin

       If dy>0 then Up;

       If dy<0 then Down;

    end;

    Application.ProcessMessages;

    if STOP then exit;

end;

end;

 

{Kör végigjárása}

procedure TMotorok.CircleOut(u,v,r:extended;PENDOWN:boolean);

begin

   EllipseOut(u,v,r,r,PENDOWN);

end;

 

{Ellipszis végigjárása}

procedure TMotorok.EllipseOut(u,v,r1,r2:extended;PENDOWN:boolean);

var i,d,lepesszam: longint;

  x,y,xr,yr,s,c,kerulet,lepeskoz : extended;

  alfa : extended;

  k: longint;

  label 111;

begin

VekOut(u+r1-ActPosition.x,v-ActPosition.y,FolytonosVagas);

If MMPerLepesX<MMPerLepesY then begin

   lepeskoz  := MMPerLepesX;

end else begin

   lepeskoz  := MMPerLepesY;

end;

If PENDOWN then begin

   Kesleltetes:=WorkKesleltetes;

   If WorkingMode=wmCut then HeadDown;

end else begin

   Kesleltetes:=QuickKesleltetes;

   If WorkingMode=wmCut then HeadUp;

end;

kerulet := 2*r1*pi;

lepesszam := Trunc(Round(kerulet/lepeskoz));

alfa := 2*pi/lepesszam;

xr := ActPosition.x;

yr := ActPosition.y;

For i:=0 to lepesszam do begin

    x:=xr; y:=yr;

    xr := u+r1*cos(i*alfa);

    yr := v+r2*sin(i*alfa);

    If Trunc(Round(x/MMPerLepesX))<>Trunc(Round(xr/MMPerLepesX)) then begin

       If (xr-x)<0 then Left;

       If (xr-x)>0 then Right;

    end;

    If Trunc(Round(y/MMPerLepesY))<>Trunc(Round(yr/MMPerLepesY)) then begin

       If (yr-y)>0 then Up;

       If (yr-y)<0 then Down;

    end;

    Application.ProcessMessages;

    If Stop then Exit;

{      Image1.Canvas.LineTo(Trunc(xr),Image1.Height-Trunc(yr));}

end;

end;

 

{Ellipszis végigjárása}

procedure TMotorok.ArcOut(p1,p2,p3:TPoint2d;PENDOWN:boolean);

var i,d,lepesszam: longint;

  u,v,r,x,y,xr,yr,s,c,kerulet,lepeskoz : extended;

  alfa,dalfa,alfa1,alfa2,alfa3 : extended;

  k: longint;

  pp3: TPoint3d;

  label 111;

begin

pp3:=HaromPontbolKor(p1,p2,p3);

u:=pp3.x; v := pp3.y; r := pp3.z;

alfa1 := RelAngle2D(Point2d(u,v),p1);

alfa2 := RelAngle2D(Point2d(u,v),p2);

alfa3 := RelAngle2D(Point2d(u,v),p3);

dalfa := RelSzogDiff(alfa1,alfa2,alfa3);

alfa  := alfa1;

 

If ((p1.x-ActPosition.x)>MMPerLepesX) or ((p1.y-ActPosition.y)>MMPerLepesY) then

   VekOut(p1.x-ActPosition.x,p1.y-ActPosition.y,FolytonosVagas);

 

If SabloniMage<>nil then SabloniMage.MoveTo(Trunc(p1.x),Trunc(p1.y));

If MMPerLepesX<MMPerLepesY then begin

   lepeskoz  := MMPerLepesX;

end else begin

   lepeskoz  := MMPerLepesY;

end;

If PENDOWN then begin

   Kesleltetes:=WorkKesleltetes;

   If WorkingMode=wmCut then HeadDown;

end else begin

   Kesleltetes:=QuickKesleltetes;

   If WorkingMode=wmCut then HeadUp;

end;

kerulet := 2*r*Abs(dalfa);

lepesszam := Trunc(Round(kerulet/lepeskoz));

dalfa := dalfa/lepesszam;

xr := ActPosition.x;

yr := ActPosition.y;

For i:=0 to lepesszam do begin

    x:=xr; y:=yr;

    xr := u+r*cos(alfa);

    yr := v+r*sin(alfa);

    alfa := alfa + dalfa;

    If Trunc(Round(x/MMPerLepesX))<>Trunc(Round(xr/MMPerLepesX)) then begin

       If (xr-x)<0 then Left;

       If (xr-x)>0 then Right;

    end;

    If Trunc(Round(y/MMPerLepesY))<>Trunc(Round(yr/MMPerLepesY)) then begin

       If (yr-y)>0 then Up;

       If (yr-y)<0 then Down;

    end;

{      If SabloniMage<>nil then begin

       SabloniMage.LineTo(Trunc(x),Trunc(y));

       SabloniMage.LineTo(Trunc(xr),Trunc(yr));

    end;}

    Application.ProcessMessages;

    If Stop then Exit;

end;

end;

 

{Gyártási folyamat sablon alapján}

procedure TMotorok.TotalWorking;

begin

If SablonImage<>nil then begin

   SablonImage.sblSTM.Seek(0,0);

{     WorkOn:=True;}

   Working;

end;

end;

 

{Gyártási folyamat adott sarokponttól alapján}

procedure TMotorok.WorkingFromPoint(ap:longint);

begin

If SablonImage<>nil then begin

   SablonImage.sblSTM.Seek(ap*SizeOf(TRajzelem),0);

{     WorkOn:=True;}

   Working;

end;

end;

 

{Gyártási folyamat sablon alapján}

procedure TMotorok.Working;

var meret,ii,aktpos : longint;

  p,p_1,p_2,p_3 : TPoint2d;

  TollLe : boolean;

  pontszam: integer;

  z,r: extended;

  Relem  : TRajzelem;

  rLast,rNext: TRajzelem;

  oldFuncCode:integer;

begin

Try

{  GotoNullPosition(actPosition);}

If not STOP then begin

If SablonImage<>nil then

With SablonImage do begin

     Repaint;

     aktpos := sblSTM.Position;

     meret  := sblSTM.Size div SizeOf(TRajzelem);

     TollLe := False;

     Canvas.Brush.Style:=bsClear;

     pontszam := 1;

     oldFuncCode := 0;

For ii:=(AktPos div SizeOf(TRajzelem)) to meret do begin

    sblSTM.Read(Relem,SizeOf(TRajzelem));

  If not Relem.torolt then begin

    p := Point2d(Relem.x/1000,Relem.y/1000);

    z := Relem.z/1000; r := Relem.r/1000;

      If z<>0 then GoHead(z);

    If not TollLe then SablonImage.MoveTo(p.x,p.y);

    TollLe := True;

    Canvas.Pen.Mode := pmCopy;

    Case Relem.FuncCode of    {0=tollfel; 1=Pont; 2=Vonal; 3=Köriv}

    0 : begin TollLe := False;

              LineTo(p.x,p.y);

              VekOut(p.x-ActPosition.x,p.y-ActPosition.y,False);

        end;

    1 : begin MoveTo(p.x,p.y); VekOut(p.x-ActPosition.x,p.y-ActPosition.y,False); end;

    2 : begin

        If oldFuncCode<>2 then

           MoveTo(p.x,p.y)

        else

           LineTo(p.x,p.y);

           VekOut(p.x-ActPosition.x,p.y-ActPosition.y,WorkOn);

        end;

    3 : begin

        Ellipse(p.x-Trunc(z),p.y-Trunc(z),p.x+Trunc(z),p.y+Trunc(z));

        CircleOut(p.x,p.y,z,WorkOn);

        end;

    4 : if ii<>meret then begin

          P_2.X:=p.x; P_2.Y:=p.y;

          RajzelemLoad(rLast,ii-1);

          p := Point2d(rLast.x/1000,rlast.y/1000);

          P_1.X:=p.x; P_1.Y:=p.y;

          RajzelemLoad(rNext,ii+1);

          p := Point2d(rNext.x/1000,rNext.y/1000);

          P_3.X:=p.x; P_3.Y:=p.y;

          SablonImage.Arc(p_1,p_2,p_3);

          ArcOut(P_1,P_2,P_3,WorkOn);

        end;

    5 : begin

        Ellipse(p.x-Trunc(z),p.y-Trunc(r),p.x+Trunc(z),p.y+Trunc(r));

        EllipseOut(p.x,p.y,z,r,WorkOn);

        end;

    255:begin

          Exit;

        end;

    end;

    If Stop then exit;

    oldFuncCode := Relem.FuncCode;

  end

end;

end;

end;

finally

If SablonImage<>nil then

With SablonImage do begin

     sblSTM.Seek(aktpos,0);

     ActPosition := ActPosition;

end;

WorkOn:=False;

end;

end;

 

end.

 

(*  A motorok vezérlése az LPTn (1..3) porotokon történhet:

 

  Parallel port bitek jelentése:

 

      7     6     5     4     3     2     1     0

    STOP         Off   On     -  Y  +     -  X  +

 

  0.1.       : x irányú léptetés: 0 Bit pozitív irány; 1 Bit negiv irány

  2.3.       : y irányú léptetés: 2 Bit pozitív irány; 3 Bit negiv irány

  4.5.       : megmunkálás be/ki: 4 Bit indul; 5 Bit leáll

  7.         : STOP! = Vészleállás;

 

 

*)