STLISTA

Top  Previous  Next

 

{ StellaMAP listaformátum generátor }

 

unit Stlista;

 

interface

uses

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

Forms, Dialogs, StdCtrls, stmap16, stmap161, Almtype, Szoveg, Menus,

Buttons, Spin, ExtCtrls;

 

type

TListaType = (LiComplex,liPont,liVonal,liFelirat,liJelkulcs,liReteg,liHrsz,liTer);

TVonallistaTip = (lsSimpla,lsTav);

TOutType   = (ouInput,ouOutput);  {kimeneti hely}

 

TStListaGen = class(TComponent)

private

  FStellaMap    : TStellaMap;

  FListaType    : TListaType;

  FOutType      : TOutType;

  FListaFile    : string;

  FVonallistaTip: TVonallistaTip;

  FTextEditor   : string;

protected

  Fpos : integer;

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure Execute;

  procedure ExecuteDlg;

  procedure ListaGenerator;

  procedure pontlistair(fn:string; uj: boolean);

  procedure Vonallistair(fn:string; listatip : TVonallistaTip; uj: boolean);

  procedure Feliratlistair(fn:string; HRSZ,uj: boolean);

  procedure Jelkulcslistair(fn:string; uj: boolean);

  procedure Objectlistair(fn:string; uj: boolean);

  procedure ReteglistaIr(fn:string; uj: boolean);

  procedure Komplexlista;

  procedure Teruletlistair(fn:string; uj: boolean);

published

  property StellaMapSource: TStellaMap read FStellaMap write FStellaMap;

  property ListaType: TListaType read FListaType write FListaType;

  property OutType: TOutType read FOutType write FOutType;

  property ListaFile: string read FListaFile write FListaFile;

  property VonallistaTip: TVonallistaTip read FVonallistaTip write FVonallistaTip;

  property TextEditor: string read FTextEditor write FTextEditor;

end;

 

TListDialog = class(TForm)

  Panel1: TPanel;

  Panel2: TPanel;

  OKBtn: TBitBtn;

  HelpBtn: TBitBtn;

  Panel3: TPanel;

  GroupBox1: TGroupBox;

  Label4: TLabel;

  Label5: TLabel;

  Label6: TLabel;

  CheckBox1: TCheckBox;

  CheckBox2: TCheckBox;

  CheckBox3: TCheckBox;

  Bevel1: TBevel;

  CheckBox4: TCheckBox;

  CheckBox5: TCheckBox;

  CheckBox6: TCheckBox;

  SpinEdit1: TSpinEdit;

  Label7: TLabel;

  Label9: TLabel;

  CheckBox7: TCheckBox;

  CheckBox8: TCheckBox;

  CheckBox9: TCheckBox;

  CheckBox10: TCheckBox;

  Button1: TButton;

  CheckBox11: TCheckBox;

  Label1: TLabel;

  MainMenu1: TMainMenu;

  Pont1: TMenuItem;

  Vonal1: TMenuItem;

  Felirat1: TMenuItem;

  Jelkulcs1: TMenuItem;

  Objektum1: TMenuItem;

  Rteg1: TMenuItem;

  Egyb1: TMenuItem;

  Vonalakhosszal1: TMenuItem;

  BitBtn1: TBitBtn;

  procedure Pontok1Click(Sender: TObject);

  procedure Vonalak1Click(Sender: TObject);

  procedure FormActivate(Sender: TObject);

  procedure Szvegek1Click(Sender: TObject);

  procedure Rteglista1Click(Sender: TObject);

  procedure CheckBox1Click(Sender: TObject);

  procedure CheckBox4Click(Sender: TObject);

  procedure Jelkulcsok1Click(Sender: TObject);

  procedure Vonalakhosszal1Click(Sender: TObject);

  procedure CheckBox6Click(Sender: TObject);

  procedure CheckBox5Click(Sender: TObject);

  procedure Objektum1Click(Sender: TObject);

  procedure BitBtn1Click(Sender: TObject);

  procedure Pont1Click(Sender: TObject);

  procedure Vonal1Click(Sender: TObject);

  procedure Felirat1Click(Sender: TObject);

  procedure FormCreate(Sender: TObject);

  procedure FormDestroy(Sender: TObject);

