STDBMAP

Top  Previous  Next

unit Stdbmap;

 

interface

 

uses

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

Graphics, Controls, StdCtrls, Forms, Dialogs, Menus,

Szoveg, Szamok, FileCtrl, DsgnIntf, AlmType, StMap161;

 

type

TLreteg  = Array[0..255] of boolean;

TEltolas = (elLeft,elRight,elUp,elDown);

TVisibleRajzelem = (vPont, vVonal, vFelirat, vJelkulcs, vKitolto);

TVisibleSet      = set of TVisibleRajzelem;

 

 

TStellaMAP = class(TCustomControl)

private

  FAlapszin          : TColor;

  FPen               : TPen;

  FBrush             : TBrush;

  FGlobalDir         : string;      {Globális paraméterek könyvtára}

  FLocalDir          : string;      {Konkrét térkép dir.}

  FRajzmod           : TRajzmod;

  FMapFile           : string;      {Térkép file - trk,pt,dxf,lst}

  FRetegFile         : string;      {Réteg file *.rtg}

  FMAPAppend         : boolean;     {Uj térkép hozzáfűzése a régihez}

  FKoordLabel        : TLabel;

  FAdatLabel         : TLabel;

  FNagyitas          : extended;

  FOrigox            : double;

  FOrigoy            : double;

  FLatszik           : TVisibleSet;

  Fkozepkereszt      : boolean;

  FFixText           : TFont;

  FRetegCombo        : TCombobox;

  FAktReteg          : byte;

  FBoundsRect        : TRect;

  FCentrumx          : double;

  FCentrumy          : double;

  FTEXTkenyszer      : boolean;

  FPontszin          : TColor;

  FPontmeret         : integer;

  FHeight            : integer;

  FOrkereszt         : boolean;

  FSourceTEXT        : string;

  procedure SetAlapszin(Value: TColor);

  procedure SetPontszin(Value: TColor);

  procedure SetFPen(Value: TPen);

  procedure SetBrush(Value: TBrush);

  procedure SeTRajzmod(Value: TRajzmod);

  procedure SetMapFile(Value: string);

  procedure SetRetegFile(Value: string);

  procedure SetLatszik(Value: TVisibleSet);

  procedure SetKoordLabel(Value: TLabel);

  procedure SetAdatLabel(Value: TLabel);

  procedure SetNagyitas(Value: extended);

  procedure SetOrigox(Value: double);

  procedure SetOrigoy(Value: double);

  procedure SetKozepkereszt(Value: boolean);

  procedure SetRetegCombo(Value: TCombobox);

  procedure SetAktReteg(Value: byte);

  function  GetBoundsRect: TRect;

  procedure SetBoundsRect(Value: TRect);

  procedure SetCentrumx(Value: double);

  procedure SetCentrumy(Value: double);

  procedure SetTextKenyszer(Value: boolean);

  function  GetLathatoreteg(Index: integer):boolean;

  procedure SetLathatoreteg(Index: integer;Value: boolean);

  procedure SetPontmeret(Value: integer);

  procedure SetOrkereszt(Value: boolean);

  procedure WMSize(var Msg: TWMSize); message WM_SIZE;

  procedure SetSourceTEXT(Value:string);

protected

  ca: TCanvas;

  TRKSaveBitmap: TBitmap;       {Biztonsági másolat a TRK felülethez}

  kepmozgatas  : boolean;       {Kép mozgatás van folyamatban}

  orec_no      : longint;

  ohrsz        : string;

  Procedure Paint;override;

  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 KeyPress(var Key: Char); override;

public

  tm            : array[1..4] of TMemoryStream;

  cw            : TMapConfig; { Globális paraméterek }

  jelkulcsStream: TFileStream;{ Jelkulcsok filestream-ja}

  jelkHeader    : TJelkulcsHeader;

  jelkData      : TJelkulcsRecord;

  ObjStream     : TFileStream;  { Objektumok filestream-ja}

  fontstream    : TMemoryStream;{ Fontok filestream-je}

  rtgstream     : TMemoryStream;{ Rétegek a memóriában }

  lreteg        : TLreteg;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  property lathatoreteg[index:integer]: boolean read Getlathatoreteg

           write SetLathatoreteg;

  property Origox: double read FOrigox write SetOrigox;

  property Origoy: double read FOrigoy write SetOrigoy;

{    property Rec_no: longint read GetRec_no write SetRec_no;}

  procedure Ujrarajzol;

  procedure Filemegnyitas(fnev: string;poz: boolean);

  procedure Rajzol( T,B: TPoint; AMode: TPenMode; ujrajz: Boolean);

  procedure Pont_rajzolas(ca: TCanvas;t: TRect);

  procedure Szoveg_rajzolas(ca: TCanvas;cw: TMapConfig);

  procedure Jelkulcs_rajzolas(ca: TCanvas;cw: TMapConfig);

  procedure Jelkulcsrajz(ca: TCanvas;kod,x,y:integer;szog:real;cw: TMapConfig);

  procedure StreamMeretek(var cw:TMapConfig);

  procedure OrkeresztRajzol(ca:TCanvas);

  procedure precnull(var p: pontrecord);

  procedure vrecnull(var p: vonalrecord);

  procedure szrecnull(var p: szovegrecord);

  procedure rrecnull(var p: retegrecord);

  Procedure PontRekordIr(arec: longint; pr: Pontrecord);

  Procedure VonalRekordIr(arec: longint; vr: Vonalrecord);

  Procedure SzovegRekordIr(arec: longint; pr: Szovegrecord);

  procedure MinMaxKeres;

  procedure Alapratesz;

  Function  FontrekordKap(arec: word): Fontrecord;

  Function  FontStylusKap(fkod:integer): TFontStyles;

  function  MapToScreen(ca: TCanvas;x,y: Extended; cw: TMapConfig):Tpoint;

  function  ScreenToMap(mxy: TPoint; cw: TMapConfig):Tpoint2d;

  function  OrigoToCent:TPoint2D;

  function  CentToOrigo(c:TPoint2D):TPoint2D;

  procedure Centrumba(x,y:integer);

  procedure RetegMegnyit(fnev:string);

  procedure HRSZkereses;

  procedure HRSZRAKERES(hrsz:string;reteg:byte);

  Function  HRSZkeres(var sz: Szovegrecord;var ap: Longint): boolean;

  procedure HRSZComboFeltolt(var cb:TCombobox;reteg:byte);

  Function  HrszOsszerak(ds:TDataset):string;

  Procedure HrszSzetszed(hrsz:string;var h1,h2,h3,h4:string);

  property  BoundsRect: TRect read GetBoundsRect write SetBoundsRect;

  procedure Eltolas(Value:TEltolas);

published

  property Alapszin: TColor read FAlapszin write SetAlapszin;

  property Pontszin: TColor read FAlapszin write SetPontszin;

  property Pontmeret: integer read FPontmeret write SetPontmeret;

  Property Pen : TPen read FPen write SetFPen;

  Property Brush : TBrush read FBrush write SetBrush;

  property GlobalDir: string read FGlobalDir write FGlobalDir;

  property LocalDir: string read FLocalDir write FLocalDir;

  property RajzMod: TRajzmod read FRajzmod write SeTRajzmod;

  property MapFile: string read FMapFile write SetMapFile;

  property RetegFile: string read FRetegFile write SetRetegFile;

  property MAPAppend: boolean read FMAPAppend write FMAPAppend default False;

  property Nagyitas: extended read FNagyitas write SetNagyitas;

  Property KoordLabel : TLabel read FKoordLabel write SetKoordLabel;

  Property AdatLabel : TLabel read FAdatLabel write SetAdatLabel;

  property Latszik: TVisibleSet read FLatszik write SetLatszik

            default [vPont, vVonal, vFelirat];

  property kozepkereszt: boolean read Fkozepkereszt write Setkozepkereszt;

  property FixText: TFont read FFixText write FFixText;

  property RetegCombo: TComboBox read FRetegCombo write SetRetegCombo;

  property AktReteg: byte read FAktReteg write SetAktReteg;

  property Centrumx: double read FCentrumx write SetCentrumx;

  property Centrumy: double read FCentrumy write SetCentrumy;

  property TEXTkenyszer: boolean read FTEXTkenyszer write SetTEXTkenyszer;

  property Orkereszt: boolean read FOrkereszt write SetOrkereszt;

  property SourceTEXT: string read FSourceTEXT write SetSourceTEXT;

  property Align;

  property DragCursor;

  property DragMode;

  property Enabled;

  property Hint;

  property ParentShowHint;

  property PopupMenu;

  Property Top;

  Property Left;

  Property Height;

