KOORD

Top  Previous  Next

 

{ DESCARTES KOORDINÁTA RENDSZER komponens

 

}

 

unit Koord;

 

interface

 

uses

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

Graphics, Controls, Forms, Dialogs, Szoveg, Geom, Szamok, Menus;

 

type

 

TDrawingTool = (dtNone, dtPoint, dtLine, dtEllipse, dtRectangle,

     dtRoundRect,  dtFillRect, dtFillRoundRect,

     dtFillEllipse, dtPolyLine, dtIv, dtText, dtInfo,

     dtExtraText,dtBrush);

 

{TMoveHint = class(TCustomControl)}

 

{2 dimenziós pont objektum}

T2DPoint = class(TPersistent)

public

FOnChange: TNotifyEvent;

Fx : extended;

Fy : extended;

procedure Setx(Value:extended);

procedure Sety(Value:extended);

procedure Changed; dynamic;

published

property OnChange: TNotifyEvent read FOnChange write FOnChange;

property x: extended read Fx write Setx;

property y: extended read Fy write Sety;

end;

 

{Ablak sarokpontjainak objektuma}

TWindowRect = class(TPersistent)

public

FOnChange: TNotifyEvent;

Fx1 : extended;

Fy1 : extended;

Fx2 : extended;

Fy2 : extended;

procedure Setx1(Value:extended);

procedure Sety1(Value:extended);

procedure Setx2(Value:extended);

procedure Sety2(Value:extended);

procedure Changed; dynamic;

published

property OnChange: TNotifyEvent read FOnChange write FOnChange;

property x1: extended read Fx1 write Setx1;

property y1: extended read Fy1 write Sety1;

property x2: extended read Fx2 write Setx2;

property y2: extended read Fy2 write Sety2;

end;

 

TScale = class(TPersistent)

private

FOnChange: TNotifyEvent;

FAxisVisible : boolean;          {Koord. tengelyek látszonak?}

FAxisColor : TColor;            {Koord. tengelyek  szine}

FAxisWidth : integer;           {Koord. tengelyek  vastagsága}

FIncrement : extended;       {A beosztások távolsága}

FFont : TFont;

FFontVisible  : boolean;

FScaleVisible : boolean;          {Koord. tengelyek látszonak?}

procedure SetIncrement(Value:extended);

procedure SetFont(Value:TFont);

procedure SetAxisVisible(Value:boolean);

procedure SetAxisColor(Value:TColor);

procedure SetAxisWidth(Value:integer);

procedure SetFontVisible(Value:boolean);

procedure SetScaleVisible(Value:boolean);

procedure Changed; dynamic;

public

constructor Create;

destructor Destroy;

published

property OnChange: TNotifyEvent read FOnChange write FOnChange;

property AxisVisible : boolean read FAxisVisible write SetAxisVisible default True;

property AxisColor : TColor read FAxisColor write SetAxisColor;

property AxisWidth : integer read FAxisWidth write SetAxisWidth;

property Increment : extended read FIncrement write SetIncrement;

property Font : TFont read FFont write SetFont;

property FontVisible : boolean read FFontVisible write SetFontVisible default True;

property ScaleVisible : boolean read FScaleVisible write SetScaleVisible default True;

end;

 

{Rács objektum a rajzoláshoz}

TGridStyle = (gsDot, gsDash, gsLine);

 

TGrid = class(TPersistent)

private

FOnChange: TNotifyEvent;

FVisible: boolean;           {Rács látszik-e?}

FDistance: extended;           {Rácspontok távolsága}

FStyle  : TGridStyle;        {0=nincs,1=pontrács,2=szaggatott,3=vonalrács}

FColor  : TColor;            {Rács szine}

FAttach : boolean;           {Rácsraállás van-e}

FParent : TComponent;

FScale  : TScale;

procedure SetVisible(Value:boolean);

procedure SetDistance(Value:extended);

procedure SetStyle(Value:TGridStyle);

procedure SetColor(Value:TColor);

procedure SetScale(Value:TScale);

procedure Changed; dynamic;

public

constructor Create;

destructor Destroy;

procedure Change(Sender: TObject);

published

property OnChange: TNotifyEvent read FOnChange write FOnChange;

property Visible: boolean read FVisible write SetVisible;

property Distance : extended read FDistance write SetDistance;

property Style : TGridStyle read FStyle write SetStyle;

property Color : TColor read FColor write SetColor;

property Attach: boolean read FAttach write FAttach;

property Scale: TScale read FScale write SetScale;

