MMKEP

Top  Previous  Next

 

{ mm beosaztású tervezőlap komponens }

 

unit mmKep;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Menus, DsgnIntf,

Graphics, Controls, Forms, Dialogs, stdctrls, ExtCtrls, DGrafik, Geom,

B_Spline;

 

type

TScale = (stNone,stLine,stDot);

 

TPointType = class(TPersistent)

public

  FOnChange: TNotifyEvent;

  Fx : integer;

  Fy : integer;

  procedure Setx(Value:integer);

  procedure Sety(Value:integer);

  procedure Changed; dynamic;

published

  property OnChange: TNotifyEvent read FOnChange write FOnChange;

  property x: integer read Fx write Setx;

  property y: integer read Fy write Sety;

end;

 

TVAlakzat = (tvPenUp,          {0 = Toll fel, pozícionálás (0,x,y);}

             tvFire,           {1 = Átfúvás adott pozíciónál (1,100,100)}

             tvLine,           {2 = Vonal   (pontlánc) első ponttól az utolsóig (2,x,y)}

             tvCircle,         {3 = Kör     Középpont koordináták+sugár (3,x,y,z)}

             tvArc,            {4 = Körív   3 pont által megadott 4,x1,y1 - kezdő pont}

             tvEllipse,        {5 - Ellipszis : Középpont+r1+r2   5,100,100,50,20}

             tvEllipseArc,     {6 - Ellipszis ív}

             tvBsplineP,       {7 - Periodikus BSpline}

             tvBsplineNP,      {8 - Nem periodikus BSpline}

             tvBsplineMullP,   {9 - Periodikus MullRom BSpline}

             tvBsplineMullNP   {10- Nem periodikus MullRom BSpline}

            );

 

TTopologyMode = (topPenup,topPosition,topLine,topCircle,topArc,topEllipse,

                 topVertex,topLight,topNone);

 

TRajzmodType = (

       rmNincs,

       rmPont,

       rmVonal,

       rmKor,

       rmKoriv,

       rmEllipszis,

       rmEllipszisIv,

       rmBsplineP,

       rmBsplineNP,

       rmBsplineMullP,

       rmBsplineMullNP,

       rmBsplineMove,

       rmBsplineIns,

       rmBsplineDel,

       rmSokszog,

       rmNagyito,

       rmKicsinyito,

       rmCentrum,

       rmPonttorol,

       rmVonaltorol,

       rmKorivtorol,

       rmPontAtrak,

       rmKorivAtrak,

       rmPontkijelol,

       rmAblakkijelol,

       rmPolygonKijelol,

       rmKijeloltMasol,

       rmTopologia,

       rmHelp);

 

Const RajzmodFelirat : Array[0..Ord(High(TRajzmodType))] of string[18] =

      ('Nincs','Pont','Vonal','Kör','Körív','Ellipszis','Ellipszisív',

       'Periodikus BSpline','Nem periodikus BSpline','Periodikus MullRom BSpline',

       'Nem periodikus MullRom BSpline','Támpont mozgatás','Új támpont',

       'Támpont törlés',

       'Sokszög','Nagyító','Kicsinyítő',

       'Centrum','Ponttörlés','Vonaltörlés','Körívtörlés','Pontátrakás',

       'Körívátrakás','Támpont kijeloles','Ablak kijelölés','Sokszög kijelölés',

       'Kijelölt másolás','Topológia',

       'Help');

 

   VAlakzatFelirat : Array[0..Ord(High(TVAlakzat))] of string[30] =

      ('Toll Fel','Átfúvás','Vonal','Kör','Körív','Ellipszis','Ellipszisív',

       'Periodikus BSpline','Nem periodikus BSpline','Periodikus MullRom BSpline',

       'Nem periodikus MullRom BSpline');

 

Type

 

TRajzmodChangeEvent = procedure(Sender: TObject; Rajzmod:TRajzmodType) of object;

{TResizeEvent = procedure(Sender: TObject; SablonWidth,SablonHeight: integer) of object;}

 

TRajzelem = record                {Sablon file *.SBL adatblokk rekord}

No           : Longint;         {Sorszám}

ObjCode      : Longint;         {Objektum kód}

torolt       : boolean;

FuncCode     : byte;            {0,1=Toll fel,pozicionálás,2=vonal,3=kör,4=köriv}

X            : Longint;         {1000*x, 1/1000 mm = 1}

Y            : Longint;

Z            : Longint;

R            : Longint;

kijelolt     : boolean;

end;

 

TFactoryConfig = record

Demo          : boolean;        {Demó verzió = True}

Belepett      : word;           {Ennyiszer lépett be a programba}

UtolsoBelepes : TDateTime;      {Utolsó belépés dátuma}

globaldir     : String[120];    {Config és catalógus és INI file könyvtára}

localdir      : String[120];    {Sablon könyvtár}

filenev       : String[120];    {Utolsára megnyitorr Sablon file}

Rajzlap       : TPoint;         {Rajzlap méretei}

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

valtozott     : boolean;        {True = ha a rajzon módosítás történt}

pontszam      : longint;

vonalszam     : longint;

korszam       : longint;

korivszam     : longint;

kitoltoszin   : TColor;

orkereszt     : boolean;        {True = Látszik}

orkereszttav  :longint;         {cm=10mm; 5mm; 1mm}

orkeresztszin :TColor;          {Rácsozat szine}

orkeresztStilus:byte;      {0..3 = rácsozat,pontrács,keresztek,szaggatott vonal}

rmod          : TRajzmodType;          {rajzmód}

nagyitas      : real;

texteditor    : string[80];

printing      : boolean;        {True = nyomtatás folyamatban}

 

LepesX        : real;           {X léptetőmotor mm/1 léptetés}

LepesY        : real;           {Y léptetőmotor mm/1 léptetés}

LepesZ        : real;           {Z léptetőmotor mm/1 léptetés}

WorkSebesseg  : integer;        {Megmunkálási sebesség = 1..50}

PosSebesseg   : integer;        {Pozícionálási sebesség = 1..50}

Precizio      : integer;        {Tizedesek száma}

ActPosition   : TPoint3d;       {Utolsó aktuális pozíció}

Kiemeles      : integer;        {A fej kiemelése [leptetes_szám]}

KesleltetesMIN: longint;        {A léptetőmotorok min. késleltetése}

KesleltetesMINz: longint;       {A Z léptetőmotor min. késleltetése}

WorkingMode   : byte;           {0=teszt,1=Vágás,2=Glavírozáa}

end;

 

TReferences = Array[0..100] of TPoint2D;

 

TMMImage = class(TCustomControl)

private

  FFileName : String;             {Sablonfile neve}

  FBackImageFile : String;        {Háttérkép neve}

  FBackMonochrome : boolean;      {Háttérkép monochrome}

  FActPosition : TPoint3D;        {Aktuális pozíció a munkadarabon}

  FColor : TColor;

  FDrawPointer: TPoint2D;         {Mutató a rajzon sarokpontokhoz}

  FPaperWidth : integer;

  FPaperHeight : integer;

  FPen: TPen;

  FFont: TFont;

  FScaleVisible : boolean;

  FScaleColor : TColor;

  FScaleType : TScale;

  FScalemm : integer;

  FMagnify : extended;

  FMargin : integer;

  FXYLabel : TLabel;

  FXPos : extended;

  FYPos : extended;

  FPointInfo : boolean;          {Pont info megjelenítése}

  FPointSize : integer;           {pontok mérete}

  FPointColor : TColor;           {pontok szine}

  FRajzMod: TRajzmodType;

  FRajzModCombo: TCombobox;

  FRajzmodChange: TRajzmodChangeEvent;

  FRajzmodLabel : TLabel;

  FText : string;                {Egy szöveg kiírása a sablonra}

  FTextPosition : TPointType;

  FTopologyMode : TTopologyMode;

  FVisibleMoving: boolean;       {A pozícionálások is láthatók a rajzon szürke vonallal}

  FOnResize : TNotifyEvent;      {Ázméretezés esemény}

  procedure SetFileName(Value:string);

  procedure SetBackImageFile(Value:string);

  procedure SetBackMonochrome(Value : boolean);

  procedure SetActPosition(Value:TPoint3D);

  procedure SetColor(Value:TColor);

  procedure SetFont(Value:TFont);

  procedure SetMagnify(Value:extended);

  procedure SetMargin(Value:integer);

  procedure SetPaperWidth(Value:integer);

  procedure SetPaperHeight(Value:integer);

  procedure SetPen(Value: TPen);

  procedure SetPointInfo(Value:boolean);

  procedure SetPointSize(Value:integer);

  procedure SetPointColor(Value:TColor);

  procedure SetRajzmod(Value: TRajzmodType);

  procedure SetRajzmodLabel(Value: TLabel);

  procedure SetRajzmodCombo(Value: TCombobox);

  procedure SetScaleVisible(Value:boolean);

  procedure SetScaleColor(Value:TColor);

  procedure SetScaleType(Value:TScale);

  procedure SetScalemm(Value:integer);

  procedure SetText(Value:string);

  procedure SetXYLabel(Value:TLabel);

  procedure SetVisibleMoving(Value:boolean);

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