{    :integer read FHeight Write FHeight default 50;}

  Property Width default 50;

  property TabOrder;

  property TabStop;

  property Visible;

  Property OnDblClick;

  property OnClick;

  property OnDragDrop;

  property OnDragOver;

  property OnEndDrag;

  property OnEnter;

  property OnExit;

  property OnKeyDown;

  property OnKeyPress;

  property OnKeyUp;

  Property OnMouseDown;

  Property OnMouseMove;

  Property OnMouseUp;

end;

 

type

TDirProperty = class(TStringProperty)

public

  function GetAttributes: TPropertyAttributes; override;

  function GetValue: string; override;

  procedure SetValue(const Value: string); override;

  procedure Edit; override;

end;

 

type

TFileProperty = class(TStringProperty)

public

  FOpenDialog : TOpenDialog;

  function GetAttributes: TPropertyAttributes; override;

  function GetValue: string; override;

  procedure SetValue(const Value: string); override;

  procedure Edit; override;

end;

 

Var

Origin      : TPoint;        {rámutatási pont}

MovePt      : TPoint;        {elmozdulás a rámutatási ponthoz képest}

oldOrigin   : TPoint;

oldMovePt   : TPoint;

nWidth,nHeight   : Integer;  {nagyito keret meretei}

wrec,wrec1,wrec2 : Vonalrecord;

 

const

crMyCursor1  = 1;

crKicsinyito = 2;

crNagyito    = 3;

crKez        = 4;

crKereszt    = 5;

crHelp       = 6;

 

 

procedure Register;

 

implementation

 

{$R MAP1.DCR}

 

procedure Register;

begin

RegisterComponents('AL', [TStellaMAP]);

RegisterPropertyEditor(TypeInfo(string), TStellaMAP, 'LocalDir', TDirProperty);

RegisterPropertyEditor(TypeInfo(string), TStellaMAP, 'GlobalDir', TDirProperty);

RegisterPropertyEditor(TypeInfo(string), TStellaMAP, 'MapFile', TFileProperty);

RegisterPropertyEditor(TypeInfo(string), TStellaMAP, 'RetegFile', TFileProperty);

end;

 

constructor TStellaMAP.Create(AOwner:TComponent);

var i: integer;

  h: HCursor;

  a: real;

begin

inherited Create(AOwner);

For i:=1 to 4 do tm[i]:=TMemoryStream.Create;

rtgstream  := TMemoryStream.Create;

FontStream := TMemoryStream.Create;

Screen.Cursors[crMyCursor1] :=  LoadCursor(h, 'CURSOR_1');

Screen.Cursors[crNagyito] :=  LoadCursor(h, 'NAGYITO');

Screen.Cursors[crKicsinyito] :=  LoadCursor(h, 'KICSINYITO');

Screen.Cursors[crKez] :=  LoadCursor(h, 'KEZCURSOR');

Screen.Cursors[crKereszt] :=  LoadCursor(h, 'CURSOR_2');

Screen.Cursors[crHelp] :=  LoadCursor(h, 'HELPCURSOR');

FDataLink := TFieldDataLink.Create;

FDataLink.Control := Self;

FDataLink.OnDataChange := DataChange;

{

FDataLink.OnEditingChange := EditingChange;

FDataLink.OnUpdateData := UpdateData;

}

Alapratesz;

FHeight     := 99;

Height     := 100;

Width      := 100;

FPen       := TPen.Create;

FBrush     := TBrush.Create;

FCentrumx  := 0;

FCentrumy  := 0;

Nagyitas   := 0.01;

origox     := 730000.0;

origoy     := 310000.0;

latszik    := [vPont, vVonal, vFelirat];

Kozepkereszt := True;

alapszin   := clWhite;

Rajzmod    := rmNincs;

FFixtext   := TFont.Create;

TEXTkenyszer:=False;

With Fixtext do begin

  Name := 'System';

  Size := 10;

  Color:= clBlack;

end;

FMapfile    := '';

Retegfile   := '';

ohrsz       := '';

cw.orkereszttav:=100;

end;

 

 

destructor TStellaMAP.Destroy;

var i: integer;

begin

  FDataLink.Free;

  FDataLink := nil;

  For i:=1 to 4 do tm[i].Destroy;

   rtgstream.Destroy;

   FontStream.Destroy;

   FixText.Free;

   FPen.Free;

   FBrush.Free;

   inherited Destroy;

end;

 

procedure TStellaMAP.SetSourceTEXT(Value:string);

begin

If FSourceTEXT<>Value then begin

   FSourceTEXT:=Value;

   HRSZRakeres(Value,Aktreteg);

end;

end;

 

procedure TStellaMAP.WMSize(var Msg: TWMSize);

begin

  inherited;

  Ujrarajzol;

end;

 

procedure TStellaMAP.SetPontmeret(Value: integer);

begin

FPontmeret:=Value;

cw.Pontmeret:=Value;

invalidate;

end;

 

procedure TStellaMAP.SetLathatoreteg(Index: integer;Value: boolean);

begin

lreteg[index]:=Value;

invalidate;

end;

 

function TStellaMAP.GetLathatoreteg(Index: integer):boolean;

begin

Result:= lreteg[Index];

end;

 

function TStellaMAP.GetBoundsRect: TRect;

begin

Result := Rect(0,0,Width,Height);

end;

 

procedure TStellaMAP.SetBoundsRect(Value: TRect);

begin

FBoundsrect:=Value;

end;

 

{

procedure TStellaMAP.SetHeight(Value: integer);

var oh: integer;

begin

If Fheight<>Value then begin

  oh:=Fheight;

  Fheight:=Value;

  origoy:=origoy+nagyitas*(oh-Value)/2;

  Invalidate;

end;

end;

}

 

procedure TStellaMAP.SetTextKenyszer(Value: boolean);

begin

FTextKenyszer:=Value; Invalidate;

end;

 

procedure TStellaMAP.SetOrkereszt(Value: boolean);

begin

FOrkereszt:=Value;

Invalidate;

end;

 

procedure TStellaMAP.SetAlapszin(Value: TColor);

begin

If FAlapszin<>Value then begin

   FAlapszin:=Value;

   Canvas.Brush.Color:=Value;

   cw.alapszin:=Value;

   Invalidate;

end;

end;

 

procedure TStellaMAP.SetPontszin(Value: TColor);

begin

If FPontszin<>Value then begin

   FPontszin:=Value;

   cw.Pontszin:=Value;

   Invalidate;

end;

end;

 

procedure TStellaMAP.SetMapFile(Value: string);

var vandbf: integer;

begin

If FMapFile<>Value then begin

   FMapFile := Value;

   LocalDir := F_Path(FMapfile);

   RajzMod  := rmNincs;

   If (Retegfile='') and FileExists(ChangeFileExt(Value,'RTG'))

    then Retegfile:=ChangeFileExt(Value,'RTG');

   If not MAPAppend then Alapratesz;

   If Value<>'' then FileMegnyitas(FMapFile,True);

   Invalidate;

end;

end;

 

procedure TStellaMAP.SetFPen(Value:TPen);

begin

FPen.Assign(Value);

Invalidate;

end;

 

procedure TStellaMAP.SetBrush(Value: TBrush);

begin

FBrush.Assign(Value);

Invalidate;

end;

 

procedure TStellaMAP.SetRetegFile(Value: string);

var i: integer;

begin

