DIGIT

Top  Previous  Next

 

{

TDigitizer   DELPHI1.0 komponens

Szerző       Agócs László StellaSOFT

 

Leírás: Bitmap háttérkép betöltése után a térképészetben szokásos szerkesztés

során - pontok,vonalak,feliratok - elhelyezésével, mintegy sablont körülrajzolva

digitális térképi állományt hozhatunk létre a háttérkép koordinátarendszerében:

Bal alsó sarok: 0,0 ; jobb felső sarok: szélesség,magasság pixelben.

    A dig. állomány StellaMAP file szerkezető.

}

 

unit Digit;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, ExtCtrls, Controls, Forms, Dialogs, AlmType, stm, DGrafik,

Szamok, StdCtrls, StMap16, Stmap161, ClipBrd;

 

type

 

TStreamSizeChangeEvent = procedure(Sender: TObject; Points,Lines,Texts:longint) of object;

 

TDigitizer = class(TImage)

private

  FAlapkepfile    : string;

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

  FRajzmod        : TRajzmodType;

  FMonochrome     : boolean;

  FZoom           : double;              {Az alapkép nagyítása: 1,2,4}

  FPontmeret      : integer;              {Pontméret Zoom függő}

  FPontszin       : TColor;

  FMunkafile      : string;

  FAktReteg       : byte;

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

  FRetegCombo     : TCombobox;

  FAlapkeplatszik : boolean;              {Látszik-e az alapkép}

  FTerkeplatszik : boolean;               {Látszik-e az dig. térkép}

  FHatterSzin     : TColor;               {Ha nincs alapkép ez a szin él}

  FEloterSzin     : TColor;               {a pontok szine}

  FKoordLabel     : TLabel;

  FAdatLabel      : TLabel;

  FLatszik        : TVisibleSet;

  FBaseWidth      : integer;

  FBaseHeight     : integer;

  FStellaMapSource : TStellaMap;

  FStreamSizeChange: TStreamSizeChangeEvent;

  procedure SetStellaMapSource(Value:TStellaMap);

  procedure SetKoordLabel(Value: TLabel);

  procedure SetAdatLabel(Value: TLabel);

  procedure SetAlapkepfile(Value:string);

  procedure SetAlapkeplatszik(Value:boolean);

  procedure SetAlakzatmod(Value: TAlakzatmod);

  procedure SetTerkeplatszik(Value:boolean);

  procedure SetRajzmod(Value:TRajzmodType);

  procedure SetMonochrome(Value:boolean);

  procedure SetZoom(Value:double);

  procedure SetPontmeret(Value:integer);

  procedure SetPontszin(Value: TColor);

  procedure SetMunkafile(Value:string);

  procedure SetHatterSzin(Value:TColor);

  procedure SetEloterSzin(Value:TColor);

  procedure SetLatszik(Value: TVisibleSet);

  procedure SetAktReteg(Value: byte);

  procedure SetRetegFile(Value: string);

  procedure SetRetegCombo(Value: TCombobox);

  function GetBaseWidth:integer;

  function GetBaseHeight:integer;

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

protected

  BaseColorImage: TImage;      {alapkép betöltéséhez szines alapbitmap}

  BaseMonoImage : TImage;       {alapkép betöltéséhez monochrome alapbitmap}

  UndoStreams   : array[0..20,1..4] of TMemoryStream;

  UndoIndex     : integer;

  jelkHeader    : TJelkulcsHeader;

  jelkData      : TJelkulcsRecord;

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

  vanablak      : boolean;

  t             : TRect;

  nWidth,nHeight: Integer;      {nagyito keret meretei}

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

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

  oldOrigin     : TPoint;

  oldMovePt     : TPoint;

  polirec         : TPolygonRecord;

  apont           : longint;

  wrec,wrec1,wrec2: TVonalrecord;

  von1            : boolean;

  uj_szoveg       : boolean;

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

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

