STMTYPES

Top  Previous  Next

 

{ StellaMap konverter,

 

Minden filetipust StellaMAP trk állománnyá alakít, majd ebből képezi a

kimenetet.

Ha a StellaMapSource=nil, akkor a belső stream-eket használja a konverzióhoz}

 

unit StmConv;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,

Dialogs, StMap16, StMap161, AlmType;

 

type

TConvertType = (ctyNone,ctyITR,ctyTRK,ctyWMF,ctyDXF,ctyLST,ctyDAT);

 

TInOutType   = (ioInput,ioOutput,ioInputOutput);

 

TStMapConverter = class(TComponent)

private

  FIndicatorGauge : TGauge;

  FInputFile : string;

  FInOutType : TInOutType;

  FOutputFile : string;

  FActive : boolean;

  FConvertType : TConvertType;

  FStellaMapSource : TStellaMap;

  procedure SetInputFile(Value:string);

  procedure SetOutputFile(Value:string);

  procedure SetActive(Value:boolean);

protected

public

  tm       : TRajzelemStream;   {Belső mem.stream, ha a StMapSource=nil}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  Function  RetegSzamKap(rnev: string): word;

  Function DXFToTRK(stm:TStellaMap;dxffn,trkfn:string;mentes:boolean;csik:TGauge):boolean;

published

  Property IndicatorGauge : TGauge read FIndicatorGauge write FIndicatorGauge ;

  Property InputFile : string read FInputFile write SetInputFile ;

  property InOutType : TInOutType read FInOutType write FInOutType;

  Property OutputFile : string read FOutputFile write SetOutputFile ;

  Property Active : boolean read FActive write SetActive ;

  Property ConvertType : TConvertType read FConvertType write FConvertType ;

  Property StellaMapSource : TStellaMap read FStellaMapSource write FStellaMapSource ;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('StellaMAP',[TStMapConverter]);

end;

 

constructor TStMapConverter.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

end;

 

destructor TStMapConverter.Destroy;

begin

   inherited Destroy;

end;

 

 

procedure TStMapConverter.SetInputFile(Value:string);

begin

FInputFile:=Value;

end;

 

 

procedure TStMapConverter.SetOutputFile(Value:string);

begin

FOutputFile:=Value;

end;

 

procedure TStMapConverter.SetActive(Value:boolean);

begin

If StellaMAPSource<>nil then begin

Case InOutType of

ioInput:

    Case ConvertType of

    end;

ioOutput:

ioInputOutput:

end;

end else FActive:=False;

end;

 

 

{ **************  KONVERZIÓS RUTINOK *************}

 

{DXF file beolvasás}

Function TStMapConverter.DXFToTRK(stm:TStellaMap;dxffn,trkfn:string;

                mentes:boolean;csik:TGauge):boolean;

Type Tdxfmod = (dxfNONSEC,dxfHEADER,dxfTABLES,dxfBLOCKS,dxfENTITIES,dxfEOF);

   TdxfTable = (dxfNONTABLE,dxfLTYPE,dxfLAYER,dxfSTYLE,dxfUCS);

   Tdxfelozo = (semmi,pont,vonal,szoveg,sokszog,kor);

var  dxfmod: Tdxfmod;

   dxfTable: TdxfTable;

   dxfelozo,rmuj: Tdxfelozo;

   fn,fpath,sor: string;

   f,f1: file; ft: TEXTFILE;

   resu: word;

   retegszam: integer;

   p3d,op3d: TPoint3d;

   vertexdb: integer;    {a polyline oldalszáma}

   fs,hol,maxpontszam: longint;

begin

{DXF FILE feldolgozás}

If FileExists(dxffn) then