private

public

  stl:TStListaGen;

end;

 

 

Var

StListaGen : TStListaGen;

ListDialog: TListDialog;

stm: TStellaMap;

i,j,k  : Longint;

f: TEXTFILE;

sor : string;

iDir: string;

fsz : string;

 

Function Filenevbeker(var fn:string; focim,iDir,ext,filt: string): boolean;

Procedure FileMegmutat(editor:string;fn:string);

 

implementation

 

{$R *.DFM}

{Function  Filemegnyitas(tm: TRajzelemStream;fnev: string;poz: boolean):boolean;

        far;external 'STELLA';}

 

procedure TStListaGen.Execute;

begin

stm:= StellaMapSource;

ListaGenerator;

end;

 

procedure TStListaGen.ExecuteDlg;

begin

stm:= StellaMapSource;

ListDialog:= TListDialog.Create(Application);

ListDialog.ShowModal;

end;

 

procedure TStListaGen.ListaGenerator;

var lf:string;

const ouS: Array[0..1] of string[10] = (' mentése',' betöltése');

begin

if stm=nil then stm:= StellaMapSource;

For i:=1 to 4 do stm.tm[i].Seek(0,0);

lf:=stm.mapfile;

   lf:=ChangeFileExt(lf,'.LST');

Case ListaType of

liComplex : fsz:='Komplex lista';

liPont    : fsz:='Pontlista';

liVonal   : fsz:='Vonallista';

liFelirat : fsz:='Feliratlista';

liJelkulcs: fsz:='Jelkulcslista';

end;

 

If Filenevbeker(lf,fsz+ouS[Ord(OutType)],F_Path(stm.mapfile),'LST',

       'Lista file (*.LST)|*.LST|Minden file (*.*|*.*)') then begin

       ListaFile:=lf;

Case OutType of

ouOutput:

begin

    Case ListaType of

    liPont    :    Pontlistair(listafile,True);

    liVonal   :    Vonallistair(listafile,VonallistaTip,True);

    liFelirat :    Feliratlistair(listafile,False,True);

    liJelkulcs:    Jelkulcslistair(listafile,True);

    liReteg   :    Reteglistair(listafile,True);

    liHrsz    :    Feliratlistair(listafile,True,True);

    liComplex : begin

                   Pontlistair(listafile,True);

                   Vonallistair(listafile,lsSimpla,False);

                   Feliratlistair(listafile,False,False);

                   Jelkulcslistair(listafile,False);

                end;

    liTer     : TeruletListair(listafile,True);

    end;

    If TextEditor='' then TextEditor:=stm.cw.TextEditor;

       FileMegmutat(Texteditor,listafile);

end;

ouInput:

begin

    If stm<>nil then Filemegnyitas(stm.tm,stm.rtgstream,ListaFile,stm.MapAppend,stm.Gauge)

end;

end;

end;

 

end;

 

constructor TStListaGen.Create(AOwner:TComponent);

begin

   stm:=nil;

   FStellaMap:=nil;

   FOutType := ouOutput;

   FListaType := liComplex;

   inherited Create(AOwner);

end;

 

destructor TStListaGen.Destroy;

begin

   stm:=nil;

   inherited Destroy;

end;

 

procedure TStListaGen.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

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

then StellaMapSource := nil;

end;

 

Function Filenevbeker(var fn:string; focim,iDir,ext,filt: string): boolean;

var SaveDialog1: TSaveDialog;

begin

Result := True;

SaveDialog1:=TSaveDialog.Create(Application);

With SaveDialog1 do begin

  Filename:=fn;

  Title := focim;

  DefaultExt:=ext;

  Filter:= filt;

  InitialDir:=iDir;

  If Execute then fn := Filename else Result := False;