{    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 RetegClick(Sender:Tobject);

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

  procedure StreamOut;

public

  REMStream     : TRajzelemStream; {TM[i] Pont,Vonal,Felirat,Jelkulcs stream-ek}

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

  fontstream    : TMemoryStream;   { Fontok filestream-je}

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

  poliStream    : TMemoryStream;

  lreteg        : TLreteg;

  pontszam      : longint;

  pontsorszam   : Longint;         {Pontsorszamok}

  PontRec       : TPontrecord;

  VonalRec      : TVonalrecord;

  FeliratRec    : TSzovegrecord;

  JelkulcsRec   : TJelkulcsrecord;

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

  aktvonal      : Longint;

  aktszoveg     : Longint;

  aktjelkulcs   : Longint;

  oldprec,oprec : TPontrecord;

  vrec,oldvrec    : TVonalrecord;

  szrec,oldszrec  : TSzovegrecord;

  jrec,oldjrec    : TJelkulcsRecord;

  rrec,oldrrec    : TRetegrecord;

  frec,oldfrec    : TFontrecord;

  Cur,oldCur    : TCursor;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

{    property Canvas;}

  procedure KepRepaint;

  procedure HatterTorles(co:TColor);

  procedure Ujrarajzol(ca:TCanvas);

  procedure NewMap;

  procedure CopyToClipboard;

  procedure CopyFromClipboard;

  procedure RetegMegnyit(fnev:string);

  function  SaveMAP(fn:string):boolean;

  function  LoadMAP(fn:string):boolean;

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

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

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

  procedure Undo;

  procedure Redo;

published

  Property StellaMapSource : TStellaMap read FStellaMapSource write SetStellaMapSource ;

  Property KoordLabel : TLabel read FKoordLabel write SetKoordLabel;

  Property AdatLabel : TLabel read FAdatLabel write SetAdatLabel;

  property AktReteg: byte read FAktReteg write SetAktReteg;

  Property Alakzatmod: TAlakzatmod read FAlakzatmod write SetAlakzatmod;

  property RetegFile: string read FRetegFile write SetRetegFile;

  property RetegCombo: TComboBox read FRetegCombo write SetRetegCombo;

  Property Alapkepfile : string read FAlapkepfile write SetAlapkepfile ;

  Property Alapkeplatszik : boolean read FAlapkeplatszik write SetAlapkeplatszik ;

  Property Terkeplatszik : boolean read FTerkeplatszik write SetTerkeplatszik ;

  Property Rajzmod : TRajzmodType read FRajzmod write SetRajzmod ;

  Property Monochrome : boolean read FMonochrome write SetMonochrome ;

  Property Zoom: double read FZoom write SetZoom;

  Property Pontmeret : integer read FPontmeret write SetPontmeret ;

  Property PontSzin:TColor read FEloterSzin write SetPontszin;

  property Latszik: TVisibleSet read FLatszik write SetLatszik

            default [vPont, vVonal, vFelirat];

  Property Munkafile : string read FMunkafile write SetMunkafile ;

  Property HatterSzin:TColor read FHatterSzin write SetHatterszin;

  Property EloterSzin:TColor read FEloterSzin write SetEloterszin;

  Property BaseWidth : integer read GetBaseWidth;

  Property BaseHeight : integer read GetBaseHeight;

  property Width;

  property Height;

  property OnClick;

  property OnDblClick;

  property OnMouseDown;

  property OnMouseMove;

  property OnMouseUp;

  property StreamSizeChange: TStreamSizeChangeEvent read FStreamSizeChange

                             write FStreamSizeChange;

end;

 

implementation

 

constructor TDigitizer.Create(AOwner:TComponent);

var i,j: integer;

begin

   inherited Create(AOwner);

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

   For i:=0 to 19 do

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

   UndoIndex := -1;

   rtgstream:=TMemoryStream.Create;

   Fontstream:=TMemoryStream.Create;;

   BaseColorImage:= TImage.Create(Self);

   BaseMonoImage:= TImage.Create(Self);

   BaseMonoImage.Picture.Bitmap.Monochrome:=True;

   FRajzmod:=rmNincs;

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

   Aktreteg   := 0;

   Zoom       := 1.0;

   Stretch    := True;

   Alapratesz(cw);

   latszik    := [vPont, vVonal, vFelirat];

   Width:=100; Height:=100;

   FAlapkeplatszik := True;

   FTerkeplatszik  := True;

   StreamOut;

end;

 

destructor TDigitizer.Destroy;

var i,j: integer;

begin

   BaseColorImage.Free;

   BaseMonoImage.Free;

   rtgstream.Free;

   Fontstream.Free;

   Try

      For i:=0 to 19 do

          For j:=1 to 4 do UndoStreams[i][j].Free;

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

   finally

      inherited Destroy;

   end;

end;

 

procedure TDigitizer.KepRepaint;

var ww,hh : integer;

begin

   ww := Round(Zoom * BaseColorImage.Picture.Bitmap.Width);

   hh := Round(Zoom * BaseColorImage.Picture.Bitmap.Height);

   Picture.Bitmap.Width:=ww;

   Picture.Bitmap.Height:=hh;

   If Monochrome then

      Canvas.StretchDraw(ClientRect,BaseMonoImage.Picture.Graphic)

   else

      Canvas.StretchDraw(ClientRect,BaseColorImage.Picture.Graphic);

   Ujrarajzol(Canvas);

   StreamOut;

   Invalidate;

end;

 

procedure TDigitizer.WMSize(var Msg: TWMSize);

begin

Msg.width:=width;

Msg.Height:=Height;

Invalidate;

end;

 

procedure TDigitizer.SetStellaMapSource(Value:TStellaMap);

begin

If FStellaMapSource<>Value then begin

   FStellaMapSource:=Value;

end;

end;

 

procedure TDigitizer.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 TDigitizer.GetBaseWidth:integer;

begin

Result:=BaseColorImage.Width;

end;

 

function TDigitizer.GetBaseHeight:integer;

begin

Result:=BaseColorImage.Height;

end;

 

procedure TDigitizer.CopyToClipboard;

begin

end;

 

procedure TDigitizer.CopyFromClipboard;

begin

if Clipboard.HasFormat(CF_BITMAP) then begin

   BaseColorImage.Picture.Bitmap.assign(Clipboard);

   BaseMonoImage.Picture.Bitmap.Monochrome:=True;

   BaseMonoImage.Picture.Bitmap.assign(Clipboard);

   Monochrome:=Monochrome;

   invalidate;

end;

end;

 

procedure TDigitizer.SetAktReteg(Value: byte);

begin

If FAktReteg<>Value then begin

   FAktreteg:=Value mod 256;

   cw.aktreteg:=FAktreteg;

end;

end;

 

procedure TDigitizer.SetRetegFile(Value: string);

begin

If FRetegFile<>Value then begin

   FRetegFile := Value;

   RetegMegnyit(FRetegFile);

   Invalidate;

end;

end;

 

procedure TDigitizer.SetRetegCombo(Value: TCombobox);

begin

   FRetegCombo:=Value;

   If RetegFile<>'' then begin

      RetegMegnyit(RetegFile);

      RetegCombo.Itemindex:=AktReteg;

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

      RetegCombo.OnClick:=RetegClick;

   end;

   Invalidate;

end;

 

procedure TDigitizer.RetegClick(Sender:Tobject);

begin

If RetegCombo<>nil then

   Aktreteg:=(Sender as TCombobox).Itemindex;

end;

 

{ Rétegfile stream megnyitása }

procedure TDigitizer.RetegMegnyit(fnev:string);

var f: file of Tretegrecord;

  resu: word;

  I: integer;

begin

If FileExists(fnev) then begin

     {$I-}

     AssignFile(f,fnev);

     Reset(f);

     rtgStream.Seek(0,0);

     If Retegcombo<>nil then RetegCombo.Clear;

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

         Read(f,rrec);

         If IOResult<>0 then RRecNull(rrec);

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

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

            + ' ' + rrec.retegnev);

     end;

     CloseFile(f);

     cw.retegfile:=fnev;

     {$I+}