end;

 

TPaintEvent = procedure(Sender: TObject) of object;

 

TCoordRajzmod = (tcrNone,tcrCentrum,tcrNagyito,tcrKicsinyito,tcrHotpoint);

 

TCoordSystem = class(TCustomControl)

private

  FHotPoint   : T2DPoint;            {Alakzat középpontja, aktiv fókuszpont}

  FHotPointVisible : boolean;        {Látszik-e a fokusz}

  Fcentrum    : T2DPoint;

  FColor      : TColor;

  FGrid       : TGrid;

  FKoordLabel : TLabel;

  FcentrumLabel : TLabel;

  FNagyitas   : extended;

  Fprecision  : extended;             {A kép és skála felbontás tizedes értékei}

  FWindowDef  : TWindowRect;

  FCoordRajzmod: TCoordRajzmod;        {Rajzolási mód}

  FCRajzmodLabel : TLabel;             {rajzmód label}

  FHintWindow : THintWindow;

  FOnKeyDown  : TNotifyEvent;

  FOnKeyPress : TNotifyEvent;

  FOnPaint    : TPaintEvent;

  FCanvas     : TCanvas;

  procedure SetColor(Value:TColor);

  procedure SetHotPoint(Value:T2DPoint);

  procedure SetHotPointVisible(Value:boolean);

  procedure Setcentrum(Value:T2DPoint);

  procedure SetNagyitas(Value:extended);

  procedure Setprecision(Value:extended);

  procedure SetWindowDef(Value:TWindowRect);

  procedure SetCoordRajzmod(Value:TCoordRajzmod);

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

  procedure CNKeyDown(var Message: TWMKeyDown);

protected

  oldBoundsRect : TRect;

  GridBitmap: TBitmap;

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

  gridvaltozott : boolean;      {Ujra kell rajzolni a hátteret}

  grw,n: extended;

  grxdb, grydb : integer;

  KPX,KPY : extended;           {középkereszt koordinátái}

  PX,PY   : extended;

  HPX,HPY : integer;           {középkereszt koordinátái}

  pe      : TPen;

  s       : string;

  kbeosztas : extended;        {kezdő beosztás}

  procedure Paint; override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

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

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure KeyDown(var Key: Word;Shift: TShiftState); override;

  procedure KeyPress(var Key: Char); override;

public

  BasePointx,BasePointy : extended;        {A képterület sarka}

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

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

  oldOrigin   : TPoint;

  oldMovePt   : TPoint;

  Decimals    : integer;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  property Canvas;

  procedure cls(ca:TCanvas;co: TColor);

  procedure MoveTo( x, y : extended );

  procedure LineTo( x, y : extended );

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

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

  procedure GridDraw;

  procedure KoordDraw;

  procedure SkalaDraw;

  procedure HotPointDraw;

  procedure HotPointToCentrum;

  function  CoordToScreen(x,y:extended):TPoint;

  function  ScreenX(x:extended):integer;

  function  ScreenY(y:extended):integer;

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

  function  CoordX(x:integer):extended;

  function  CoordY(y:integer):extended;

  function  CorrectRect(t:TRect):TRect;

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

  procedure Vegpont(ca:TCanvas;x,y: extended;d:integer;co:TColor);

  procedure Change(Sender: TObject);

  procedure SBI;           {Canvas mentése}

  procedure LBI;           {Canvas visszatöltése}

  property  WindowDef : TWindowRect read FWindowDef write SetWindowDef;

  property  HintWindow : THintWindow read FHintWindow write FHintWindow;

  procedure AlakzatRajz(Canv: TCanvas; DrawingTool:TDrawingTool; T,B: TPoint;

                              AMode: TPenMode; ujrajz: Boolean);

published

  Property Centrum : T2DPoint read Fcentrum write Setcentrum ;

  Property CentrumLabel : TLabel read FcentrumLabel write FcentrumLabel ;

  Property Color : TColor read FColor write SetColor ;

  property CoordRajzmod : TCoordRajzmod read FCoordRajzmod write SetCoordRajzmod;

  property CoordRajzmodLabel : TLabel read FCRajzmodLabel write FCRajzmodLabel;

  Property Grid : TGrid read FGrid write FGrid ;

  Property HotPoint : T2DPoint read FHotPoint write SetHotPoint ;

  Property HotPointVisible : boolean read FHotPointVisible write SetHotPointVisible ;

  Property KoordLabel : TLabel read FKoordLabel write FKoordLabel ;

  property Nagyitas : extended read FNagyitas write SetNagyitas;

  property Precision : extended read FPrecision write SetPrecision;

  property OnPaint: TPaintEvent read FOnPaint write FOnPaint;

  property Cursor;

  property Align;

  property ShowHint;

  property ParentShowHint;

  property Visible;

  property PopupMenu;

  property OnClick;

  property OndblClick;

  property OnMouseDown;

  property OnMouseMove;

  property OnMouseUp;

  property OnKeyDown;

  property OnKeyPress;