If FRetegFile<>Value then begin

   FRetegFile := Value;

   If Value<>'' then RetegMegnyit(FRetegFile)

   else {rétegek alapértékei}

   rtgstream.Clear;

   For i:=0 to 255 do begin

     With rrec do begin

          retegszam   := i;

          retegnev    := Format('%3d',[i]);

          pontszin    := clBlack;

          vonalszin   := clGreen;

          vonalvastag := 1;

          vonalstylus := 0;

          szovegszin  := clBlack;

          fontnev     := 'Arial';

          fontmeret   := 10;

          fontstylus  := 0;

          vedett      := False;

     end;

     rtgstream.Write(rrec,SizeOf(rrec));

   end;

   Invalidate;

end;

end;

 

procedure TStellaMAP.SetAktReteg(Value: byte);

begin

If FAktReteg<>Value then begin

   FAktreteg:=Value mod 256;

end;

end;

 

procedure TStellaMAP.SetKozepkereszt(Value: boolean);

begin

If FKozepkereszt<>Value then begin

   FKozepkereszt := Value; cw.kozepkereszt:=Value;

   Invalidate;

end;

end;

 

procedure TStellaMAP.SetRetegCombo(Value: TCombobox);

begin

   FRetegCombo:=Value;

   If RetegFile<>'' then begin

      RetegMegnyit(RetegFile);

      RetegCombo.Itemindex:=AktReteg;

      RetegCombo.Text:=RetegCombo.Items[AktReteg];

   end;

   Invalidate;

end;

 

procedure TStellaMAP.SetLatszik(Value: TVisibleSet);

begin

If FLatszik<>Value then begin

FLatszik := Value;

If vpont in Value then cw.pontlatszik:=True else cw.pontlatszik:=False;

If vvonal in Value then cw.vonallatszik:=True else cw.vonallatszik:=False;

If vfelirat in Value then cw.szoveglatszik:=True else cw.szoveglatszik:=False;

If vjelkulcs in Value then cw.jelkulcslatszik:=True else cw.jelkulcslatszik:=False;

Invalidate;

end;

end;

 

procedure TStellaMAP.SetNagyitas(Value: extended);

var m,a,felx,fely: extended;

begin

Try

Value:=Abs(Value); If Value=0 then Value:=0.01;

cw.nagyitas:=Abs(cw.nagyitas); If cw.nagyitas=0 then cw.nagyitas:=0.00001;

If (cw.nagyitas <> Value) then begin

   felx := Width/(2*cw.nagyitas);

   fely := Height/(2*cw.nagyitas);

   origox := cw.origox+felx*(1-(cw.nagyitas/Value));

   origoy := cw.origoy+fely*(1-(cw.nagyitas/Value));

   cw.nagyitas:= Value;

   FNagyitas:=Value;

   {Semlegesit;}

   {m:=GetMeretarany;

   ComboBox2.Text:='1:'+Format('%6.0f',[m]);}

   Invalidate;

end;

except

On Exception do exit;

end;

end;

 

procedure TStellaMAP.SeTRajzmod(Value: TRajzmod);

begin

If FRajzmod<>Value then begin

   oldrmod:=FRajzmod;

   FRajzmod:=Value;

   cw.rmod := Value;

   Cursor:=crDefault;

   Case Value of

     rmNincs : begin

               end;

     rmNagyito:begin

                 Cursor:=crNagyito;

               end;

     rmKicsinyito:begin

                 Cursor:=crkicsinyito;

               end;

     rmCentrum:begin

                 Cursor:=crMyCursor1;

               end;

     rmAblak:  begin

               nWidth := Width div 4;

               nHeight:= Height div 4;

               cw.nkeret:=Rect((Width div 2)-(nWidth div 2),

                  (Height div 2)-(nHeight div 2),

                  (Width div 2)+(nWidth div 2),

                  (Height div 2)+(nHeight div 2));

               vanablak := True;

               end;

   end;

end;

end;

 

procedure TStellaMAP.SetCentrumx(Value: double);

var p: TPoint2d;

begin

   FCentrumx:=Value;

   p:=CentToOrigo(Point2d(Value,Origoy));

   Origox:=p.x;

   Invalidate;

end;

 

procedure TStellaMAP.SetCentrumy(Value: double);

var p: TPoint2d;

begin

   FCentrumy:=Value;

   p:=CentToOrigo(Point2d(Origox,Value));

   Origoy:=p.y;

   Invalidate;

end;

 

 

procedure TStellaMAP.SetOrigox(Value: double);

var p: TPoint2d;

begin

If FOrigox<>Value then begin

   FOrigox:=Value; cw.Origox:=Value;

   Centrumx:=OrigoTocent.x;

end;

end;

 

procedure TStellaMAP.SetOrigoy(Value: double);

begin

If FOrigoy<>Value then begin

   FOrigoy:=Value; cw.Origoy:=Value;

   Centrumy:=OrigoTocent.y;

end;

end;

 

 

procedure TStellaMAP.SetKoordLabel(Value:TLabel);

begin

   FKoordLabel:=Value;

   Invalidate;

end;

 

procedure TStellaMAP.SetAdatLabel(Value:TLabel);

begin

   FAdatLabel:=Value;

   Invalidate;

end;

 

procedure TStellaMAP.HRSZkereses;

var ap: longint;

begin

Rajzmod := rmHRSZker;

szrec.szoveg := InputBox('Keresés','HRSZ','');

If HRSZKeres(szrec,ap) then begin

  origox := szrec.X - (Width /2)/nagyitas;

  origoy := szrec.y - (Height/2)/nagyitas;

  kozepkereszt := True;

end;

end;

 

Function  TStellaMAP.HRSZkeres(var sz: Szovegrecord;var ap: Longint): boolean;

var s: string;

  i: integer;

begin

 StreamMeretek(cw);

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

 s := Alltrim(sz.szoveg);

 Result := False;

 For i:=1 to cw.szovegszam do begin

     tm[3].Read(sz,SizeOf(sz));

     If Alltrim(sz.szoveg)=s then begin

        ap:=i;

        Result := True;

        Exit;

     end;

 end;

end;

 

 

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

begin

Case Key of

VK_ADD     : begin Nagyitas:=2*Nagyitas; Key:=0;end;

VK_SUBTRACT: begin Nagyitas:=0.5*Nagyitas; Key:=0;end;

 

VK_LEFT    : Eltolas(elLeft);

VK_RIGHT   : Eltolas(elRight);

VK_UP      : Eltolas(elUp);

VK_DOWN    : Eltolas(elDown);

 

VK_RETURN  :

   Case Rajzmod of

   rmAblak   : MouseDown(mbMiddle,[ssMiddle],mousex,mousey);

   rmHRSZker : HRSZkereses;

   end;

VK_SPACE   : Ujrarajzol;

end;

end;

 

procedure TStellaMAP.KeyPress(var Key: Char);

begin

inherited KeyPress(Key);

If Key='+' then begin Nagyitas:=2*Nagyitas; Key:=#0;end;

If Key='-' then begin Nagyitas:=0.5*Nagyitas; Key:=#0;end;

If Key=#13 then begin

   Case Rajzmod of

   rmAblak   : MouseDown(mbMiddle,[ssMiddle],mousex,mousey);

   rmHRSZker : HRSZkereses;

   end;

end;

end;

 

procedure TStellaMAP.MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

var  ymax,my,i,j,el : integer;

   x1,y1,x2,y2 : integer;

   szog,alfa,beta,teru,ker: real;

   p,p1        : TPoint2D;

   pontvan,vanpont,vonalvan,talalt : boolean;

   RecNo       : longint;

   alappont,kp : TPoint2D;

   tp,tp1,tp2  : TPoint;

   d,d1,d2     : real;

   egy1,egy2   : TEgyenesfgv;

   tpp,tpp1,tpp2 : TPoint2d;

   s1,s2       : string;

   tp2d        : TPoint2D;

begin

inherited MouseDown(Button, Shift, X, Y);

mousex := x;

mousey := y;

oldOrigin := Origin;

oldMovePt := MovePt;

Origin := Point(X, Y);

MovePt := Origin;

ymax   := Height;

my     := ymax-y;