end else RetegFile:='';

end;

 

procedure TDigitizer.SetAlapkepfile(Value:string);

begin

If FAlapkepfile<>Value then begin

Try

   FAlapkepfile:=Value;

   If FileExists(Value) then begin

      BaseColorImage.Picture.LoadFromFile(Value);

      BaseMonoImage.Picture.LoadFromFile(Value);

      Alapkeplatszik:=True;

   end;

   If Value='' then begin

{        Picture:=nil;}

      BaseColorImage.Canvas.FillRect(BoundsRect);

      BaseMonoImage.Canvas.FillRect(BoundsRect);

      Alapkeplatszik:=False;

   end;

   Monochrome:=Monochrome;

   invalidate;

except

 Exit;

end;

end;

end;

 

procedure TDigitizer.SetKoordLabel(Value:TLabel);

begin

   FKoordLabel:=Value;

   Invalidate;

end;

 

procedure TDigitizer.SetAdatLabel(Value:TLabel);

begin

   FAdatLabel:=Value;

   Invalidate;

end;

 

procedure TDigitizer.SetRajzmod(Value:TRajzmodType);

begin

If FRajzMod<>Value then begin

   FRajzMod:=Value;

   von1:=False;

   Cursor := crDefault;

end;

end;

 

 

procedure TDigitizer.SetMonochrome(Value:boolean);

var i:integer;

begin

If (BaseColorImage<>nil) then begin

 FMonochrome:=Value;

 KepRepaint;

 Picture.Bitmap.Monochrome:=Value;

 If Alapkeplatszik then begin

   Canvas.CopyMode:=cmSrcCopy;

   If Monochrome then begin

      Canvas.Brush.Color:=ClSilver;

      Canvas.Font.Color:=ClWhite;

      Canvas.StretchDraw(ClientRect,BaseMonoImage.Picture.Graphic)

   end else

      Canvas.StretchDraw(ClientRect,BaseColorImage.Picture.Graphic);

   Picture.Bitmap.Monochrome:=False;

 end;

   Invalidate;

   Ujrarajzol(Canvas);

   StreamOut;

end;

end;

 

procedure TDigitizer.SetZoom(Value:double);

begin

If FZoom<>Value then begin

{     If Value in [1..8] then begin}

   If Value<0.01 then Value:=0.01;

   If Value>16 then Value:=16;

   FZoom:=Value;

   cw.nagyitas:=Value;

   Monochrome:=Monochrome;

{     end;}

end;

end;

 

procedure TDigitizer.SetPontmeret(Value:integer);

begin

If FPontmeret<>Value then begin

   If Value<0 then Value:=0;

   FPontmeret:=Value;

   cw.Pontmeret:=Value;

   Monochrome:=Monochrome;

   Ujrarajzol(Canvas);