protected

  BackImage       : TBitmap;

  ujrarajzolas    : boolean;     {Ujrarajzolás folyamatban}

  racstav         : integer;

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

  pFazis          : integer;

  Origin,MovePt   : TPoint;

  oldOrigin,oldMovePt : TPoint;

  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 RajzmodComboClick(Sender: TObject);

  procedure Change(Sender: TObject);

  procedure RacsRajzol;

public

  sblSTM             : TMemoryStream;    {Sablon memória stream}

  changeSTM          : TMemoryStream;    {memória stream sorrend ártendezéséhez}

  copySTM            : TMemoryStream;    {memória stream ideglenes másolathoz}

  poliSTM            : TMemoryStream;    {memória stream poligonokhoz}

  basePoint          : TPoint;           {poligon kiindulási pont}

  FactoryConfig      : TFactoryConfig;

  actualpont         : longint;     {akt.pont sorszáma az sblSTM-en}

  actRajzelem        : TRajzelem;

  actNo              : longint;     {Sorszám topologizáláshoz}

  newObj             : boolean;     {Topológiában új alakzat kezdődik}

  Rajzelem           : TRajzelem;

  Cur,oldCur         : TCursor;

  P1,P2,P3           : TPoint2D;

  mm                 : extended;

  ap                 : longint;

  cDataArray         : CurveDataArray;

  cDataCount         : word;

  csakKijeloltek     : boolean;          {Műveletek csak kijelöltekkel}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure ClearSablon;                 {Törli a sablont és az adatokat}

  procedure RajzelemNull(var r:TRajzelem);

  function CoordtoMM(x,y:integer): TPoint2D;

  function MMtoCoord(xmm,ymm:extended): TPoint;

  procedure MoveTo(x,y:extended);

  procedure LineTo(x,y:extended);

  procedure Rectangle(x1,y1,x2,y2:extended);

  procedure Ellipse(x1,y1,x2,y2:extended);

  procedure Arc(p1,p2,p3:TPoint2d);

{    procedure Spline(CA:TCanvas;var dd:CurveDataArray;nPoints,nSteps:word;

               spAlgoritm:TBSplineAlgoritm);}

  procedure Ujrarajzol;

  function Pontkeres(x,y: Longint; Var Rajzelem : TRajzelem; var pno: longint;pos: longint):boolean;

  function MaxNo:longint;

  procedure RajzelemSave(actR:TRajzelem;actP:longint);

  function RajzelemLoad(var actR:TRajzelem;actP:longint):boolean;

  procedure KijeloltToCopyStream;

  procedure KijeloltFromCopyStream;

  procedure SablonEltolas(var sbl:TMemoryStream;dx,dy:extended);

  procedure SablonNyujtas(var sbl:TMemoryStream;ox,oy,dx,dy:extended);

  procedure SablonElforgatas(var sbl:TMemoryStream;origo:TPoint2d;szog:extended);

  procedure SablonTukrozes(var sbl:TMemoryStream;dx,dy:extended;

                               merre:integer);

  procedure NewDrawPointer(Value:TPoint2D);

  procedure PoligonKijelol;

  procedure VeglegesTorles;

  {topologizálás}

  procedure NewTopology;

  procedure EndTopology;

  procedure UndoTopology;

  property Canvas;

  Property ActPosition : TPoint3D read FActPosition write SetActPosition;

  Property XPos : extended read FXPos write FXPos ;

  Property YPos : extended read FYPos write FYPos ;

  Property DrawPointer: TPoint2D read FDrawPointer write FDrawPointer;

  Property TopologyMode : TTopologyMode read FTopologyMode write FTopologyMode;

published

  Property FileName : String read FFileName write SetFileName;

  Property BackImageFile : String read FBackImageFile write SetBackImageFile;

  Property BackMonochrome : boolean read FBackMonochrome write SetBackMonochrome;

  Property Color : TColor read FColor write SetColor default clWhite;

  Property Font: TFont read FFont write SetFont;

  Property Magnify : extended read FMagnify write SetMagnify;

  Property Margin : integer read FMargin write SetMargin;

  Property PaperWidth : integer read FPaperWidth write SetPaperWidth default 1;

  Property PaperHeight : integer read FPaperHeight write SetPaperHeight default 1;

  Property Pen: TPen read FPen write SetPen;

  Property PointInfo : boolean read FPointInfo write SetPointInfo;

  property PointSize : integer read FPointSize write SetPointSize default 2;

  property PointColor : TColor read FPointColor write SetPointColor default 2;

  property PopupMenu;

  property RajzMod: TRajzmodType read FRajzmod write SeTRajzmod default rmNincs;

  Property RajzmodLabel : TLabel read FRajzmodLabel write SetRajzmodLabel;

  Property RajzmodCombo : TCombobox read FRajzmodCombo write SetRajzmodCombo;

  Property ScaleVisible : boolean read FScaleVisible write SetScaleVisible default True;

  Property ScaleColor : TColor read FScaleColor write SetScaleColor default clGreen;

  Property ScaleType : TScale read FScaleType write SetScaleType ;

  Property Scalemm : integer read FScalemm write SetScalemm default 1;

  Property Text : string read FText write SetText;

  Property TextPosition : TPointType read FTextPosition write FTextPosition;

  Property XYLabel : TLabel read FXYLabel write SetXYLabel ;

  Property VisibleMoving: boolean read FVisibleMoving write SetVisibleMoving;

  property OnResize: TNotifyEvent read FOnResize write FOnResize;

  property OnRajzmodChange: TRajzmodChangeEvent read FRajzmodChange write FRajzmodChange;

  property Showhint;

end;

 

TSablonImage = class(TMMImage)

private

protected

  procedure Paint;override;

public

  property Canvas;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  property Align;

  Property Color;

  Property Magnify;

  Property Margin;

  Property PaperWidth;

  Property PaperHeight;

  Property Pen;

  property PopupMenu;

  property RajzMod;

  Property RajzmodLabel;

  Property ScaleVisible;

  Property ScaleColor;

  Property ScaleType;

  Property Scalemm;

  Property XYLabel;

  property Showhint;

  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

TFileProperty = class(TStringProperty)

private

  FileType : string[3];

public

  FOpenDialog : TOpenDialog;

  function GetAttributes: TPropertyAttributes; override;

  function GetValue: string; override;

  procedure SetValue(const Value: string); override;

  procedure Edit; override;

end;

 

procedure Register;

Function RajzmodToString(rmod:TRajzmodType):string;

Function StringToRajzmod(rmodstring:string):TRajzmodType;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL',[TMMImage,TSablonImage]);

RegisterPropertyEditor(TypeInfo(string), TMMImage, 'FileName', TFileProperty);

RegisterPropertyEditor(TypeInfo(string), TMMImage, 'BackImageFile', TFileProperty);

end;

 

{ -----------  TPointType --------- }

procedure TPointType.Changed;

begin if Assigned(FOnChange) then FOnChange(Self); end;

 

procedure TPointType.Setx(Value:integer);

begin

If Fx<>Value then begin

   Fx:=Value;

   Changed;

end;

end;

 

procedure TPointType.Sety(Value:integer);

begin

If Fy<>Value then begin

   Fy:=Value;

   Changed;

end;

end;

 

constructor TMMImage.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   sblSTM    := TMemoryStream.Create;   {Sablon memória stream}

   changeSTM := TMemoryStream.Create;   {Átsorszámozáshoz}

   copySTM   := TMemoryStream.Create;   {Másolásokhoz}

   poliSTM   := TMemoryStream.Create;   {Poligonokhoz}

   BackImage := TBitmap.Create;

   FTextPosition := TPointType.Create;

   FTextPosition.OnChange := Change;

   cDataCount    := 0;

   FPen          := TPen.Create;

   FPen.Color    := clBlack;

   FPen.Width    := 1;

   FFont         := TFont.Create;

   FRajzmod      := rmNincs;

   FScaleColor   := clSilver;

   FScalemm      := 1;

   FMagnify      := 1;

   FColor        := clWhite;

   FMargin       := 0;

   FScaleVisible  := True;

   FRajzmodCombo  := RajzmodCombo;

   FVisibleMoving:= False;

   FDrawPointer  := Point2d(0,0);

   FPointSize    := 2;

   mm            := Screen.PixelsPerInch/25.4;

   actNo         := 0;

   csakKijeloltek:= False;

   PaperWidth    := 50;

   PaperHeight   := 50;

