STMAP16W

Top  Previous  Next

unit Stmap16w;

 

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, ExtCtrls, Menus, ClipBrd,

Graphics, Controls, StdCtrls, Forms, Dialogs, Printers, Szoveg, Szamok,

AlmType, stmap161, StPrint, {DBTables, DB,} Gauges;

 

Type

 

TRajzmod  = TRajzmodType;

TPaintEvent = procedure(Sender: TObject) of object;

TRajzmodEvent = procedure(Sender: TObject; rmod: TRajzmod) of object;

TAlakzatmodEvent = procedure(Sender: TObject; rmod: TAlakzatmod) of object;

TOrigoChangeEvent = procedure(Sender: TObject; OrigoX,OrigoY:double) of object;

TSearchEvent = procedure(Sender: TObject; No:integer; AktPos : longint; var Rec) of object;

                {No = 1..4 a rajzelemek, Rec=record}

TDistanceChange = procedure(Sender: TObject;distance:double) of object;

TNewMapFile     = procedure(Sender: TObject;MapFile:string) of object;

 

TStMapW = class(TCustomControl)

private

   FAdatLabel         : TLabel;    {Adatmegjelenítő Label}

   FAktReteg          : byte;      {Aktuális réteg sorszáma 0..255}

   FAlapszin          : TColor;    {Térkép alapszine}

   FAlakzatmod        : TAlakzatmod;  {Alakzattal végzendő művelet}

   FBackImageFile     : string;    {Háttérkép}

   FCentrumx          : double;    {középpont világkoordinátái}

   FCentrumy          : double;

   FOrigox            : double;    {Sarokpont világkoordinátái}

   FOrigoy            : double;

   FNagyitas          : extended;

   FElforgSzog        : double;    {Elforgatás szöge}

   FFixText           : TFont;     {Fix felirat TEXTkényszer esetén}

   FHRSZCombo         : TCombobox; {10-es réteg helyrajzi számok Combo-ja}

   FJelkulcsFile      : string;    {jelkulcs file *.jlk}

   FGauge             : TGauge;    {TGauge folyamat kijelzsésekhez}

   FGrafPot           : boolean;   {Grafikus potenciometer}

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

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

   FHomogenrajz       : boolean;   {Egyszínű rajz}

   Fkeppont           : TPoint2d;

   FKoordLabel        : TLabel;    {Koordináta kijelző Label}

   Fkozepkereszt      : boolean;

   FLatszik           : TVisibleSet; {Pont,vonal,felirat,jelkulcs láthatóság}

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

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

   FMeretaranyCombo   : TCombobox;

   FMeretarany        : extended;

   FOrkereszt         : boolean;   {Őrkereszt látszik-e}

   FPontmeret         : integer;

   FPontszin          : TColor;

   FRajzmod           : TRajzmod;  {Rajzmód}

   FRajzmodCombo      : TCombobox; {Rajzmód feliratok Combo-ja}

   FRajzmodLabel      : TLabel;

   FRetegCombo        : TCombobox; {Réteg nevek Combo-ja}

   FRetegFile         : string;    {Réteg definíciós file *.rtg}

   FTEXTkenyszer      : boolean;   {Szöveg kényszer minden nagyításban}

   FTeruletLabel      : TLabel;    {Terület megjelenítő Label}

   FKeruletLabel      : TLabel;    {Kerület megjelenítő Label}

   Fkerulet           : real;

   Fterulet           : real;

   Ftavolsag          : real;

   FOnPaint           : TPaintEvent;      {Ujrarjzolás esemény}

   FOnRajzmod         : TRajzmodEvent;    {Rajzmód változás esemény}

   FOnAlakzatmod      : TAlakzatmodEvent; {Rajzmód változás esemény}

   FOnOrigoChange     : TOrigoChangeEvent;{Origó változás esemény}

   FOnSearch          : TSearchEvent;     {Keresési esemény}

   procedure SetAdatLabel(Value: TLabel);

   procedure SetAlakzatmod(Value: TAlakzatmod);

   procedure SetAktReteg(Value: byte);

   procedure SetAlapszin(Value: TColor);

   procedure SetBackImageFile(Value: string);

   procedure SetCentrumx(Value: double);

   procedure SetCentrumy(Value: double);

   procedure SetOrigox(Value: double);

   procedure SetOrigoy(Value: double);

   procedure SetGlobalDir(Value: string);

   procedure SetElforgSzog(Value: double);

   procedure SetFixText(Value: TFont);

   procedure SetHomogenrajz(Value: boolean);

   procedure SetHRSZCombo(Value: TCombobox);

   procedure SetJelkulcsFile(Value: string);

   procedure SetKoordLabel(Value: TLabel);

   procedure SetKozepkereszt(Value: boolean);

   procedure SetLatszik(Value: TVisibleSet);

   procedure SetMapFile(Value: string);

   procedure SetMeretaranyCombo(Value: TCombobox);

   Function GetMeretarany:extended;

   procedure SetMeretarany(Value: extended);

   procedure SetNagyitas(Value: extended);

   procedure SetOrkereszt(Value: boolean);

   procedure SetPontmeret(Value: integer);

   procedure SetPontszin(Value: TColor);

   procedure SetRajzmodCombo(Value: TCombobox);

   procedure SetRajzmodLabel(Value: TLabel);

   procedure SetRetegCombo(Value: TCombobox);

   procedure SetRetegFile(Value: string);

   procedure SetTextKenyszer(Value: boolean);

   procedure SetTeruletLabel(Value: TLabel);

   procedure SetKeruletLabel(Value: TLabel);

   procedure Setkerulet(Value:real);

   procedure SetTerulet(Value:real);

   procedure SetTavolsag(Value:real);

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

   procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER;

   procedure CMMouseLeave(var msg: TWMMouse); message CM_MOUSELEAVE;

protected

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

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

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

   oldOrigin     : TPoint;

   oldMovePt     : TPoint;

   apont           : longint;

   wrec,wrec1,wrec2: TVonalrecord;

   pontsorszam     : Longint;      {Pontsorszamok}

   von1            : boolean;

   uj_szoveg       : boolean;

   Rajzmodstring   : string[18];  {rajzmód szövegesen}

   xx,yy           : real;        {térkép koordináták}

   GrafPotLabel    : TLabel;

   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 Notification(AComponent: TComponent;

     Operation: TOperation); override;

   procedure SBI;           {Canvas mentése}

   procedure LBI;           {Canvas visszatöltése}

   procedure Restore;

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

   procedure OrkeresztRajzol(ca:TCanvas;t:TRect);virtual;

   procedure MeretaranyClick(Sender:TObject);virtual;

   procedure RajzmodClick(Sender:TObject);virtual;

   procedure RetegClick(Sender:TObject);virtual;

   procedure RetegDrawItem(Control: TWinControl;

             Index: Integer; Rect: TRect; State: TOwnerDrawState);

   procedure HRSZClick(Sender:TObject);virtual;

   procedure HRSZKeyDown(Sender:TObject;var Key: Word;

             Shift: TShiftState);virtual;

public

   tm            : TRajzelemStream;

   BackImage     : TBitmap;         { Háttlrkép }

   BackImageBox  : TRect;          { Háttérkép befoglalója }

   BImBox        : TRect2d;        { Háttérkép befoglalója a térképen }

   BImOrigo      : TPoint2d;       { Háttérkép beillesztési pontja }

   cw,ocw        : TMapConfig;     { Globális paraméterek aktuális,mentett}

   jelkulcsStream: TFileStream;    { Jelkulcsok filestream-ja}

   fontstream    : TMemoryStream;  { Fontok filestream-je}

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

   poliStream    : TMemoryStream;

   lreteg        : TLreteg;

   PontRec       : TPontrecord;

   VonalRec      : TVonalrecord;

   FeliratRec    : TSzovegrecord;

   JelkulcsRec   : TJelkulcsrecord;

 

   aktpont       : Longint;       {Aktuális pont sorszáma}

   aktvonal      : Longint;

   aktszoveg     : Longint;

   aktjelkulcs   : Longint;

   prec,oldprec,oprec : TPontrecord;

   vrec,oldvrec  : TVonalrecord;

   szrec,oldszrec: TSzovegrecord;

   jrec,oldjrec  : TJelkulcsRecord;

   rrec,oldrrec  : TRetegrecord;

   frec,oldfrec  : TFontrecord;

   polirec       : TPolygonRecord;

 

   jelkHeader    : TJelkulcsHeader;

   jelkData      : TJelkulcsRecord;

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

   vanablak      : boolean;

   t             : TRect;

   nWidth,nHeight: Integer;      {nagyito keret meretei}

 

   Cur,oldCur    : TCursor;

   kMODE         : TKeresesMod;   {a Keresesek rutin erre keres}

   FOnDistanceChange  : TDistanceChange;  {Távmérés,vonalhúzás során a távolság érzékelése}

   FNewMapFile        : TNewMapFile;      {Új térkép megnyitásakor}

   constructor Create(AOwner:TComponent);override;

   destructor Destroy;override;

   property Canvas;

   procedure Keresesek(x,y:integer;event:boolean); virtual;

   procedure SetRajzmod(Value: TRajzmod);virtual;

   property keppont: TPoint2d read Fkeppont write Fkeppont;

   property kerulet : real read Fkerulet write Setkerulet;

   property terulet : real read FTerulet write SetTerulet;

   property tavolsag: real read Ftavolsag write Settavolsag;

   procedure Ujrarajzol(ca:TCanvas;tt:TRect);virtual;

   procedure Pontrajzol(ca:TCanvas; x,y,m: integer; pm: TColor);

   procedure Vonalrajzol(ca:TCanvas; pv: TVonalrecord);

   procedure Szovegrajzol(ca:TCanvas; szr: TSzovegrecord; pc: TColor);

   procedure GrafikusAdatok(t:Trect);

   Function PontrekordKap(ap: Longint):Tpontrecord;

   Function VonalrekordKap(ap: Longint):TVonalrecord;

   Function SzovegrekordKap(ap: Longint):TSzovegrecord;

   Function JelkulcsrekordKap(ap: Longint):Tjelkulcsrecord;

   Function RetegrekordKap(arec: word): TRetegrecord;

   Function FontrekordKap(arec: word): TFontrecord;

   Function FontStylusKap(fkod:integer): TFontStyles;

   Function Pontkeres(x,y: Longint; var pr: TPontrecord;var ap: Longint): boolean;

   function Vonalkeres(x,y:Longint;var vrec:Tvonalrecord;var ap: Longint): boolean;

   Function Feliratkeres(x,y: Longint; var szrec: Tszovegrecord;

                               var ap: Longint): boolean;

   Function Jelkulcskeres(x,y: Longint; var jk: Tjelkulcsrecord;var ap: Longint): boolean;

   Function LegkozelebbiPont(p: TPoint2D;var ap: Longint):TPontrecord;

   Function LegkozelebbiVonal(p: TPoint2D;var ap: Longint;var d:real):TVonalrecord;

   Function NextLine(p: TPoint2D;var vrec :TVonalrecord;var ap: Longint;reteg:byte):boolean;

   Function LegkozelebbiSzoveg(p: TPoint2D;var ap: Longint):TSzovegrecord;

   Function LegkozelebbiJelkulcs(p: TPoint2D;var ap: Longint):TJelkulcsrecord;

   procedure MapLoad(fnev: string;append: boolean);

   procedure MapSave(fnev: string);

   procedure SaveToClipboard;

   procedure RegionCopyToClipboard(tt:TRect);

   procedure RetegMegnyit(fnev:string);virtual;

   procedure JelkulcsMegnyit(fnev:string);virtual;

   procedure StreamMeretek(var cw:TMapConfig);

   procedure MinMaxKeres;

   procedure Alapratesz;

   procedure Centrumba(x,y:integer);

   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 Eltolas(Value:TEltolas);

   procedure NyomtatasPRN(ca: TCanvas);virtual;

   procedure HRSZkereses;

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

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

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

   Function HrszOsszerak(h1,h2,h3,h4:string):string;

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

   Function PontbolEl(p: Tpontrecord; re_teg: byte):integer;

   Function FeliratInPoligon(var szrec:Tszovegrecord;reteg:byte;

             var ap: longint):boolean;virtual;

   Function CsatoltVonal(p: TPoint2D; var vrec :TVonalrecord; re_teg: byte;

                        var RecNo: Longint ):boolean;virtual;

   Function Teruletszamitas(ca: TCanvas; p : TPoint2D; re_teg: byte;

                             var kerulet:real): real;

   procedure RetegComboFeltolt;