end;

end;

 

procedure TDigitizer.SetPontszin(Value: TColor);

begin

If FPontszin<>Value then begin

   FPontszin:=Value;

   cw.Pontszin:=Value;

   Ujrarajzol(Canvas);

end;

end;

 

procedure TDigitizer.SetAlapkeplatszik(Value:boolean);

begin

   FAlapkeplatszik:=Value;

   If FAlapkeplatszik then begin

      Monochrome:=Monochrome;

   end else begin

      HatterTorles(Hatterszin);

   end;

   Invalidate;

   Ujrarajzol(Canvas);

end;

 

procedure TDigitizer.SetTerkeplatszik(Value:boolean);

begin

 FTerkeplatszik := Value;

 If Value then latszik := [vPont, vVonal, vFelirat] else latszik := [];

 Monochrome:=Monochrome;

 Repaint;

end;

 

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

Invalidate;

Ujrarajzol(Canvas);

end;

end;

 

procedure TDigitizer.SetMunkafile(Value:string);

var i,j:integer;

begin

If LoadMAP(Value) then begin

   FMunkafile:=Value;

   For i:=0 to 19 do

       For j:=1 to 4 do UndoStreams[i][j].Clear;

   UndoIndex := 0;

   Monochrome:=Monochrome;

end;

end;

 

procedure TDigitizer.SetHatterSzin(Value:TColor);

begin

If FHatterszin<>Value then begin

   FHatterszin:=Value;

   Canvas.Brush.Color:=Value;

   AlapkepLatszik:=AlapkepLatszik;

   Invalidate;

end;

end;

 

procedure TDigitizer.SetEloterSzin(Value:TColor);

begin

If FEloterszin<>Value then begin

   FEloterszin:=Value;

   Canvas.Font.Color:=Value;

   AlapkepLatszik:=AlapkepLatszik;

   Invalidate;

end;

end;

 

 

{procedure TDigitizer.Paint;

begin

Ujrarajzol(Canvas);

inherited paint;

end;}

 

 

{Az alapkep törlése a szinnel}

procedure TDigitizer.HatterTorles(co:TColor);

var br: TBrush;

begin

 br:=Canvas.Brush;

 Canvas.Brush.Color:=co;

 Canvas.Brush.Style:=bsSolid;

 Canvas.Rectangle(0,0,Width,Height);

 Canvas.Brush:=br;

end;

 

procedure TDigitizer.Ujrarajzol(ca:TCanvas);

var cur: TCursor;

  t  : TRect;

begin

t:= Ca.cliprect;

{  Hattertorles(cw.alapszin);}

{  If orkereszt then OrkeresztRajzol(ca);}

ca.Brush.Color:=Hatterszin;

ca.Brush.style:=bsClear;

ca.Pen.Mode:=pmCopy;

stm.Vonal_rajzolas(REMStream[2],rtgstream,lreteg,cw,ca,t);

{Kitolto_rajzolas(ca,cw);}

stm.Szoveg_rajzolas(REMStream[3],rtgstream,lreteg,cw,ca,t);

stm.Pont_rajzolas(REMStream[1],rtgstream,lreteg,cw,ca,t);

{  Jelkulcs_rajzolas(ca,cw);}

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

{GrafikusAdatok(kepernyo);}

 stm.StreamMeretek(REMStream,cw);

end;

 

function TDigitizer.SaveMAP(fn:string):boolean;

var button:integer;

begin

Result:=False;

If (fn='') then begin

   Application.MessageBox('Nem megfelelő filenév!','Figyelmeztetés',mb_Ok);

   exit;

end;

If FileExists(fn) then begin

   button:=Application.MessageBox('Már létező file! Fölülírható?!','Figyelmeztetés',mb_YesNo);

   If button = IDYES then begin

      SaveMapToFile(REMStream,fn);

      Result:=True;

   end;

end else begin

    SaveMapToFile(REMStream,fn);

    Result:=True;

end;

end;

 

function TDigitizer.LoadMAP(fn:string):boolean;

begin

If (fn<>'') and FileExists(fn) then begin

   NewMap;

   LoadMapFromFile(REMStream,fn);

   Keprepaint;

   Result:=True;

end else Result:=False;

end;

 

procedure TDigitizer.NewMap;

Var i,j: integer;

begin

Alapratesz(cw);

   For i:=0 to 19 do

       For j:=1 to 4 do UndoStreams[i][j].Clear;

UndoIndex := 0;

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

For i:=1 to 4 do REMStream[i].Clear;

latszik    := [vPont, vVonal, vFelirat];

Alapkeplatszik:=Alapkeplatszik;

end;

 

Procedure TDigitizer.PontRekordIr(arec: longint; pr: TPontrecord);

begin WriteRec(REMStream[1],arec,pr,SizeOf(pr));

end;

 

Procedure TDigitizer.VonalRekordIr(arec: longint; vr: TVonalrecord);

begin WriteRec(REMStream[2],arec,vr,SizeOf(vr));