end;

SaveDialog1.Free;

end;

 

procedure TStListaGen.pontlistair(fn:string; uj: boolean);

begin

stm.StreamMeretek(stm.cw);

stm.tm[1].Seek(0,0);

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' PONTLISTA');

WriteLn(f,'*');

WriteLn(f,'*No    Réteg      No       X          Y            M       Pkód   Info    Obj Jelző');

WriteLn(f,'*'+replicate('-',82));

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

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

    WriteLn(f, Format('%6d',[i])+ ' '+Format('%3d',[prec.reteg])

                     +' '+ Format('%9d',[prec.No])

                     +' '+ Format('%11.3f',[prec.x])

                     +' '+ Format('%11.3f',[prec.y])

                     +' '+ Format('%11.3f',[prec.z])

                     +' '+ Format('%5d',[prec.pkod])

                     +' '+ Format('%6d',[prec.info])

                     +' '+ Format('%6d',[prec.obj])

                     +' '+ Format('%3d',[prec.jelzo]));

  end;

WriteLn(f,'*'+replicate('-',82));

closeFile(f);

end;

 

procedure TStListaGen.Vonallistair(fn:string; listatip : TVonallistaTip; uj: boolean);

var d,d1: real;

begin

stm.StreamMeretek(stm.cw);

stm.tm[2].Seek(0,0);

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' VONALLISTA');

WriteLn(f,'*');

Case listatip of

lsSimpla:

WriteLn(f,'*  No  Réteg     X1         Y1          Z1          X2          Y2          Z2  Vastag Tipus Obj Jelző');

lsTav:

WriteLn(f,'*  No  Réteg     X1         Y1          Z1          X2          Y2          Z2         d2      d3');

end;

WriteLn(f,'*'+replicate('-',99));

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

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

    Case listatip of

    lsSimpla:

    WriteLn(f, Format('%6d',[i])+ ' '+Format('%3d',[vrec.reteg])

                     +' '+ Format('%11.3f',[vrec.x1])

                     +' '+ Format('%11.3f',[vrec.y1])

                     +' '+ Format('%11.3f',[vrec.z1])

                     +' '+ Format('%11.3f',[vrec.x2])

                     +' '+ Format('%11.3f',[vrec.y2])

                     +' '+ Format('%11.3f',[vrec.z2])

                     +' '+ Format('%3d',[vrec.vastag])

                     +' '+ Format('%3d',[vrec.tipus])

                     +' '+ Format('%6d',[vrec.obj1])

                     +' '+ Format('%3d',[vrec.jelzo]));

    lsTav:

    begin

    d := KeTPontTavolsaga(vrec.x1,vrec.y1,vrec.x2,vrec.y2);

    d1:= RelDist3D(Point3D(vrec.x1,vrec.y1,vrec.z1),

                   Point3D(vrec.x2,vrec.y2,vrec.z2));

    WriteLn(f, Format('%6d',[i])+ Format('%3d',[vrec.reteg])

                     +' '+ Format('%11.3f',[vrec.x1])

                     +' '+ Format('%11.3f',[vrec.y1])

                     +' '+ Format('%11.3f',[vrec.z1])

                     +' '+ Format('%11.3f',[vrec.x2])

                     +' '+ Format('%11.3f',[vrec.y2])

                     +' '+ Format('%11.3f',[vrec.z2])

                     +' '+ Format('%8.3f',[d])

                     +' '+ Format('%8.3f',[d1]));

    end;

    end;

  end;

WriteLn(f,'*'+replicate('-',99));

closeFile(f);

end;

 

procedure TStListaGen.Teruletlistair(fn:string; uj: boolean);

var d,d1: real;

  kiindulo,oprec:TPontrecord;

  meret:longint;

begin

stm.StreamMeretek(stm.cw);

stm.polistream.Seek(0,0);

meret:=(stm.polistream.Size div SizeOf(TPontrecord));

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' VONALLISTA');