keppont := ScreenToMap(Point(x,ymax-y),cw);

 

If (Button = mbRight) and (RajzMod=rmNagyito) then RajzMod := rmKicsinyito;

If (Button = mbLeft) and (RajzMod=rmKicsinyito) then RajzMod := rmNagyito;

 

Case Rajzmod of

rmNagyito:    begin Centrumba(x,y); nagyitas:= 2*cw.nagyitas; end;

 

rmKicsinyito: begin Centrumba(x,y); nagyitas:= 0.5*cw.nagyitas; end;

 

rmCentrum:    begin Centrumba(x,y); end;

 

rmAblak: Case Button of

         mbLeft: begin

             nWidth  := Trunc(nWidth * 1.5);

             nHeight := Trunc(nHeight * 1.5);

             MouseMove(Shift,x,y);

           end;

         mbRight: begin

             nWidth  := Trunc(nWidth * 0.75);

             nHeight := Trunc(nHeight * 0.75);

             MouseMove(Shift,x,y);

           end;

         mbMiddle: begin

             Centrumba(x,y); nagyitas:= nagyitas * Width / nWidth;

             Rajzmod := oldrmod;

           end;

         end;

end;

 

end;

 

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

var x1,y1,x2,y2,ymax,my : integer;

  pt: TPoint;

  d,d1 : real;

  kp,kp1: TPoint2D;

  fRect,cRect: TRect;

  ca: TCanvas;

begin

inherited MouseMove(Shift,x,y);

mousex := x;  mousey := y;

oldMovePt := MovePt;

MovePt := Point(X, Y);

ymax   := Height;

my     := ymax-y;

keppont := ScreenToMap(Point(x,ymax-y),cw);

IF cw.nagyitas<>0 then begin

xx := cw.origox + x / cw.nagyitas;

yy := cw.origoy + my / cw.nagyitas;

 

If KoordLabel<>nil then

 (KoordLabel as TLabel).Caption:=Format('%9.3f',[xx])+':'+Format('%9.3f',[yy]);

end;

 

Case Rajzmod of

 

 rmNincs,rmHRSZ:

    If (Shift=[ssLeft]) then begin

       If not kepmozgatas then begin

         Canvas.Pen.Mode:=pmCopy;

         TRKSaveBitmap:=TBitmap.Create;

         TRKSaveBitmap.width  := Width;

         TRKSaveBitmap.height := height;

         If kozepkereszt then Kereszt(Canvas,clGreen);

         TRKSaveBitmap.Canvas.CopyRect(Canvas.Cliprect,Canvas,Canvas.Cliprect);

         If kozepkereszt then Kereszt(Canvas,clGreen);

         kepmozgatas:=True;

         Screen.Cursor := crKez;

       end else

       If (Origin.x<>MovePt.x) and (Origin.y<>MovePt.y) then begin

         Try

         Canvas.Draw(MovePt.x-Origin.x,MovePt.y-Origin.y,

                TRKSaveBitmap);

         ca:=Canvas;

         ClsKivul(ca,MovePt.x-Origin.x,MovePt.y-Origin.y,alapszin);

         If kozepkereszt then Kereszt(Canvas,clGreen);

         except

           On Exception do exit;

         end;

       end;

    end;

 

 rmAblak: begin

         vanablak := True;

         If not semleges then

         Rajzol(Point(cw.nkeret.left,cw.nkeret.top),

                Point(cw.nkeret.right,cw.nkeret.bottom),pmNotXor,False)

         else semleges := False;

         cw.nkeret:=Rect(x-(nWidth div 2),y-(nHeight div 2),

                       x+(nWidth div 2),y+(nHeight div 2));

         Rajzol(Point(cw.nkeret.left,cw.nkeret.top),

                Point(cw.nkeret.right,cw.nkeret.bottom),pmNotXor,False);

        end;

 end;

end;

 

procedure TStellaMAP.MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

 Inherited MouseUp(Button,Shift,X, Y);

 Case Rajzmod of

 rmNincs,rmHRSZ:

    begin

    If kepmozgatas then begin

       TRKSaveBitmap.Free;

       x:=(x-Origin.x); y:=(y-Origin.y);

       origox := origox - x/cw.nagyitas;

       origoy := origoy + y/cw.nagyitas;

       If cw.kozepkereszt then Kereszt(Canvas,clGreen);

       invalidate;

    end;

    Cursor := crDefault;

    Screen.Cursor:=crDefault;

    kepmozgatas:=False;

    end;

 end;

end;

 

Procedure TStellaMAP.Paint;

begin

If not kepmozgatas then begin

UjraRajzol;

{  inherited Paint;}

end;

end;

 

procedure TStellaMAP.Eltolas(Value:TEltolas);

var el: real;

  xm,ym: integer;

begin

   el := (100/nagyitas);

   xm:=0; ym:=0;

   If Value=elLeft  then begin

      origox:=origox+el; xm:=-100; end;

   If Value=elRight then begin

      origox:=origox-el; xm:=+100; end;

   If Value=elUp   then begin

      origoy:=origoy+el; ym:=+100; end;

   If Value=elDown  then begin

      origoy:=origoy-el; ym:=-100; end;

   invalidate;

end;

 

 

{----------------------- Rutinok -------------------------------------}

 

{ Teljes térkép felrajzolása }

procedure TStellaMAP.Ujrarajzol;

var cur: TCursor;

  t  : TRect;

begin

cur:=Screen.Cursor; Screen.Cursor:=crHourGlass;

StreamMeretek(cw);

Ca:=Canvas;

t:= Canvas.cliprect;

SetPen(ca,clBlack,1,psSolid,pmCopy);

ClsRect(Ca,t,cw.alapszin);

If orkereszt then OrkeresztRajzol(ca);

ca.Brush.Color:=clWhite;

ca.Brush.style:=bsClear;

Vonal_rajzolas(tm[2],rtgstream,lreteg,cw,ca,t);

{Kitolto_rajzolas(ca,cw);}

Szoveg_rajzolas(ca,cw);

Pont_rajzolas(ca,t);

Jelkulcs_rajzolas(ca,cw);

If kozepkereszt then Kereszt(ca,clGreen);

{GrafikusAdatok(kepernyo);}

Screen.Cursor:=cur;

end;

 

procedure TStellaMAP.Rajzol( T,B: TPoint; AMode: TPenMode; ujrajz: Boolean);

var pe: TPen;

  br: TBrush;

begin

pen.Assign(Canvas.Pen); brush.Assign(Canvas.Brush);

With Canvas do

begin

  With Pen do begin

     Color:=clBlack;

     Style:=psSolid;

     Mode :=AMode;

  end;

  Brush.Color:=clWhite;

  Brush.style:=bsClear;

  If (T.X<>B.x) OR (T.Y<>B.Y) then

  begin

      If ujrajz then

          case RajzMod of

          rmPont :      Pen.Color := cw.pontszin;

          rmVonal:      Pen.Color := rrec.vonalszin;

          rmFelirat :   Pen.Color := rrec.szovegszin;

          rmvonaltorol: Pen.Color := cw.alapszin;

          rmTermanual,rmvonalkijelol,rmMetszes,rmVetites,rmIvmetszes,

             rmBemeres,rmKituzes:

             begin Pen.Color := clRed; Pen.Width:=2; end;

          end;

      case RajzMod of

      rmPont:  Rectangle(T.X-1,T.Y-1,T.X+1,T.Y+1);

      rmvonal,rmvonalkijelol,rmTavmeres,rmvonaltorol,rmSokszog,

      rmTermanual,rmMetszes,rmVetites,rmIvmetszes,rmBemeres,rmKituzes,

      rmElometszes,rmHatrametszes:

          begin

              MoveTo(T.X, T.Y); LineTo(B.X, B.Y);

          end;

      rmAblak      : Rectangle(T.X, T.Y, B.X, B.Y);

      rmkepterulet,rmablakkijelol : Rectangle(T.X, T.Y, B.X, B.Y);

      rmNegyszog   : Rectangle(T.X, T.Y, B.X, B.Y);

      rmEllipszis  : Ellipse(T.X, T.Y, B.X, B.Y);

      end;

  end;