end;

 

Var belep: boolean;

const

crMyCursor1  = 10;

crKicsinyito = 11;

crNagyito    = 12;

crKez        = 13;

crKereszt    = 14;

crKeret      = 15;

crEllipszis  = 16;

crNegyszog   = 17;

crHelp       = 20;

 

 

procedure Register;

 

implementation

 

{$R KOORD}

 

function KerekitN(szam,mire:extended):extended;

begin

Result:=mire*(Int(szam/mire)+Round(Maradek(szam,mire)));

end;

 

procedure ClsKivul(ca:TCanvas;x,y: integer;co:TColor);

var pe : TPen; br: TBrush;

  c,c1,c2: TRect;

begin

with ca do

begin

    pe:=Pen; br := Brush;

    Pen.Color := co; pen.Mode := pmCopy;

    Pen.width := 1;

    Brush.color:=co; brush.style:=bsSolid;

    c:=cliprect;

    If x>0 then Rectangle(0,0,x,c.bottom) else

       Rectangle(c.right+x,0,c.right,c.bottom);

    If y>0 then Rectangle(0,0,c.right,y) else

       Rectangle(0,c.bottom+y,c.right,c.bottom);

    Pen:=pe; Brush := br;

end;

end;

 

procedure Register;

begin

   RegisterComponents('AL',[TCoordSystem]);

end;

 

{ -----------  T2DPoint --------- }

procedure T2DPoint.Changed;

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

 

procedure T2DPoint.Setx(Value:extended);

begin

If Fx<>Value then begin

   Fx:=Value;

   Changed;

end;

end;

 

procedure T2DPoint.Sety(Value:extended);

begin

If Fy<>Value then begin

   Fy:=Value;

   Changed;

end;

end;

 

{ -----------  TWindowRect --------- }

procedure TWindowRect.Changed;

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

procedure TWindowRect.Setx1(Value:extended);

begin Fx1:=Value; Changed; end;

procedure TWindowRect.Sety1(Value:extended);

begin Fy1:=Value; Changed; end;

procedure TWindowRect.Setx2(Value:extended);

begin Fx2:=Value; Changed; end;

procedure TWindowRect.Sety2(Value:extended);

begin Fy2:=Value; Changed; end;

 

{ -----------  TScale --------- }

constructor TScale.Create;

begin

   FFont:=TFont.Create;

   With FFont do begin

        Name:='Arial';

        Color:=clWhite;

        Size:=8;

   end;

   FIncrement:=1;

   FAxisVisible := True;

   FAxisWidth := 1;

   FAxisColor := clRed;

   FScaleVisible := True;

end;

 

 

destructor TScale.Destroy;

begin

   FFont.Free;

end;

 

procedure TScale.Changed;

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

procedure TScale.SetFontVisible(Value:boolean);

begin FFontVisible:=Value; Changed; end;

procedure TScale.SetScaleVisible(Value:boolean);

begin FScaleVisible:=Value; Changed;end;

procedure TScale.SetIncrement(Value:extended);

begin

If (FIncrement<>Value) and (Value>0) then begin

   FIncrement:=Value;

   Changed;

end;

end;

 

procedure TScale.SetFont(Value:TFont);

begin FFont.Assign(Value); Changed;end;

 

procedure TScale.SetAxisVisible(Value:boolean);

begin

If FAxisVisible<>Value then begin

   FAxisVisible:=Value;

   Changed;

end;

end;

procedure TScale.SetAxisColor(Value:TColor);

begin

If FAxisColor<>Value then begin

   FAxisColor:=Value;

   Changed;

end;

end;

procedure TScale.SetAxisWidth(Value:integer);

begin

If FAxisWidth<>Value then begin

   If Value<1 then Value:=1;

   FAxisWidth:=Value;

   Changed;

end;

end;

 

{ -----------  TGrid --------- }

constructor TGrid.Create;

begin

   FScale:=TScale.Create;

   FScale.OnChange := Change;

end;

 

destructor TGrid.Destroy;

begin

   FScale.Free;

   inherited Destroy;