end;

 

destructor TMMImage.Destroy;

begin

   FPen.Destroy;

   FFont.Destroy;

   sblSTM.Destroy;

   changeSTM.Free;

   poliSTM.Free;

   copySTM.Free;

   FTextPosition.Free;

   BackImage.Free;

   inherited Destroy;

end;

 

procedure TMMImage.Change(Sender: TObject);

begin

invalidate;

end;

 

procedure TMMImage.ClearSablon;          {Törli a sablont és az adatokat}

begin

sblSTM.Clear;

invalidate;

end;

 

procedure TMMImage.RajzelemNull(var r:TRajzelem);

begin

r.No        := 0;

r.ObjCode   := 0;

r.torolt    := False;

r.FuncCode  := 0;

r.x         := 0;

r.y         := 0;

r.z         := 0;

r.r         := 0;

r.kijelolt  := False;

end;

 

{Ujra topologizálás: törli a changeSTM stream-et}

procedure TMMImage.NewTopology;

begin

changeSTM.Clear;

newObj:=True;

repaint;

end;

 

procedure TMMImage.EndTopology;

begin

sblSTM.LoadFromStream(changeSTM);

changeSTM.Clear;

newObj:=False;

repaint;

end;

 

{Az utolsó élő rajzelem törlése}

procedure TMMImage.UndoTopology;

var i,meret: longint;

  Relem : TRajzelem;

begin

If changeSTM.Size>0 then begin

   meret := changeSTM.Size div SizeOf(TRajzelem);

   changeSTM.Seek(-SizeOf(TRajzelem),2);

   repeat

     changeSTM.Read(Relem,SizeOf(TRajzelem));

     changeSTM.Seek(-2*SizeOf(TRajzelem),1);

   until (not Relem.torolt) or (changeSTM.Position=0);

   Relem.torolt:=True;

   changeSTM.Seek(SizeOf(TRajzelem),1);

   changeSTM.Write(Relem,SizeOf(TRajzelem));

   invalidate;

end;

end;

 

procedure TMMImage.SetFileName(Value:string);

begin

If (FFileName<>Value) then begin

   FFileName:=Value;

   If FileExists(Value) then

      sblSTM.LoadFromFile(Value)

   else

      sblSTM.Clear;

   actNo := 0;

   invalidate;

end;

end;

 

procedure TMMImage.SetBackImageFile(Value:string);

begin

If (FBackImageFile<>Value) then begin

   FBackImageFile:=Value;

   If FileExists(Value) then begin

      BackImage.LoadFromFile(Value)

   end else

   With BackImage.Canvas do begin

      Brush.Color:=color;

      Pen.Color  :=color;

      FillRect(BackImage.Canvas.Cliprect);

   end;

   actNo := 0;

   invalidate;

end;

end;

 

procedure TMMImage.SetBackMonochrome(Value : boolean);

begin

FBackMonochrome := Value;

BackImage.Monochrome := Value;

Invalidate;

end;

 

{Rámutatás a sablon egy pontjára}

procedure TMMImage.NewDrawPointer(Value:TPoint2D);

var dc: HDC;

  p : TPoint;

begin

   DC := SaveDC(Canvas.Handle);

   Canvas.Pen.Mode:=pmNotXor;

   Canvas.Brush.Style:=bsSolid;

   Canvas.Brush.Color:=clRed;

   p:=MMtoCoord(FDrawPointer.x,FDrawPointer.y);

   Canvas.Rectangle(p.x-4,p.y-4,p.x+4,p.y+4);

   FDrawPointer:=Value;

   p:=MMtoCoord(FDrawPointer.x,FDrawPointer.y);

   Canvas.Rectangle(p.x-4,p.y-4,p.x+4,p.y+4);

   RestoreDC(Canvas.Handle,DC);

end;

 

procedure TMMImage.SetFont(Value:TFont);

begin

   FFont.Assign(Value);

   Repaint;

end;

 

procedure TMMImage.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetPointSize(Value:integer);

begin

If FPointSize<>Value then begin

   FPointSize:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetPointColor(Value:TColor);

begin

If FPointColor<>Value then begin

   FPointColor:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetMargin(Value:integer);

begin

If FMargin<>Value then begin

   FMargin:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetPen(Value: TPen);

begin

FPen.Assign(Value);

Canvas.Pen.Assign(Value);

invalidate;

end;

 

procedure TMMImage.SetScaleVisible(Value:boolean);

begin

If FScaleVisible<>Value then begin

   FScaleVisible:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetScaleColor(Value:TColor);

begin

FScaleColor := Value;

invalidate;

end;

 

procedure TMMImage.SetPaperWidth(Value:integer);

begin

If FPaperWidth<>Value then begin

   FPaperWidth:=Value;

   Width := Trunc(FPaperWidth * FMagnify * mm);

   invalidate;

end;

end;

 

procedure TMMImage.SetPaperHeight(Value:integer);

begin

If FPaperHeight<>Value then begin

   FPaperHeight:=Value;

   Height := Trunc(FPaperHeight * FMagnify * mm);

   invalidate;

end;

end;

 

procedure TMMImage.SetPointInfo(Value:boolean);

begin

If FPointInfo<>Value then begin

   FPointInfo:=Value;

   Invalidate;

end;

end;

 

procedure TMMImage.SetRajzmod(Value: TRajzmodType);

var s:string;

begin

If FRajzmod<>Value then begin

   FRajzmod:=Value;

   FactoryConfig.rmod := Value;

   s := Rajzmodfelirat[Ord(Value)];

   Cursor := crDefault;

   pFazis := 1;

   Case Value of

     rmNincs : Repaint;

     rmBsplineP,rmBsplineNP,rmBsplineMullP,rmBsplineMullNP:

       cDataCount:=0;

     rmPolygonKijelol,rmAblakkijelol:

       begin

         poliSTM.Clear;

       end;

     rmKijeloltMasol: KijeloltToCopyStream;

     rmTopologia: ActNo := MaxNo;

{       rmNagyito:    Cursor:=crNagyito;

     rmKicsinyito: Cursor:=crKicsinyito;

     rmCentrum:    Cursor:=crCentrum;

     rmHelp:       Cursor:=crHelp;

     rmKoriv : ;}

   end;

   oldCur:=Cursor; Cur := Cursor;

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

   If RajzmodCombo<>nil then begin

      RajzmodCombo.Itemindex:=Ord(Value);

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

   end;

   Rajzmodstring:=s;

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

end;

end;

 

procedure TMMImage.SetRajzmodLabel(Value: TLabel);

begin

   FRajzmodLabel:=Value;

   FRajzmodLabel.Caption:=Rajzmodstring;

end;

 

procedure TMMImage.SetRajzmodCombo(Value: TCombobox);

var i: integer;

begin

   FRajzmodCombo:=Value;

   If Value<>nil then begin

      FRajzmodCombo.Clear;

      For i:=0 To High(RajzmodFelirat) do

          FRajzmodCombo.Items.Add(RajzmodFelirat[i]);

      FRajzmodCombo.Text := RajzmodFelirat[Ord(Rajzmod)];

      FRajzmodCombo.OnClick := RajzmodComboClick;

   end;

   invalidate;

end;

 

procedure TMMImage.RajzmodComboClick(Sender: TObject);

begin

   RajzMod := TRajzModType(RajzmodCombo.Itemindex);

   inherited Click;

end;

 

procedure TMMImage.SetScaleType(Value:TScale);

begin

If FScaleType<>Value then begin

   FScaleType:=Value;

   invalidate;

end;

end;

 

 

procedure TMMImage.SetScalemm(Value:integer);

begin

If FScalemm<>Value then begin

   FScalemm:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetText(Value:string);

begin

If FText<>Value then begin

   FText:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.SetMagnify(Value:extended);

var oldValue:extended;

begin

If FMagnify<>Value then begin

   oldValue:=FMagnify;

   If Value<0.0001 then Value:=0.0001;

   FMagnify:=Value;

   Width := Trunc(FPaperWidth * FMagnify * mm);

   Height := Trunc(FPaperHeight * FMagnify * mm);

   Font.Size:=Round(Font.Size*Value/oldValue);

   invalidate;