WriteLn(f,'*');

WriteLn(f,'*  No  Réteg     X1         Y1          Z1          X2          Y2          Z2         d2      d3');

WriteLn(f,'*'+replicate('-',99));

  For i:=1 to meret+1 do begin

    If i=meret+1 then prec:=kiindulo

    else stm.polistream.Read(prec,SizeOf(prec));

    If i>1 then begin

    d := KeTPontTavolsaga(prec.x,prec.y,oprec.x,oprec.y);

    d1:= RelDist3D(Point3D(prec.x,prec.y,prec.z),

                   Point3D(oprec.x,oprec.y,oprec.z));

    WriteLn(f, Format('%6d',[i])+ Format('%3d',[prec.reteg])

                     +' '+ Format('%11.3f',[oprec.x])

                     +' '+ Format('%11.3f',[oprec.y])

                     +' '+ Format('%11.3f',[oprec.z])

                     +' '+ Format('%11.3f',[prec.x])

                     +' '+ Format('%11.3f',[prec.y])

                     +' '+ Format('%11.3f',[prec.z])

                     +' '+ Format('%8.3f',[d])

                     +' '+ Format('%8.3f',[d1]));

    end;

    If i=1 then kiindulo:=prec;

    oprec:=prec;

  end;

WriteLn(f,'*'+replicate('-',99));

closeFile(f);

end;

 

procedure TStListaGen.Feliratlistair(fn:string; HRSZ,uj: boolean);

begin

stm.StreamMeretek(stm.cw);

stm.tm[3].Seek(0,0);

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' FELIRATLISTA');

WriteLn(f,'*');

WriteLn(f,'*     Réteg  Felirat               község X           Y       Font szél.stil Szög   Obj Jelző');

WriteLn(f,'*'+replicate('-',92));

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

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

    If not HRSZ or (HRSZ and (szrec.reteg=10)) then begin

    WriteLn(f, Format('%6d',[i])+ ' '+Format('%3d',[szrec.reteg])

                     +' '+ PadC(Stuff(szrec.szoveg,' ','_'),' ',20)

                     +' '+ Format('%4d',[szrec.kozsegkod])

                     +' '+ Format('%11.3f',[szrec.x])

                     +' '+ Format('%11.3f',[szrec.y])

                     +' '+ Format('%3d',[szrec.font])

                     +' '+ Format('%3d',[szrec.szeles])

                     +' '+ Format('%3d',[szrec.stilus])

                     +' '+ Format('%6d',[szrec.szog])

                     +' '+ Format('%6d',[szrec.obj])

                     +' '+ Format('%3d',[szrec.jelzo]));

    end;

  end;

WriteLn(f,'*'+replicate('-',92));

closeFile(f);

end;

 

procedure TStListaGen.ReteglistaIr(fn:string; uj: boolean);

var ret: array[1..3,0..255] of longint;

  ossz: Array[1..3] of longint;

begin

stm.StreamMeretek(stm.cw);

For i:=1 to 3 do begin

  For j:=0 to 255 do ret[i,j]:=0;

  ossz[i]:=0;

end;

For i:=1 to 3 do begin

  stm.tm[i].Seek(0,0);

  Case i of

  1: For j:=1 to stm.cw.pontszam do begin

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

         Inc(ret[i,prec.reteg]);

     end;

  2: For j:=1 to stm.cw.vonalszam do begin

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

         Inc(ret[i,vrec.reteg]);

     end;

  3: For j:=1 to stm.cw.szovegszam do begin

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

         Inc(ret[i,szrec.reteg]);

     end;

  end;

end;

AssignFile(f,fn);

Rewrite(f);

WriteLn(f,stm.mapfile+' RÉTEGLISTA');

WriteLn(f,'');

WriteLn(f,'    Rétegnév                    Pont     Vonal   Felirat');

WriteLn(f,replicate('-',56));