end;

 

procedure TGrid.Change(Sender: TObject);

begin

  Changed;

end;

 

procedure TGrid.Changed;

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

 

procedure TGrid.SetVisible(Value:boolean);

begin

If FVisible<>Value then begin

   FVisible:=Value;

   Changed;

end;

end;

 

procedure TGrid.SetDistance(Value:extended);

begin

If (FDistance<>Value) and (Value>0) then begin

   FDistance:=Value;

   Changed;

end;

end;

procedure TGrid.SetStyle(Value:TGridStyle);

begin

If FStyle<>Value then begin

   FStyle:=Value;

   Changed;

end;

end;

procedure TGrid.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   Changed;

end;

end;

 

procedure TGrid.SetScale(Value:TScale);

begin

If FScale<>Value then begin

   FScale:=Value;

   Changed;

end;

end;

 

{ -----------  TCoordSystem --------- }

 

constructor TCoordSystem.Create(AOwner:TComponent);

Var h: HCursor;

begin

   inherited Create(AOwner);

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

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

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

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

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

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

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

Screen.Cursors[crEllipszis] :=  LoadCursor(h, 'C_ELLIPSZIS');

Screen.Cursors[crNegyszog] :=  LoadCursor(h, 'C_NEGYSZOG');

{     FCanvas := TCanvas.Create;}

   FHotPoint := T2DPoint.Create;

   Fcentrum := T2DPoint.Create;

   FGrid  := TGrid.Create;

   GridBitmap:=TBitmap.Create;

   FWindowDef := TWindowRect.Create;

   FHotPoint.OnChange := Change;

   Fcentrum.OnChange := Change;

   FGrid.OnChange := Change;

   FWindowDef.OnChange := Change;

   With FGrid do begin

        Visible := True;

        Distance:=1;

        Style:=gsDot;

        Color:=clYellow;

   end;

   With FWindowDef do begin

        x1:=-50; x2:=50;

        y1:=-50; y2:=50;

   end;

   Fcentrum.x:=0; Fcentrum.y:=0;

   FNagyitas      := 20;

   FColor         := clBlack;

   Width          := 200;

   Height         := 200;

   GridBitmap.Width:=Width;

   GridBitmap.Height:=Height;

   FPrecision     := 1;

   oldBoundsRect:=BoundsRect;

   gridvaltozott:=True;

   belep:=true;

   FHintWindow:=THintWindow.Create(Self);

end;

 

destructor TCoordSystem.Destroy;

begin

   GridBitmap.Free;

   HotPoint.Free;

   centrum.Free;

   Grid.Free;

   FWindowDef.Free;

   FHintWindow.Free;

{     FCanvas.Free;}

   inherited Destroy;

end;

 

procedure TCoordSystem.Change(Sender: TObject);

begin

gridvaltozott:=True;

invalidate;

end;

 

procedure TCoordSystem.WMSize(var Msg: TWMSize);

begin

  inherited;

   gridvaltozott:=True;

   GridBitmap.Width:=Msg.Width;

   GridBitmap.Height:=Msg.Height;

   invalidate;

end;

 

procedure TCoordSystem.CNKeyDown(var Message: TWMKeyDown);

begin

Case Message.CharCode of

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

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

end;

end;

 

procedure TCoordSystem.SetCoordRajzmod(Value:TCoordRajzmod);

const rmtomb: array[0..4] of string[10] =

    ('Nincs','Centrum','Nagyito','Kicsinyitő','HotPoint');

begin

FCoordRajzmod:=Value;

Case FCoordRajzmod of

tcrNone:    Cursor:=crDefault;

tcrCentrum: Cursor:=crMyCursor1;

tcrNagyito: Cursor:=crNagyito;

tcrKicsinyito: Cursor:=crKicsinyito;

tcrHotpoint  : Cursor:=crKereszt;

end;

If CoordRajzmodLabel<>nil then

   CoordRajzmodLabel.Caption := rmtomb[Ord(TCoordRajzmod(Value))];

end;

 

procedure TCoordSystem.SetWindowDef(Value:TWindowRect);

begin

If FWindowDef<>Value then begin

   FWindowDef:=Value;

   FNagyitas := Width/(Value.x2 - Value.x1);

   FCentrum.x := (Value.x1 + Value.x2)/2;

   Centrum.y := (Value.y1 + Value.y2)/2;

end;

end;

 

procedure TCoordSystem.SetHotPointVisible(Value:boolean);

begin