end;

end;

 

 

procedure TMMImage.SetXYLabel(Value:TLabel);

begin

If FXYLabel<>Value then begin

   FXYLabel:=Value;

end;

end;

 

procedure TMMImage.SetVisibleMoving(Value:boolean);

begin

If FVisibleMoving<>Value then begin

   FVisibleMoving:=Value;

   invalidate;

end;

end;

 

procedure TMMImage.WMSize(var Msg: TWMSize);

begin

  inherited;

{    FPaperWidth := Trunc(Msg.width/(FMagnify * mm));

  FPaperHeight := Trunc(Msg.Height/(FMagnify * mm));}

  If Assigned(FOnResize) then FOnResize(Self);

end;

 

{ A mmpapír fizikai koordinátákat átszámítja a mm skálára }

function TMMImage.CoordtoMM(x,y:integer): TPoint2D;

begin

Result.x := x/(Magnify*mm);

Result.y := (Height-y)/(Magnify*mm);

XPos := Result.x; YPos := Result.y;

end;

 

{ A mmpapír mm skáláját átszámítja fizikai koordinátákká }

function TMMImage.MMtoCoord(xmm,ymm:extended): TPoint;

begin

Result := Point(Trunc(Xmm*(Magnify*mm)),Height-Trunc(Ymm*(Magnify*mm)));

end;

 

procedure TMMImage.SetActPosition(Value:TPoint3D);

Var p : TPoint;

  d : integer;

  pe: TPen;

begin

   d := 4;  pe:=Canvas.Pen;

   Canvas.Pen.Mode:=pmNotXor;

   Canvas.Pen.Color:=clRed;

   If not ujrarajzolas then begin

      p := MMtoCoord(ActPosition.x,ActPosition.y);

      Canvas.Ellipse(p.x-d,p.y-d,p.x+d,p.y+d);

   end;

   FActPosition := Value;

   p := MMtoCoord(FActPosition.x,FActPosition.y);

   Canvas.Ellipse(p.x-d,p.y-d,p.x+d,p.y+d);

   Canvas.Pen := pe;

   ujrarajzolas := False;

end;

 

procedure TMMImage.Paint;

var p: TPoint;

  DC: HDC;

begin

DC := SaveDC(Canvas.Handle);

ujrarajzolas := True;

Cls(Canvas,Color);

Canvas.Draw(0,0,BackImage);

If ScaleVisible then RacsRajzol;

Ujrarajzol;

   Canvas.Pen.Mode:=pmNotXor;

   Canvas.Brush.Style:=bsSolid;

   Canvas.Brush.Color:=clRed;

   p:=MMtoCoord(FDrawPointer.x,FDrawPointer.y);

   Canvas.Rectangle(p.x-4,p.y-4,p.x+4,p.y+4);

RestoreDC(Canvas.Handle,DC);

inherited Paint;

end;

 

procedure TMMImage.RacsRajzol;

var i,xx,yy: integer;

begin

Canvas.Pen.Color := ScaleColor;

Canvas.Pen.Width := 1;

Canvas.Pen.Style := psSolid;

For i:=0 to PaperHeight do begin

    yy:=Trunc(Round(i*Magnify*mm));

    If (i mod 10)=0 then begin

       Canvas.Pen.Width := 2

    end else begin

       Canvas.Pen.Width := 1;

    end;

    If ((magnify<1) and (Canvas.Pen.Width=2)) or (magnify>=1) then

    Canvas.MoveTo(0,Height-yy);Canvas.LineTo(Width,Height-yy);

end;

For i:=0 to PaperWidth do begin

    xx:=Round(Trunc(i*Magnify*mm));

    If (i mod 10)=0 then begin

       Canvas.Pen.Width := 2

    end else begin

       Canvas.Pen.Width := 1;

    end;

    If ((magnify<1) and (Canvas.Pen.Width=2)) or (magnify>=1) then

    Canvas.MoveTo(xx,0);Canvas.LineTo(xx,Height);

end;

end;

 

procedure TMMImage.Ujrarajzol;

var meret,i,aktpos : longint;

  p,pPos : TPoint;

  pp1,pp2,pp3 : TPoint2d;

  TollLe : boolean;

  z,r: integer;

  pontszam : integer;

  peColor  : TColor;

  oldFuncCode : byte;

  rLast,rNext: TRajzelem;

begin

meret  := sblSTM.Size div SizeOf(TRajzelem);

aktpos := sblSTM.Position;

sblSTM.Seek(0,0);

TollLe := False;

Canvas.Pen.Assign(Pen);

Canvas.Brush.Style:=bsClear;

Canvas.Font.Assign(Font);

Canvas.TextOut(TextPosition.x,Height-TextPosition.y-Canvas.TextHeight(Text),Text);

pontszam := 1;

oldFuncCode := 0;

p := MMtoCoord(ActPosition.x,ActPosition.y);

Canvas.MoveTo(p.x,p.y);

For i:=1 to meret do begin

    sblSTM.Read(Rajzelem,SizeOf(TRajzelem));

  If not Rajzelem.torolt then begin

    p := MMtoCoord(Rajzelem.x/1000,Rajzelem.y/1000);

    z := Trunc((Rajzelem.z/1000)*Magnify*mm);

    r := Trunc((Rajzelem.r/1000)*Magnify*mm);

    If not TollLe then Canvas.MoveTo(p.x,p.y);

    TollLe := True;

 

    If PointInfo then begin

       pPos:=Canvas.Penpos;

       peColor:= Canvas.Pen.Color;

       If Rajzelem.kijelolt then begin

          Canvas.Pen.Color := clBlue;

          Canvas.Brush.Color := clBlue;

          Canvas.Brush.Style:=bsSolid;

       end else begin

          Canvas.Pen.Color:=PointColor;

          Canvas.Brush.Style:=bsClear;

       end;

       Canvas.Pen.Mode := pmCopy;

       Canvas.Ellipse(p.x-PointSize,p.y-PointSize,p.x+PointSize,p.y+PointSize);

       Canvas.Pen.Color:=peColor;

{         Canvas.Font.Assign(Font);

       Canvas.TextOut(p.x,p.y,IntToStr(i)+'('+IntToStr(Rajzelem.FuncCode)+')');}

       Canvas.MoveTo(pPos.x,pPos.y);

    end;

    If Rajzelem.kijelolt then

       Canvas.Pen.Color := clBlue

    else Canvas.Pen.Assign(Pen);

 

    If (oldFuncCode in [7..10]) and (not (Rajzelem.FuncCode in [7..10]) or (i=meret)) then

       Spline(Canvas,cDataArray,cDataCount,16,TBSplineAlgoritm(oldFuncCode-6));

 

    Case Rajzelem.FuncCode of    {0=tollfel; 1=Átfúvás; 2=Vonal; 3=Köriv, 4=Ellipszis}

    0,1 : If VisibleMoving then begin

          TollLe := False;

          peColor := Canvas.Pen.Color;

          Canvas.Pen.Color := clSilver;

          Canvas.LineTo(p.x,p.y);

          pPos:=Canvas.Penpos;

          If Rajzelem.FuncCode=1 then begin  {Átfúvás}

             peColor := Canvas.Pen.Color;

             Canvas.Pen.Color := clSilver;

             Canvas.Ellipse(p.x-4,p.y-4,p.x+4,p.y+4);

          end;

          Canvas.Pen.Color:=peColor;

          Canvas.MoveTo(pPos.x,pPos.y);

        end;

    2 : If oldFuncCode<>2 then

           Canvas.MoveTo(p.x,p.y)

        else

           Canvas.LineTo(p.x,p.y);

    3 : Canvas.Ellipse(p.x-z,p.y-z,p.x+z,p.y+z);

    4 : if i<meret then begin

          PP2.X:=p.x; PP2.Y:=p.y;

          RajzelemLoad(rLast,i-2);

          p := MMtoCoord(rLast.x/1000,rlast.y/1000);

          PP1.X:=p.x; PP1.Y:=p.y;

          RajzelemLoad(rNext,i);

          p := MMtoCoord(rNext.x/1000,rNext.y/1000);

          PP3.X:=p.x; PP3.Y:=p.y;

          KorivRajzol(Canvas,PP1,PP2,PP3);

        end;

