STCOMM

Top  Previous  Next

 

{ StellaMAP komponens készlet:

 

TSTMCommander

-------------

A StellaMAP térképen műveleteket hajt végre parancssori módszerrel.

Ha TStellaMAP komponenssel össze van kapcsolva, akkor Active=True esetén a

begépelt Command parancssor azonnal végrehajtásra kerül.

 

Active            = A parancsvégrehajtás engedélyezése

Command           = Parancssor

CommandDictionary = Az elérhető parancsok ill. függvények listája (nem módosítható);

}

 

unit StComm;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, Szoveg, AlmType, StMap16, StMap161;

 

type

 

TCommandListArray = array[0..10] of string[30];

 

TCommandEvent = procedure(Sender: TObject; var CommandLine:string;

                        Success:boolean) of object;

 

{Ismeret szint : ettől függ, hogy milyen mértékű segítséget nyukt a rendszer

       ill. milyen mértékű megerősítést kér a parancsvégrehajtás előtt és

       közben. levExpert esetén nincs megerősítési igény a sikeres végrehaj-

       tást a SuccessProcess változó jelzi }

TLevel = ( levAmateur, levNovice, levExpert );

 

TSTMCommander = class(TComponent)

private

  FStellaMapSource : TStellaMAP;

  FCommand         : string;          {Parancssor paraméterekkel}

  FCommandResult   : string;          {Parancs után visszaadott érték}

  FActive          : boolean;         {Végrehajtás engedélyezése}

  FLevel           : TLevel;          {Felhasználói szint}

  FSuccessProcess  : boolean;         {A sikeres végrehajtás jelzése}

  FCommandDictionary: TStringList;    {Parancs szótár}

  FCommandList     : TStringList;     {Parancs kulcsszavak listája}

  FActualCommand   : String;          {Aktuális parancs}

  FOnBeforeExecute : TCommandEvent;   {Parancs végrehajtás előtti esemény}

  FOnAfterExecute  : TCommandEvent;   {Parancs végrehajtás utáni esemény}

{    procedure GetStellaMapSource(Value:TStellaMAP);}

  procedure SetStellaMapSource(Value:TStellaMAP);

  procedure SetCommand(Value:string);

{    procedure SetActive(Value:boolean);}

  function GetCommandDictionary:TStringList;

  function GetCommandList:TStringList;

protected

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  Property ActualCommand : String read FActualCommand;

  property SuccessProcess : boolean read FSuccessProcess;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  Function Execute(CommandLine:string) : boolean;

  { Parancssor előzetes elemzése -> True = Szintaktikailag helyes }

  Function CommandPreAnalyse(CommandLine:string):boolean;

  { Parancssor végrehajtása }

  Function CommandExecute(CommandLine:string):boolean;

  Function IsCommand(Command:string):integer;

  function ParN(s:string;n:integer):string;

published

  Property StellaMapSource : TStellaMAP read FStellaMapSource write SetStellaMapSource ;

  Property Active : boolean read FActive write FActive ;

  Property Command : string read FCommand write SetCommand ;

  Property CommandResult : string read FCommandResult write FCommandResult ;

  Property Level : TLevel read FLevel write FLevel default levAmateur;

  Property OnBeforeExecute : TCommandEvent read FOnBeforeExecute write FOnBeforeExecute ;

  Property OnAfterExecute : TCommandEvent read FOnAfterExecute write FOnAfterExecute ;

  Property CommandDictionary: TStringList read GetCommandDictionary;

  Property CommandList: TStringList read GetCommandList;

end;

 

implementation

 

Const

STMCommandsType : TCommandListArray =

    ('P','P','P','F','P','P','P','P','','','');

STMCommands : TCommandListArray =

    ('NewMap','LoadMap','SaveMap','SetRajzmod',

     'NewPoint','NewLine','NewText','Rotate','Line','','');

STMShortCommands : TCommandListArray =

    ('NM','LM','SM','SRM',

     'P','L','T','ROT','','','');

STMParameters : TCommandListArray =

    ('','filenév (*.PT)','filenév (*.TRK)','rajzmód','No,x,y,z',

     'x1,y1,z1,x2,y2,z2,Réteg','Réteg,Felirat,x,y,[szög]',

     'szög','No1,No2','','');

STMResult : TCommandListArray =

    ('','','','True/False','','','','','','','');

STMNote : TCommandListArray =

    ('Új térkép: törli az előzőt',

    'Térkép file betöltése',

    'Térkép file mentése',

    'Rajzmód megadása',

    'Új pont felvitele',

    'Új él felvitele',

    'Új felirat felvitele',

    'Térkép forgatás',

    'Két pont összekötése','','');

 

procedure Register;

begin

   RegisterComponents('StellaMAP',[TSTMCommander]);

end;

 

Function TSTMCommander.Execute(CommandLine:string) : boolean;

begin

Result := False;

If Active and (StellaMapSource<>nil) then begin

   Command := CommandLine;

   Result := SuccessProcess;

end;

end;

 

constructor TSTMCommander.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FCommandDictionary := TStringList.Create;

   FCommandList       := TStringList.Create;

   Active := False;

end;

 

destructor TSTMCommander.Destroy;

begin

   FCommandDictionary.Free;

   FCommandList.Free;

   inherited Destroy;

end;

 

procedure TSTMCommander.SetStellaMapSource(Value:TStellaMAP);

begin

FStellaMapSource:=Value;

end;

 

procedure TSTMCommander.SetCommand(Value:string);

begin

If Active {and (Command<>Value)} then begin

   If CommandPreAnalyse(Value) then begin

      FSuccessProcess := CommandExecute(Value);

      FCommand := Value;

   end;