begin

  Decimalseparator:='.';

  stm.cw.vonalszam:=0; stm.cw.szovegszam:=0;

  csik.Progress:=0; hol:=0;

  stm.StreamMeretek(cw);

  maxpontszam := MaxPontszamKeres;

  AssignFile(ft,dxffn); Reset(ft);

  fs:=Filesize(ft);

  dxfelozo:=semmi;

  While not EOF(ft) do

  begin

    If (sor='ENDSEC') then dxfMod:=dxfNONSEC;

    ReadLn(ft,sor); hol:=hol+Length(sor);

    IF sor='HEADER' then dxfmod := dxfHEADER;

    IF sor='TABLES' then dxfmod := dxfTABLES;

    IF sor='BLOCKS' then dxfmod := dxfBLOCKS;

    IF sor='ENTITIES' then dxfmod := dxfENTITIES;

    Case dxfmod of

    dxfHEADER:

    begin

    If sor='$EXTMIN' then begin

       ReadLn(ft,sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); stm.cw.minx:=StrToFloat(sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); stm.cw.miny:=StrToFloat(sor); hol:=hol+Length(sor);

    end;

    If sor='$EXTMAX' then begin

       ReadLn(ft,sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); stm.cw.maxx:=StrToFloat(sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); hol:=hol+Length(sor);

       ReadLn(ft,sor); stm.cw.maxy:=StrToFloat(sor); hol:=hol+Length(sor);

    end;

    end;

 

    dxfTABLES:

    repeat

       ReadLn(ft,sor); hol:=hol+Length(sor);

       IF sor='TABLE' then begin

          ReadLn(ft,sor); hol:=hol+Length(sor);

          ReadLn(ft,sor); hol:=hol+Length(sor);

          If sor='LTYPE' then dxfTable:=dxfLTYPE;

          If sor='LAYER' then dxfTable:=dxfLAYER;

          If sor='STYLE' then dxfTable:=dxfSTYLE;

          If sor='UCS'   then dxfTable:=dxfUCS;

 

          Case dxfTable of

 

          dxfLTYPE:

          begin

            dxfTable:=dxfNONTABLE;

          end;

 

          dxfSTYLE:

          begin

            dxfTable:=dxfNONTABLE;

          end;

 

          dxfUCS:

          begin

            dxfTable:=dxfNONTABLE;

          end;

 

          dxfLAYER:

          begin

            stm.rtgStream.Clear;

            retegszam:=0;

            ReadLn(ft,sor); hol:=hol+Length(sor);

            While sor<>'ENDTAB' do begin

                ReadLn(ft,sor); hol:=hol+Length(sor);

                If sor='LAYER' then begin

                   Repeat

                         ReadLn(ft,sor); hol:=hol+Length(sor);

                         If sor='  2' then begin   {Rétegnév}

                            ReadLn(ft,sor); hol:=hol+Length(sor);

                            rrec.retegszam:=retegszam;

                            rrec.retegnev :=sor;

                         end;

                         If sor=' 62' then begin   {vonalszín}

                            ReadLn(ft,sor); hol:=hol+Length(sor);

                            rrec.vonalszin:=strtoint(sor);

                         end;

                         If sor='  6' then begin   {vonaltipus}

                            ReadLn(ft,sor); hol:=hol+Length(sor);

                            rrec.vonalstylus:=0;

                         end;

                   Until sor='  0';

                   stm.rtgStream.Write(rrec,SizeOf(rrec));

                   retegszam:=retegszam+1;

                end;

            end;

            dxfTable:=dxfNONTABLE;

          end;

 

          end;

       end;

 

    until (sor='ENDSEC') or EOF(ft);

 

    dxfENTITIES:

    begin

    If sor='POINT' then begin

       stm.PrecNull(prec);

       repeat

       dxfelozo:=pont;

       ReadLn(ft,sor); hol:=hol+Length(sor);

       If sor = ' 10' then begin

          ReadLn(ft,sor); prec.x:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 20' then begin

          ReadLn(ft,sor); prec.y:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 30' then begin

          ReadLn(ft,sor); prec.z:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = '  1' then begin

          ReadLn(ft,sor); prec.no:=StrToInt(sor); hol:=hol+Length(sor);

       end;

       Until (sor='  0') or EOF(ft);

       stm.tm[1].Write(prec,SizeOf(prec));

       Inc(stm.cw.pontszam);

    end;

    If sor='LINE' then begin

       stm.vrecnull(vrec);

       repeat

       dxfelozo:=vonal;

       ReadLn(ft,sor); hol:=hol+Length(sor);

       If sor = '  8' then begin

          ReadLn(ft,sor); hol:=hol+Length(sor);

          Try

             vrec.reteg:=StrToInt(Alltrim(sor))-1;

             If vrec.reteg<0 then vrec.reteg:=0;

          except

             On Exception do

             Try

                vrec.reteg:=RetegszamKap(sor);

             except

                On Exception do vrec.reteg:=0;

             end;

          end;

       end;

       If sor = ' 10' then begin

          ReadLn(ft,sor); vrec.x1:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 20' then begin

          ReadLn(ft,sor); vrec.y1:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 11' then begin

          ReadLn(ft,sor); vrec.x2:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 21' then begin

          ReadLn(ft,sor); vrec.y2:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       Until (sor='  0') or EOF(ft);

       vrec.jelzo:=0;

       stm.tm[2].Write(vrec,SizeOf(vrec));

    end;

 

    If sor='TEXT' then begin

       stm.szrecnull(szrec);

       repeat

       ReadLn(ft,sor); hol:=hol+Length(sor);

       If sor = '  8' then begin

          ReadLn(ft,sor); hol:=hol+Length(sor);

          Try

             szrec.reteg:=StrToInt(Alltrim(sor))-1;

          except

             On Exception do

             Try

                szrec.reteg:=stm.RetegszamKap(sor);

             except

                On Exception do szrec.reteg:=0;

             end;

          end;

       end;

       If sor = ' 10' then begin

          ReadLn(ft,sor); szrec.x:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 20' then begin

          ReadLn(ft,sor); szrec.y:=StrToFloat(sor); hol:=hol+Length(sor);

       end;

       If sor = '  1' then begin

          ReadLn(ft,sor); szrec.szoveg:=ASCIIToWin(sor); hol:=hol+Length(sor);

       end;

       If sor = ' 50' then begin

          ReadLn(ft,sor); szrec.szog:=Trunc(100*StrToFloat(sor)); hol:=hol+Length(sor);

       end;

       Until (sor='  0') or EOF(ft);

       szrec.jelzo:=0;

       if dxfelozo=pont then begin

          If szrec.szoveg='' then prec.no:=0 else

             prec.no:=StrToInt(szrec.szoveg);

          pontrekordir(cw.pontszam-1,prec);

          dxfelozo:=semmi;

       end else begin

           stm.tm[3].Write(szrec,SizeOf(szrec));

           dxfelozo:=szoveg;

       end;

    end;

 

    If sor='POLYLINE' then begin

    vertexdb :=0;

    Repeat

       ReadLn(ft,sor); hol:=hol+Length(sor);

       If sor = '  8' then begin

          ReadLn(ft,sor); hol:=hol+Length(sor);

          Try

             retegszam:=StrToInt(Alltrim(sor))-1;

          except

             On Exception do begin

             Try

                retegszam:=RetegszamKap(sor);

             except

                On Exception do retegszam:=0;

             end;

             end;

          end;

       end;

       If sor='VERTEX' then begin

          op3d.z :=0;

       repeat

             dxfelozo:=sokszog;

             ReadLn(ft,sor); hol:=hol+Length(sor);

             If sor = ' 10' then begin

                ReadLn(ft,sor); op3d.x:=StrToFloat(sor); hol:=hol+Length(sor);

             end;

             If sor = ' 20' then begin

                ReadLn(ft,sor); op3d.y:=StrToFloat(sor); hol:=hol+Length(sor);

             end;

             If sor = ' 30' then begin

                ReadLn(ft,sor); op3d.z:=StrToFloat(sor); hol:=hol+Length(sor);

             end;

       Until (sor='  0') or EOF(ft);

             vertexdb := vertexdb+1;

             If vertexdb=1 then begin

                vrec.x1:=op3d.x;

                vrec.y1:=op3d.y;

                vrec.z1:=op3d.z;

             end else begin

                vrec.x2:=op3d.x;

                vrec.y2:=op3d.y;

                vrec.z2:=op3d.z;

             end;

             precnull(prec);

             prec.x:=op3d.x; prec.y:=op3d.y; prec.z:=op3d.z;

             stm.tm[1].Write(prec,SizeOf(prec));

             Inc(cw.pontszam);

             If vertexdb>1 then begin

                stm.tm[2].Write(vrec,SizeOf(vrec));

                vrec.x1:=vrec.x2;

                vrec.y1:=vrec.y2;

                vrec.z1:=vrec.z2;

             end;

       end;

        If csik<>nil then csik.Progress:=Trunc(100*hol/fs);

    Until sor='SEQEND';

    end;  {Polyline}

 

 

    end;

    end;

        If csik<>nil then csik.Progress:=Trunc(100*hol/fs);

    end;

    CloseFile(ft);

    stm.StreamMeretek(cw);

    If mentes then begin

       If Pos('.',trkfn)>0 then trkfn:=Copy(trkfn,1,Pos('.',trkfn));

       stm.rtgstream.SaveToFile(trkfn+'RTG');

       stm.tm[1].savetofile(trkfn+'TRK');

       stm.tm[2].savetofile(trkfn+'LIN');

       stm.tm[3].savetofile(trkfn+'SZV');

    end;

  end;

 