{         Case pontszam of

        1: begin PP1.X:=p.x; PP1.Y:=p.y; Inc(pontszam,1); end;

        2: begin PP2.X:=p.x; PP2.Y:=p.y; Inc(pontszam,1); end;

        3: begin

                 PP3.X:=p.x; PP3.Y:=p.y;

                 KorivRajzol(Canvas,PP1,PP2,PP3);

                 pontszam:=1;

                 TollLe := False;

           end;

        end;}

    5 : Canvas.Ellipse(p.x-z,p.y-r,p.x+z,p.y+r);

    7,8,9,10 :

       begin

          If not (oldFuncCode in [7..10]) then cDataCount := 1;

          cDataArray[cDataCount] := Point3d(p.x,p.y,0);

          Inc(cDataCount);

        end;

    end;

    oldFuncCode := Rajzelem.FuncCode;

    end

end;

 

{topologizálás megjelenítése}

If changeSTM.Size>0 then begin

   meret  := changeSTM.Size div SizeOf(TRajzelem);

   changeSTM.Seek(0,0);

   oldFuncCode := 0;

   For i:=1 to meret do begin

       changeSTM.Read(Rajzelem,SizeOf(TRajzelem));

   If not Rajzelem.torolt then begin

       p := MMtoCoord(Rajzelem.x/1000,Rajzelem.y/1000);

       z := Trunc((Rajzelem.z/1000)*Magnify*mm);

       r := Trunc((Rajzelem.r/1000)*Magnify*mm);

       Canvas.Pen.Color := clRed;

       Canvas.Pen.Width := 2;

    Case Rajzelem.FuncCode of    {0=tollfel; 1=Átfúvás; 2=Vonal; 3=Köriv, 4=Ellipszis}

    0,1 : If VisibleMoving then begin

          pPos:=Canvas.Penpos;

          If Rajzelem.FuncCode=1 then begin  {Átfúvás}

             peColor := Canvas.Pen.Color;

             Canvas.Pen.Color := clSilver;

             Canvas.Ellipse(p.x-4,p.y-4,p.x+4,p.y+4);

          end else begin

             Canvas.Pen.Color := clBlue;

             Canvas.MoveTo(p.x,p.y);

          end;

          Canvas.Pen.Color:=peColor;

          Canvas.MoveTo(pPos.x,pPos.y);

        end;

    2 : If oldFuncCode<>2 then

           Canvas.MoveTo(p.x,p.y)

        else

           Canvas.LineTo(p.x,p.y);

    3 : Canvas.Ellipse(p.x-z,p.y-z,p.x+z,p.y+z);

    4 : if i<meret then begin

          PP2.X:=p.x; PP2.Y:=p.y;

          changeSTM.Seek(-2*SizeOf(Rajzelem),1);

          changeSTM.Read(rLast,SizeOf(Rajzelem));

          p := MMtoCoord(rLast.x/1000,rlast.y/1000);

          PP1.X:=p.x; PP1.Y:=p.y;

          changeSTM.Seek(SizeOf(Rajzelem),1);

          changeSTM.Read(rNext,SizeOf(Rajzelem));

          p := MMtoCoord(rNext.x/1000,rNext.y/1000);

          PP3.X:=p.x; PP3.Y:=p.y;

          KorivRajzol(Canvas,PP1,PP2,PP3);

          Canvas.Moveto(Round(pp3.x),Round(pp3.y));

          changeSTM.Seek(-SizeOf(Rajzelem),1);

        end;

{          Case pontszam of

        1: begin PP1.X:=p.x; PP1.Y:=p.y; Inc(pontszam,1); end;

        2: begin PP2.X:=p.x; PP2.Y:=p.y; Inc(pontszam,1); end;

        3: begin

                 PP3.X:=p.x; PP3.Y:=p.y;

                 KorivRajzol(Canvas,PP1,PP2,PP3);

                 Canvas.MoveTo(p.x,p.y);

                 pontszam:=1;

                 TollLe := False;

           end;

        end;}

    5 : Canvas.Ellipse(p.x-z,p.y-r,p.x+z,p.y+r);

    255: begin

             peColor := Canvas.Pen.Color;

             Canvas.Pen.Color := clGreen;

             Canvas.Rectangle(p.x-4,p.y-4,p.x+4,p.y+4);

             Canvas.Pen.Color:=peColor;

         end;

    end;

    pPos:=Canvas.Penpos;

    Canvas.Ellipse(p.x-4,p.y-4,p.x+4,p.y+4);

    Canvas.MoveTo(pPos.x,pPos.y);

    oldFuncCode := Rajzelem.FuncCode;

   end;

   end;

end;

 

sblSTM.Seek(aktpos,0);

ActPosition := ActPosition;

Canvas.Brush.Style:=bsSolid;

end;

 

procedure TMMImage.MoveTo(x,y:extended);

Var p : TPoint;

begin

p := MMtoCoord(x,y);

Canvas.MoveTo(p.x,p.y);

end;

 

procedure TMMImage.LineTo(x,y:extended);

Var p : TPoint;

begin

p := MMtoCoord(x,y);

Canvas.LineTo(p.x,p.y);

end;

 

procedure TMMImage.Rectangle(x1,y1,x2,y2:extended);

Var pp1,pp2 : TPoint;

begin

pp1 := MMtoCoord(x1,y1);

pp2 := MMtoCoord(x2,y2);

Canvas.Rectangle(pp1.x,pp1.y,pp2.x,pp2.y);

end;

 

procedure TMMImage.Ellipse(x1,y1,x2,y2:extended);

Var pp1,pp2 : TPoint;

begin

pp1 := MMtoCoord(x1,y1);

pp2 := MMtoCoord(x2,y2);

Canvas.Ellipse(pp1.x,pp1.y,pp2.x,pp2.y);

end;

 

procedure TMMImage.Arc(p1,p2,p3:TPoint2d);

Var pp1,pp2,pp3 : TPoint;

begin

pp1 := MMtoCoord(p1.x,p1.y);

pp2 := MMtoCoord(p2.x,p2.y);

pp3 := MMtoCoord(p3.x,p3.y);

Korivrajzol(Canvas,Point2d(pp1.x,pp1.y),Point2d(pp2.x,pp2.y),Point2d(pp3.x,pp3.y));

end;

 

function TMMImage.Pontkeres(x,y: Longint; Var Rajzelem : TRajzelem;

                           var pno: longint;pos: longint):boolean;

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

  i,meret,aPos: longint;

  tures: real;

  pp: TPoint;

begin

Try

Result:=False;

aPos := sblSTM.Position;

If pos<=0 then sblSTM.Seek(0,0)

else sblSTM.Seek(pos*SizeOf(TRajzelem),0);

meret := sblSTM.Size div SizeOf(TRajzelem);

xx_ := x;

yy_ := y;

tures := 4;

For i:=(sblSTM.Position div SizeOf(TRajzelem)) to meret-1 do begin

   sblSTM.Read(Rajzelem,SizeOf(TRajzelem));

   pp := MMToCoord(Rajzelem.x/1000,Rajzelem.y/1000);

   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 begin

{            pno := (sblSTM.Position div SizeOf(TRajzelem))-1;}

          pno    := i;

          Result := True;

          Break;

      end;

end;

finally

sblSTM.Position:=aPos;

end;

end;

 

{Maximális rajzelem sorszámot ad vissza}

function TMMImage.MaxNo:longint;

var i,meret,poz: longint;

begin

Try

Result:=0;

poz:=sblSTM.position;

meret := sblSTM.Size div SizeOf(TRajzelem);

sblSTM.Seek(0,0);

For i:=0 to meret-1 do begin

   sblSTM.Read(Rajzelem,SizeOf(TRajzelem));

   If Result<Rajzelem.No Then begin

          Result := i;

          Exit;

   end;

end;

finally

sblSTM.position:=poz;

end;

end;

 

 

{Egy Rajzelem rekord mentése az sblSTM stream actP pozíciójára,

Ha az actP nagyobb mint a stream mérete, akkor a végére}

procedure TMMImage.RajzelemSave(actR:TRajzelem;actP:longint);

var poz: longint;

begin

poz:=sblSTM.Position;

If (sblSTM.Size div SizeOf(TRajzelem))<actP then sblSTM.Seek(0,2)

else sblSTM.Seek(actP*SizeOf(TRajzelem),0);

sblSTM.Write(actR,SizeOf(TRajzelem));

sblSTM.Position:=poz;

end;

 

{Egy Rajzelem rekord betöltése az sblSTM stream actP pozíciójáról,

Ha az actP nagyobb mint a stream mérete vagy <0, akkor False értéket ad,

és az eredet rajzelemet nem módosítja}

function TMMImage.RajzelemLoad(var actR:TRajzelem;actP:longint):boolean;