end;

Canvas.Pen.Assign(pen); Canvas.Brush.Assign(brush);

end;

 

procedure TStellaMAP.Pont_rajzolas(ca: TCanvas;t: TRect);

var i,x,y,x1,y1: integer;

  d,szog: real;

  ymax: integer;

  prec: pontrecord;

  rrec: retegrecord;

  kep: TRect2D;

label 1;

begin

If cw.pontszam>0 then begin

With ca do

  if cw.pontlatszik and (cw.pontszam>0) then

  begin

  kep:=Rect2D(origox+t.left/nagyitas, origoy+t.top/nagyitas,

          origox+t.right/nagyitas, origoy+t.bottom/nagyitas);

 

  ymax := Cliprect.bottom;

  SetPen(ca,clBlack,1,psSolid,pmCopy);

  IF not TEXTkenyszer then begin

     Font.Size:= Trunc(cw.nagyitas);

     If Font.Size<2 then Font.Size:=2;

  end;

  Font.Color:=cw.pontszin;

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

  For i:=1 to cw.pontszam do begin

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

    If (((prec.jelzo and 1)=0) or (cw.toroltek)) then begin

     If PontInKep(prec.x,prec.y,kep) then begin

        x:=Trunc(cw.nagyitas*(prec.x-cw.origox));

        y:=ymax-Trunc(cw.nagyitas*(prec.y-cw.origoy));

       If (cw.toroltek and ((prec.jelzo and 1)=1)) then

         SetPen(ca,clRed,4,psdot,pen.mode);

       If cw.kijelolesek and (GetBit(prec.jelzo,7)=1) then

         SetPen(ca,clBlue,2,psSolid,pmCopy);

       If prec.jelzo=0 then SetPen(ca,cw.pontszin,1,psSolid,pen.mode);

       if (csakkijelolesek and (GetBit(prec.jelzo,7)=1)) or

          (csaktoroltek and ((prec.jelzo and 1)=1)) or

          (not csakkijelolesek) and (not csaktoroltek) then

       begin

       Rectangle(x-cw.pontmeret,y-cw.pontmeret,x+cw.pontmeret,y+cw.pontmeret);

       If cw.pontszamlatszik then TextOut(x+2,y+2,IntToStr(prec.No));

       end;

    end; end;

  end;

  Pen.Mode := pmCopy;

  Pen.Style := psSolid;

  end;

Screen.Cursor:=crDefault;

end;

end;

 

 

procedure TStellaMAP.szoveg_rajzolas(ca: TCanvas;cw: TMapConfig);

var i,x,y,x1,y1: integer;

  t,t1: TRect;

  fele: TPoint;

  d,szog: real;

  meret: Longint;

  ymax: integer;

  Rgn: HRgn;

  oki: boolean;

  rmod: TRajzmod;

  szrec: szovegrecord;

  rrec: retegrecord;

  pe: TPen;

label 1;

begin

With ca do

  if cw.szoveglatszik then

  begin

  pe:=Pen;

  t := ClipRect;

  Rgn := CreateRectRgn(t.left,t.top,t.right,t.bottom);

  ymax := t.bottom;

  IF not TEXTkenyszer then begin

     Font.Size:= Trunc(cw.nagyitas);

     If Font.Size<2 then Font.Size:=2;

  end else Ca.Font.Assign(FixText);

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

  meret := SizeOf(szrec);

  For i:=1 to cw.szovegszam do begin

    tm[3].Read(szrec,meret);

    If lreteg[szrec.reteg] and (((szrec.jelzo and 1)=0) or (cw.toroltek)) then begin

     x := Trunc(cw.nagyitas*(szrec.x-cw.origox));

     y := ymax-Trunc(cw.nagyitas*(szrec.y-cw.origoy));

     If PtInRegion(Rgn,x,y) then begin

            If Font.Size>0 then begin

               x := x-Trunc(ca.Font.height*COS(Radian(90+szrec.szog/10)));

               y := y+Trunc(ca.Font.height*SIN(Radian(90+szrec.szog/10)));

               If (cw.toroltek and ((szrec.jelzo and 1)=1)) then begin

                  SetPen(ca,clRed,4,psdot,pen.mode);

                  Font.Color := clSilver;

                  Rectangle(x-cw.pontmeret,y-cw.pontmeret,x+cw.pontmeret,y+cw.pontmeret);

               end;

               If cw.kijelolesek and (GetBit(szrec.jelzo,7)=1) then begin

                  SetPen(ca,clBlue,2,psdot,pen.mode);

                  Font.Color:=clBlue;

                  Rectangle(x-cw.pontmeret,y-cw.pontmeret,x+cw.pontmeret,y+cw.pontmeret);

               end;

               If (csaktoroltek and ((szrec.jelzo and 1)=1)) or (not csaktoroltek)

               then begin

               If szrec.jelzo=0 then begin

                  rrec := RetegrekordKap(rtgstream,szrec.reteg);

                  IF not TEXTkenyszer then begin

                     Font.Name  := rrec.fontnev;

                     Font.size  := Trunc(cw.nagyitas * rrec.fontmeret/4);

                     Font.Style := FontStylusKap(rrec.fontstylus);

                  end;

                  Font.Color := rrec.szovegszin;

               end;

             RotText(ca,x,y,szrec.szoveg,szrec.szog);

            end;

            end;

     end;

    end;

  end;

  Pen:=pe;

  {Pen.Mode := pmCopy;

  Pen.Style := psSolid;}

  end;

1:DeleteObject(Rgn);

Screen.Cursor:=crDefault;

end;

 

procedure TStellaMAP.Jelkulcs_rajzolas(ca: TCanvas;cw: TMapConfig);

var i,x,y,x1,y1: integer;

  t,t1: TRect;

  fele: TPoint;

  d,szog: real;

  meret: Longint;

  ymax: integer;

  Rgn: HRgn;

  prec: pontrecord;

  rrec: retegrecord;

begin

If cw.jelkulcsszam>0 then begin

With ca do

  if cw.jelkulcslatszik and (cw.jelkulcsszam>0)then

  begin

  t := ClipRect;

  Rgn := CreateRectRgn(t.left,t.top,t.right,t.bottom);

  ymax := t.bottom;

  Pen.Color :=cw.pontszin;

  IF not TEXTkenyszer then begin

     Font.Size:= Trunc(cw.nagyitas);

     If Font.Size<2 then Font.Size:=2;

  end else ca.Font.Assign(FixText);

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

  For i:=1 to cw.jelkulcsszam do begin

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

    If lreteg[jrec.reteg] and ((jrec.jelzo and 1)=0) then begin

     x:=Trunc(cw.nagyitas*(jrec.x-cw.origox));

     y:=ymax-Trunc(cw.nagyitas*(jrec.y-cw.origoy));

     If PtInRegion(Rgn,x,y) then begin

       If (cw.toroltek and ((jrec.jelzo and 1)=1)) then

         SetPen(ca,clRed,4,psdot,pen.mode);

       If cw.kijelolesek and (GetBit(jrec.jelzo,7)=1) then begin

         SetPen(ca,clBlue,2,psdot,pen.mode);

         Rectangle(x-cw.pontmeret,y-cw.pontmeret,x+cw.pontmeret,y+cw.pontmeret);

       end;

       If prec.jelzo=0 then

         SetPen(ca,cw.pontszin,1,psSolid,pen.mode);

       if (csakkijelolesek and (GetBit(jrec.jelzo,7)=1)) or

          (csaktoroltek and ((jrec.jelzo and 1)=1)) or

          (not csakkijelolesek) and (not csaktoroltek) then

          Jelkulcsrajz(Canvas,jrec.kod,x,y,jrec.szog,cw);

     {If cw.jelkulcslatszik then TextOut(x+2,y+2,IntToStr(jrec.No));}

    end; end;

  end;

  Pen.Mode := pmCopy;

  Pen.Style := psSolid;

  end;

DeleteObject(Rgn);

Screen.Cursor:=crDefault;