end;

 

 

{DXF file kiírás}

 

procedure TRKToDXF(filenev:string);

var  ii: longint;

   f: Textfile;

begin

Try

  Screen.Cursor:=crHourGlass;

  StreamMeretek(cw);

  AssignFile(f,filenev);

  Rewrite(f);

 

  {Header kiírás}

  WriteLn(f,'  0');

  WriteLn(f,'SECTION');

  WriteLn(f,'  2');

  WriteLn(f,'HEADER');

  WriteLn(f,'  9');

  WriteLn(f,'$EXTMIN');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.minx])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.miny])));

  WriteLn(f,'  9');

  WriteLn(f,'$EXTMAX');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.maxx])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.maxy])));

  WriteLn(f,'  9');

  WriteLn(f,'$LINMIN');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.minx])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.miny])));

  WriteLn(f,'  9');

  WriteLn(f,'$LINMAX');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.maxx])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[cw.maxy])));

  WriteLn(f,'  0');

  WriteLn(f,'ENDSEC');

 

  WriteLn(f,'  0');

  WriteLn(f,'SECTION');

  WriteLn(f,'  2');

  WriteLn(f,'ENTITIES');

  WriteLn(f,'  0');

  For ii:=1 to 3 do begin

  tm[ii].Seek(0,0);

  Case ii of

  1: For i:=1 to cw.pontszam do begin

         tm[1].Read(prec,SizeOf(prec));

         WriteLn(f,'POINT');

         WriteLn(f,'  8'); WriteLn(f,'PT');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[prec.x])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[prec.y])));

         WriteLn(f,' 30');

         WriteLn(f,Alltrim(Format('%12.3f',[prec.z])));

         WriteLn(f,'  0');

         WriteLn(f,'TEXT');

         WriteLn(f,'  8');

         WriteLn(f,'TX-256');

         WriteLn(f,'  6');

         WriteLn(f,'CONTINUOUS');

         WriteLn(f,' 62');

         WriteLn(f,'15');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[prec.x])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[prec.y])));

         WriteLn(f,' 40');

         WriteLn(f,'1.00');

         WriteLn(f,'  1');

         WriteLn(f,IntToStr(prec.no));

         WriteLn(f,' 50');

         WriteLn(f,'0.0000');

         WriteLn(f,'  7');

         WriteLn(f,'ST-1');

         WriteLn(f,'  0');

     end;

  2: For i:=1 to cw.vonalszam do begin

         tm[2].Read(vrec,SizeOf(vrec)); vrec.jelzo:=0;

         WriteLn(f,'LINE');

         WriteLn(f,'  8'); WriteLn(f,'GR-'+IntToStr(vrec.reteg+1));

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[vrec.x1])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[vrec.y1])));

         WriteLn(f,' 11');

         WriteLn(f,Alltrim(Format('%12.3f',[vrec.x2])));

         WriteLn(f,' 21');

         WriteLn(f,Alltrim(Format('%12.3f',[vrec.y2])));

         WriteLn(f,'  0');

     end;

  3: For i:=1 to cw.szovegszam do begin

         tm[3].Read(szrec,SizeOf(szrec)); szrec.jelzo:=0;

         RREC:=RetegrekordKap(szrec.reteg);

         WriteLn(f,'TEXT');

         WriteLn(f,'  8'); WriteLn(f,'TX-'+IntToStr(szrec.reteg+1));

         WriteLn(f,'  6'); WriteLn(f,'CONTINUOUS');

         WriteLn(f,' 62'); WriteLn(f,'12');

         WriteLn(f,' 10');

         WriteLn(f,Alltrim(Format('%12.3f',[szrec.x])));

         WriteLn(f,' 20');

         WriteLn(f,Alltrim(Format('%12.3f',[szrec.y])));

         WriteLn(f,' 40');

         WriteLn(f,Alltrim(Format('%12.2f',[rrec.fontmeret/5])));

         WriteLn(f,'  1');

         WriteLn(f,szrec.szoveg);

         WriteLn(f,' 50');

         WriteLn(f,Alltrim(Format('%12.4f',[szrec.szog/100])));

         WriteLn(f,' 51');

         WriteLn(f,'STANDARD');

         WriteLn(f,'  7');

         WriteLn(f,'ST-3');

         WriteLn(f,'  0');

    end;

  end;

  end;

 

Finally

    WriteLn(f,'ENDSEC');

    WriteLn(f,'  0');

    WriteLn(f,'EOF');

    CloseFile(f);

end;

end;

 

procedure TRKToLST;

BEGIN

END;

 

procedure TRKToWMF;

BEGIN

END;

 

Function RetegSzamKap(stm:TStellaMap;rnev: string): word;

var i: integer;

  r: RetegRecord;

  meret: longint;

begin

Result:=0;

meret:=stm.rtgStream.Size div SizeOf(r);

with stm.rtgstream do begin

     Seek(0,0);

  For i:=0 to 255 do begin

      Read(rrec,SizeOf(rrec));

      If rnev=rrec.retegnev then begin

         Result:=i; exit;

      end;

  end;

end;

end;

 

end.