published

   Property AdatLabel : TLabel read FAdatLabel write SetAdatLabel;

   property AktReteg: byte read FAktReteg write SetAktReteg default 9;

   Property Alakzatmod: TAlakzatmod read FAlakzatmod write SetAlakzatmod;

   property Alapszin: TColor read FAlapszin write SetAlapszin;

   property BackImageFile : string read FBackImageFile write SetBackImageFile;

   property Centrumx: double read FCentrumx write SetCentrumx;

   property Centrumy: double read FCentrumy write SetCentrumy;

   property ElforgSzog: double read FElforgSzog write SetElforgSzog;

   property FixText: TFont read FFixText write SetFixText;

   property HRSZCombo: TComboBox read FHRSZCombo write SetHRSZCombo;

   property Homogenrajz: boolean read FHomogenrajz write SetHomogenrajz default True;

   property Gauge : TGauge read FGauge write FGauge;

   property GrafPot : boolean read FGrafPot write FGrafPot;

   property GlobalDir: string read FGlobalDir write SetGlobalDir;

   property LocalDir: string read FLocalDir write FLocalDir;

   property JelkulcsFile: string read FJelkulcsFile write SetJelkulcsFile;

   Property KoordLabel : TLabel read FKoordLabel write SetKoordLabel;

   Property TeruletLabel : TLabel read FTeruletLabel write SetTeruletLabel;

   Property KeruletLabel : TLabel read FKeruletLabel write SetKeruletLabel;

   property Kozepkereszt: boolean read Fkozepkereszt write Setkozepkereszt;

   property Latszik: TVisibleSet read FLatszik write SetLatszik

             default [vPont, vVonal, vFelirat];

   property MAPAppend: boolean read FMAPAppend write FMAPAppend default False;

   property MapFile: string read FMapFile write SetMapFile;

   property Meretarany: extended read GetMeretarany write SetMeretarany;

   property MeretaranyCombo: TComboBox read FMeretaranyCombo write SetMeretaranyCombo;

   property Nagyitas: extended read FNagyitas write SetNagyitas;

   property Origox: double read FOrigox write SetOrigox;

   property Origoy: double read FOrigoy write SetOrigoy;

   property Orkereszt: boolean read FOrkereszt write SetOrkereszt;

   property Pontmeret: integer read FPontmeret write SetPontmeret;

   property Pontszin: TColor read FPontszin write SetPontszin;

   property RajzMod: TRajzmod read FRajzmod write SeTRajzmod default rmNincs;

   property RajzmodCombo: TComboBox read FRajzmodCombo write SetRajzmodCombo;

   Property RajzmodLabel : TLabel read FRajzmodLabel write SetRajzmodLabel;

   property RetegCombo: TComboBox read FRetegCombo write SetRetegCombo;

   property RetegFile: string read FRetegFile write SetRetegFile;

   property TEXTkenyszer: boolean read FTEXTkenyszer write SetTEXTkenyszer;

   property Align;

   property Cursor;

   property Enabled;

   property Hint;

   property ParentShowHint;

   property PopupMenu;

   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;

   property OnPaint: TPaintEvent read FOnPaint write FOnPaint;

   property OnRajzmod: TRajzmodEvent read FOnRajzmod write FOnRajzmod;

   property OnAlakzatmod: TAlakzatmodEvent read FOnAlakzatmod write FOnAlakzatmod;

   property OnOrigoChange: TOrigoChangeEvent read FOnOrigoChange write FOnOrigoChange;

   property OnSearch: TSearchEvent read FOnSearch write FOnSearch;

   property OnDistanceChange : TDistanceChange read FOnDistanceChange

            write FOnDistanceChange;

   property OnNewMapFile : TNewMapFile read FNewMapFile write FNewMapFile;

end;

 

{  TStDBMapW = class(TSTMapW)

private

   FDataLink: TDataLink;

   FDataSource: TDataSource;

   function GetDataSource: TDataSource;

   procedure SetDataSource(Value: TDataSource);

protected

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

published

   property DataSource: TDataSource  read FDataSource write FDataSource;

end;}

 

implementation

 

{$R SMCURS}

 

{procedure Kereszt(DC: HDC; co: TColor); far;external 'STELLA';

Procedure MAPForgat(var tm:TRajzelemStream;cent:TPoint2D;szog:real);

         far;external 'STELLA';

Function  Filemegnyitas(var tm: TRajzelemStream;fnev: string;append: boolean):boolean;

         far;external 'STELLA';

procedure Filementes(tm: TRajzelemStream;filename: string); far;external 'STELLA';}

 

constructor TStMapW.Create(AOwner:TComponent);

var i: integer;

   a: real;

   H: HCURSOR;

begin

inherited Create(AOwner);

Screen.Cursors[crCentrum]    :=  LoadCursor(h, 'SM_CENTRUM');

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

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

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

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

Screen.Cursors[crKeret]      :=  LoadCursor(h, 'SM_KERET');

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

Screen.Cursors[crTav]        :=  LoadCursor(h, 'SM_TAV');

If FGlobaldir='' then FGlobalDir:=ExtractFilePath(Application.Exename);

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

rtgstream     := TMemoryStream.Create;

FontStream    := TMemoryStream.Create;

Polistream    := TMemoryStream.Create;

TRKSaveBitmap := TBitmap.Create;

FFixtext   := TFont.Create;

With Fixtext do begin

   Name := 'Arial';

   Size := 10;

   Color:= clBlack;

end;

latszik    := [vPont, vVonal, vFelirat];

Height      := 100;          Width       := 100;

FCentrumx   := 0;            FCentrumy   := 0;

Forigox     := 0;            Forigoy     := 0;

alapszin    := clTeal;       Nagyitas    := 0.01;

FRajzmod    := rmNincs;      FElforgSzog := 0;

Kozepkereszt := True;        FHomogenrajz:= False;

FMapfile    := '';           {ohrsz       := '';}

t:=rect(0,0,width,height);   Pontszin    := clBlack;

cw.orkereszttav:=100;

cw.aspx     := 1;            FAktreteg    := 9;

AktJelkulcs := 1;

Alapratesz;

GrafPotLabel := TLabel.Create(Self);

{  GrafPotLabel.Visible:=False;

GrafPot:=False; GrafPotLabel.Parent:=Self;

With GrafPotLabel.Font do begin Name:='Arial'; Size:=8; Color:=clNavy; end;}

PrinterParamNull(PrinterParam);

BImOrigo := Point2D(0,0);

{  ControlStyle := ControlStyle + [csOpaque];}

end;

 

destructor TStMapW.Destroy;

var i: integer;

begin

    If BackImage<>nil then BackImage.Free;

    TRKSaveBitmap.Free;

    rtgstream.Destroy;

    FontStream.Destroy;

    PoliStream.Destroy;

    FixText.Free;

    GrafPotLabel.Free;

    Try

       For i:=1 to 4 do if TM[i]<>nil then TM[i].Free;

    finally

       inherited Destroy;

    end;

end;

 

procedure TStMapW.SetBackImageFile(Value: string);

begin

If Value<>FBackImageFile then begin

    FBackImageFile := Value;

    If (Value='') and (BackImage<>nil) then BackImage.Free

    else

     If FileExists(Value) then begin

        BackImage := TBitmap.Create;

        BackImage.LoadFromFile(Value);

        BackImageBox := BackImage.BoundsRect;

        BImBox := Rect2d(BImOrigo.x,BImOrigo.y,

                  BImOrigo.x+Nagyitas*(BackImageBox.Right-BackImageBox.Left),

                  BImOrigo.y+Nagyitas*(BackImageBox.Bottom-BackImageBox.Top));

        invalidate;

     end;

end;

end;

 

{

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

begin

Case Key of

VK_ADD     : begin nagyitas:=2*nagyitas; end;

VK_SUBTRACT: begin nagyitas:=0.5*nagyitas; end;

VK_SPACE   : begin Refresh; end;

end;

inherited KeyDown(Key, Shift);

end;

}

 

procedure TStMapW.SeTRajzmod(Value: TRajzmod);

var s:string;

begin

    FRajzmod:=Value;

    cw.rmod := Value;

    s := Rajzmodfelirat[Ord(Value)];

    von1:=False;

    Case Value of

      rmNincs : begin

                    Cursor := crDefault;

                    kMODE := kmNone;

                    Invalidate;

                end;

      rmNagyito,rmAblaknagyitas:  Cursor:=crNagyito;

      rmKicsinyito: Cursor:=crKicsinyito;

      rmCentrum:    Cursor:=crCentrum;

      rmAblak:  begin

                Cursor := crDefault;

                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 := False;

                end;

      rmTavmeres,rmTer : begin Cursor:=crTav; end;

      rmHrsz: begin KMode := kmHRSZ; Cursor := crDefault; end;

      rmHelp:   Cursor:=crHelp;

    end;

    oldCur:=Cursor; Cur := Cursor;

    RajzmodLabel.Caption:=s;

    Rajzmodstring:=s;

    If RajzmodCombo<>nil then begin

       RajzmodCombo.Itemindex:=Ord(Value);

       RajzmodCombo.Text:=RajzmodCombo.Items[RajzmodCombo.Itemindex];

    end;

    If Assigned(FOnRajzmod) then FOnRajzmod(Self,FRajzmod);