For i:=0 to 255 do begin

  If ret[1,i]+ret[2,i]+ret[3,i]>0 then begin

    rrec := stm.RetegrekordKap(i);

    sor := PadR(IntToStr(i),' ',3)+' ';

    If rrec.retegnev[1]=#0 then

       sor:=sor+space(25)

    else sor:=sor+PadL(rrec.retegnev,' ',25);

    ossz[1]:=ossz[1]+ret[1,i];

    ossz[2]:=ossz[2]+ret[2,i];

    ossz[3]:=ossz[3]+ret[3,i];

    WriteLn(f,sor+' '+Format('%6d',[ret[1,i]])+'    '

                     +Format('%6d',[ret[2,i]])+'    '

                     +Format('%6d',[ret[3,i]]));

  end;

end;

WriteLn(f,replicate('-',56));

WriteLn(f,'Összesen:                     '+Format('%6d',[ossz[1]])+'    '

                              +Format('%6d',[ossz[2]])+'    '

                              +Format('%6d',[ossz[3]]));

closeFile(f);

end;

 

procedure TStListaGen.Jelkulcslistair(fn:string; uj: boolean);

begin

stm.StreamMeretek(stm.cw);

stm.tm[4].Seek(0,0);

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' JELKULCSLISTA');

WriteLn(f,'*');

WriteLn(f,'*     Réteg        X          Y       Pkód   Méret  szög    Obj Jelző');

WriteLn(f,'*'+replicate('-',80));

  For i:=1 to stm.cw.jelkulcsszam do begin

    stm.tm[4].Read(jrec,SizeOf(jrec));

    WriteLn(f, Format('%6d',[i])+ ' '+Format('%3d',[jrec.reteg])

                     +' '+ Format('%13.3f',[jrec.x])

                     +' '+ Format('%13.3f',[jrec.y])

                     +' '+ Format('%3d',[jrec.kod])

                     +' '+ Format('%6d',[jrec.meret])

                     +' '+ Format('%6.2f',[jrec.szog/100])

                     +' '+ Format('%6d',[jrec.obj])

                     +' '+ Format('%3d',[jrec.jelzo]));

  end;

WriteLn(f,'*'+replicate('-',80));

closeFile(f);

end;

 

procedure TStListaGen.Objectlistair(fn:string; uj: boolean);

begin

{

stm.StreamMeretek(stm.cw);

AssignFile(f,fn);

if uj then Rewrite(f) else

If Fileexists(fn) then reset(f) else Rewrite(f);

Append(f);

WriteLn(f,'*'+stm.mapfile+' PONTLISTA');

WriteLn(f,'*');

WriteLn(f,'*   No  kod Irsz HRSZ          Név');

WriteLn(f,'*'+replicate('-',82));

  stm.ObjStream.Seek(0,0);

  For i:=1 to stm.cw.objectszam do begin

    stm.ObjStream.Read(stm.objrec,SizeOf(objrec));

    WriteLn(f, Format('%6d',[i])+ ' '+Format('%3d',[objrec.objkod])

                     +' '+ objrec.objkozseg

                     +' '+ PadL(objrec.objHRSZ,' ',15)

                     +' '+ PadL(objrec.objNev,' ',40)

                     +' '+ Format('%11.3f',[objrec.objKoord.x])

                     +' '+ Format('%11.3f',[objrec.objKoord.y])

                     +' '+ Format('%6d',[objrec.objSzulo])

                     +' '+ Format('%6d',[objrec.objTip])

                     +' '+ Format('%11.2f',[objrec.objter])

                     +' '+ Format('%11.2f',[objrec.objker])

                     +' '+ Format('%3d',[objrec.objjelzo]));

  end;

WriteLn(f,'*'+replicate('-',82));

closeFile(f);

}

end;

 

procedure TStListaGen.Komplexlista;

begin

 ListaType := liComplex;

 Execute;

end;

 

Procedure FileMegmutat(editor:string;fn:string);

var f: Array[0..20] of Char;

  s: string;

begin