If FHotPointVisible<>Value then begin

   FHotPointVisible:=Value;

   gridvaltozott:=True;

   invalidate;

end;

end;

 

procedure TCoordSystem.SetHotPoint(Value:T2DPoint);

begin

If FHotPoint<>Value then begin

   FHotPoint:=Value;

   gridvaltozott:=True;

   invalidate;

end;

end;

 

procedure TCoordSystem.Setcentrum(Value:T2DPoint);

begin

If Fcentrum<>Value then begin

   FWindowDef.x1:=FWindowDef.x1 + (Value.x - Fcentrum.x);

   FWindowDef.x2:=FWindowDef.x2 + (Value.x - Fcentrum.x);

   FWindowDef.y1:=FWindowDef.y1 + (Value.y - Fcentrum.y);

   FWindowDef.y2:=FWindowDef.y2 + (Value.y - Fcentrum.y);

   Fcentrum:=Value;

   gridvaltozott:=True;

   If not kepmozgatas then invalidate;

end;

end;

 

procedure TCoordSystem.SetNagyitas(Value:extended);

begin

If (FNagyitas<>Value) and (Value>0) and (Value<800) then begin

   FNagyitas:=Value;

   gridvaltozott:=True;

   invalidate;

end;

end;

 

procedure TCoordSystem.SetPrecision(Value:extended);

begin

If (FPrecision<>Value) and (Value>0) then begin

   FPrecision:=Value;

   decimals:=pos(decimalseparator,floattostr(precision));

   If decimals>0 then  decimals:= Length(floattostr(precision))-decimals;

   gridvaltozott:=True;

   invalidate;

end;

end;

 

procedure TCoordSystem.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   gridvaltozott:=True;

   invalidate;

end;

end;

 

 

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

    X, Y: Integer);

begin

oldOrigin := Origin;

oldMovePt := MovePt;

Origin := Point(X, Y);

MovePt := Origin;

If PopupMenu<>nil then

   PopupMenu.AutoPopup:=not (CoordRajzmod in [tcrNagyito,tcrKicsinyito]);

If (Button = mbRight) and (CoordRajzMod=tcrNagyito) then

   CoordRajzMod := tcrKicsinyito;

If (Button = mbLeft) and (CoordRajzMod=tcrKicsinyito) then

   CoordRajzMod := tcrNagyito;

Case CoordRajzmod of

     tcrCentrum : begin Centrum.x := CoordX(x); Centrum.y := CoordY(y); end;

     tcrNagyito :

       begin

            FCentrum.x := CoordX(x); FCentrum.y := CoordY(y);

            nagyitas := 2*nagyitas;

       end;

     tcrKicsinyito :

       begin

            FCentrum.x := CoordX(x); FCentrum.y := CoordY(y);

            nagyitas := nagyitas/2;

       end;

     tcrHotpoint :

       begin HotPoint.x := Kerekit(Coordx(x),precision);

             HotPoint.y := Kerekit(Coordy(y),precision);

       end;

end;

invalidate;

{  Repaint;}

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

end;

 

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

var xx,yy: extended;

  ca: TCanvas;

HintInfo: Tmsg;

begin

oldMovePt := MovePt;

MovePt := Point(X, Y);

If KoordLabel<>nil then KoordLabel.Caption:=

      Alltrim(Format('%7.'+inttostr(Decimals)+'f',[CoordX(x)]))+' : '+

      Alltrim(Format('%7.'+inttostr(Decimals)+'f',[CoordY(y)]));

Case CoordRajzMod of

tcrNone:

    If (Shift=[ssLeft]) then begin

       If not kepmozgatas then begin

         kepmozgatas:=True;

         Canvas.Pen.Mode:=pmCopy;

         Screen.Cursor := crKez;

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

       end else

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

         Try

         Canvas.Draw(MovePt.x-Origin.x,MovePt.y-Origin.y,GridBitmap);

         ca:=Canvas;

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

{           If kozepkereszt then Kereszt(Canvas,clGreen);}

         except

           On Exception do exit;

         end;

       end;

    end;

end;

{  HintWindowClass:=HintWindow;}

If HintWindow.IsHintMsg(HintInfo) then

   x:=1;

{     HintInfo.HintPos := Point(x,y);}

 

inherited MouseMove(Shift,x,y);

end;

 

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

    X, Y: Integer);

begin

Case CoordRajzMod of

tcrNone:

    begin

    If kepmozgatas then begin

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

       FCentrum.x := Centrum.x-x/nagyitas;

       Centrum.y  := Centrum.y+y/nagyitas;

    Cursor := crDefault;

    Screen.Cursor:=crDefault;

    kepmozgatas:=False;

    end;

    end;