end;

 

procedure TStMapW.SetAlakzatmod(Value:TAlakzatmod);

begin

    FAlakzatmod:=Value;

    Case Value of

    pRajzol : Cursor := crDefault;

    pKeres  : Cursor := crDefault;

    pKijelol: Cursor := crNegyszog;

    pTorol  : Cursor := crKeret;

    end;

    oldcur:=Cursor;

    If Assigned(FOnAlakzatmod) then FOnAlakzatmod(Self,FAlakzatmod);

end;

 

procedure TStMapW.WMSize(var Msg: TWMSize);

begin

   inherited;

   t:=rect(0,0,Msg.width,Msg.height);

   TRKSaveBitmap.Width:=Width;

   TRKSaveBitmap.Height:=Height;

   Centrumx:=Centrumx;

   Centrumy:=Centrumy;

   cw.kepernyo:=t;

   Invalidate;

end;

 

{Ha a cursor elhagyja a komponenst}

procedure TStMapW.CMMouseLeave(var msg: TWMMouse);

var x1,x2,y1,y2: integer; curPos : TPoint; rec: TRect;

begin

GetCursorPos(curPos);

ScreenToClient(curPos);

x1:=ClientOrigin.x; y1:=ClientOrigin.y;

x2:=x1+Width; y2:=y1+Height;

Case rajzmod of

rmPont,rmVonal,rmFelirat :

begin

{    If curPos.X>x2 then Eltolas(elRight);

   If curPos.Y>y2 then Eltolas(elUp);

   If curPos.X<x1 then Eltolas(elLeft);

   If curPos.Y<y1 then Eltolas(elDown);}

end;

rmAblak: begin

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

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

    vanablak:=False;

end;

end;

{  GrafPotLabel.Visible:=False;}

end;

 

{Ha a cursor rálép a komponensre}

procedure TStMapW.CMMouseEnter(var msg:TMessage);

begin

{  If GrafPot then GrafPotLabel.Visible:=True;}

end;

 

procedure TStMapW.SetCentrumx(Value: double);

var p: TPoint2d;

begin

    FCentrumx:=Value;

    p.x:=Value; p.y:=Origoy;

    p:=CentToOrigo(p);

    Origox:=p.x;

    If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,Origox,Origoy);

    Invalidate;

end;

 

procedure TStMapW.SetCentrumy(Value: double);

var p: TPoint2d;

begin

    FCentrumy:=Value;

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

    Origoy:=p.y;

    If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,Origox,Origoy);

    Invalidate;

end;

 

procedure TStMapW.SetOrigox(Value: double);

begin

If FOrigox<>Value then begin

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

    Centrumx:=OrigoTocent.x;

    If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,Origox,Origoy);

end;

end;

 

procedure TStMapW.SetOrigoy(Value: double);

begin

If FOrigoy<>Value then begin

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

    Centrumy:=OrigoTocent.y;

    If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,Origox,Origoy);

end;

end;

 

procedure TStMapW.SetMeretarany(Value: extended);

var m : extended;

   centx,centy: real;

begin

If FMeretarany<>Value then begin

If MeretaranyCombo<>nil then begin

    MeretaranyCombo.Color := clWhite;

    m    := StrToFloat(Copy(MeretaranyCombo.Text,3,12));

end else m:=Value;

If m<0.00001 then m:=0.00001;

    Centx:= cw.origox + (Width/2)/nagyitas;

    Centy:= cw.origoy + (Height/2)/nagyitas;

    nagyitas:= (Screen.PixelsPerInch/0.0251)*(1/m);

    If cw.aspx<>0 then nagyitas:=cw.aspx*nagyitas;

    origox := Centx - (Width/2)/nagyitas;

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

    FMeretarany:=m;

    Restore;

end;

end;

 

Function TStMapW.GetMeretarany : extended;

begin

If cw.aspx=0 then cw.aspx:=1;

Result := cw.aspx*Screen.PixelsPerInch/(0.0251*Fnagyitas);

end;

 

procedure TStMapW.SetMeretaranyCombo(Value: TCombobox);

Var i:integer;

Const mr: Array[0..10] of string = ('1:100','1:250','1:1000','1:2000','1:4000',

         '1:8000','1:16000','1:25000','1:100000','1:1000000','1:10000000');

begin

    FMeretaranyCombo:=Value;

    MeretaranyCombo.Clear;

    For i:=0 to 10 do MeretaranyCombo.Items.Add(mr[i]);

    Meretarany:=GetMeretarany;

    MeretaranyCombo.Text:='1:'+Format('%6.0f',[Meretarany]);

    MeretaranyCombo.OnClick:=MeretaranyClick;

end;

 

{A Meretarany Click event-je az aktuális réteg kijelölésére}

procedure TStMapW.MeretaranyClick(Sender:TObject);

Var s:string;

begin

    S:=MeretaranyCombo.Items[MeretaranyCombo.Itemindex];

    MeretaranyCombo.Text:=S;

    meretarany:=StrToFloat(Copy(MeretaranyCombo.Text,3,12));

    Invalidate;

end;

 

procedure TStMapW.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;

    Invalidate;

    FMeretarany:=GetMeretarany;

    If MeretaranyCombo <> nil then

       MeretaranyCombo.Text:='1:'+Alltrim(Format('%6.0f',[FMeretarany]));

end;

except

On Exception do exit;

end;

end;

 

procedure TStMapW.SetOrkereszt(Value: boolean);

begin

FOrkereszt:=Value;

Invalidate;

end;

 

procedure TStMapW.Setkerulet(Value:real);

begin

FKerulet:=Value;

If KeruletLabel<>nil then KeruletLabel.Caption:=Format('%9.3f',[Kerulet]);

end;

 

procedure TStMapW.SetTerulet(Value:real);

begin

FTerulet:=Value;

If TeruletLabel<>nil then TeruletLabel.Caption:=Format('%9.3f',[Terulet]);

end;

 

procedure TStMapW.SetAdatLabel(Value:TLabel);

begin FAdatLabel:=Value; end;

 

procedure TStMapW.SetKoordLabel(Value:TLabel);

begin FKoordLabel:=Value; end;

 

procedure TStMapW.SetTeruletLabel(Value:TLabel);

begin FTeruletLabel:=Value; end;

 

procedure TStMapW.SetKeruletLabel(Value:TLabel);

begin FKeruletLabel:=Value; end;

procedure TStMapW.SetRajzmodLabel(Value: TLabel);

begin

    FRajzmodLabel:=Value;

    FRajzmodLabel.Caption:=Rajzmodstring;

end;

 

procedure TStMapW.SetTavolsag(Value:real);

begin

FTavolsag:=Value;

end;

 

procedure TStMapW.SetRajzmodCombo(Value: TCombobox);

var i:integer;

begin

    FRajzmodCombo:=Value;

    RajzmodCombo.Clear;

    For i:=0 to High(RajzmodFelirat) do RajzmodCombo.Items.Add(RajzmodFelirat[i]);

    RajzmodCombo.Itemindex:=Ord(Rajzmod);

    RajzmodCombo.Text:=RajzmodCombo.Items[Ord(Rajzmod)];

    RajzmodCombo.OnClick:=RajzmodClick;

end;

 

{A RajzmodCombo Click event-je az aktuális Rajzmod kijelölésére}

procedure TStMapW.RajzmodClick(Sender:TObject);

begin

    RajzmodCombo.Text:=RajzmodCombo.Items[RajzmodCombo.Itemindex];

    Rajzmod:=StringToRajzmod(RajzmodCombo.Items[RajzmodCombo.Itemindex]);

    Invalidate;

end;

 

procedure TStMapW.SetHRSZCombo(Value: TCombobox);

begin

    FHRSZCombo:=Value;

    If Value<>nil then begin

       HRSZComboFeltolt(Value,10);

       HRSZCombo.Itemindex:=0;

       HRSZCombo.Text:=HRSZCombo.Items[0];

       HRSZCombo.OnClick:=HRSZClick;

       HRSZCombo.OnKeyDown:=HRSZKeyDown;

    end else begin

       HRSZCombo.OnClick:=HRSZCombo.OnClick;

       HRSZCombo.OnKeyDown:=HRSZCombo.OnKeyDown;

    end;

    Invalidate;

end;

 

{A HRSZCombo Click event-je az aktuális réteg kijelölésére}

procedure TStMapW.HRSZClick(Sender:TObject);

begin

HRSZRakeres(HRSZCombo.Items[HRSZCombo.Itemindex],10);

inherited Click;

end;

 

procedure TStMapW.HRSZKeyDown(Sender:TObject;var Key: Word;

Shift: TShiftState);

begin

If key in [VK_UP,VK_DOWN,VK_RETURN] then

   HRSZRakeres(HRSZCombo.Text,10);

inherited KeyDown(Key,Shift);

end;

 

procedure TStMapW.SetKozepkereszt(Value: boolean);

var h: THandle;

begin

If FKozepkereszt<>Value then begin

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

    Try

     If Parent<>nil then Kereszt(Canvas,Boundsrect,clBlack);

    except

       Exit;

    end;

end;

end;

 

procedure TStMapW.SetLatszik(Value: TVisibleSet);

begin

If FLatszik<>Value then begin

FLatszik := Value;

cw.pontlatszik    := vpont in Value;

cw.vonallatszik   := vvonal in Value;

cw.szoveglatszik  := vfelirat in Value;

cw.jelkulcslatszik:= vjelkulcs in Value;

cw.pontszamlatszik:= vPontszam in Value;

cw.kijelolesek    := vKijeloltek in Value;

cw.toroltek       := vToroltek in Value;

cw.tavlatszik     := vMeretek in Value;

cw.csakkijeloltek := vCsakkijeloltek in Value;

cw.csaktoroltek   := vCsaktoroltek in Value;

If cw.csakkijeloltek then begin

    cw.kijelolesek := False;

    cw.csaktoroltek:= False;

    cw.toroltek    := False;

    FLatszik := FLatszik - [vKijeloltek,vToroltek,vCsaktoroltek];

end;

If cw.csaktoroltek then begin

    cw.kijelolesek := False;

    cw.csakkijeloltek:= False;

    cw.toroltek    := False;

    FLatszik := FLatszik - [vKijeloltek,vToroltek,vCsakkijeloltek];

end;

invalidate;

end;

end;

 

procedure TStMapW.SetRetegFile(Value: string);