var poz: longint;

begin

poz:=sblSTM.Position;

Result := (actP<0) or ((sblSTM.Size div SizeOf(TRajzelem))>actP);

If Result then begin

   sblSTM.Seek(actP*SizeOf(TRajzelem),0);

   sblSTM.Read(actR,SizeOf(TRajzelem));

end;

sblSTM.Position:=poz;

end;

 

{Kijelölt elemek másolása a copySTM streamre}

procedure TMMImage.KijeloltToCopyStream;

var p,i,meret: longint;

  re       : TRajzelem;

begin

copySTM.Clear;

p := sblSTM.Position;

sblSTM.Seek(0,0);

meret := sblSTM.Size div SizeOf(TRajzelem);

For i:=1 to meret do begin

   sblSTM.Read(re,SizeOf(TRajzelem));

   If re.kijelolt then begin

      re.kijelolt := False;

      copySTM.Write(re,SizeOf(TRajzelem));

   end;

end;

sblSTM.Position := p;

end;

 

{Kijelölt elemek másolása a copySTM streamről az sblSTM stream végére}

procedure TMMImage.KijeloltFromCopyStream;

var p,i,meret: longint;

  re       : TRajzelem;

begin

p := sblSTM.Position;

sblSTM.Seek(0,2);

copySTM.Seek(0,0);

meret := copySTM.Size div SizeOf(TRajzelem);

For i:=1 to meret do begin

   copySTM.Read(re,SizeOf(TRajzelem));

      sblSTM.Write(re,SizeOf(TRajzelem));

end;

sblSTM.Position := p;

invalidate;

end;

 

{ A logikailag törlésre jelölt rajzelemeket végleg eltávolítja }

procedure TMMImage.VeglegesTorles;

var i,meret: longint;

  re       : TRajzelem;

  dSTM     : TMemoryStream;

begin

Try

dSTM := TMemoryStream.Create;

sblSTM.Seek(0,0);

dSTM.Clear;

meret := sblSTM.Size div SizeOf(TRajzelem);

For i:=1 to meret do begin

   sblSTM.Read(re,SizeOf(TRajzelem));

   If not re.torolt then dSTM.Write(re,SizeOf(TRajzelem));

end;

finally

sblSTM.LoadFromStream(dSTM);

dSTM.Destroy;

invalidate;

end;

end;

 

procedure TMMImage.SablonEltolas(var sbl:TMemoryStream;dx,dy:extended);

var i,meret: longint;

  re       : TRajzelem;

begin

meret := sbl.size div SizeOf(TRajzelem);

sbl.Seek(0,0);

For i:=1 to meret do begin

    sbl.Read(Re,SizeOf(TRajzelem));

    If not csakKijeloltek or (csakKijeloltek and Re.kijelolt) then begin

    With Re do begin

         x := x+Trunc(1000*dx); y := y+Trunc(1000*dy);

    end;

    sbl.Seek(-SizeOf(TRajzelem),1);

    sbl.Write(Re,SizeOf(TRajzelem));

    end;

end;

end;

 

procedure TMMImage.SablonNyujtas(var sbl:TMemoryStream;ox,oy,dx,dy:extended);

var i,meret: longint;

  re       : TRajzelem;

begin

meret := sbl.size div SizeOf(TRajzelem);

sbl.Seek(0,0);

For i:=1 to meret do begin

    sbl.Read(Re,SizeOf(TRajzelem));

    If not csakKijeloltek or (csakKijeloltek and Re.kijelolt) then begin

    With Re do begin

         x := Trunc(1000*ox+(x-1000*ox)*dx); y := Trunc(1000*oy+(y-1000*oy)*dy);

         z := Trunc(1000*ox+(z-1000*ox)*dx); r := Trunc(1000*oy+(r-1000*oy)*dy);

         If funcCode=3 then funcCode:=5;

    end;

    sbl.Seek(-SizeOf(TRajzelem),1);

    sbl.Write(Re,SizeOf(TRajzelem));

    end;

end;

end;

 

procedure TMMImage.SablonElforgatas(var sbl:TMemoryStream;origo:TPoint2d;szog:extended);

var i,meret: longint;

  re     : TRajzelem;

  rP     : TPoint2d;

begin

meret := sbl.size div SizeOf(TRajzelem);

sbl.Seek(0,0);

For i:=1 to meret do begin

    sbl.Read(Re,SizeOf(TRajzelem));

    If not csakKijeloltek or (csakKijeloltek and Re.kijelolt) then begin

       rP := Elforgatas(Point2d(re.x,re.y),origo,szog);

       With Re do begin

         x := Round(rP.x);

         y := Round(rP.y);

       end;

    sbl.Seek(-SizeOf(TRajzelem),1);

    sbl.Write(Re,SizeOf(TRajzelem));

    end;

end;

end;

 

{Sablon tükrözés: merre: 1=vizszintes, 2=függőleges, 3=középpontos}

procedure TMMImage.SablonTukrozes(var sbl:TMemoryStream;dx,dy:extended;

        merre:integer);

var i,meret: longint;

  re       : TRajzelem;

begin

meret := sbl.size div SizeOf(TRajzelem);

sbl.Seek(0,0);

dx:=1000*dx;

dy:=1000*dy;

For i:=1 to meret do begin

    sbl.Read(Re,SizeOf(TRajzelem));

    If not csakKijeloltek or (csakKijeloltek and Re.kijelolt) then begin

    With Re do begin

         Case merre of

         1: x := Trunc(dx-(x-dx));

         2: y := Trunc(dy-(y-dy));

         3: begin

            x := Trunc(dx-(x-dx));

            y := Trunc(dy-(y-dy));

            end;

         end;

    end;

    sbl.Seek(-SizeOf(TRajzelem),1);

    sbl.Write(Re,SizeOf(TRajzelem));

    end;

end;

end;

 

{A poliSTM streamen tárolt poligon területre eső pontok kijelölése}

procedure TMMImage.PoligonKijelol;

var i,meret  : longint;

  pTomb    : Array[0..100] of TPoint;

  p        : TPoint;

  re       : TRajzelem;

  RG       : HRgn;

begin

meret := poliStm.size div SizeOf(TPoint);

poliSTM.Seek(0,0);

For i:=0 to meret-1 do begin

    poliSTM.Read(p,SizeOf(p));

    pTomb[i]:=p;

end;

RG:=CreatePolygonRgn(pTomb,meret,ALTERNATE);

InvertRgn(Canvas.Handle,RG);

meret := sblStm.size div SizeOf(TRajzelem);

sblStm.Seek(0,0);

For i:=0 to meret-1 do begin

    sblStm.Read(Re,SizeOf(TRajzelem));

    p := MMToCoord(re.x/1000,re.y/1000);

    If PtInRegion(RG,p.x,p.y) then begin

       re.kijelolt:=True;

       RajzelemSave(re,i);

    end;

end;

Repaint;

end;

 

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

    X, Y: Integer);

Var ActPos,ppp: TPoint2D;

  rElem : TRajzelem;

  ii,r  : integer;

  pos   : longint;

  p_p   : TPoint;

  RG    : HRgn;

  tr    : TRect;

  rr    : extended;

 

  procedure IvPontMent(Code,x,y,z,r:longint);

  Var ppp: TPoint2D;

  begin

     RajzelemNull(actRajzelem);

     If not Pontkeres(x,y,actRajzelem,ap,0) then begin

        ppp := CoordtoMM(x,y);

        actRajzelem.x := Trunc(Round(1000*ppp.x));

        actRajzelem.y := Trunc(Round(1000*ppp.y));

     end else begin

        actRajzelem.torolt:=False;

        actRajzelem.kijelolt:=False;

     end;

     actRajzelem.FuncCode := Code;

     actRajzelem.z := Trunc(Round(1000*z));

     actRajzelem.r := Trunc(Round(1000*r));

     RajzelemSave(actRajzelem,100000);

  end;

 

begin

oldOrigin := Origin;

{  oldMovePt := MovePt;}

Origin := Point(x,y);

MovePt := Point(x,y);

ActPos := CoordtoMM(x,y);

XPos := x/(Magnify*mm); YPos := (Height-y)/(Magnify*mm);

ppp := CoordtoMM(Origin.x,Origin.y);

 

If XYLabel <> nil then

   XYLabel.Caption := Format('%6.2f',[ActPos.x])+':'+Format('%6.2f',[ActPos.y]);

 

Canvas.Pen.Mode := pmCopy;

 

Case RajzMod of

rmNincs:

    begin

    end;

rmPont :

    begin

    end;

 