end;

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

end;

 

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

end;

inherited KeyDown(Key,Shift);

end;

 

procedure TCoordSystem.KeyPress(var Key: Char);

begin

inherited KeyPress(Key);

end;

 

{Canvas mentés}

procedure TCoordSystem.SBI;

begin

StretchBlt(GridBitmap.Canvas.Handle,0,0,width,Height,

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

end;

 

{Canvas visszatöltés}

procedure TCoordSystem.LBI;

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

 

procedure TCoordSystem.cls(ca:TCanvas;co: TColor);

var pe: TPen; br: TBrush; c: Trect;

begin

with Ca do

begin

    pe:= Pen;

    br:=Brush;

    Pen.color:=co;

    brush.style:=bsSolid;

    Brush.color:=co;

    c:=ca.cliprect;

    Rectangle(c.left,c.top,c.right,c.bottom);

    Pen:=pe; Brush := br;

end;

end;

 

{A rácsozat megjelenítése}

procedure TCoordSystem.GridDraw;

var i,j,x,y : integer;

  pe:TPen;

  x1,x2,y1,y2: integer;

begin

   pe:=Canvas.Pen;

If Grid.Visible and gridvaltozott then begin

   Canvas.pen.Color := Grid.Color;

   Canvas.pen.Width := 1;

   grw := Grid.Distance * nagyitas;

   n   := Grid.Scale.Increment;

   kbeosztas:=KerekitN(CoordX(Width div 2),n);

   KPX := Screenx(kbeosztas);

   kbeosztas:=KerekitN(Coordy(Height div 2),n);

   KPY := Screeny(kbeosztas);

 

   If grw>1 then begin

      grxdb:= Trunc(width/grw) div 2; grydb:= Trunc(Height/grw) div 2;

      If grydb>grxdb then grxdb:=grydb;

   For i:=0 to grxdb+10 do begin

      x1 := Trunc(KPX+i*grw);

      x2 := Trunc(KPX-i*grw);

      y1 := Trunc(KPY+j*grw);

      y2 := Trunc(KPY-j*grw);

      Case Grid.Style of

      gsDot :

            For j:=0 to grydb+10 do begin

                y1 := Trunc(KPY+j*grw);

                y2 := Trunc(KPY-j*grw);

                Canvas.Pixels[x1,y1]:=Grid.Color;

                Canvas.Pixels[x2,y2]:=Grid.Color;

                Canvas.Pixels[x1,y2]:=Grid.Color;

                Canvas.Pixels[x2,y1]:=Grid.Color;

            end;

      gsDash: begin

                Canvas.Pen.Style := psDot;

                Line(Trunc(KPX+i*grw),0,Trunc(KPX+i*grw),Height);

                Line(0,Trunc(KPY+i*grw),Width,Trunc(KPY+i*grw));

                Line(Trunc(KPX-i*grw),0,Trunc(KPX-i*grw),Height);

                Line(0,Trunc(KPY-i*grw),Width,Trunc(KPY-i*grw));

              end;

      gsLine: begin

                Canvas.Pen.Style := psSolid;

                Line(Trunc(KPX+i*grw),0,Trunc(KPX+i*grw),Height);

                Line(0,Trunc(KPY+i*grw),Width,Trunc(KPY+i*grw));

                Line(Trunc(KPX-i*grw),0,Trunc(KPX-i*grw),Height);

                Line(0,Trunc(KPY-i*grw),Width,Trunc(KPY-i*grw));

              end;

      end;

   end;

   end;

Canvas.Pen:=pe;

end;

end;

 

{Koord.tengelyek megrajzolása}

procedure TCoordSystem.KoordDraw;

var pe:TPen;

begin

   HPX := Trunc((Width div 2)-centrum.x*nagyitas);   {y tengely x koord-ja}

   HPY := Trunc((Height div 2)+centrum.y*nagyitas);  {x tengely y koord-ja}

 

{  With GridBitmap do begin}

   If Grid.Scale.AxisVisible then begin

      pe:=Canvas.Pen;

      Canvas.Pen.Style := psSolid;

      Canvas.Pen.Width := Grid.Scale.AxisWidth;

      Canvas.Pen.Color := Grid.Scale.AxisColor;

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

      Canvas.MoveTo(0,HPY);Canvas.LineTo(Width,HPY);

      Canvas.Pen:=pe;

   end;

{  end;}

end;

 

{Skála megrajzolása}

procedure TCoordSystem.SkalaDraw;

var i,x,y : integer;

var pe:TPen;

begin

{  With GridBitmap do begin}

   If Grid.Scale.ScaleVisible then begin

      pe:=Canvas.Pen;

      Canvas.Font.Assign(Grid.Scale.font);

      If nagyitas<1 then Canvas.Font.Size:=Trunc(nagyitas*Canvas.Font.Size);

      If Canvas.Font.Size<4 then Canvas.Font.Size:=4;

      Canvas.Brush.Style := bsClear;

      n   := Grid.Scale.Increment;

      grw := n * nagyitas;                {Beosztás táv a képen}

      If grw>1 then begin

 

      kbeosztas:=KerekitN(CoordX(0),n);

      KPX := Screenx(kbeosztas);

      {x tengely skála}

      If (HPY>0) and (HPY<Height) then begin

         grxdb:= Trunc(Width/grw)+1;

         For i:=0 to grxdb do begin

             x := Trunc(KPX + i * grw);

             Canvas.MoveTo(x,HPY);Canvas.LineTo(x,HPY+4);

             If Grid.Scale.FontVisible then begin

             s:=Alltrim(Format('%7.'+inttostr(Decimals)+'f',[kbeosztas+i*n]));

             Canvas.TextOut(x-(Canvas.TextWidth(s) div 2),HPY+4,s);

             end;

         end;

      end;

      {y tengely skála}

      kbeosztas:=KerekitN(Coordy(Height),n);

      KPY := Screeny(kbeosztas);

      If (HPY>0) and (HPY<Height) then begin

      end;

         grydb:= Trunc(Height/grw)+1;

         For i:=0 to grydb do begin

             y := Trunc(KPY - i * grw);

             Canvas.MoveTo(HPX,y);Canvas.LineTo(HPX-4,y);

             If Grid.Scale.FontVisible then begin

             s:=Alltrim(Format('%7.'+inttostr(Decimals)+'f',[kbeosztas+i*n]));

             Canvas.TextOut(HPX-4-Canvas.TextWidth(s),y+(Canvas.Font.Height div 2),s);

             end;

         end;

      end;

      Canvas.Pen:=pe;

   end;

{  end;}

end;

 

{HotPoint rajzolás}

procedure TCoordSystem.HotpointDraw;

var i,j,x,y : integer;

var pe:TPen;

begin

   If HotPointVisible then begin

      pe:=Canvas.Pen;

      Canvas.Pen.Width := 1;

      HPX := Trunc((Width div 2)+nagyitas*(HotPoint.x-centrum.x));

      HPY := Trunc((Height div 2)-nagyitas*(HotPoint.y-centrum.y));

      i:=10;

      Canvas.ellipse(HPX-(i div 2),HPY-(i div 2),HPX+(i div 2),HPY+(i div 2));

      Canvas.MoveTo(HPX,HPY-i);Canvas.LineTo(HPX,HPY+i);

      Canvas.MoveTo(HPX-i,HPY);Canvas.LineTo(HPX+i,HPY);

      Canvas.Pen:=pe;

   end;

end;

 

{Vegpont: az adott világkord. pontban a képernyőre d átmérőjű négyzetet rajzol}

procedure TCoordSystem.Vegpont(ca:TCanvas;x,y: extended;d:integer;co:TColor);

var pe: TPen;

begin

pe:=Canvas.Pen;

Canvas.Pen.Color:=co;

Canvas.Rectangle(Screenx(x)-d,Screeny(y)-d,

                 Screenx(x)+d,Screeny(y)+d);

Canvas.Pen:=pe;

end;

 

procedure TCoordSystem.Paint;

var felx,fely: extended;

  br: TBrush;

begin

If belep or gridvaltozott then begin

   br:=Canvas.Brush;

   Canvas.Pen.Mode:=pmCopy;

   Canvas.Brush.Style:=bsClear;

   If not kepmozgatas then

      cls(Canvas,Color);

   BasePointx:=Coordx(0);

   BasePointy:=Coordy(Height);

   GridDraw;

   KoordDraw;

   SkalaDraw;

   HotPointDraw;

   SBI;

   oldBoundsRect:=BoundsRect;

   belep:=False;

   gridvaltozott:=False;

   Canvas.Brush:=br;

end else LBI;

If centrumLabel<>nil then

   centrumLabel.Caption:=

           Alltrim(Format('%7.'+inttostr(Decimals)+'f',[centrum.x]))+' : '

           +Alltrim(Format('%7.'+inttostr(Decimals)+'f',[centrum.y]));

If Assigned(FOnPaint) then FOnPaint(Self);

Inherited Paint;

end;

 

procedure TCoordSystem.HotPointToCentrum;

begin Centrum.x:=HotPoint.x; Centrum.y:=HotPoint.y; end;

 

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

 

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

begin

   Canvas.MoveTo( ScreenX(x), ScreenY(y) );

end;

 

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

begin

   Canvas.LineTo( ScreenX(x), ScreenY(y) );

end;

 

procedure TCoordSystem.Line(x1,y1,x2,y2:extended);

begin

   Canvas.Moveto(ScreenX(x1), ScreenY(y1));

   Canvas.LineTo(ScreenX(x2), ScreenY(y2));

end;

 

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

begin

   Canvas.Ellipse( ScreenX(x1),ScreenY(y1),ScreenX(x2), ScreenY(y2) );

end;

 

{A koordinátákat képernyő ponttá konvertálja}

function TCoordSystem.CoordToScreen(x,y:extended):TPoint;

begin

Result.X := Trunc((Width div 2)+nagyitas*(x-centrum.x));

Result.Y := Trunc((Height div 2)-nagyitas*(y-centrum.y));

end;

 

 

  {A képernyő pontot világkoordinátákká konvertálja}

  function TCoordSystem.ScreenToCoord(x,y:integer):TPoint2D;

  begin

    Result.X := centrum.x + (x - centrum.x)/nagyitas;

    Result.Y := centrum.y - (y - centrum.y)/nagyitas;

  end;

 

  {Világkoordinátákat képernyő koordinátává konvertál}

  function  TCoordSystem.ScreenX(x:extended):integer;

  begin Result:=Trunc((Width div 2)+nagyitas*(x-centrum.x)); end;

 

  function  TCoordSystem.ScreenY(y:extended):integer;

  begin Result:=Trunc((Height div 2)-nagyitas*(y-centrum.y)); end;

 

  {Képernyőkoordinátákat világkoordinátává konvertál}

  function  TCoordSystem.CoordX(x:integer):extended;

  begin Result:= centrum.x + (x-Width/2)/nagyitas; end;

 

  function  TCoordSystem.CoordY(y:integer):extended;

  begin Result:= centrum.y - (y-Height/2)/nagyitas; end;

 

  {Normal rectangle vizsgálata és átalakítás: ball felső-jobb alsó sarokká.

  pl Rect(-1,-3,5,4) => Rect(-1,4,5,-3)}

  function TCoordSystem.CorrectRect(t:TRect):TRect;

  var k: integer;

  begin

    result:=t;

    With Result do begin

      If Left>Right then begin k:=Left; Left:=Right; Right:=k; end;

      If Top>Bottom then begin k:=Top; Top:=Bottom; Bottom:=k; end;

    end;

  end;

 

{A képernyő x,y koordinátát a legközelebbi grid pontra illeszti, a

'Precision' értéknek megfelelően}

function  TCoordSystem.ScreenToGrid(x,y:integer):TPoint2D;

  begin

    Result.X := Kerekit(Coordx(x),precision);

    Result.Y := Kerekit(Coordy(y),precision);

  end;

 

procedure TCoordSystem.AlakzatRajz(Canv: TCanvas; DrawingTool:TDrawingTool; T,B: TPoint;

         AMode: TPenMode; ujrajz: Boolean);

begin

  Canv.Pen.Mode := AMode;

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

  begin

      If ujrajz then

      begin

      end;

  case DrawingTool of

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

    dtLine: begin

              Canv.MoveTo(T.X, T.Y);

              Canv.LineTo(B.X, B.Y);

            end;

    dtRectangle: begin

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

         end;

    dtEllipse:   Canv.Ellipse(T.X, T.Y, B.X, B.Y);

    dtRoundRect: Canv.RoundRect(T.X, T.Y, B.X, B.Y,

      (T.X - B.X) div 2, (T.Y - B.Y) div 2);

  end;

  case DrawingTool of

    dtFillRect: begin

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

      end;

    dtFillEllipse: begin

      Canv.Ellipse(T.X, T.Y, B.X, B.Y);

      end;

    dtFillRoundRect: begin

      Canv.RoundRect(T.X, T.Y, B.X, B.Y,

      (T.X - B.X) div 2, (T.Y - B.Y) div 2);

      end;

  end;

  end;

  Canv.Refresh;

end;

 

end.