begin

    FRetegFile := Value;

    RetegMegnyit(FRetegFile);

    If RetegCombo<>nil then RetegCombo:=RetegCombo;

    Invalidate;

end;

 

procedure TStMapW.SetRetegCombo(Value: TCombobox);

begin

    FRetegCombo:=Value;

    If Value<>nil then begin

    If RetegFile<>'' then begin

       RetegMegnyit(RetegFile);

       RetegComboFeltolt;

       FRetegCombo.Style:=csOwnerDrawVariable;

       FRetegCombo.OnClick:=RetegClick;

       FRetegCombo.OnDrawItem:=RetegDrawItem;

       FRetegCombo.Itemindex:=AktReteg;

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

    end;

    end;

    Invalidate;

end;

{A RetegCombo Click event-je az aktuális réteg kijelölésére}

procedure TStMapW.RetegClick(Sender:TObject);

begin AktReteg:=RetegCombo.Itemindex; end;

{A RetegCombo Click event-je az aktuális réteg kijelölésére}

procedure TStMapW.RetegDrawItem(Control: TWinControl;

Index: Integer; Rect: TRect; State: TOwnerDrawState);

Var col1,col2 : TColor;

begin

Try

with RetegCombo.Canvas do

begin

   ReadRec(rtgstream,index,rrec,SizeOf(rrec));

   Pen.Mode  := pmCopy;

   FillRect(Rect);

   col1 := rrec.vonalszin;

   col2 := rrec.szovegszin;

   Pen.Color := clBlack;

   Brush.color := col1;

   Rectangle(Rect.Left+2,Rect.Top+2,Rect.Left+18,Rect.Bottom-2);

   Brush.color := col2;

   Rectangle(Rect.Left+18+2,Rect.Top+2,Rect.Left+18+18,Rect.Bottom-2);

   Pen.Color := clBlack;

   Brush.color := clWhite;

   Brush.Style := bsClear;

   TextOut(Rect.Left + 2 + 40, Rect.Top , RetegCombo.Items[Index]);

   Brush.Style := bsSolid;

end;

except

exit;

end;

end;

 

procedure TStMapW.SetGlobalDir(Value: string);

var FontList:TStringList;

   i:integer;

begin

If FGlobalDir<>Value then begin

Try

    FGlobalDir:=Value;

    cw.GlobalDir:=Value;

    If (Retegfile='') and FileExists(FGlobalDir+'\FALUMAP.RTG')

     then Retegfile:=FGlobalDir+'\FALUMAP.RTG';

    If FileExists(FGlobalDir+'\FALUMAP.JLK') then

       jelkulcsStream:=TFileStream.Create(FGlobalDir+'\FALUMAP.JLK',fmOpenReadWrite);

    If FileExists(FGlobalDir+'\FALUMAP.FNT') then

       FontStream.LoadFromFile(FGlobalDir+'\FALUMAP.FNT')

    else begin

       FontList:=TStringList.Create;

       FontList.AddStrings(Screen.Fonts);

       For i:=0 to FontList.Count-1 do begin

       With frec do begin

           fontkod := i;

           fontnev := FontList.Strings[i];

       end;

          FontStream.write(frec,SizeOf(frec));

       end;

       FontStream.SaveToFile(FGlobalDir+'\FALUMAP.FNT');

       FontList.Free;

    end;

except

    FGlobalDir:=ExtractFilePath(Application.Exename);

end;

end;

end;

 

procedure TStMapW.SetMapFile(Value: string);

begin

    FMapFile := Value;

    LocalDir := F_Path(FMapfile);

    If Value<>'' then MapLoad(FMapFile,MAPAppend)

       else Alapratesz;

    cw.localdir:= LocalDir;

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

    RajzMod  := rmNincs;

end;

 

procedure TStMapW.MapLoad(fnev: string;append: boolean);

var fn:string;

   rtgfile: string;

   configExist : boolean;

begin

   If Filemegnyitas(tm,rtgstream,fnev,append,Gauge) then begin

   {Lokális config file keresés}

   configExist := ConfigLoad(ChangeFileExt(fnev,'.CFG'),cw);

   rtgfile := ChangeFileExt(fnev,'.RTG');

         If FileExists(rtgfile) then RetegFile := rtgfile

         else begin

             rtgfile := GlobalDir+'FALUMAP.RTG';

             If FileExists(rtgfile) then RetegFile := rtgfile;

         end;

   {Ha nincs lokális cfg, akkor a globálist tölti be}

{    If not configExist then configExist := ConfigLoad(GlobalDir+'STMAP.CFG',cw);

      If configExist then begin

         RetegFile := cw.RetegFile;

      end else begin

          rtgfile := ChangeFileExt(fnev,'.RTG');

         If FileExists(rtgfile) then RetegFile := rtgfile

         else begin

             rtgfile := GlobalDir+'FALUMAP.RTG';

             If FileExists(rtgfile) then RetegFile := rtgfile;

         end;

      end;}

   If FileExists(ChangeFileExt(fnev,'.JLK')) then

    jelkulcsStream:=TFileStream.Create(ChangeFileExt(fnev,'.JLK'),fmOpenReadWrite)

   else If FileExists(GlobalDir+'\FALUMAP.JLK') then

    jelkulcsStream:=TFileStream.Create(GlobalDir+'\FALUMAP.JLK',fmOpenReadWrite);

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

   cw.valtozott := False;

   HRSZComboFeltolt(FHRSZCombo,10);

   RetegComboFeltolt;

   If not append then

   MinMaxKeres;

   cw.filenev := fnev;

   cw.tavmod:=tmSzogben;

end else begin

    Alapratesz;

    cw.filenev := '';

end;

end;

 

procedure TStMapW.MapSave(fnev: string);

begin

Filementes(tm,fnev,Gauge);

end;

 

{Canvas mentés}

procedure TStMapW.SBI;

begin

StretchBlt(TRKSaveBitmap.Canvas.Handle,0,0,width,Height+4,

            Canvas.handle,0,0,width,Height+4,SRCCOPY)

end;

 

{Canvas visszatöltés}

procedure TStMapW.LBI;

begin Canvas.Draw(0,0,TRKSaveBitmap) end;

 

procedure TStMapW.SetJelkulcsFile(Value: string);

begin

If FJelkulcsFile<>Value then begin

    FJelkulcsFile := Value;

    JelkulcsMegnyit(FJelkulcsFile);

    Invalidate;

end;

end;

 

procedure TStMapW.SetAktReteg(Value: byte);

begin

If FAktReteg<>Value then begin

    FAktreteg:=Value mod 256;

    cw.aktreteg:=FAktreteg;

    rrec:=RetegRekordKap(aktreteg);

    If RetegCombo<>nil then begin

       RetegCombo.Itemindex:=FAktReteg;

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

    end;

end;

end;

 

procedure TStMapW.SetElforgSzog(Value: double);

begin

{  If FElforgSzog<>Value then begin}

    Mapforgat(tm,Point2D(Centrumx,Centrumy),Radian(FElforgSzog-Value));

    FElforgSzog:= Value;

    Invalidate;

{  end;}

end;

 

procedure TStMapW.SetAlapszin(Value: TColor);

begin

    FAlapszin:=Value;

    Canvas.Brush.Color:=Value;

    cw.alapszin:=Value;

    Invalidate;

end;

 

procedure TStMapW.SetPontmeret(Value: integer);

begin

FPontmeret:=Value;  cw.Pontmeret:=Value;

invalidate;

end;

 

procedure TStMapW.SetPontszin(Value: TColor);

begin

If FPontszin<>Value then begin

    FPontszin:=Value;

    cw.Pontszin:=Value;

{     Pont_rajzolas(canvas,t,tm[1],cw);}

end;

end;

 

procedure TStMapW.SetHomogenrajz(Value: boolean);

begin

FHomogenrajz:=Value; cw.Homogenrajz:=Value;

invalidate;

end;

 

procedure TStMapW.SetTextKenyszer(Value: boolean);

begin

FTextKenyszer:=Value; cw.TextKenyszer:=Value;

If Value then Canvas.Font.Assign(Fixtext);

Invalidate;

end;

 

procedure TStMapW.SetFixText(Value: TFont);

begin

FFixText.Assign(Value);

cw.fixtext := Value;

Canvas.Font.Assign(Value);

Invalidate;

end;

 

procedure TStMapW.Eltolas(Value:TEltolas);

var el: real;

begin

    el := (100/nagyitas);

    Case Value of

    elLeft : origox:=origox+el;

    elRight: origox:=origox-el;

    elUp   : origoy:=origoy-el;

    elDown : origoy:=origoy+el;

    end;

    invalidate;

end;

 

Procedure TStMapW.Paint;

begin

Try

Try

If (ComponentState <> [csDestroying]) then begin

If (not kepmozgatas) or (not cw.printing) or (not printer.printing) then begin

    If BackImage<>nil then begin

        BImBox := Rect2d(BImOrigo.x,BImOrigo.y,

                  BImOrigo.x+Nagyitas*(BackImageBox.Right-BackImageBox.Left),

                  BImOrigo.y+Nagyitas*(BackImageBox.Bottom-BackImageBox.Top));

        Canvas.StretchDraw(BackImageBox,BackImage);

    end;

    UjraRajzol(Canvas,t);

    SBI;

end;

       If not (ComponentState = [csDesigning]) then

          If Assigned(FOnPaint) then FOnPaint(Self);

end;

except

   On Exception do begin

      exit;

   end;

end;

finally

inherited Paint;

end;

end;

 

{Rajzelemek keresése a Mouse event-ekhez: event=True akkor eseményt generál}

procedure TStMapW.Keresesek(x,y:integer;event:boolean);

Var s: string; talalt: boolean;

begin

If not kepmozgatas then begin

    talalt := False; s:='';

    Case kMODE of

    kmPont:

           If Pontkeres(x,y,prec,aktpont) then begin

              talalt := True; vanpont:= talalt; s:=IntToStr(prec.No);

              PontRec := prec;

              If event and Assigned(FOnSearch) then FOnSearch(Self,1,aktPont,PontRec);

           end else vanpont:=False;

    kmVonal:

           If Vonalkeres(x,y,vrec,aktvonal) then begin

              talalt := True; vanvonal:= talalt; s:=IntToStr(vrec.Reteg);

              VonalRec := vrec;

              If event and Assigned(FOnSearch) then FOnSearch(Self,2,aktvonal,VonalRec);

           end else vanvonal:=False;

    kmFelirat, kmHRSZ:

           If Feliratkeres(x,y,szrec,aktszoveg) then begin

              talalt := True; vanszoveg:= talalt; s:=szrec.szoveg;

              FeliratRec := szrec;

              If event and Assigned(FOnSearch) then FOnSearch(Self,3,aktszoveg,FeliratRec);

           end else vanszoveg:=False;

    kmJelkulcs:

           If Jelkulcskeres(x,y,jrec,aktJelkulcs) then begin

              talalt := True; vanJelkulcs:= talalt; s:=IntToStr(jrec.kod);

              JelkulcsRec := jrec;

              If event and Assigned(FOnSearch) then FOnSearch(Self,4,aktJelkulcs,JelkulcsRec);

           end else vanJelkulcs:=False;

    end;

          If talalt then begin

             Cursor := crDrag;

             If AdatLabel<>nil then AdatLabel.Caption:=s;

          end else begin

             Cursor := oldCur;

             If AdatLabel<>nil then AdatLabel.Caption:='';

          end;