If FileExists(editor) then s:=editor else s := 'WRITE.EXE';

If FileExists(fn) then s:=s+' '+fn;

StrPCopy(f,s);

WinExec(f,SW_SHOWNORMAL);

end;

 

{ -------------  lISTADLG rutinok --------------}

 

procedure TListDialog.FormActivate(Sender: TObject);

begin

stm.StreamMeretek(stm.cw);

label4.Caption:=Format('%8d',[stm.cw.pontszam]);

label5.Caption:=Format('%8d',[stm.cw.vonalszam]);

label6.Caption:=Format('%8d',[stm.cw.szovegszam]);

label9.Caption:=Format('%8d',[stm.cw.jelkulcsszam]);

label1.Caption:=Format('%8d',[stm.cw.objectszam]);

end;

 

procedure TListDialog.Pontok1Click(Sender: TObject);

begin

Caption:='Pontok adatlistája';

With StListaGen do begin

     ListaType := liPont;

     Execute;

end;

{  listafile:=Copy(cw.filenev,1,Pos('.',cw.filenev)-1)+'.LST';

If Filenevbeker(listafile,'Pontlista mentése',F_Path(cw.filenev),'LST',

     'Lista file (*.LST)|*.LST|Minden file (*.*|*.*)') then begin

   StreamMeretek(cw);

   pontlistair(listafile,True);

   FileMegmutat(cw.texteditor,listafile);

end;

}

end;

 

procedure TListDialog.Vonalak1Click(Sender: TObject);

begin

Caption:='Vonalak adatlistája';

end;

 

procedure TListDialog.Szvegek1Click(Sender: TObject);

begin

Caption:='Feliratok adatlistája';

end;

 

procedure TListDialog.Rteglista1Click(Sender: TObject);

begin

Caption:='Rétegek adatlistája';

end;

 

procedure TListDialog.Jelkulcsok1Click(Sender: TObject);

begin

Caption:='Jelkulcsok adatlistája';

end;

 

procedure TListDialog.Objektum1Click(Sender: TObject);

begin

Caption:='Objektumok adatlistája';

end;

 

procedure TListDialog.Vonalakhosszal1Click(Sender: TObject);

begin

Caption:='Vonalak adatlistája';

end;

 

procedure TListDialog.CheckBox1Click(Sender: TObject);

begin

If CheckBox1.Checked then begin

  CheckBox4.Checked:=False;

end;

end;

 

procedure TListDialog.CheckBox4Click(Sender: TObject);

begin

If CheckBox4.Checked then begin

CheckBox1.Checked:=False;

CheckBox2.Checked:=False;

CheckBox3.Checked:=False;

CheckBox7.Checked:=True;

CheckBox8.Checked:=True;

CheckBox9.Checked:=True;

CheckBox10.Checked:=True;

end;

end;

 

procedure TListDialog.CheckBox5Click(Sender: TObject);

begin

CheckBox4.Checked:=False;

end;

 

procedure TListDialog.CheckBox6Click(Sender: TObject);

begin

SpinEdit1.Enabled:=CheckBox6.checked;

If CheckBox6.checked then SpinEdit1.Color:=clWhite

else SpinEdit1.Color:=clSilver;

end;

 

 

procedure TListDialog.BitBtn1Click(Sender: TObject);

begin

StListaGen.ListaGenerator;

end;

 

procedure TListDialog.Pont1Click(Sender: TObject);

begin

StListaGen.Listatype:=liPont;

end;

 

procedure TListDialog.Vonal1Click(Sender: TObject);

begin

StListaGen.Listatype:=liVonal;

end;

 

procedure TListDialog.Felirat1Click(Sender: TObject);

begin

StListaGen.Listatype:=liFelirat;

end;

 

procedure TListDialog.FormCreate(Sender: TObject);

begin

{  stl:=TStListaGen.Create(Application);}

end;

 

procedure TListDialog.FormDestroy(Sender: TObject);

begin

{  stl.Free;}

end;

 

end.