end;

end;

 

{ Parancssor előzetes elemzése -> True = Szintaktikailag helyes }

Function TSTMCommander.CommandPreAnalyse(CommandLine:string):boolean;

begin

Result := True;

end;

 

{ Parancsszótár beolvasása }

function TSTMCommander.GetCommandDictionary:TStringList;

var s: string; i: integer;

begin

Result := TStringList.Create;

With Result do begin

     For i:=Low(STMCommands) to High(STMCommands) do begin

         s := UpperCase(STMShortCommands[i])+' ';

         If STMCommandsType[i]='P'

            then s:=s+'procedure' else s:=+s+'function';

         s := s + ' ' + STMCommands[i];

{           If STMCommandsType[i]='F' then}

         s:=s+'('+STMParameters[i]+')';

         If STMResult[i]<>'' then s := s + ':' + STMResult[i]+';';

         Add(s+' => '+ STMNote[i]);

     end;

end;

end;

 

{ Parancsszótár beolvasása }

function TSTMCommander.GetCommandList:TStringList;

var i: integer;

begin

Result := TStringList.Create;

For i:=Low(STMCommands) to High(STMCommands) do

    Result.Add(UpperCase(STMCommands[i]));

end;

 

{Megkeresei a teljes és rövidített utasításkészletben a parancsot és

a találatot a 0-tól nagyobb visszadott érték jelzi}

Function TSTMCommander.IsCommand(Command:string):integer;

var i: integer;

begin

Result := 0;

For i:=Low(STMCommands) to High(STMCommands) do

    If UpperCase(Command) = UpperCase(STMShortCommands[i]) then begin

       Result := i;

       Exit;

    end;

If Result=0 then

For i:=Low(STMCommands) to High(STMCommands) do

    If UpperCase(Command) = UpperCase(STMCommands[i]) then begin

       Result := i;

       Exit;

    end;

end;

 

{ Parancssor végrehajtása }

Function TSTMCommander.CommandExecute(CommandLine:string):boolean;

Var aComm,aPars : string;

  index,ppos: integer;

  ps       : string;   {par. változók}

  px,py,pz : real;

  preteg   : byte;

  No       : longint;

begin

CommandResult := '';

Result := False;

If CommandLine <> '' then begin

   aComm := Szo(CommandLine,1);

   index := IsCommand(aComm);

   If index > 0 then begin

      FActualCommand := STMCommands[index];

      aComm := Upper(STMCommands[index]);

      ppos := Pos(' ',CommandLine);

      aPars := Alltrim(Copy(CommandLine,ppos,250));

 

      With StellaMapSource do begin

      If aComm = 'SAVEMAP' then

      begin

         MapSave(ParN(aPars,1));

         Result := True;

      end;

      If aComm = 'LOADMAP' then

      begin

         MapFile:=aPars;

         Result := True;

      end;

      If aComm = 'SETRAJZMOD' then

      begin

         StellaMapSource.Rajzmod:=StringToRajzmod(aPars);

         Result := True;

      end;

      If aComm = 'NEWPOINT' then

      begin

              recnull(prec);

              prec.No := StrToInt(ParN(aPars,1));

              prec.x  := StrToFloat(ParN(aPars,2));

              prec.y  := StrToFloat(ParN(aPars,3));

              prec.z  := StrToFloat(ParN(aPars,4));

              Result  := Ujpont(prec);

      end;

      If aComm = 'NEWLINE' then

      begin

              recnull(vrec);

              vrec.x1 := StrToInt(ParN(aPars,1));

              vrec.y1 := StrToFloat(ParN(aPars,2));

              vrec.z1 := StrToFloat(ParN(aPars,3));

              vrec.x2 := StrToInt(ParN(aPars,4));

              vrec.y2 := StrToFloat(ParN(aPars,5));

              vrec.z2 := StrToFloat(ParN(aPars,6));

              vrec.reteg := StrToInt(ParN(aPars,7));

              Result  := UjVonal(vrec);

      end;

      If aComm = 'NEWTEXT' then

      begin

              recnull(szrec);

              szrec.reteg := StrToInt(ParN(aPars,1));

              szrec.szoveg:= ParN(aPars,2);

              szrec.x     := StrToFloat(ParN(aPars,3));

              szrec.y     := StrToFloat(ParN(aPars,4));

              szrec.szog  := 10*StrToInt(ParN(aPars,5));

              Result      := UjFelirat(szrec);

      end;

      If aComm = 'ROTATE' then

      begin

         ElforgSzog := StrToFloat(aPars);

      end;

      If aComm = 'LINE' then

      begin

          recnull(vrec);

          prec.No := StrToInt(ParN(aPars,1));

          Pontszamkeres(tm[1],prec,No);

          vrec.x1:=prec.x; vrec.y1:=prec.y; vrec.z1:=prec.z;

          prec.No := StrToInt(ParN(aPars,2));

          Pontszamkeres(tm[1],prec,No);

          vrec.x2:=prec.x; vrec.y2:=prec.y; vrec.z2:=prec.z;

          vrec.reteg:= Aktreteg;

          Result  := UjVonal(vrec);

      end;

      invalidate;

      end;

 

   end;

end;

end;

 

{Az N. paramétert adja vissza:

a paramétereket vesszővel kell elválasztani, szövegek esetén a Space-t nem

tekinti elválasztásnak}

function TSTMCommander.ParN(s:string;n:integer):string;

var ParCount : integer;

  ss: string;

begin

ParCount := StrCount(s,',')+1;

Result := StrCountD(s,',',n);

end;

 

procedure TSTMCommander.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = StellaMapSource)

then StellaMapSource := nil;

end;

 

end.