end;

end;

 

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

     X, Y: Integer);

var ymax,my : integer;

    x1,y1,x2,y2,dx,dy : integer;

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

    p,p1        : TPoint2D;

    pontvan,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;

    op1,op2: TPoint;

    rec_no: longint;

    tr    : HRgn;

begin

oldOrigin := Origin;

oldMovePt := MovePt;

Origin := Point(X, Y);

MovePt := Origin;

ymax   := Height;

my     := ymax-y;

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

 

Keresesek(x,my,True);

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

 

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; Restore; end;

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

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

 

rmAblak: If (ssCtrl in Shift) then begin

          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;

          end;

          end else

          if (Button in [mbMiddle,mbLeft]) then begin

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

          end;

 

rmKepterulet,rmAblakNagyitas :

        If button = mbLeft then

          If not von1 then begin

             LBI; von1:=True

          end else

          If (Rajzmod=rmKepterulet) and von1 then

             begin

                  Rajzol(Origin,oldMovePt,pmNotXor,False);

                  RegionCopyToClipboard(Rect(oldOrigin.x,oldOrigin.y,x,y));

                  tr := CreateRectRgn( oldOrigin.x,oldOrigin.y,x,y );

                  InvertRgn(Canvas.Handle,tr);

                  DeleteObject(tr);

                  von1:=False;

             end else begin

                 dx:=(x-oldOrigin.x); dy:=(y-oldOrigin.y);

                 Centrumba(x-dx div 2,y-dy div 2); nagyitas:= nagyitas * Width / dx;

                 If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,FOrigox,FOrigoy);

                 von1:=False;

             end

        else begin

             Rajzol(Origin,oldMovePt,pmNotXor,False);

             von1:=False;

        end;

 

rmTavmeres :begin

          If (not von1) then begin

             If button = mbLeft then begin

                if vanpont then begin

                     Origin := MapToScreen(Canvas,prec.x,prec.y,cw);

                     MovePt := Origin;

                     oldprec:=prec

                end else begin

                     oldprec.x:=keppont.x; oldprec.y:=keppont.y;

                end;

                d:=0; von1:=True;

              end;

          end else begin

             Case button of

             mbLeft: begin

                     Rajzol(oldOrigin,oldMovePt,pmCopy,True);

                     oldOrigin := MapToScreen(Canvas,oldprec.x,oldprec.y,cw);

                     If not vanpont then begin

                        oprec.x:=keppont.x; oprec.y:=keppont.y;

                     end else begin

                        Origin := MapToScreen(Canvas,prec.x,prec.y,cw);

                        oprec.x:=prec.x; oprec.y:=prec.y;

                     end;

                     MovePt := Origin;

                     tavolsag := KeTPontTavolsaga(oldprec.x,oldprec.y,oprec.x,oprec.y);

                     If Assigned(FOnDistanceChange) then FOnDistanceChange(Self,tavolsag);

                     kerulet := kerulet+tavolsag;

                     oldprec := oprec;

                     oldOrigin := Origin;

                     oldMovePt := MovePt;

                     end;

             end;

          end;

          If (Button=mbRight) and von1 then begin

             von1 := False;

             Rajzol(oldOrigin,oldMovePt,pmNotXor,False);

             kerulet:=0; terulet:=0; tavolsag:=0;

             {

             If grafPot.enabled then begin

                grafPot.enabled := False;

                GrafpotBe(grafPot,TRK.Canvas,x,y-8);

                grafPot.enabled := True;

             end;

             }

          end;

          end;

 

rmTer,rmObj : begin

       terulet := Teruletszamitas(Canvas,keppont,aktreteg,ker);

       kerulet:=ker;

       RegioFestes(PoliStream,Canvas,cw);

       talalt:=FeliratInPoligon(szrec,10,aktszoveg);

{        If TeruletLabel<>nil then TeruletLabel.Caption:=Format('%9.3f',[Terulet]);

       If KeruletLabel<>nil then KeruletLabel.Caption:=Format('%9.3f',[Kerulet]);

 

       s1:=Padl(szrec.szoveg,' ',10);

       s1:=s1+'  '+Format('%9.2f',[terulet])+'  '+Format('%9.2f',[kerulet]);;

       If terulet<>0 then begin

          NaploDlg.Memo1.Lines.Add(s1);

          If (rmod=rmObj) and talalt then

             Objektumizal(szrec,aktszoveg,kozseg);

       end;

       }

       end;

 

end;

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

end;

 

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

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

   pt: TPoint;

   d,d1 : real;

   kp,kp1,keppont: TPoint2D;

   fRect,cRect: TRect;

   ca: TCanvas;

   op1,op2: TPoint;

   rec_no: longint;

   pp: TPontrecord;

   szog: extended;

begin

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;

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

    GrafPotLabel.Left := x+8; GrafPotLabel.Top := y+18;

    If (KoordLabel<>nil) then KoordLabel.Caption:=GrafPotLabel.Caption;

end;

 

If Rajzmod in [rmNincs,rmHRSZ] then begin

     If (Shift=[ssLeft]) then begin

        If not kepmozgatas then begin

          Screen.Cursor := crKez;

          If kozepkereszt then Kereszt(Canvas,Boundsrect,clBlack);

          SBI;

{           If kozepkereszt then Kereszt(Canvas,Boundsrect,clBlack);}

          kepmozgatas:=True;

          kiugras:=true;

        end else

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

          Try

          Cursor := crKez;

          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,Boundsrect,clBlack);

          except

            On Exception do exit;

          end;

        end;

     end;

end;

 

If not (Rajzmod in [rmNagyito,rmKicsinyito,rmAblak]) then

If (Abs(oldMovePt.x-x)<cw.tentativtures) or (Abs(oldMovePt.y-y)<cw.tentativtures)

then Keresesek(x,my,False);

 

Case Rajzmod of

 

  rmVonal,rmSokszog,rmTermanual,rmPontVonallal,rmTavmeres,rmPoligonkijelol:

  begin

         If von1 then begin

              kp.x := xx; kp.y := yy;

              pp   := LegkozelebbiPont(kp,aktPont);

              kp.x := x; kp.y := y;

              Pt := MapToScreen(Canvas,pp.x,pp.y,cw);

              d := KeTPontTavolsaga(x,y,Pt.x,Pt.y);

              If d<cw.tentativtures then MovePt:=Pt;

              If rajzmod<>rmVonal then begin

                 pp:=oldprec;

                 Pt := MapToScreen(Canvas,pp.x,pp.y,cw);

                 d1 := KeTPontTavolsaga(x,y,Pt.x,Pt.y);

                 If (d1<cw.tentativtures) and (d1<d) then MovePt:=Pt;

              end;

            kp := ScreenToMap(Origin,cw);

            kp1:= ScreenToMap(MovePt,cw);

            d := KeTPontTavolsaga(kp.x,kp.y,kp1.x,kp1.y);

          Rajzol(Origin,oldMovePt,pmNotXor,False);

          Rajzol(Origin,MovePt,pmNotXor,False);

          If Assigned(FOnDistanceChange) then FOnDistanceChange(Self,d);

         end;

  end;

 

  rmAblak: If not TerkepUjrarajzolas then begin

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

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

          If not vanablak then

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

                 Point(cw.nkeret.right,cw.nkeret.bottom),pmNotXor,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);

          vanablak:=True;

         end;

 

rmKepterulet,rmAblakNagyitas :

          If von1 then begin

             Rajzol(Origin,oldMovePt,pmNotXor,False);

             Rajzol(Origin,MovePt,pmNotXor,False);

          end;

  end;

inherited MouseMove(Shift,x,y);

end;

 

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

     X, Y: Integer);

Var dx,dy,xm,ym,ii: integer;

   tr1,tr2,ablakkeret:  TRect;

   xx,yy,szog:  extended;

   b:integer;   {keret vastagság csúsztatásnál}

   j: longint;

   tp,tp1: TPoint;

   ke: boolean;

   tr: HRgn;

begin

  IF nagyitas<>0 then begin

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

  yy := cw.origoy + (height-y) / cw.nagyitas;

  end;

  Case Rajzmod of

  rmNincs,rmHRSZ:

     begin

     If kepmozgatas then begin

        xm:=Width; ym :=Height;

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

        Forigox := origox - dx/cw.nagyitas;

        Forigoy := origoy + dy/cw.nagyitas;

        FCentrumx:=Forigox + (xm/2)/nagyitas;

        FCentrumy:=Forigoy + (ym/2)/nagyitas;

        kepmozgatas:=False;

        kiugras:=False;

        cw.origox:=Forigox;

        cw.origoy:=Forigoy;

{           Ujrarajzol(canvas,t);}

 

        ke := FKozepkereszt;

        Fkozepkereszt:=False;

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

                 TRKSaveBitmap);

 

        If dx<>0 then begin

           If dx>0 then tr1:=Rect(0,0,dx+16,Height)

           else tr1:=Rect(Width+dx,0,Width,Height);

           Ujrarajzol(canvas,tr1);

        end;

        If dy<>0 then begin

           If dy>0 then tr2:=Rect(0,0,Width,dy)

           else tr2:=Rect(0,Height+dy,Width,Height);

           SubtractRect(tr2,tr2,tr1);

           Ujrarajzol(canvas,tr2);

        end;

 

        Fkozepkereszt:=Ke;

        If Fkozepkereszt then Kereszt(Canvas,Boundsrect,clBlack);

 

        ocw:=cw;

        b:=0;

        Cursor := crDefault;

        Screen.Cursor := crDefault;

        If Assigned(FOnOrigoChange) then FOnOrigoChange(Self,FOrigox,FOrigoy);

     end;

     end;

 

  end;

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

end;

 

procedure TStMapW.RegionCopyToClipboard(tt:TRect);

var im: TBitmap;

begin

Try

im := TBitmap.Create;

im.width := tt.Right-tt.Left;

im.height:= tt.Bottom-tt.top;

BitBlt(Im.Canvas.Handle,0,0,im.width,im.height,

    Canvas.HAndle,tt.left,tt.top,SRCCOPY);

Clipboard.Assign(im);

im.Free;

except

exit;

end;

end;

 

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

 