end;

end;

 

procedure TStellaMAP.Jelkulcsrajz(ca: TCanvas;kod,x,y:integer;szog:real;cw: TMapConfig);

var ii:integer;

  szorzo: real;

  po,p1,p2,p11,p22: TPoint2d;

begin

  szorzo:=cw.jelkulcsmeret*cw.nagyitas;

  JelkulcsStream.Seek(kod*SizeOf(jelkHeader),0);

  JelkulcsStream.Read(jelkHeader,SizeOf(jelkHeader));

  JelkulcsStream.Seek(jelkHeader.jkcim,0);

  po.x:=0; po.y:=0;

      For ii:=1 to jelkHeader.jkdb do begin

          JelkulcsStream.Read(jelkDATA,SizeOf(jelkDATA));

          With jelkDATA do begin

          p11.x:=szorzo*jelkDATA.x1;

          p11.y:=szorzo*jelkDATA.y1;

          p22.x:=szorzo*jelkDATA.x2;

          p22.y:=szorzo*jelkDATA.y2;

          If szog<>0 then begin

            p1:=Elforgatas(p11,po,Radian(180+szog/100));

            p2:=Elforgatas(p22,po,Radian(180+szog/100));

          end else begin

            p1.x:=p11.x; p1.y:=p11.y;

            p2.x:=p22.x; p2.y:=p22.y;

          end;

          x1 := Trunc(p1.x);  y1 := Trunc(p1.y);

          x2 := Trunc(p2.x);  y2 := Trunc(p2.y);

          end;

      If homogenrajz then Ca.Pen.Color:=cw.pontszin else

         Ca.pen.color:=jelkDATA.szin;

      Ca.pen.width:=2*jelkDATA.vastag;

      Case jelkDATA.kod of

      1: Ca.Pixels[x+jelkDATA.x1,y+jelkDATA.y1]:=jelkDATA.szin;

      2: begin

         Ca.MoveTo(x+jelkDATA.x1,y+jelkDATA.y1);

         Ca.LineTo(x+jelkDATA.x2,y+jelkDATA.y2);

         end;

      3: Ca.Ellipse(x+jelkDATA.x1,y+jelkDATA.y1,x+jelkDATA.x2,y+jelkDATA.y2);

      end;

   end;

end;

 

procedure TStellaMAP.OrkeresztRajzol(ca:TCanvas);

var t: TRect; pe: TPen;

  kp,kp0: TPoint2d;

  kx,ky: integer;

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

  ymax: integer;

begin

  SetPen(ca,cw.orkeresztSzin,1,psSolid,pmCopy);

With ca do begin

  If cw.orkeresztStilus=3 then pen.style:= psDot else pen.style:= psSolid;

  t := ClipRect;  ymax := t.bottom;

    tav:= cw.nagyitas*cw.orkereszttav;

    marx := -Maradek(cw.origox,cw.orkereszttav);

    mary := -Maradek(cw.origoy,cw.orkereszttav);

    kp.x := tav*marx;

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

  If (tav>=2)  then

  If (cw.orkeresztStilus in [1,2]) then begin

  While kp.x<=t.right do begin

  While kp.y<=t.bottom do begin

     Case cw.orkeresztStilus of

     2: begin

         MoveTo(Trunc(kp.x)-4,ymax-Trunc(kp.y));LineTo(Trunc(kp.x)+5,ymax-Trunc(kp.y));

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

        end;

     1: begin

         Pixels[Trunc(kp.x),ymax-Trunc(kp.y)]:= cw.orkeresztSzin;

        end;

     end;

     kp.y := kp.y+tav;

  end;

     kp.x:=kp.x+tav;

     kp.y := kp0.y;

  end;

  end else begin

 

  While kp.x<=t.right do begin

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

     Case cw.orkeresztStilus of

     0,3: LineTo(Trunc(kp.x),t.bottom);

     end;

      kp.x:=kp.x+tav;

  end;

  While kp.y<=t.bottom do begin

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

     Case cw.orkeresztStilus of

     0,3: LineTo(t.right,ymax-Trunc(kp.y));

     end;

     kp.y:=kp.y+tav;

  end;

  end;

end;

end;

 

 

procedure TStellaMAP.precnull(var p: pontrecord);

begin

With P do begin

  No   := 0;

  x    := 0;

  y    := 0;

  pkod := 0;

  reteg:= 0;

  info := 0;

end;

end;

 

procedure TStellaMAP.vrecnull(var p: vonalrecord);

begin

With p do begin

reteg  := 0;

x1:=0; y1:=0; z1:=0;

x2:=0; y2:=0; z2:=0;

vastag :=0;

tipus  :=0;

obj1   :=0;

obj2   :=0;

jelzo  :=0;

end;

end;

 

procedure TStellaMAP.szrecnull(var p: szovegrecord);

begin

With P do begin

     reteg  := 0;

     x      := 0;

     y      := 0;

     szoveg := space(20);

     font   := 0;

     szeles := 1;

     stilus := 0;

     szog   := 0;

     obj    := 0;

     jelzo  := 0;

end;

end;

 

procedure TStellaMAP.rrecnull(var p: retegrecord);

begin

With P do begin

retegszam   :=0;

retegnev    :=space(20);

pontszin    :=clBlack;

vonalszin   :=clBlack;

vonalvastag :=1;

vonalstylus :=0;

szovegszin  :=clGreen;

fontnev     :='Arial';

fontmeret   :=10;

fontstylus  :=0;

vedett      :=False;

end;

end;

 

Procedure TStellaMAP.PontRekordIr(arec: longint; pr: Pontrecord);

begin

with tm[1] do begin

  Seek(arec * SizeOf(pr),0);

  Write(pr,SizeOf(pr));

end;

end;

 

Procedure TStellaMAP.VonalRekordIr(arec: longint; vr: Vonalrecord);

begin

with tm[2] do begin

  Seek(arec * SizeOf(vr),0);

  Write(vr,SizeOf(vr));

end;

end;

 

Procedure TStellaMAP.SzovegRekordIr(arec: longint; pr: Szovegrecord);

begin

with tm[3] do begin

  Seek(arec * SizeOf(pr),0);

  Write(pr,SizeOf(pr));

end;

end;

 

procedure TStellaMAP.Filemegnyitas(fnev: string;poz: boolean);

Type Tdxfmod = (HEADER,ENTITIES);

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

var  dxfmod: Tdxfmod;

   dxfelozo,rmuj: Tdxfelozo;

   fn,fpath,sor: string;

   f: file; ft: TEXTFILE;

   resu: word;

   i: longint;

   jrec: Jelkulcsrecord;

begin

 