rmVonal:

    If Button=mbLeft then begin

       ShowLine(Canvas,Origin.x,Origin.y,Movept.x,Movept.y);

       Case pFazis of

       1 : begin

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

           Inc(pFazis,1);

           end;

       2 : begin

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

           If not Pontkeres(Round(p1.x),Round(p1.y),actRajzelem,ap,0) then begin

              IvPontMent(1,Round(p1.x),Round(p1.y),0,0);

              IvPontMent(2,Round(p1.x),Round(p1.y),0,0);

           end;

           IvPontMent(2,Round(p2.x),Round(p2.y),0,0);

           repaint;

           pFazis:=1;

           end;

       end;

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmKor:

    If Button=mbLeft then begin

           If pFazis=1 then begin

              Canvas.Ellipse(x-2,y-2,x+2,y+2);

              oldMovePt:=Point(x+2,y);

              Inc(pFazis,1);

           end else begin

              rr:=KetPontTavolsaga(oldOrigin.x,oldOrigin.y,MovePt.x,MovePt.y);

              Canvas.Ellipse(oldOrigin.x-Round(rr),oldOrigin.y-Round(rr),

                             oldOrigin.x+Round(rr),oldOrigin.y+Round(rr));

              rr:=rr/(Magnify*mm);

              IvPontMent(3,oldOrigin.x,oldOrigin.y,Round(rr),0);

              repaint;

              pFazis:=1;

           end;

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmEllipszis:

    If Button=mbLeft then begin

       Case pFazis of

       1 : begin

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

           Inc(pFazis,1);

           end;

       2 : begin

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

           IvPontMent(5,Round(p1.x),Round(p1.y),

                      Abs(Round((p1.x-x)/(Magnify*mm))),Abs(Round((p1.y-y)/(Magnify*mm))));

           repaint;

           pFazis:=1;

           end;

      end;

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmSokszog:

    If Button=mbLeft then begin

           If pFazis=1 then begin

              ShowLine(Canvas,Origin.x,Origin.y,Movept.x,Movept.y);

              IvPontMent(1,x,y,0,0);

           end else begin

              ShowLine(Canvas,Origin.x,Origin.y,oldMovept.x,oldMovept.y);

           end;

           IvPontMent(2,x,y,0,0);

           Inc(pFazis,1);

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmKoriv  :

    If Button=mbLeft then begin

      Canvas.Rectangle(Origin.x-2,Origin.y-2,Origin.x+2,Origin.y+2);

      Case pFazis of

      1 : begin

          p1.x := Origin.x; p1.y := Origin.y;

          Inc(pFazis,1);

          end;

      2 : begin

          p3.x := Origin.x; p3.y := Origin.y;

          p2.x := Origin.x; p2.y := Origin.y;

          Canvas.Pen.Mode:=pmNotXor;

          ShowLine(Canvas,oldOrigin.x,oldOrigin.y,oldMovept.x,oldMovept.y);

          KorivRajzol(Canvas,P1,P2,P3);

          Inc(pFazis,1);

          end;

      3 : Try

          p2.x := Origin.x; p2.y := Origin.y;

          If not Pontkeres(Round(p1.x),Round(p1.y),actRajzelem,ap,0) then

             IvPontMent(1,Round(p1.x),Round(p1.y),0,0);

          IvPontMent(2,Round(p1.x),Round(p1.y),0,0);

          IvPontMent(4,Round(p2.x),Round(p2.y),0,0);

          IvPontMent(2,Round(p3.x),Round(p3.y),0,0);

          KorivRajzol(Canvas,P1,P2,P3);

          finally

          repaint;

          pFazis:=1;

          end;

    end;

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmNagyito:

    begin

    end;

rmKicsinyito:

    begin

    end;

rmCentrum:

    begin

    end;

 

rmPonttorol:

    If Button=mbLeft then begin

       If Pontkeres(x,y,Rajzelem,ap,0) then begin

          Rajzelem.torolt:=not Rajzelem.torolt;

          RajzelemSave(actRajzelem,ap);

          Repaint;

       end;

    end;

 

rmPontkijelol:

    If Button=mbLeft then begin

       If Pontkeres(x,y,actRajzelem,ap,0) then begin

          actRajzelem.kijelolt:=not actRajzelem.kijelolt;

          If (actRajzelem.FuncCode = 4) and (ap>0) then begin

             Repeat

               Dec(ap);

               RajzelemLoad(Relem,ap);

               If Relem.FuncCode<>4 then

               begin

                    Inc(ap);

                    Break;

               end;

             Until True;

               For ii:=0 to 2 do begin

                   RajzelemLoad(Relem,ap+ii);

                   Relem.kijelolt := actRajzelem.kijelolt;

                   RajzelemSave(Relem,ap+ii);

               end;

          end else

             RajzelemSave(actRajzelem,ap);

          Repaint;

       end;

    end;

rmVonaltorol:

    begin

    end;

rmKorivtorol:

    begin

    end;

 

rmPontAtrak:

    If Button=mbLeft then begin

    Case pFazis of

    1: If Pontkeres(x,y,Rajzelem,ap,0) then begin

          actualpont := ap;

          actRajzelem:=Rajzelem;

          ShowLine(Canvas,Origin.x,Origin.y,Movept.x,Movept.y);

          Inc(pFazis,1);

       end;

    2: begin

       If Pontkeres(x,y,Rajzelem,ap,0) then actRajzelem:=Rajzelem

       else begin

            actRajzelem.x:=Trunc(Round(1000*XPOS));

            actRajzelem.y:=Trunc(Round(1000*YPOS));

       end;

       RajzelemSave(actRajzelem,actualpont);

       Repaint;

       pFazis:=1;

       end;

    end;

    end else if pFazis=1 then begin

       Canvas.Pen.Mode := pmNotXor;

       ShowLine(Canvas,oldOrigin.x,oldOrigin.y,oldMovept.x,oldMovept.y);

    end;

 

rmKorivAtrak:

    begin

    end;

 

rmBsplineP,rmBsplineNP,rmBsplineMullP,rmBsplineMullNP:

    If Button=mbLeft then begin

      RajzelemNull(Rajzelem);

      If Pontkeres(x,y,Rajzelem,ap,0) then begin

          actualpont := ap;

          actRajzelem:=Rajzelem;

       end else begin

          actRajzelem.x:=Trunc(Round(1000*ppp.x));

          actRajzelem.y:=Trunc(Round(1000*ppp.y));

       end;

       Canvas.Pen.Mode := pmCopy;

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

       actRajzelem.FuncCode := Ord(RajzMod);

       RajzelemSave(actRajzelem,100000);

       cDataArray[cDataCount] := Point3d(x,y,0);

       Inc(cDataCount);

       Inc(pFazis,1);

{         Repaint;}

    end else begin

        repaint;

        pFazis:=1;

    end;

 

rmTopologia:

    begin

    pos:=0;

    If Pontkeres(x,y,Rajzelem,actualpont,pos) then begin

       pos := actualpont+1;

       rElem := Rajzelem;

       If (ActNo=0) or newObj then

       begin

           Inc(ActNo);

           Rajzelem.No:=ActNo;

           Rajzelem.FuncCode:=1;

           changeSTM.Seek(0,2);

           changeSTM.Write(Rajzelem,SizeOf(Rajzelem));

           newObj:=False;

       end;

       Inc(ActNo);

       Relem.No:=ActNo;

       Case rElem.FuncCode of

       1: Pontkeres(x,y,Relem,actualpont,pos);

       4: begin

          end;

       end;

       RajzelemSave(Relem,actualpont);

{         Rajzelem.FuncCode := Ord(TopologyMode);}

       changeSTM.Seek(0,2);

       changeSTM.Write(Relem,SizeOf(Rajzelem));

       invalidate;

    end;

{      else

    If Ord(TopologyMode)<2 then

    begin

       ppp := CoordtoMM(Origin.x,Origin.y);

       Inc(ActNo);

       Rajzelem.No:=ActNo;

       Rajzelem.Torolt:=False;

       Rajzelem.FuncCode := Ord(TopologyMode);

       Rajzelem.x := Trunc(Round(1000*ppp.x));

       Rajzelem.y := Trunc(Round(1000*ppp.y));

    end;}

    end;

 