{ Teljes térkép felrajzolása }

procedure TStMapW.Ujrarajzol(ca:TCanvas;tt:TRect);

var cur: TCursor;

begin

Try

Try

TerkepUjrarajzolas:=True;

If (not kepmozgatas) then begin

StreamMeretek(cw);

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

If not kepmozgatas then ClsRect(ca,tt,cw.alapszin);

If orkereszt then OrkeresztRajzol(ca,t);

Ca.Brush.Color:=clWhite;

Ca.Brush.style:=bsClear;

If Homogenrajz then begin

If not kiugras then Vonal_Homogen(ca,Pontszin,tt,tm[2],rtgstream,lreteg,cw);

       If not (ComponentState = [csDesigning]) then Application.ProcessMessages;

end else begin

If not kiugras then Vonal_rajzolas(ca,tt,tm[2],rtgstream,lreteg,cw);

       If not (ComponentState = [csDesigning]) then Application.ProcessMessages;

If not kiugras then Szoveg_rajzolas(ca,tt,tm[3],rtgstream,fontstream,lreteg,cw);

       If not (ComponentState = [csDesigning]) then Application.ProcessMessages;

If not kiugras then Pont_rajzolas(ca,tt,tm[1],cw);

       If not (ComponentState = [csDesigning]) then Application.ProcessMessages;

If not kiugras then Jelkulcs_rajzolas(ca,tt,tm[4],Jelkulcsstream,lreteg,cw);

    GrafikusAdatok(tt);

end;

end;

except

TerkepUjrarajzolas:=False;

kiugras:=True;

Exit;

end;

finally

If kozepkereszt then Kereszt(Ca,tt,clBlack);

TerkepUjrarajzolas:=False;

vanablak:=False;

kiugras:=False;

If demovar then

    If FindWindow('TAppBuilder', Nil) = 0 Then

       ShowMessage('StellaMAP DEMO! Nem registrált verzió!')

end;

end;

 

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

var DC:HDC;

begin

DC := GetDC(Canvas.Handle);

With Canvas do

begin

   rrec:=RetegRekordKap(aktreteg);

   If Amode=pmNotXor then

      SetPen(canvas,not Alapszin,1,TPenStyle(rrec.vonalstylus),AMode)

   else

      SetPen(canvas,rrec.vonalszin,rrec.vonalvastag,TPenStyle(rrec.vonalstylus),AMode);

   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;

           rmFelirat :   Pen.Color := rrec.szovegszin;

           rmTermanual,rmTavmeres,rmPoligonkijelol:

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

           end;

       case RajzMod of

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

       rmvonal,rmTavmeres,rmSokszog,rmPontAtrak,rmPoligonkijelol,

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

       rmElometszes,rmHatrametszes:

           begin

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

           end;

       rmPontVonallal:

           begin

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

               Pen.Color := cw.pontszin;

               Rectangle(T.X-pontmeret,T.Y-pontmeret,T.X+pontmeret,T.Y+pontmeret);

               Rectangle(B.X-pontmeret,B.Y-pontmeret,B.X+pontmeret,B.Y+pontmeret);

           end;

       rmAblak      :

           begin

               SetPen(canvas,Alapszin xor clRed,4,TPenStyle(psSolid),pmNotXor);

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

           end;

       rmkepterulet,rmNegyszog,rmAblaknagyitas :

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

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

       end;

   end;

end;

RestoreDC(Canvas.Handle,DC);

end;

 

procedure TStMapW.Pontrajzol(ca:TCanvas; x,y,m: integer; pm: TColor);

begin

  Canvas.Pen.Mode := pmCopy;

  Canvas.Pen.Color:= pm;

  Canvas.Pen.Style := psSolid;

  Canvas.Rectangle(x-m,y-m,x+m,y+m);

end;

 

procedure TStMapW.Vonalrajzol(ca:TCanvas; pv: TVonalrecord);

var x,y,x1,y1: integer;

   d,szog: real;

begin

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

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

      x1:= Trunc(cw.nagyitas*(pv.x2-cw.origox));

      y1:= t.bottom-Trunc(cw.nagyitas*(pv.y2-cw.origoy));

      Canvas.MoveTo(x,y);Canvas.LineTo(x1,y1);

      If cw.tavlatszik or (cw.rmod in [rmVetites,rmKituzes])then begin

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

         x := Trunc((x+x1)/2); y := Trunc((y+y1)/2);

      Case cw.tavmod of

      tmNormal:

         Canvas.TextOut(x,y+Canvas.Font.height,Format('%6.2f',[d]));

      tmSzogben: begin

         szog := Fok(Szakaszszog(x,y1,x1,y));

         If (szog>=90) and (szog<=270) then szog:= szog-180;

         x := x-Trunc(Canvas.Font.height*COS(Radian(90+szog)));

         y := y+Trunc(Canvas.Font.height*SIN(Radian(90+szog)));

         RotText(ca,x,y,Format('%6.2f',[d]),10*Trunc(szog));

      end;

      end;

      end;

end;

 

procedure TStMapW.Szovegrajzol(ca:TCanvas; szr: TSzovegrecord; pc: TColor);

var x,y,ymax: integer;

   Rgn: HRgn;

begin

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

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

      ymax := t.bottom;

      Ca.Font.Color:= pc;

      Ca.Pen.Mode:=pmCopy;

             rrec := RetegrekordKap(szr.reteg);

             IF not TEXTkenyszer then begin

                Ca.Font.Name := rrec.fontnev;

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

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

             end else ca.Font.Assign(FixText);

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

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

      If PtInRegion(Rgn,x,y) then begin

         If szr.szog=0 then Canvas.TextOut(x,y+Ca.Font.Height,szr.szoveg)

         else begin

              x := x-Trunc(Ca.Font.Height*COS(Radian(90+szr.szog/10)));

              y := y+Trunc(Ca.Font.Height*SIN(Radian(90+szr.szog/10)));

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

         end;

      end;

      DeleteObject(Rgn);

   end;

end;

 

{A koord. tengelyekre felirja a koord-ákat}

 

procedure TStMapW.GrafikusAdatok(t:Trect);

Var o: TPoint2D; fm:TFont;

   xm,ym: real;

begin

   If vGrafikusAdatok in Latszik then begin

      With Canvas do begin

           fm:=Font; Font.Size:=8; Font.Color:=not alapszin;

           Font.style:=[fsBold];

           o:=OrigoToCent;

           xm:=cw.origox+width/cw.nagyitas;

           ym:=cw.origoy+Height/cw.nagyitas;

           TextOut(Width div 2,Height-14,Format('%9.0f',[o.x]));

           TextOut(0,(Height div 2)-14,Format('%9.0f',[o.y]));

           TextOut(0,Height-14,' '+

                Alltrim(Format('%9.0f',[cw.origox]))+':'+

                Alltrim(Format('%9.0f',[cw.origoy])));

           TextOut(Width-80,2,

                Alltrim(Format('%9.0f',[xm]))+':'+

                Alltrim(Format('%9.0f',[ym])));

           Font:=fm;

      end;

   end;

end;

 

 

procedure TStMapW.OrkeresztRajzol(ca:TCanvas;t:TRect);

var 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;

     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;

 

Function TStMapW.PontrekordKap(ap: Longint):Tpontrecord;

begin If tm[1].Size>0 then ReadRec(tm[1],ap,Result,SizeOf(Result))

     else recNull(Result); end;

 

Function TStMapW.VonalRekordKap(ap: Longint):TVonalrecord;

begin ReadRec(tm[2],ap,Result,SizeOf(Result));end;

 

Function TStMapW.SzovegrekordKap(ap: Longint):TSzovegrecord;

begin ReadRec(tm[3],ap,Result,SizeOf(Result));end;

 

Function TStMapW.JelkulcsrekordKap(ap: Longint):Tjelkulcsrecord;

begin ReadRec(tm[4],ap,Result,SizeOf(Result));end;

 

Function TStMapW.RetegrekordKap(arec: word): TRetegrecord;

begin ReadRec(rtgstream,arec,Result,SizeOf(Result));end;

 

Function TStMapW.FontrekordKap(arec: word): TFontrecord;

begin ReadRec(fontstream,arec,Result,SizeOf(Result));end;

 

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

Function TStMapW.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;

 

{ Rétegfile stream megnyitása }

procedure TStMapW.RetegMegnyit(fnev:string);

var f: file of Tretegrecord;

   resu: word;

   I: integer;

   s: string[1];

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 rrec.vedett then s:='*' else s:=' ';

          If Retegcombo<>nil then RetegCombo.Items.Add(IntToStr(rrec.retegszam)

             + s + rrec.retegnev);

      end;

      CloseFile(f);

      cw.retegfile:=fnev;

      {$I+}

end else RetegFile:='';

end;

 

procedure TStMapW.RetegcomboFeltolt;

var i:integer;

   s: string[1];

   meret : integer;

begin

      rtgStream.Seek(0,0);

      If Retegcombo<>nil then begin

         RetegCombo.Clear;

         meret := rtgStream.Size div SizeOf(rrec);

      For i:=0 to meret-1 do begin        {256 réteg van}

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

          If rrec.vedett then s:='*' else s:=' ';

          RetegCombo.Items.Add(IntToStr(rrec.retegszam)

             + s + rrec.retegnev);

      end;

      RetegCombo.Text := RetegCombo.Items[Aktreteg]

      end;

end;

 

procedure TStMapW.JelkulcsMegnyit(fnev:string);

var f: file of Tretegrecord;

   I: integer;

begin

If FileExists(fnev) then begin

    jelkulcsStream:=TFileStream.Create(fnev,fmOpenReadWrite);

end else begin

    jelkulcsStream:=TFileStream.Create(GlobalDir+'FALUMAP.JLK',fmCreate);

    For i:=1 to 1000 do jelkulcsStream.Write(jelkHeader,SizeOf(jelkHeader));

end;

end;

 

procedure TStMapW.MinMaxKeres;

var xmin,xmax,ymin,ymax : real;

   nagyx,nagyy : real;

   p: TPoint2d;

   i,k: longint;

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;

If cw.pontszam>0 then

For i:=1 to cw.pontszam do begin

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

   If prec.jelzo=0 then begin

      If prec.x<xmin then xmin:=prec.x;

      If prec.x>xmax then xmax:=prec.x;

      If prec.y<ymin then ymin:=prec.y;

      If prec.y>ymax then ymax:=prec.y;

      cw.sulypont.x:=cw.sulypont.x+prec.x;

      cw.sulypont.y:=cw.sulypont.y+prec.y;

      k:=k+1;

   end;

end

else

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;

   end;

end;

 

If k>0 then begin

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

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

end;

Try

    nagyx := Width /(xmax - xmin);

    nagyy := Height/(ymax - ymin);