end;

 

Procedure TDigitizer.SzovegRekordIr(arec: longint; pr: TSzovegrecord);

begin WriteRec(REMStream[3],arec,pr,SizeOf(pr));

end;

 

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

     Canvas.Font.Color:= pc;

     Canvas.Pen.Mode:=pmCopy;

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

{              IF not TEXTkenyszer then begin

               Ca.Font.Name  := rrec.fontnev;

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

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

            end else 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+Canvas.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;

 

{ ----------- Mouse események ------------}

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

    X, Y: Integer);

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

   x1,y1,x2,y2 : integer;

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

   p,p1,keppont: TPoint2D;

   pontvan,vanpont,vonalvan,talalt : boolean;

   RecNo       : longint;

   alappont,kp : TPoint2D;

   tp,tp1,tp2  : TPoint;

   d,d1,d2     : real;

   egy1,egy2   : TEgyenesfgv;

   tpp,tpp1,tpp2 : TPoint2d;

   s1,s2       : string;

   tp2d        : TPoint2D;

   op1,op2: TPoint;

   rec_no: longint;

   newSTR      : String;

   pp: TPontrecord;

begin

oldOrigin := Origin;

oldMovePt := MovePt;

Origin := Point(X, Y);

MovePt := Origin;

ymax   := Height;

my     := ymax-y;

xx := Round(x/Zoom); yy := Round(my/Zoom);

keppont := Point2d(x,my);

 

Case Rajzmod of

rmPont   :

      If button=mbLeft then

      Case Alakzatmod of

      pRajzol:

      begin

         Pontrajzol(Canvas,x,y,cw.pontmeret,cw.pontszin);

         stm.precnull(pp);

         Inc(pontszam);

         With pp do begin

            reteg := cw.Aktreteg;

            x     := xx;

            y     := yy;

            z     := 0;

            No    := pontsorszam;

         end;

         Inc(pontsorszam);

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

            Ujpont(REMStream[1],cw,pp);

      end;

      pTorol:

         If pontkeres(REMStream[1],cw,x,my,prec,aktPont) then begin

            prec.jelzo:=SetBit(prec.jelzo,0,1);

            WriteRec(REMStream[1],aktPont,prec,SizeOf(prec));

            Monochrome:=Monochrome;

         end;

      end;

 

rmVonal,rmPontVonallal,rmNegyszog:

      Case Alakzatmod of

      pRajzol:

      begin

        If von1 and not pontvan then

           pontvan := pontkeres(REMStream[1],cw,oldmovept.x,ymax-oldMovePt.y,prec,aktPont)

        else pontvan:=pontkeres(REMStream[1],cw,x,my,prec,aktPont);

        vanpont:=pontvan;

        If rajzmod in [rmNegyszog,rmPontVonallal] then begin

           If not pontvan then begin

              stm.precnull(prec);

              prec.reteg := cw.Aktreteg;

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

           end;

           pontvan:=True;

           prec.No:=pontsorszam;

        end;

        If pontvan then

         If (not von1) then begin

            If button = mbLeft then

             begin

                    wrec.reteg := cw.aktreteg;

                    wrec.x1 := prec.x;

                    wrec.y1 := prec.y;

                    wrec.x2 := prec.x;

                    wrec.y2 := prec.y;

                    Origin := Point(X, Y);

                    MovePt := Origin;

                       If Rajzmod=rmPontVonallal then begin

                          Ujpont(REMStream[1],cw,prec);

                          Inc(pontsorszam);

                       end;

                    von1     := True;

             end;

         end else begin

            Case button of

            mbLeft: begin

                    wrec.x2 := prec.x;

                    wrec.y2 := prec.y;

                    Rajzol(Canvas,cw,oldOrigin,oldMovePt,Rajzmod,pmCopy,True);

                    Origin := Point(X, Y);

                    MovePt := Origin;

                    oldOrigin := Origin;

                    oldMovePt := MovePt;

 

                    Case rajzmod of

                    rmVonal,rmPontVonallal:begin

                       wrec.reteg := cw.aktreteg;

                       UjVonal(REMStream[2],rtgstream,cw,wrec);

                       If (Rajzmod=rmPontVonallal) and not vanpont then begin

                          Ujpont(REMStream[1],cw,prec);

                          Inc(pontsorszam);

                       end;

                    end;

                    rmNegyszog:begin

                       precNull(prec);

                       prec.reteg:=0;

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

                       vrec:=wrec;

 

                       vrec.y2:=wrec.y1;

                       REMStream[2].write(vrec,SizeOf(vrec));

                       prec.x:=wrec.x1; prec.y:= wrec.y1;

                       prec.No:=pontsorszam;

                       REMStream[1].write(prec,SizeOf(prec));

 

                       vrec.x1:=wrec.x2; vrec.y2:=wrec.y2;

                       REMStream[2].write(vrec,SizeOf(vrec));

                       prec.x:=wrec.x2; prec.y:= wrec.y1;

                       prec.No:=pontsorszam+1;

                       REMStream[1].write(prec,SizeOf(prec));

 

                       vrec.x1:=wrec.x1; vrec.x2:=wrec.x2;vrec.y1:=wrec.y2;

                       vrec.y2:=wrec.y2;

                       REMStream[2].write(vrec,SizeOf(vrec));

                       prec.x:=wrec.x2; prec.y:= wrec.y2;

                       prec.No:=pontsorszam+2;

                       REMStream[1].write(prec,SizeOf(prec));

 

                       vrec.x2:=wrec.x1; vrec.y1:=wrec.y1; vrec.y2:=wrec.y2;

                       REMStream[2].write(vrec,SizeOf(vrec));

                       prec.x:=wrec.x1; prec.y:= wrec.y2;

                       prec.No:=pontsorszam+3;

                       REMStream[1].write(prec,SizeOf(prec));

 

                       Inc(cw.vonalszam,4); Inc(cw.pontszam,4);

                       von1 := False; pontsorszam:=pontsorszam+4;

                       Update;

                    end;

 

                    end;

                    wrec.x1 := wrec.x2;

                    wrec.y1 := wrec.y2;

                    end;

            end;

         end else begin

            Origin := oldOrigin;

            MovePt := oldMovePt;

         end;

         If (Button=mbRight) and von1 then begin

            von1 := False;

            Rajzol(Canvas,cw,oldOrigin,oldMovePt,Rajzmod,pmNotXor,False);

         end;

         end;

      pTorol:

         If (Button=mbLeft) and Vonalkeres(REMStream[2],cw,x,my,vrec,aktPont)

         then begin

            vrec.jelzo:=SetBit(vrec.jelzo,0,1);

            WriteRec(REMStream[2],aktPont,vrec,SizeOf(vrec));

            Monochrome:=Monochrome;

         end;

      end;

 