rmPolygonKijelol,rmAblakkijelol:

    If Button=mbLeft then begin

       p_p := Point(x,y);

       poliSTM.Seek(0,2);

       Case pFazis of

       1: begin

             basePoint:=p_p;

             poliSTM.Write(p_p,SizeOf(TPoint));

          end;

       else

          Case Rajzmod of

          rmAblakkijelol:

              If pFazis=2 then

              begin

                   p_p:=Point(x,basePoint.y);

                   poliSTM.Write(p_p,SizeOf(TPoint));

                   p_p:=Point(x,y);

                   poliSTM.Write(p_p,SizeOf(TPoint));

                   p_p:=Point(basePoint.x,y);

                   poliSTM.Write(p_p,SizeOf(TPoint));

                   PoligonKijelol;

                   rajzMod := rmNincs;

              end;

          rmPolygonKijelol:

              begin

                 poliSTM.Write(p_p,SizeOf(TPoint));

                 RG := CreateRectRgn(basePoint.x-4,basePoint.y-4,basePoint.x+4,basePoint.y+4);

                 if PtInRegion(RG,x,y) then begin

                    PoligonKijelol;

                    rajzMod := rmNincs;

                 end;

              end;

          end;

       end;

     Inc(pFazis,1);

 

    end else begin

       rajzMod := rmNincs;

    end;

 

rmKijeloltMasol:

     begin

{          SablonEltolas(copySTM,10,10);

        KijeloltFromCopyStream;}

     end;

rmHelp :

    begin

    end;

end;

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

end;

 

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

Var ActPos: TPoint2D;

  igen  : boolean;

  RG    : HRgn;

  r,r1,r2 : integer;

begin

MovePt := Point(x,y);

ActPos := CoordtoMM(x,y);

XPos := x/(Magnify*mm); YPos := (Height-y)/(Magnify*mm);

{  IF XYLabel<>nil then begin

   XYLabel.Caption := IntToStr(XPos)+':'+IntToStr(YPos);

end;}

 

If XYLabel <> nil then

   XYLabel.Caption := Format('%6.2f',[ActPos.x])+' : '+Format('%6.2f',[ActPos.y]);

 

Canvas.Pen.Mode := pmNotXor;

Canvas.Brush.Style:=bsClear;

 

Case RajzMod of

rmVonal,rmPontAtrak,rmSokszog,rmPolygonKijelol :

     If pFazis>=2 then

     begin

         If RajzMod=rmPolygonKijelol then begin

            RG := CreateRectRgn(basePoint.x-4,basePoint.y-4,basePoint.x+4,basePoint.y+4);

            If pFazis>1 then InvertRgn(Canvas.Handle,RG);

            if PtInRegion(RG,x,y) then Cursor := crDrag else Cursor := crDefault;

         end;

         ShowLine(Canvas,Origin.x,Origin.y,oldMovept.x,oldMovept.y);

         ShowLine(Canvas,Origin.x,Origin.y,Movept.x,Movept.y);

     end;

rmKor:

     If pFazis=2 then begin

        Canvas.Brush.Style:=bsClear;

        r:=Round(KetPontTavolsaga(Origin.x,Origin.y,oldMovePt.x,oldMovePt.y));

        Canvas.Ellipse(Origin.x-r,Origin.y-r,Origin.x+r,Origin.y+r);

        r:=Round(KetPontTavolsaga(Origin.x,Origin.y,MovePt.x,MovePt.y));

        Canvas.Ellipse(Origin.x-r,Origin.y-r,Origin.x+r,Origin.y+r);

     end;

rmKoriv  :

     Case pFazis of

     2:

     begin

         ShowLine(Canvas,Origin.x,Origin.y,oldMovept.x,oldMovept.y);

         ShowLine(Canvas,Origin.x,Origin.y,Movept.x,Movept.y);

     end;

     3:

     begin

        KorivRajzol(Canvas,P1,P2,P3);

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

        KorivRajzol(Canvas,P1,P2,P3);

     end;

     end;

 

rmEllipszis:

     Case pFazis of

     2: begin

        r1 :=Origin.x-oldMovePt.x; r2:=Origin.y-oldMovePt.y;

        Canvas.Ellipse(Origin.x-r1,Origin.y-r2,Origin.x+r1,Origin.y+r2);

        r1 :=Origin.x-MovePt.x; r2:=Origin.y-MovePt.y;

        Canvas.Ellipse(Origin.x-r1,Origin.y-r2,Origin.x+r1,Origin.y+r2);

        end;

     end;

 

rmAblakkijelol :

     If pFazis>1 then begin

         Canvas.Rectangle(Origin.x,Origin.y,oldMovept.x,oldMovept.y);

         Canvas.Rectangle(Origin.x,Origin.y,Movept.x,Movept.y);

     end;

 

rmKijeloltMasol:

     begin

     end;

 

rmBsplineP,rmBsplineNP,rmBsplineMullP,rmBsplineMullNP:

     begin

        Spline(Canvas,cDataArray,cDataCount,16,TBSplineAlgoritm(Ord(RajzMod)-6));

        cDataArray[cDataCount] := Point3d(x,y,0);

        Spline(Canvas,cDataArray,cDataCount,16,TBSplineAlgoritm(Ord(RajzMod)-6));

     end;

 

end;

 

oldMovePt := Point(x,y);

inherited MouseMove(Shift, X, Y);

end;

 

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

    X, Y: Integer);

var ablakkeret : TRect;

  ablakMM    : TRect2D;

  pp         : TPoint;

  tr         : HRgn;

  i          : integer;

begin

MovePt := Point(x,y);

 

{  Case RajzMod of

 rmAblakkijelol:

    If Button=mbLeft then begin

         Case Rajzmod of

         rmAblakkijelol:

         If pFazis=3 then begin

               ablakkeret:=Rect(Origin.x,Origin.y,x,y);

               poliSTM.Clear;

 

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

               InvertRgn(Canvas.Handle,tr);

               sblSTM.Seek(0,0);

               For i:=0 to (sblSTM.Size div SizeOf(TRajzelem))-1 do begin

                   sblSTM.Read(Rajzelem,SizeOf(TRajzelem));

                   pp := MMToCoord(Rajzelem.x/1000,Rajzelem.y/1000);

                   If PtInRegion(tr,pp.x,pp.y) then begin

                      Rajzelem.kijelolt := True;

                      sblSTM.Seek(-SizeOf(Rajzelem),1);

                      sblSTM.Write(Rajzelem,SizeOf(TRajzelem));

                   end;

                end;

                RajzMod:=rmNincs;

         end;

         end;

    end else RajzMod:=rmNincs;

 end;}

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

end;

 

{* ------------ TSablonImage komponens ---------- *}

 

constructor TSablonImage.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

end;

 

destructor TSablonImage.Destroy;

begin

   inherited Destroy;

end;

 

procedure TSablonImage.Paint;

begin

Ujrarajzol;

inherited Paint;

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;

}

 

Function RajzmodToString(rmod:TRajzmodType):string;

begin

Result := Rajzmodfelirat[Ord(rmod)];

end;

 

Function StringToRajzmod(rmodstring:string):TRajzmodType;

var i:integer;

begin

Result := rmNincs;

For i:=0 to High(RajzmodFelirat) do

If RajzmodFelirat[i]=rmodstring then Result := TRajzmodType(i);

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;

  ftype: string;

begin

  FOpenDialog := TOpenDialog.Create(Application);

  try

         FOpenDialog.InitialDir:=ExtractFilePath(GetValue);

         With FOpenDialog do begin

           FileName  :=GetValue;

           ftype := UpperCase(GetName);

           If ftype='FILENAME' then begin

              Title   := 'Sablon file betöltés';

              FileName:='*.SBL';

              Filter  := 'Sablon file (*.SBL)';

           end;

           If ftype='BACKIMAGEFILE' then begin

              Title   := 'Háttérkép file betöltés';

              FileName:='*.BMP;*.WMF;*.GIF;';

           end;

           Title:='Sablon file megnyitása';

           If execute then SetStrValue(Filename);

      end;

  finally

      FOpenDialog.Free;

  end;

end;

 

end.

 

{

 

Rajzelemek:

 

No       : sorszám (ID) topologizáláskor

ObjCode  : objektum sorszám (ID)

FuncCode : 0 = Toll fel, pozícionálás (0,x,y);

           1 = Átfúvás adott pozíciónál (1,100,100);

           2 = Vonal   (pontlánc) első ponttól az utolsóig (2,x,y)

           3 = Kör     Középpont koordináták+sugár (3,x,y,z)

           4 = Körív   3 pont által megadott 4,x1,y1 - kezdő pont

                                             4,x2,y2 - közbülső pont

                                             4,x3,y3 - záró pont

           5 - Ellipszis : Középpont+r1+r2   5,100,100,50,20

           6 - Ellipszis ív

           7 - BSpline

}