Try

  fn := fnev;

  If not FileExists(fn) then begin

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

     exit;

  end;

  Screen.Cursor:=crHourGlass;

  fnev:=F_Name(fnev);

  fpath:=F_Path(fn);

  cw.filetipus := UpperCase(F_Ext(fn));

 

  {Objinit(fpath+'\'+fnev+'.obj');}

 

If cw.filetipus = 'TRK' then

begin

  fn:= fpath+'\'+fnev+'.trk';

  If FileExists(fn) then begin

     AssignFile(f,fn);

     Reset(f,1);

     Repeat

           BlockRead(f,prec,Sizeof(prec),Resu);

           If Resu=SizeOf(prec) then tm[1].Write(prec,SizeOf(prec));

     Until Resu<>SizeOf(prec);

     CloseFile(f);

  end;

     fn:= fpath+'\'+fnev+'.lin';

  If FileExists(fn) then begin

     AssignFile(f,fn);

     Reset(f,1);

     Repeat

           BlockRead(f,vrec,Sizeof(vrec),Resu);

           If Resu=SizeOf(vrec) then tm[2].Write(vrec,SizeOf(vrec));

     Until Resu<>SizeOf(vrec);

     CloseFile(f);

  end;

     fn:= fpath+'\'+fnev+'.szv';

  If FileExists(fn) then begin

     AssignFile(f,fn);

     Reset(f,1);

     Repeat

           BlockRead(f,szrec,Sizeof(szrec),Resu);

           If Resu=SizeOf(szrec) then tm[3].Write(szrec,SizeOf(szrec));

     Until Resu<>SizeOf(szrec);

     CloseFile(f);

  end;

     fn:= fpath+'\'+fnev+'.jlk';

  If FileExists(fn) then begin

     AssignFile(f,fn);

     Reset(f,1);

     Repeat

           BlockRead(f,jrec,Sizeof(jrec),Resu);

           If Resu=SizeOf(jrec) then tm[4].Write(jrec,SizeOf(jrec));

     Until Resu<>SizeOf(jrec);

     CloseFile(f);

  end;

     fn:= fpath+'\'+fnev+'.rtg';

  If FileExists(fn) then begin

     AssignFile(f,fn);

     Reset(f,SizeOf(lreteg[0]));

     For i:=0 to 255 do begin

         BlockRead(f,lreteg[i],Sizeof(lreteg[i]),Resu);

     end;

     CloseFile(f);

  end;

end;

 

If cw.filetipus = 'PT' then

begin

  AssignFile(f,fn);

  Reset(f,1);

    BlockRead(f,ITRpHeader,Sizeof(ITRpHeader),Resu);

  Repeat

    BlockRead(f,ITRPREC,Sizeof(ITRprec),Resu);

    If Resu=SizeOf(ITRprec) then

    begin

         prec.reteg:= ITRprec.reteg;

         prec.No   := ITRprec.No;

         prec.x    := ITRprec.x/100;

         prec.y    := ITRprec.y/100;

         prec.z    := ITRprec.z/100;

         prec.pkod := ITRprec.pkod;

         prec.info := 0;

         prec.obj  := 0;

         If ITRprec.azonosito=0 then prec.jelzo:=1 else

         prec.jelzo:= 0;

         If (prec.x+prec.y+prec.no)<>0 then

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

    end;

  Until Resu<>SizeOf(ITRprec);

  CloseFile(f);

 

  { Vonalak beolvasása }

  AssignFile(f,fpath+'\'+fnev+'.el');

  Reset(f,1);

    BlockRead(f,ITRvHeader,Sizeof(ITRvHeader),Resu);

  Repeat

    BlockRead(f,ITRvREC,Sizeof(ITRvrec),Resu);

    If Resu=SizeOf(ITRvrec) then

    If (ITRVrec.x1<>0) and (ITRVrec.x2<>0) then

    begin

         vrec.reteg:= ITRvrec.reteg;

         vrec.x1   := ITRvrec.y1/100;

         vrec.y1   := ITRvrec.x1/100;

         vrec.z1   := 0;

         vrec.x2   := ITRvrec.y2/100;

         vrec.y2   := ITRvrec.x2/100;

         vrec.z2   := 0;

         vrec.vastag := 0;

         vrec.tipus  := 0;

         vrec.obj1  := 0;

         vrec.obj2  := 0;

         If ITRvrec.azonosito=0 then vrec.jelzo:=1 else

         vrec.jelzo:=0;

         {If (vrec.x1+vrec.y1+vrec.reteg)<>0 then}

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

    end;

  Until Resu<>SizeOf(ITRvrec);

 

  { Jelkulcsok beolvasása }

  AssignFile(f,fpath+'\'+fnev+'.SI');

  Reset(f,1);

    BlockRead(f,ITRjkHeader,Sizeof(ITRjkHeader),Resu);

  Repeat

    BlockRead(f,ITRjkrec,Sizeof(ITRjkrec),Resu);

    If Resu=SizeOf(ITRjkrec) then

    begin

         jrec.kod   := ITRjkrec.jkkod-1;

         jrec.reteg := ITRjkrec.reteg;

         jrec.x     := ITRjkrec.y/100;

         jrec.y     := ITRjkrec.x/100;

         jrec.meret := 100;

         jrec.szog  := ITRjkrec.jkszog;

         jrec.obj   := 0;

         jrec.jelzo := 0;

         If ITRjkrec.jkkod>0 then tm[4].Write(jrec,SizeOf(jrec));

    end;

  Until Resu<>SizeOf(ITRjkrec);

  CloseFile(f);

 

  { Szövegek beolvasása }

  AssignFile(f,fpath+'\'+fnev+'.tx');

  Reset(f,1);

    BlockRead(f,ITRtHeader,Sizeof(ITRtHeader),Resu);

  Repeat

    BlockRead(f,ITRtREC,Sizeof(ITRtrec),Resu);

    If Resu=SizeOf(ITRtrec) then

    begin

         szrec.reteg := ITRtrec.reteg;

         szrec.x     := ITRtrec.y1/100;

         szrec.y     := ITRtrec.x1/100;

         szrec.szoveg:= CsakBetu(ITRtrec.Text);

         szrec.font  := 0;

         szrec.szeles:= 0;

         szrec.stilus:= 0;

         szrec.szog  := 10 * Trunc(ITRtrec.szog / 91);

         szrec.obj   := 0;

         If ITRtrec.azonosito=0 then szrec.jelzo:=1 else

         szrec.jelzo:=0;

         If szrec.szoveg<>'' then

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

    end;

  Until Resu<>SizeOf(ITRtrec);

  CloseFile(f);

 

end;

 

 

  cw.filetipus := UpperCase(F_Ext(fn));

  cw.valtozott := False;

  If poz then MinMaxKeres else

  Ujrarajzol;

except

  Raise Exception.Create('Filenyitási hiba!');

  If (cw.filetipus = 'LST') or (cw.filetipus = 'DXF') then

  CloseFile(ft) else CloseFile(f);

  Alapratesz;

  Screen.Cursor:=crDefault;

end;

  Screen.Cursor:=crDefault;

end;

 

{ StreamMeretek

Meghatározza a max pont,vonal,szöveg számot }

procedure TStellaMAP.StreamMeretek(var cw:TMapConfig);

var jrec: Jelkulcsrecord;

begin

cw.pontszam    := tm[1].Size div SizeOf(prec);

cw.vonalszam   := tm[2].Size div SizeOf(vrec);

cw.szovegszam  := tm[3].Size div SizeOf(szrec);

cw.jelkulcsszam:= tm[4].Size div SizeOf(jrec);

{

If vanobject then cw.objectszam := ObjStream.Size div SizeOf(objrec)

else cw.objectszam:=0;}

end;

 

 

procedure TStellaMAP.MinMaxKeres;

var xmin,xmax,ymin,ymax : real;

  nagyx,nagyy : real;

  p: TPoint2d;

  i,k: longint;

  spx,spy: extended; {súlypont}

begin

 

xmin:=1e+30; xmax:=-1e+30;

ymin:=1e+30; ymax:=-1e+30;

cw.sulypont.x:=0;

cw.sulypont.y:=0;

StreamMeretek(cw);

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

   k:=0; spx:=0; spy:=10;

For i:=1 to cw.vonalszam do begin

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

  If vrec.jelzo=0 then begin

     If vrec.x1<xmin then xmin:=vrec.x1;

     If vrec.x1>xmax then xmax:=vrec.x1;

     If vrec.y1<ymin then ymin:=vrec.y1;

     If vrec.y1>ymax then ymax:=vrec.y1;

     {

     cw.sulypont.x:=cw.sulypont.x+vrec.x1;

     cw.sulypont.y:=cw.sulypont.y+vrec.y1;

     k:=k+1;

     }

     spx:=spx+vrec.x1/cw.vonalszam;

     spy:=spy+vrec.y1/cw.vonalszam;

  end;

end;

 

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

cw.sulypont.x:=spx;

cw.sulypont.y:=spy;

{  If k>0 then begin

   cw.sulypont.x:=cw.sulypont.x/k;

   cw.sulypont.y:=cw.sulypont.y/k;

end;}

nagyx := Width /(xmax - xmin);

nagyy := Height/(ymax - ymin);

If nagyx > nagyy Then nagyx:= nagyy;

p := CentToOrigo(Point2D(cw.sulypont.x,cw.sulypont.y));

origox := p.x;  origoy := p.y;

nagyitas := nagyx;

end;

 

procedure TStellaMAP.Alapratesz;

var i: longint;

begin

DecimalSeparator:='.';

With cw do begin

filenev  := '';

filetipus:= '';

valtozott:= False;

aktreteg := 0;

pontszin := clWhite;

pontmeret:= 1;

pontszam := 0;

vonalszam:= 0;

szovegszam:=0;

jelkulcsszam:=0;

 

nagyitas := 1;

minx     := 0;

maxx     := 0;

miny     := 0;

maxy     := 0;

nkeret   := Rect(0,0,Width div 4,Trunc(1.1*Height/4));

             {nagyító keret}

If aspx<0 then aspx:=1;

If tentativtures<4 then tentativtures:=4;

pr.peldany:=1;

pr.paspx:=1; pr.paspy:=1;

pr.vonalvastag:=1;

pr.pbetumeret :=1;

end;

 

{Minden réteg látható}

For i:=0 to 255 do lreteg[i]:=True;

For i:=1 to 4 do tm[i].Clear;           {törli a memory streameket}

RajzMod := rmNincs;

end;

 

{ Rétegfile stream megnyitása }

procedure TStellaMAP.RetegMegnyit(fnev:string);

var f: file of retegrecord;

  resu: word;

  I: integer;

begin

If FileExists(fnev) then begin

     {$I-}

     AssignFile(f,fnev);

     Reset(f);

     rtgStream.Seek(0,0);

     If Retegcombo<>nil then RetegCombo.Clear;

     For i:=0 to 255 do begin        {256 réteg van}

         Read(f,rrec);

         If IOResult<>0 then RRecNull(rrec);

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

         If Retegcombo<>nil then RetegCombo.Items.Add(Format('%3d',[rrec.retegszam])

            + ' ' + rrec.retegnev);

     end;

     CloseFile(f);

{       cw.retegfile:=fnev;}

     {$I+}

end else RetegFile:='';

end;

 

 

Function TStellaMAP.FontrekordKap(arec: word): Fontrecord;

begin

with Fontstream do begin

  Seek(arec * SizeOf(frec),0);

  Read(result,SizeOf(frec));

end;

end;

 

{Fontstílus kinyerés: f = index, fs = jelenlegi stílus }

Function TStellaMAP.FontStylusKap(fkod:integer): TFontStyles;

begin

Case fkod of

0: Result:=[];

1: Result:=[fsBold];

2: Result:=[fsItalic];

3: Result:=[fsUnderline];

4: Result:=[fsStrikeout];

5: Result:=[fsBold,fsItalic];

6: Result:=[fsBold,fsItalic,fsUnderline];

7: Result:=[fsBold,fsItalic,fsStrikeout];

end;

end;

 

procedure TStellaMAP.HRSZComboFeltolt(var cb:TCombobox;reteg:byte);

var hrs,hrs1: string;

  i: integer;

begin

reteg:=((reteg+1) mod 255)-1;

StreamMeretek(cw);

cb.Clear;

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

If cw.szovegszam>0 then begin

 For i:=0 to cw.szovegszam-1 do begin

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

     If (szrec.reteg=reteg) and (GetBit(szrec.jelzo,0)=0) then

        Cb.Items.Add(szrec.szoveg);

 end;

 Cb.Text:=cb.Items[0];

end;

end;

 

procedure TStellaMAP.HRSZRAKERES(hrsz:string;reteg:byte);

begin

  szrec.szoveg:=hrsz;

If HRSZKeres(szrec,aktszoveg) then begin

  kozepkereszt := True;

  origox := szrec.X - (Width /2)/nagyitas;

  origoy := szrec.y - (Height/2)/nagyitas;

end else begin

  MessageBeep(0);

end;

end;

 

{A hrsz 4 mezőjét összakonkatenálja: pl. 0123/2/A/12}

Function TStellaMAP.HrszOsszerak(ds:TDataset):string;

VAR a,b,c,d,hrsz:string;

begin

Result:='';

if ds.Findfield('HRSZ')<>nil then begin

a:=Alltrim(ds.FieldByName('HRSZ').AsString);

b:=Alltrim(ds.FieldByName('HRSZ1').AsString);

c:=Alltrim(ds.FieldByName('ÉPÜLETJEL').AsString);

d:=Alltrim(ds.FieldByName('LAKÁSSZÁM').AsString);

Result:=a;

If b<>'' then Result:=Result+'/'+b;

If c<>'' then Result:=Result+'/'+c;

If d<>'' then Result:=Result+'/'+d;

end;

end;

 

{Az összetett hrsz-t szétbontja 4 részre}

Procedure TStellaMAP.HrszSzetszed(hrsz:string;var h1,h2,h3,h4:string);

var per:integer;

begin

hrsz:=Stuff(hrsz,'/',' ');

h1:=Szo(hrsz,1);h2:=Szo(hrsz,2);h3:=Szo(hrsz,3);h4:=Szo(hrsz,4);

end;

 

{ Térkép koord-ákat átszámolja képernyő koord-ákká}

function TStellaMAP.MapToScreen(ca: TCanvas;x,y: Extended; cw: TMapConfig):Tpoint;

var t: TRect;

begin

  t := ca.ClipRect;

  Result.x:=Trunc(cw.nagyitas*(x-cw.origox));

  Result.y:=t.bottom-Trunc(cw.nagyitas*(y-cw.origoy));

end;

 

{ Képernyő koord-ákat átszámolja térkép koord-ákká}

function TStellaMAP.ScreenToMap(mxy: TPoint; cw: TMapConfig):Tpoint2D;

begin

 Result.x := cw.origox + mxy.x / cw.nagyitas;

 Result.y := cw.origoy + mxy.y / cw.nagyitas;

end;

 

{Az origo koord.-áiból kiszámitja a képközéppont koord.it}

function  TStellaMAP.OrigoToCent:TPoint2D;

begin

Result.x := cw.origox+Width/(2*cw.nagyitas);

Result.y := cw.origoy+Height/(2*cw.nagyitas);

end;

 

{Az képközéppont koord.-áiból kiszámitja a origo koord.it}

function  TStellaMAP.CentToOrigo(c:TPoint2D):TPoint2D;

begin

Result.x := c.x-Width/(2*cw.nagyitas);

Result.y := c.y-Height/(2*cw.nagyitas);

end;

 

procedure TStellaMAP.Centrumba(x,y:integer);

begin

   origox := origox + ((X - Width/2) / nagyitas);

   origoy := origoy - ((Y - Height/2) /nagyitas);

   invalidate;

end;

 

{ --------------- Property Editorok -----------------}

 

function TDirProperty.GetAttributes: TPropertyAttributes;

begin

       Result := [paDialog,paAutoUpdate];

end;

 

procedure TDirProperty.SetValue(const Value: string);

begin

   SetStrValue(Value);

end;

 

 

function TDirProperty.GetValue: string;

begin

Result := GetStrValue;

end;

 

procedure TDirProperty.Edit;

var glDir: string;

begin

  glDir:=GetValue;

  If SelectDirectory(glDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0)

  then SetValue(glDir);

end;

 

function TFileProperty.GetAttributes: TPropertyAttributes;

begin

       Result := [paDialog,paAutoUpdate];

end;

 

procedure TFileProperty.SetValue(const Value: string);

begin

   SetStrValue(Value);

end;

 

function TFileProperty.GetValue: string;

begin

Result := GetStrValue;

end;

 

procedure TFileProperty.Edit;

var fn: string;

begin

  FOpenDialog := TOpenDialog.Create(Application);

  try

         FOpenDialog.InitialDir:=F_Path(GetValue);

         FOpenDialog.FileName  :=GetValue;

      FOpenDialog.Filter := 'MAP file (*.TRK)|*.TRK|ITR file (*.PT)' +

                  '|*.PT|Data Exchange (*.DXF)|*.DXF'+

                  '|Rétegfile (*.RTG)|*.RTG';

      If FOpenDialog.execute then

      begin

         SetStrValue(FOpenDialog.Filename);

      end;

  finally

      FOpenDialog.Free;

  end;

end;

 

end.