rmPontAtrak: begin

       pontvan:=pontkeres(REMStream[1],cw,x,my,prec,aktPont);

       If not von1 then begin

          If pontvan then begin

             oldprec:=prec;

             oprec:=prec;

             apont:=aktpont;

             von1:=True;

          end;

       end else begin

           von1:=False;

           Case button of

           mbLeft: begin

             If pontvan then begin

                If aktPont=apont then begin

                   prec:=oldprec;

                   PontrekordIr(aPont,prec);

                end else begin

                   oldprec.jelzo:=SetBit(oldprec.jelzo,0,1);

                   PontrekordIr(aPont,oldprec);

                end;

             end else begin

                prec:=oldprec;

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

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

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

                Pontrajzol(Canvas,op1.x,op1.y,pontmeret,clWhite);

                PontrekordIr(aPont,prec);

             end;

             rec_no:=0;

             cw.vonalszam:=REMStream[2].size div sizeof(vrec);

             While rec_no<cw.vonalszam do

             if VonalVegpontKeres(REMStream[2],oprec.x,oprec.y,vrec,rec_no) then

             begin

                  VonalVegpontAtrak(vrec,oprec,prec);

                  VonalRekordIr(rec_no,vrec);

                  rec_no:=rec_no+1;

                  Vonalrajzol(Canvas,vrec);

             end;

           end;

       end;

       end;

       Monochrome:=Monochrome;

  end;

 

rmFelirat:

 Case Alakzatmod of

 pRajzol:

  begin

    SzrecNull(szrec);

    newSTR := '';

    If InputQuery('Új felirat','Felirat',newSTR) then begin

       szrec.reteg := AktReteg;

       szrec.x     := xx;

       szrec.y     := yy;

       szrec.szoveg:= newSTR;

       UjFelirat(REMStream[3],rtgstream,cw,szrec);

       Monochrome:=Monochrome;

    end;

  end;

 pTorol:

    If (Button=mbLeft) and Feliratkeres(REMStream[3],cw,x,my,szrec,aktPont)

         then begin

            szrec.jelzo:=SetBit(szrec.jelzo,0,1);

            WriteRec(REMStream[3],aktPont,szrec,SizeOf(szrec));

            Monochrome:=Monochrome;

         end;

  end;

 

rmPontbeillesztes:

      if Vonalkeres(REMStream[2],cw,x,my,vrec,aktvonal) then begin

         wrec1:=vrec; wrec2:=vrec;

         vrec.jelzo:=vrec.jelzo or 1;

         VonalRekordir(aktvonal,vrec);

         egy1:=KetPontonAtmenoEgyenes(vrec.x1,vrec.y1,vrec.x2,vrec.y2);

         egy2:=EgypontonAtmenoMeroleges(egy1,keppont);

         tpp1 := KetEgyenesMetszespontja(egy1,egy2);

         wrec1.x2:=tpp1.x; wrec1.y2:=tpp1.y;

         wrec2.x1:=tpp1.x; wrec2.y1:=tpp1.y;

         UjVonal(REMStream[2],rtgstream,cw,wrec1);

         UjVonal(REMStream[2],rtgstream,cw,wrec2);

         stm.Precnull(prec);

         With prec do begin

            x     := tpp1.x;

            y     := tpp1.y;

            No    := maxpontszamkeres(REMStream[1])+1;

         end;

         Ujpont(REMStream[1],cw,prec);

         Monochrome:=Monochrome;

      end;