except

    nagyx:=1; nagyy:=1;

end;

If nagyx > nagyy Then nagyx:= nagyy;

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

cw.minx := xmin; cw.maxx := xmax;

cw.miny := ymin; cw.maxy := ymax;

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

nagyitas := 0.9*nagyx;

Restore;

end;

 

procedure TStMapW.Alapratesz;

var i: longint;

begin

DecimalSeparator:='.';

pontmeret:= 1;

With cw do begin

filenev  := '';

filetipus:= '';

valtozott:= False;

aktreteg := 0;

pontszam := 0;

vonalszam:= 0;

szovegszam:=0;

jelkulcsszam:=0;

jelkulcsmeret:=0.02;

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}

If HRSZCombo<>nil then HRSZCombo.Clear;

RajzMod := rmNincs;

end;

 

{ StreamMeretek

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

procedure TStMapW.StreamMeretek(var cw:TMapConfig);

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 TStMapW.Centrumba(x,y:integer);

begin

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

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

    invalidate;

end;

 

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

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

begin

   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 TStMapW.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 TStMapW.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 TStMapW.CentToOrigo(c:TPoint2D):TPoint2D;

begin

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

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

end;

 

 

procedure TStMapW.NyomtatasPRN(ca: TCanvas);

var Centx,centy: real;

   pw: TMapConfig; ms: string;

   szorzo: real;

   tt: TRect;

begin

pw:=cw;

    cw.printing:=True;

    tt:=Ca.ClipRect;

    szorzo:=tt.right/Printer.Pagewidth;

    Ca.Pen.Color := clBlack;

    Ca.Brush.Color := clWhite;

    Centx:= cw.origox + (Width/2)/cw.nagyitas;

    Centy:= cw.origoy + (Height/2)/cw.nagyitas;

    aspX := printer.pagewidth/PageWidthmm;

    aspy := printer.pageheight/PageHeightmm;

    cw.nagyitas:= aspX*(1000/PrinterParam.meretarany);

    cw.origox := Centx - (Printer.Pagewidth/2)/(cw.nagyitas*cw.pr.paspx);

    cw.origoy := Centy - (Printer.PageHeight/2)/(cw.nagyitas*cw.pr.paspy);

    cw.nagyitas:=cw.nagyitas*szorzo;

    if not cw.pr.szines then cw.alapszin:=clWhite;

 

    Ujrarajzol(ca,tt);

 

    If PrinterParam.keretezes then begin

    Ca.Pen.Mode    := pmCopy;

    Ca.Brush.Style := bsClear;

    Ca.Rectangle(0,0,tt.right,tt.bottom);

    Ca.Font.Name:='Curier New';

    Ca.Font.Height:= -Trunc(tt.bottom/50); If Ca.font.size<1 then Ca.font.size:=1;

    Ca.Font.Color:=clBlack;

    Ca.Pen.Mode    := pmCopy;

    Ca.Pen.Style   := psSolid;

    Ca.Pen.Color   := clBlack;

    Ca.Brush.Style := bsSolid;

    Ca.Brush.Color := clWhite;

    Ca.Rectangle(0,0,tt.right,Trunc(tt.bottom/20));

    RotText(ca,Trunc(szorzo*50),Trunc(szorzo*40),PrinterParam.fejlec,0);

    ms:='M = 1:'+IntToStr(PrinterParam.meretarany);

    Ca.TextOut(Trunc(tt.right-1.2*Ca.TextWidth(ms)),Trunc(szorzo*50),ms);

{

    Canvas.Font.Size:=Trunc(t.bottom/80); If Canvas.font.size<1 then Canvas.font.size:=1;

    Canvas.TextOut(Trunc(szorzo*50),Trunc(t.bottom/20)+2*Canvas.Font.Height,cw.filenev);

    Canvas.TextOut(Trunc(szorzo*50),t.bottom+2*Canvas.Font.Height,'Origó y/x :  '

                  +Format('%8.2f',[Centy])+' : '+Format('%8.2f',[Centx]));}

    end;

cw := pw;

    cw.printing:=False;

end;

 

procedure TStMapW.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) Then AComponent:=nil;

end;

 

{ PONTKERES(X,Y: képernyő koord.-ák) = pontrekord

Ha prec.No=-1 akkor nem talált a tűrési tartományon belül;

ap = a pontrekord sorszama }

Function TStMapW.Pontkeres(x,y: Longint; var pr: Tpontrecord;var ap: Longint): boolean;

var x1,y1,x2,y2,xx_,yy_: real;

   i: longint;

   tures: real;

   pp: TPontrecord;

begin

Result:=False;

streammeretek(cw);

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

yy_ := cw.origoy + y / cw.nagyitas;

tures := cw.tentativtures / cw.nagyitas;

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

For i:=0 to cw.pontszam do begin

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

    x1 := pp.x - tures;

    x2 := pp.x + tures;

    y1 := pp.y - tures;

    y2 := pp.y + tures;

    If (xx_ > x1) And (xx_ < x2) Then

       If (yy_ > y1) And (yy_ < y2) Then

          If (GetBit(pp.jelzo,0)=0) or cw.toroltek then

          begin

           ap := i; pr:=pp;

           Result := True;

           Exit;

          End;

end;

end;

 

function TStMapW.Vonalkeres(x,y:Longint;var vrec:Tvonalrecord;var ap: Longint): boolean;

var tures     : real;

   i         : longint;

   e         : TEgyenes;

   p,p1,p2   : TPoint2d;

   vr        : Tvonalrecord;

   ve,me     : Tegyenesfgv;

begin

Result:=False;

streammeretek(cw);

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

p.y := cw.origoy + y / cw.nagyitas;

tures := cw.tentativtures / cw.nagyitas;

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

ap := -1;

For i:=0 to cw.vonalszam do begin

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

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

    If IsAblakSzakaszMetszes(p.x,p.y,tures,Rect2d(vr.x1,vr.y1,vr.x2,vr.y2)) then

      begin

              ap := i;

              vrec := vr;

              Result := True;

              Exit;

      end;

end;

end;

 

Function TStMapW.Feliratkeres(x,y: Longint; var szrec: Tszovegrecord;var ap: Longint): boolean;

var x1,y1,x2,y2: real;

   szr: Tszovegrecord;

   i,meret: longint;

   tures: real;

begin

Result:=False;

streammeretek(cw);

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

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

tures := cw.tentativtures / cw.nagyitas;

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

meret := SizeOf(szr);

For i:=0 to cw.szovegszam do begin

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

    x1 := szr.x - tures;

    x2 := szr.x + tures;

    y1 := szr.y - tures;

    y2 := szr.y + tures;

    If (xx > x1) And (xx < x2) Then

       If (yy > y1) And (yy < y2) Then

          If (GetBit(szr.jelzo,0)=0) or cw.toroltek then begin

           ap := i;

           szrec:=szr;

           Result := True;

           Exit;

          End;

end;

end;

 

Function TStMapW.Jelkulcskeres(x,y: Longint; var jk: Tjelkulcsrecord;var ap: Longint): boolean;

var x1,y1,x2,y2: real;

   i: longint;

   tures: real;

   jkcs: Tjelkulcsrecord;

begin

Result:=False;

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

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

tures := cw.tentativtures / cw.nagyitas;

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

For i:=0 to cw.jelkulcsszam do begin

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

    x1 := jkcs.x - tures;

    x2 := jkcs.x + tures;

    y1 := jkcs.y - tures;

    y2 := jkcs.y + tures;

    If (xx > x1) And (xx < x2) Then

       If (yy > y1) And (yy < y2) Then

          If (GetBit(jkcs.jelzo,0)=0) or cw.toroltek then begin

           ap := i; jk:=jkcs;

           Result := True;

           Exit;

          End;

end;

end;

 

{ Egy adott p ponthoz legközelebbi térképpont megkeresése }

Function TStMapW.LegkozelebbiPont(p: TPoint2D;var ap: Longint):TPontrecord;

var d,dd: real;

   i   : longint;

   pp  : TPontrecord;

begin

StreamMeretek(cw);

if cw.pontszam>0 then begin

tm[1].Seek(ap*sizeof(pp),0);

d := 10E+20;

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

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

     If (Getbit(pp.jelzo,0)<>1) then begin

        dd := KeTPontTavolsaga(p.x,p.y,pp.x,pp.y);

        If dd<d then begin

           d:=dd; Result:=pp;

           ap:=i;

        end;

     end;

end;

If d>1000000 then ap:=0;

end else begin

recNull(pp); pp.x:=p.x; pp.y:=p.y;

Result:=pp;

end;

end;

 

{LegkozelebbiVonal :

A p oontból kiindulva mérem a szakaszoktól való távolságot.

a legkisebb távolságra lévő a visszaadott érték.

d: a keresés sugara}

Function TStMapW.LegkozelebbiVonal(p: TPoint2D;var ap: Longint;var d:real):TVonalrecord;

var i    : longint;

   t    : TRect2d;

   p1,p2: TPoint2d;

begin

StreamMeretek(cw);

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

t:=Rect2d(p.x-d,p.y+d,p.x+d,p.y-d);

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

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

     p1:=Point2d(vrec.x1,vrec.y1);

     p2:=Point2d(vrec.x2,vrec.y2);

     If NearLine2P(p,Point2d(vrec.x1,vrec.y1), Point2d(vrec.x2,vrec.y2), d) then

     If (Getbit(vrec.jelzo,0)=0) or cw.toroltek then begin

        Result:=vrec; ap:=i;

     end;

end;

end;

 

{Egy p pont fölötti legközelebbi vonalat adja vissza

    p a pont térképi helye}

Function TStMapW.NextLine(p: TPoint2D;var vrec :TVonalrecord;var ap: Longint;reteg:byte):boolean;

var y         : real;

   i,vrs     : longint;

   vr        : Tvonalrecord;

   ve,me     : Tegyenesfgv;

   d,dd      : real;

begin

Result :=False;

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

vrs := SizeOf(vr);

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

ap := -1;

dd := 10e+20;

For i:=0 to cw.vonalszam do begin

    tm[2].Read(vr,vrs);

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

    If Kozben(vr.x1,vr.x2,p.x,0) then

    begin

      ve := KeTPontonAtmenoEgyenes(vr.x1,vr.y1,vr.x2,vr.y2);

      y := ve.a*p.x+ve.b;

      If y>p.y then begin

         d := y-p.y;

         If d<dd then begin

              dd := d;

              ap := i;

              vrec := vr;

              Result :=True;

         end;

      end;

    end;

end;

end;

 

Function TStMapW.LegkozelebbiSzoveg(p: TPoint2D;var ap: Longint):TSzovegrecord;

var i    : longint;

   tures,x1,y1,x2,y2:real;

   d,dd : real;

begin

StreamMeretek(cw);

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

{tures := cw.tentativtures / cw.nagyitas;}

d := 10E+20;

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

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

    {

    x1 := prec.x - tures;

    x2 := prec.x + tures;

    y1 := prec.y - tures;

    y2 := prec.y + tures;

    If (xx > x1) And (xx < x2) Then

       If (yy > y1) And (yy < y2) Then begin

    }

     If (Getbit(szrec.jelzo,0)<>1) then begin

     dd := KeTPontTavolsaga(p.x,p.y,szrec.x,szrec.y);

       If dd<d then begin

        d:=dd;

        Result:=szrec; ap:=i;

       end;

     end;

end;

{If i>cw.szovegszam then Result.szoveg:='';}

end;

 

Function TStMapW.LegkozelebbiJelkulcs(p: TPoint2D;var ap: Longint):TJelkulcsrecord;

var d,dd: real;

   i   : longint;

begin

if cw.jelkulcsszam<1 then begin JrecNull(Result); p.x:=0;p.y:=0; exit; end;

StreamMeretek(cw);

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

d := 10E+20;

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

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

     If (Getbit(jrec.jelzo,0)<>1) then begin

     dd := KeTPontTavolsaga(p.x,p.y,jrec.x,jrec.y);

     If dd<d then begin

        d:=dd; Result:=jrec;

        ap:=i;

     end;

     end;

end;

end;

 

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

var hrs,hrs1: string;

   i: longint;

begin

If cb<>nil then 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;

end;

 

procedure TStMapW.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 TStMapW.HRSZkeres(var sz: TSzovegrecord;var ap: Longint): boolean;

var s: string;

   i: longint;

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 TStMapW.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;

   FeliratRec:=szrec;

   If Assigned(FOnSearch) then FOnSearch(Self,3,aktszoveg-1,FeliratRec);

end else begin

   MessageBeep(0);

end;

end;

 

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

Function TStMapW.HrszOsszerak(h1,h2,h3,h4:string):string;

begin

Result:=Alltrim(h1);

If h2<>'' then Result:=Result+'/'+Alltrim(h2);

If h3<>'' then Result:=Result+'/'+Alltrim(h3);

If h4<>'' then Result:=Result+'/'+Alltrim(h4);

end;

 

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

Procedure TStMapW.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;

 

{ FeliratInPoligon = a polistream-en lévő poligon belselyében a

                    reteg-ben lévő feliratot keres

                    Ha a reteg=nil, akkor az első feliratot

    }

Function TStMapW.FeliratInPoligon(var szrec:Tszovegrecord;reteg:byte;var ap: longint):boolean;

var i    : longint;

   H    : Hrgn;

   HB   : HBrush;

   pont : TPoint;

   ponttomb: array[1..2000] of TPoint;

begin

Result:=False;

StreamMeretek(cw);

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

ap:=-1;

PoliStream.seek(0,0);

For i:=1 to polirec.PointsCount do begin

     PoliStream.Read(prec,SizeOf(prec));

     ponttomb[i]:=MapToScreen(Canvas,prec.x,prec.y,cw);

end;

H := CreatePolygonRgn(ponttomb,polirec.PointsCount,ALTERNATE);

     szrecnull(szrec);

SetPen(canvas,clRed,1,psSolid,pmXor);

HB := CreateSolidBrush(clRed);

Canvas.Copymode:=cmSrcCopy;

For i:=1 to cw.szovegszam do begin

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

    pont := MapToScreen(Canvas,szrec.x,szrec.y,cw);

    If PtInRegion(H,pont.x,pont.y) then

       If szrec.reteg=reteg then begin

          ap:=i;

          Result:=True;

          FillRgn(Canvas.Handle,H,HB);

          Break;

       end;

end;

DeleteObject(HB);

DeleteObject(H);

end;

 

{ Egy p ponthoz csatlakozó vonalrekordot adja vissza (vrec) az adott retegben;

Result : Tru ha talált csatlakozó vonalrekordot,

VAR vrec = a megtalált vonalrekord;

     RecNo = a rekordsorszám

     re_teg= réteg

Előtte érdemes meghívni: PontbolEl függvényt, mely megadja a pontba

futó élek számát.

}

Function TStMapW.CsatoltVonal(p: TPoint2D; var vrec :TVonalrecord; re_teg: byte;

                        var RecNo: Longint ):boolean;

begin

StreamMeretek(cw);

tm[2].Seek(RecNo*SizeOf(vrec),0);

Result := False;

While RecNo<=cw.vonalszam-1 do begin

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

     if (re_teg=vrec.reteg) and (Getbit(vrec.jelzo,0)<>1) then

     If ((vrec.x1=p.x) and (vrec.y1=p.y)) or

        ((vrec.x2=p.x) and (vrec.y2=p.y)) then

        begin

          Result := True;

          exit;

        end;

     Inc(Recno);

end;

end;

 

{Megszámolja a pontból kiinduló élek számát}

Function TStMapW.PontbolEl(p: Tpontrecord; re_teg: byte):integer;

var i: longint;

   vr: TVonalrecord;

begin

StreamMeretek(cw);

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

Result := 0;

For i:=1 to cw.vonalszam do begin

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

     if (re_teg=vr.reteg) and (Getbit(vr.jelzo,0)<>1) then

     If ((vr.x1=p.x) and (vr.y1=p.y)) or

        ((vr.x2=p.x) and (vr.y2=p.y)) then Inc(Result);

end;

end;

 

{ Zárt alakzat belselyére mutatva, meghatározza a területét

ca : rajzfelület Canvas,

p  : rámutatási belső pont

OUT: terület m2}

Function TStMapW.Teruletszamitas(ca: TCanvas; p : TPoint2D; re_teg: byte;

         var kerulet:real): real;

var alappont,oldalappont,vegpont,pont : TPoint2D;

   terulet   : real;

   x,y       : integer;

   kiindulo,pp: TPontrecord;

   von,keresettvonal : TVonalrecord;

   alapszog,szog,oldszogdif,szogdif,keresettszog: real;

   szogmin,szogmax: real;

   talalt    : boolean;

   RecNo     : Longint;

   vanvonal  : boolean;

   el        : integer;

   tpe       : TPen;

begin

StreamMeretek(cw); tpe:=Canvas.pen;

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

   poliStream.Clear;

   Polirec.PointsCount:=0;

aktpont:=0;

result:=0;

terulet := 0;

kerulet := 0;

If NextLine(Point2d(p.x,p.y),von,aktpont,re_teg) then begin

kiindulo.x:=von.x1; kiindulo.y:=von.y1;

alappont:=Point2D(kiindulo.x,kiindulo.y);

oldalappont:=Point2D(alappont.x,alappont.y);

alapszog := SzakaszSzog(alappont.x,alappont.y,p.x,p.y);

 

Try

Repeat

     If lreteg[re_teg] then begin

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

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

      Canvas.Rectangle(x-1,y-1,x+1,y+1);

      RecNo := 0;

      oldszogdif:=0;

      vanvonal:= false;

      pp.x:=alappont.x; pp.y:=alappont.y;

      el := PontbolEl(pp,re_teg);

      {Ha 2 élnél kevesebb van akkor nem zárt az alakzat; terület=0}

      If el<2 then begin

         Result := 0; kerulet:=0;

         exit;

      end;

 

      Repeat

        talalt := CsatoltVonal(alappont,von,re_teg,Recno);

        If talalt then begin

           {Veszem a csatolt vonal másik végét}

           If (von.x1=alappont.x) and (von.y1=alappont.y) then begin

              pont.x:=von.x2; pont.y:=von.y2;

           end else begin

              pont.x:=von.x1; pont.y:=von.y1;

           end;

 

           szog := SzakaszSzog(alappont.x,alappont.y,pont.x,pont.y);

           szogdif := Szogdiff(alapszog,szog);

           {A keresett szög:

           a keresett szög = a legnagyobb szögdifferebciájú}

           If szogdif<>0 then

           If (not vanvonal) or (szogdif>oldszogdif) then

              {If not (oldalappont.x=pont.x) then}

              begin

               oldszogdif := szogdif;

               keresettvonal:=von;

               vegpont.x:=pont.x; vegpont.y:=pont.y;

               vanvonal := true;

              end;

 

           Dec(el);

           Inc(Recno);

           {Canvas.pen.color:=clSILVER; Canvas.pen.width:=2;}

           {Vonalrajzol(ca,von);}

          end;

      Until (not talalt) or (el=0);

 

      If vanvonal then begin

           Vonalrajzol(ca,keresettvonal);

           alapszog := SzakaszSzog(vegpont.x,vegpont.y,alappont.x,alappont.y);

           terulet  := terulet+(Round(100*alappont.x)/100-Round(100*vegpont.x)/100)*

                    (Round(100*alappont.y)/100+Round(100*vegpont.y)/100)/2;

           kerulet  := kerulet+KeTPonttavolsaga(alappont.x,alappont.y,

                                vegpont.x,vegpont.y);

           Inc(Polirec.PointsCount);

           Inc(pontsorszam);

           prec.x:=alappont.x;

           prec.y:=alappont.y;

           prec.reteg:=von.reteg;

           poliStream.Write(prec,SizeOf(prec));

           oldalappont:=alappont;

           alappont.x:=vegpont.x; alappont.y:=vegpont.y;

      end else begin

       terulet := 0;

       exit;

      end;

     end;

Until (alappont.x=kiindulo.x) and (alappont.y=kiindulo.y);

Result := terulet;

except

   MessageDlg('Hiba!',mtError,[mbOk],0);

end;

Canvas.pen:=tpe;

end;

end;

 

procedure TStMapW.SaveToClipboard;

begin

Clipboard.Assign(TRKSaveBitmap);

end;

 

procedure TStMapW.Restore;

begin

    Fcentrumx:=origox+(width div 2)/nagyitas;

    Fcentrumy:=origoy+(height div 2)/nagyitas;

    t:=rect(0,0,width,height);

    TRKSaveBitmap.Width:=Width;

    TRKSaveBitmap.Height:=Height;

    FCentrumx:=FCentrumx;

    Centrumy:=FCentrumy;

    cw.kepernyo:=t;

end;

 

{ -----------  TStDBMapW ------------}

{constructor TStDBMapW.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FDataSource := TDataSource.Create(Application);

FDataLink   := TFieldDataLink.Create;

end;

 

destructor TStDBMapW.Destroy;

begin

FDataSource.Free;

FDataLink.Free;

inherited Destroy;

end;

 

function TStDBMapW.GetDataSource: TDataSource;

begin

Result := FDataLink.DataSource;

end;

 

procedure TStDBMapW.SetDataSource(Value: TDataSource);

begin

FDataLink.DataSource := Value;

FDatasource := value;

end;}

 

 

initialization

Demovar:=True;

end.