{

rmFelirat: begin

         oldszrec:=szrec;

         If Cursor=crDefault then begin

         szrec.x := keppont.x;

         szrec.y := keppont.y;

         szrec.reteg  := aktreteg;

         end;

         rrec:=RetegrekordKap(szrec.reteg);

 

         Case szovegmod of

         szSzovegkeres:

            begin

            szrec:=LegkozelebbiSzoveg(keppont,aktszoveg);

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

            rrec:=RetegrekordKap(szrec.reteg);

            For i:=1 to 5 do begin

                For j:=1 to 150 do

                    Szovegrajzol(Canvas,szrec,cw.alapszin);

                For j:=1 to 150 do

                    Szovegrajzol(Canvas,szrec,rrec.szovegszin);

            end;

            ujszoveg:=False;

            end;

         szSzimpla:

            begin

              If not ujszoveg then

                 Szovegrajzol(Canvas,oldszrec,cw.alapszin);

              Rottext(Canvas,x,y,szrec.szoveg,szrec.szog);

              REMStream[3].seek(0,2);

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

              Inc(cw.szovegszam);

              ujszoveg:=False;

            end;

         szEltolas:

            begin

              If not ujszoveg then

                 Szovegrajzol(Canvas,oldszrec,cw.alapszin);

              SzovegrekordIr(aktSzoveg,szrec);

              Szovegrajzol(Canvas,szrec,rrec.szovegszin);

              ujszoveg:=False;

            end;

         szVonalra:

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

              szog:=Fok(Szakaszszog(vrec.x1,vrec.y1,vrec.x2,vrec.y2));

              If (szog>=90) and (szog<=270) then

                      szrec.szog:= 10*Trunc(szog-180)

                 else szrec.szog:= Trunc(10*szog);

              SzovegrekordIr(aktSzoveg,szrec);

              If not ujszoveg then

                 Szovegrajzol(Canvas,oldszrec,cw.alapszin);

              Szovegrajzol(Canvas,szrec,rrec.szovegszin);

              ujszoveg:=False;

           end;

           szSzogben:

           If Button=mbLeft then begin

              Rajzol(Origin,MovePt,pmCopy,True);

              ujszoveg:=False;

           end;

         end;

      end;

 

      }

end;

Canvas.Refresh;

If button=mbLeft then UndoSave;

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

end;

 

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

  vanpont: boolean;

begin

oldMovePt := MovePt;

MovePt := Point(X, Y);

ymax   := Height;

my     := ymax-y;

xx:=Round(x/Zoom); yy:=Round(my/Zoom);

keppont := Point2d(xx,yy);

{  ScreenToMap(Point(x,ymax-y),cw);}

 

If KoordLabel<>nil then begin

   KoordLabel.Caption:=IntToStr(xx)+' : '+IntToStr(yy);

   KoordLabel.Repaint;

end;

 

If Rajzmod<>rmNincs then begin

   Canvas.Refresh;

   vanpont := Pontkeres(REMStream[1],cw,x,my,pp,aktpont);

   If AdatLabel<>nil then begin

      If vanpont then AdatLabel.Caption:=IntToStr(pp.No)

      else AdatLabel.Caption:='';

      AdatLabel.Repaint;

   end;

   If vanpont then Cursor := crDrag else Cursor := oldcur;

end;

If ((Rajzmod=rmVonal) and (Alakzatmod=pTorol)) or (Rajzmod=rmPontbeillesztes) then begin

   If Vonalkeres(REMStream[2],cw,x,my,vrec,aktpont)

   then Cursor := crDrag else Cursor := oldcur;

end;

If (Rajzmod=rmFelirat) and (Alakzatmod=pTorol) then begin

   If Feliratkeres(REMStream[3],cw,x,my,szrec,aktpont)

   then Cursor := crDrag else Cursor := oldcur;

end;

 

Case Rajzmod of

{

 rmNincs,rmHRSZ:

 

    If (Shift=[ssLeft]) then begin

       If not kepmozgatas then begin

         Canvas.Pen.Mode:=pmCopy;

         TRKSaveBitmap:=TBitmap.Create;

         TRKSaveBitmap.width  := Width;

         TRKSaveBitmap.height := height;

         If kozepkereszt then Kereszt(Canvas,clGreen);

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

         If kozepkereszt then Kereszt(Canvas,clGreen);

         kepmozgatas:=True;

         Screen.Cursor := crKez;

       end else

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

         Try

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

                TRKSaveBitmap);

         ca:=Canvas;

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

         If kozepkereszt then Kereszt(Canvas,clGreen);

         except

           On Exception do exit;

         end;

       end;

    end;

 

}

 rmVonal,rmSokszog,rmTermanual,rmIvmetszes,rmBemeres,rmTavmeres,rmElometszes,

 rmPoligonkijelol,rmPontVonallal:

        If von1 then begin

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

             pp   := stm.LegkozelebbiPont(REMStream[1],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(Canvas,cw,Origin,oldMovePt,Rajzmod,pmNotXor,False);

         Rajzol(Canvas,cw,Origin,MovePt,Rajzmod,pmNotXor,False);

        end;

 

rmPontAtrak:

  If von1 then begin

       prec :=oldprec;

       prec.x:=keppont.x; prec.y:=keppont.y;

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

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

       Canvas.Pen.Color := clTeal;

       Canvas.Pen.width := 2;

       Canvas.Pen.Mode  := pmNotXor;

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

       Canvas.Pen.Mode  := pmNotXor;

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

       rec_no:=0;

       cw.vonalszam:=REMStream[2].size div sizeof(vrec);

       While rec_no<cw.vonalszam do

       if VonalVegpontKeres(REMStream[2],oprec.x,oprec.y,vrec,rec_no) then

       begin

          VonalVegpontAtrak(vrec,oprec,oldprec);

          Rajzol(Canvas,cw,MapToScreen(Canvas,vrec.x1,vrec.y1,cw),

                 MapToScreen(Canvas,vrec.x2,vrec.y2,cw),Rajzmod,pmNotXor,False);

          VonalVegpontAtrak(vrec,oldprec,prec);

          Rajzol(Canvas,cw,MapToScreen(Canvas,vrec.x1,vrec.y1,cw),

                 MapToScreen(Canvas,vrec.x2,vrec.y2,cw),Rajzmod,pmNotXor,False);

          rec_no:=rec_no+1;

       end;

       oldprec := prec;

  end;

 

{

 rmNegyszog :

        If von1 then begin

         Rajzol(Origin,oldMovePt,pmNotXor,False);

         Rajzol(Origin,MovePt,pmNotXor,False);

        end;

 

 

 rmFelirat : begin

         If (Shift=[ssLeft]) and (szovegmod=szSzogben) then begin

            Rajzol(Origin,oldMovePt,pmNotXor,False);

            Rajzol(Origin,MovePt,pmNotXor,False);

         end;

         If szovegmod=szVonalra then

         If Vonalkeres(x,my,vrec,aktvonal) then

         begin

            Cursor := crDrag;

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

         end else begin

            Cursor := crDefault;

         end;

         If szovegmod<>szSzovegkeres then begin

            Szovegrajzol(TRK.Canvas,szrec,cw.alapszin);

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

            Szovegrajzol(TRK.Canvas,szrec,rrec.szovegszin);

         end;

        end;

 

 rmVonalkijelol,rmVonaltorol :

         If Vonalkeres(x,my,vrec,aktvonal) then

         begin

            Cursor := crDrag;

            If AdatLabel<>nil then

                (AdatLabel as TLabel).Caption:=IntToStr(vrec.reteg);

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

         end else begin

            Cursor := crDefault;

            If AdatLabel<>nil then

                (AdatLabel as TLabel).Caption:='';

         end;

 

rmSzovegkijelol:

         begin

            szrec:=LegkozelebbiSzoveg(Point2D(xx,yy),aktszoveg);

            If AdatLabel<>nil then

                (AdatLabel as TLabel).Caption:=szrec.szoveg;

         end;

}

 end;

Canvas.Refresh;

inherited MouseMove(Shift,x,y);

end;

 

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

    X, Y: Integer);

begin

 Case Rajzmod of

 rmNincs,rmHRSZ:

 end;

 stm.StreamMeretek(REMStream,cw);

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

end;

 

procedure TDigitizer.UndoSave;

var i,j:integer;

begin

   UndoIndex := (UndoIndex + 1) mod 20;

   For j:=1 to 4 do RemStream[j].SaveToStream(UndoStreams[UndoIndex][j]);

   KepRepaint;

end;

 

procedure TDigitizer.Undo;

var i,j:integer;

begin

   UndoIndex := UndoIndex - 1;

   If UndoIndex<0 then UndoIndex:=0;

   For j:=1 to 4 do RemStream[j].LoadFromStream(UndoStreams[UndoIndex][j]);

   KepRepaint;

end;

 

procedure TDigitizer.Redo;

var i,j:integer;

begin

   UndoIndex := (UndoIndex + 1) mod 20;

   For j:=1 to 4 do RemStream[j].LoadFromStream(UndoStreams[UndoIndex][j]);

   KepRepaint;

end;

 

procedure TDigitizer.StreamOut;

begin

stm.StreamMeretek(REMStream,cw);

If Assigned(FStreamSizeChange) then

   FStreamSizeChange(Self,cw.pontszam,cw.vonalszam,cw.szovegszam);

end;

 

end.