STJKW

Top  Previous  Next

 

{ JELKULCS szerkesztő komponens

 

Egy jelkulcs szerkesztésére szolgál.

A jelkulcs rajzelemek a TWM memorystream-en vannak.

Törléskor a jkData rekord jkkod=0 értéket kap.

 

}

 

unit Stjkw;

 

interface

 

uses

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

Graphics, Controls, Forms, Dialogs, Koord, Geom;

 

type

TJKRajznod = (rNincs,rPont,rVonal,rKor,rNegyszog,rFest,rKijelol);

TkijelolesAction = (kjNincs,    {Nincs akció}

                  kjAll,      {Minden elemet kijelöl}

                  kjInvers,   {minden kijelölést ellenkezőjére változtat}

                  kjNot,      {minden kijelölés jelzést töröl}

                  kjDel       {minden kijelöltet töröl, jkkod=0,kijelolt=False}

                  );

 

{JELKULCS.JLK file:

HEADER : 1000 jelkulcs táblázata

DATA   : Jelkulcs adatok:

         pont :    1,x1,y1,x2,y2,szin,vastag;

         vonal:    2,x1,y1,x2,y2,szin,vastag;

         kor  :    3,x1,y1,x2,y2,szin,vastag;

         negyszög: 4,....

         festbe :  5,x1,y1,x2,y2,szin,stilus;

         festki :  6,x1,y1,x2,y2,szin,stilus;

}

TJelkulcsHeader = record

jkkod  : longint;

jkcim  : longint;

jkdb   : byte;        {Jelkulcs rajzelemek száma}

jknev  : string[20];

end;

 

TJelkulcsRecord = record  {Jelkulcs adat a *.jlk file-ban}

kod    : word;

x1,y1  : integer;

x2,y2  : integer;

szin   : TColor;

vastag : byte;

end;

 

TJelkDataRecord = record     {Jelkulcs adat a jelkulcsStream és jkWork-ön}

jkkod    : longint;          {jelkulcs sorszáma, 0 = törölt}

adat     : TJelkulcsRecord;  {jelkulcs adatok}

kijelolt : boolean;

end;

 

TJeloloNegyzet = record      {Alakzatkijelolesekhez sarok és oldalfelezo pontok}

jkData   : TJelkDataRecord;  {alakzat adatrekordja}

cim      : longint;          {alakzat címe a TWM streamen}

sarok    : TRect;            {alakzat befoglaló négyszög}

oldsarok : TRect;            {eredeti alakzat befoglaló undó-hoz}

end;

 

TJelkulcsView = class(TCoordSystem)

private

  FJelkulcsnev: string;

  FAktJelkulcs: word;

  FHotPoint   : T2DPoint;

  FOrigo      : T2DPoint;

  FColor      : TColor;

  FGrid       : TGrid;

  FRajzmod    : TJKRajznod;

  FKoordLabel : TLabel;

  FRajzmodLabel : TLabel;

  FNagyitas   : integer;

  FTentativTures: integer;               {rárántási távolság kijelölésnél}

  FkjAction   : TkijelolesAction;

  FAktColor   : TColor;                  {aktuális szín rajzoláshoz}

  FAktWidth   : integer;                 {aktuális vonalvastagság rajzoláshoz}

  FJelkulcsFile: string;

  procedure SetJelkulcsFile(Value:string);

  procedure SetAktJelkulcs(Value:word);

  procedure SeTJKRajznod(Value:TJKRajznod);

  procedure SetkjAction(Value:TkijelolesAction);

protected

  oldCur : TCursor;

  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;

public

  TWM : TmemoryStream;                 {Munkastream egy jelkulcsnak}

  jelkulcsStream : TFileStream;        {jelkulcsfile stream}

  valtozott : boolean;                 {Jelkulcskészletet módosították}

  jkvaltozott : boolean;               {az aktJelkulcsot módosították}

  jkData        : TJelkDataRecord;

  oldjkData     : TJelkDataRecord;        {a kijelolt rekord}

  TalaltjkData  : TJelkDataRecord;        {megtalált alakzat rekordja}

  AktjkData     : TJelkDataRecord;        {a rajzolás alatti elem rekordja}

  ujkijelolt    : boolean;                {uj kijelolt alakzat}

  vankijelolt   : boolean;                {van-e kijelolt alakzat}

  jkDataCim     : longint;                {kijelolt rekord cime}

  oldjkDataCim  : longint;                {elozo kijelolt rekord cime}

  befoglalo     : TRect2d;                {elem befoglaló négyszöge}

  AktivRajzMod  : integer;                {0..6 rajz funkció folyamatban}

{    jelkHeader    : TJelkulcsHeader;

  jelkData      : TJelkulcsRecord;

  oldjelkHeader : TJelkulcsHeader;

  oldjelkData   : TJelkulcsRecord;

  JeloloNegyzet : TJeloloNegyzet;}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure JKStreamInit;

  procedure JelkNull(var jk:TJelkulcsRecord);

  procedure JelkDataNull(var jk:TJelkDataRecord);

  {A TWM stream jelkulcs adat rekordját adja}

  function  GetJelkulcsszam:longint;

  {A TWM stream n. jelkulcs adat rekordjával tér vissza}

  function  GetJelkData(n:longint;var jk:TJelkDataRecord):boolean;

  {A TWM stream n. jelkulcs adat rekordját lecseréli jk-val}

  function  SetJelkData(n:longint;var jk:TJelkDataRecord):boolean;

  {A TWM stream végére jelkulcs adat rekordot ír}

  procedure JelkDataIr(jk:TJelkDataRecord);

  procedure JelkulcsRedraw;

  procedure Change(Sender: TObject);

  function AlakzatErzekeles(mpont:TPoint2d):boolean;

  procedure Kijeloles(mpont:TPoint2d;vegleges:boolean);

  procedure SarokKijelzesek(jkd:TJelkDataRecord;tomor,torol:boolean);

  procedure Sarokpont(x,y:extended;tomor,torol:boolean);

  procedure TranszColor(co:TColor);

  procedure TranszWidth(w:integer);

  property kjAction:TkijelolesAction read FkjAction write SetkjAction;

published

  property JelkulcsFile: string read FJelkulcsFile write SetJelkulcsFile;

  Property Jelkulcsnev : string read FJelkulcsnev write FJelkulcsnev;

  Property AktJelkulcs: word read FAktJelkulcs write SetAktJelkulcs default 1;

  Property Rajzmod : TJKRajznod read FRajzmod write SeTJKRajznod ;

  Property RajzmodLabel : TLabel read FRajzmodLabel write FRajzmodLabel ;

  Property TentativTures: integer read FTentativTures write FTentativTures;

  Property AktColor: TColor read FAktColor write FAktColor;

  Property AktWidth: integer read FAktWidth write FAktWidth;

  property Align;

  property OnClick;

  property OndblClick;

  property OnMouseDown;

  property OnMouseMove;

  property OnMouseUp;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TJelkulcsView]);

end;

 

 

constructor TJelkulcsView.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   JKStreamInit;

   FAktJelkulcs   := 1;

   FAktColor      := clBlack;

   FAktWidth      := 1;

   TentativTures  := 4;

end;

 

destructor TJelkulcsView.Destroy;

begin

   TWM.Free;

   inherited Destroy;

end;

 

procedure TJelkulcsView.SetJelkulcsFile(Value:string);

begin

If FJelkulcsfile<>Value then begin

  If FileExists(Value) then begin

     FJelkulcsfile:=Value;

  end;

end;

end;

 

procedure TJelkulcsView.Change(Sender: TObject);

begin

invalidate;

end;

 

procedure TJelkulcsView.SetAktJelkulcs(Value:word);

begin

If FAktJelkulcs<>Value then begin

   FAktJelkulcs:=Value;

   invalidate;

end;

end;

 

procedure TJelkulcsView.SeTJKRajznod(Value:TJKRajznod);

begin

If FRajzmod<>Value then begin

   FRajzmod:=Value;

   If RajzmodLabel<>nil then

   Case Value of

   rNincs: RajzmodLabel.Caption:='Nincs';

   rPont : RajzmodLabel.Caption:='Pont';

   rVonal: RajzmodLabel.Caption:='Vonal';

   rKor  : RajzmodLabel.Caption:='Kör';

   rFest : RajzmodLabel.Caption:='Fest';

   rNegyszog: RajzmodLabel.Caption:='Negyszog';

   end;

   If Value=rKijelol then begin

      jkDataCim:=-1;

      oldjkDataCim:=-1;

      vankijelolt:=False;

      ujkijelolt:=False;

   end;

   AktivRajzMod:=0;

   invalidate;

end;

end;

 

procedure TJelkulcsView.SetkjAction(Value:TkijelolesAction);

var jkd : TJelkDataRecord;

  i: integer;

begin

   FkjAction:=Value;

   TWM.Seek(0,0);

   For i:=1 to TWM.Size div SizeOf(jkD) do begin

     TWM.Read(jkd,SizeOf(jkD));

     Case Value of

     kjAll    : jkd.kijelolt:=True;

     kjInvers : jkd.kijelolt:=not jkd.kijelolt;

     kjNot    : jkd.kijelolt:=False;

     kjDel    : If jkd.kijelolt then begin

                  jkd.kijelolt:=False;

                  jkd.jkkod:=0;

                end;

     end;

     TWM.Seek(-SizeOf(jkD),1);

     TWM.Write(jkD,SizeOf(jkD));

   end;

     invalidate;

end;

 

{Kijelöltek szinének állítása}

procedure TJelkulcsView.TranszColor(co:TColor);

var jkd : TJelkDataRecord;

  i: integer;

begin

   TWM.Seek(0,0);

   For i:=1 to TWM.Size div SizeOf(jkD) do begin

     TWM.Read(jkd,SizeOf(jkD));

     If jkd.kijelolt then begin

        jkd.Adat.szin:=co;

        TWM.Seek(-SizeOf(jkD),1);

        TWM.Write(jkD,SizeOf(jkD));

     end;

   end;

   invalidate;

end;

 

{Kijelöltek vonalvastagságának állítása}

procedure TJelkulcsView.TranszWidth(w:integer);

var jkd : TJelkDataRecord;

  i: integer;

begin

   TWM.Seek(0,0);

   For i:=1 to TWM.Size div SizeOf(jkD) do begin

     TWM.Read(jkd,SizeOf(jkD));

     If jkd.kijelolt then begin

        jkd.Adat.vastag:=w;

        TWM.Seek(-SizeOf(jkD),1);

        TWM.Write(jkD,SizeOf(jkD));

     end;

   end;

     invalidate;

end;

 

{Törli a TWM munkastream-et}

procedure TJelkulcsView.JKStreamInit;

var i: integer;

begin

If TWM=nil then TWM:= TMemoryStream.Create else TWM.Clear;

invalidate;

end;

 

{Üres jelkulcs data rekordot ad}

procedure TJelkulcsView.JelkNull(var jk:TJelkulcsRecord);

begin

With jk do begin

kod    := 0;

x1     := 0;

x2     := 0;

y1     := 0;

y2     := 0;

szin   := clBlack;

vastag := 1;

end;

end;

 

procedure TJelkulcsView.JelkDataNull(var jk:TJelkDataRecord);

begin

jk.jkkod:=Aktjelkulcs;

JelkNull(jk.Adat);

end;

 

  {A TWM stream jelkulcs adat rekordjit adja}

function  TJelkulcsView.GetJelkulcsszam:longint;

begin  Result := TWM.Size div SizeOf(jkData); end;

 

  {A TWM stream n. jelkulcs adat rekordjával tér vissza}

function  TJelkulcsView.GetJelkData(n:longint;var jk:TJelkDataRecord):boolean;

begin

Result := GetJelkulcsszam >= n;

TWM.Seek(n*SizeOf(jkData),0);

TWM.Read(jk,SizeOf(jk));

end;

 

  {A TWM stream n. jelkulcs adat rekordját lecseréli jk-val}

function  TJelkulcsView.SetJelkData(n:longint;var jk:TJelkDataRecord):boolean;

begin

Result := GetJelkulcsszam >= n;

If Result then begin

   TWM.Seek(n*SizeOf(jkData),0);

   TWM.Write(jk,SizeOf(jk));

end;

end;

 

  {A TWM stream végére jelkulcs adat rekordot ír}

procedure  TJelkulcsView.JelkDataIr(jk:TJelkDataRecord);

begin

   TWM.Seek(0,2);

   TWM.Write(jk,SizeOf(jk));

end;

 

procedure TJelkulcsView.JelkulcsRedraw;

var i,meret: longint;

  xx1,yy1,xx2,yy2: integer;

begin

meret := TWM.Size div SizeOf(jkData);

TWM.Seek(0,0);

With Canvas do begin

  Brush.Style:=bsClear;

  For i:=1 to meret do begin

     TWM.Read(jkData,SizeOf(jkData));

     If jkData.jkkod<>0 then

     With jkData.Adat do begin

          Pen.Color:= szin;

          Pen.Width:= vastag;

          xx1:=Screenx(x1);

          yy1:=Screeny(y1);

          xx2:=Screenx(x2);

          yy2:=Screeny(y2);

          Case kod of

          1: begin Rectangle(xx1-2,yy1-2,xx1+2,yy1+2)end;

          2: begin Line(xx1,yy1,xx2,yy2); end;

          3: begin

             Ellipse(xx1,yy1,xx2,yy2);

             end;

          4: begin Rectangle(xx1,yy1,xx2,yy2); end;

{            5: begin

             Brush.Color:=szin;

             Brush.Style:=TBrushStyle(vastag);

             Pen.Mode:=pmCopy;

             end;

          6: begin

             Brush.Color:=szin;

             Brush.Style:=bsClear;

             Pen.Mode:=pmCopy;

             end;}

          end;

          If jkData.kijelolt then SarokKijelzesek(jkData,True,False);

     end;

  end;

end;

end;

 

procedure TJelkulcsView.Paint;

begin

Inherited Paint;

JelkulcsRedraw;

end;

 

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

    X, Y: Integer);

var mpont : TPoint2d;           {rámutatási pont világkoordinátája}

  kx,ky : integer;

begin

mpont := ScreenToGrid(x,y);

kx    := Screenx(mpont.x); ky := Screeny(mpont.y);

Origin := Point(kx,ky);

Canvas.pen.color:=AktColor;

Canvas.pen.Width:=AktWidth;

If AktivRajzMod=0 then

With aktjkData do begin

     jkkod:=AktJelkulcs;

     adat.kod:= Ord(RajzMod);

     adat.x1:=Trunc(mpont.x);

     adat.y1:=Trunc(mpont.y);

     adat.szin:=AktColor;

     adat.vastag:=AktWidth;

end;

Case RajzMod of

rNincs:

  begin

    AktivRajzMod:=0;

  end;

rPont:

  begin

    JelkDataIr(aktjkData);

    AktivRajzMod:=0;

  end;

rVonal,rKor,rNegyszog:

  If AktivRajzMod<>0 then begin

    If Button=mbLeft then begin

       With aktjkData do begin

            adat.x2:=Trunc(mpont.x);

            adat.y2:=Trunc(mpont.y);

       end;

       JelkDataIr(aktjkData);

       If RajzMod=rVonal then

       With aktjkData do begin

            jkkod:=AktJelkulcs;

            adat.kod:= Ord(RajzMod);

            adat.x1:=Trunc(mpont.x);

            adat.y1:=Trunc(mpont.y);

       end;

    end;

    If (Button=mbRight) or (RajzMod<>rVonal) then AktivRajzMod:=0;

  end else AktivRajzMod:=Ord(RajzMod);

rKijelol:

  begin

    Kijeloles(mpont,True);

  end;

end;

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

end;

 

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

var mpont : TPoint2d;           {rámutatási pont világkoordinátája}

  kx,ky : integer;

begin

inherited MouseMove(Shift,x,y);

mpont := ScreenToGrid(x,y);

kx    := Screenx(mpont.x); ky := Screeny(mpont.y);

MovePt := Point(kx,ky);

If AktivRajzMod<>0 then begin

     Alakzatrajz(Canvas,TDrawingTool(Ord(RajzMod)),Origin,MovePt,pmNotXor,False);

     Alakzatrajz(Canvas,TDrawingTool(Ord(RajzMod)),Origin,oldMovePt,pmNotXor,False);

end;

Case RajzMod of

rKijelol:

  begin

    AlakzatErzekeles(mpont);

  end; {rkijelol}

end; {Case}

oldMovePt := MovePt;

end;

 

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

    X, Y: Integer);

var mpont : TPoint2d;           {rámutatási pont világkoordinátája}

  kx,ky : integer;

begin

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

mpont := ScreenToGrid(x,y);

kx    := Screenx(mpont.x); ky := Screeny(mpont.y);

Origin := Point(kx,ky);

With aktjkData do begin

     jkkod:=AktJelkulcs;

     adat.kod:= Ord(RajzMod);

     adat.x2:=Trunc(mpont.x);

     adat.y2:=Trunc(mpont.y);

end;

Case RajzMod of

rNincs:

  begin

  end;

rPont:

  begin

  end;

rVonal:

  begin

  end;

rKor:

  begin

  end;

rNegyszog:

  begin

  end;

rFest:

  begin

  end;

rKijelol:

  begin

  end;

end;

end;

 

{Kijelölések, ha vegleges=True, beírja a jkData rekordba és sötétkék sarkokkal

            jelzi}

function TJelkulcsView.AlakzatErzekeles(mpont:TPoint2d):boolean;

var rgn: HRgn;

  t : TRect;

  i,j,meret: longint;

  ter,minTer: extended;       {Minimális terület}

  talalt : boolean;           {rajzelem megtalált}

  d: real;

begin

  minTer := 2e+9;

  meret := TWM.Size div SizeOf(jkData);

  TWM.Seek(0,0);

  talalt := False;

  jkDatacim:=-1;

 

  For i:=0 to meret-1 do begin

     TWM.Read(jkData,SizeOf(jkData));

 

     With jkData.Adat do begin

       {Téglalap alakú befoglaló regió létrehozása}

       d:=Tentativtures/nagyitas;

       befoglalo := CorrectRealRect(Rect2d(x1,y1,x2,y2));

{

       If PontInKep(mpont.x,mpont.y,Rect2d(befoglalo.x1-d,befoglalo.y1-d,

                    befoglalo.x2+d,befoglalo.y2+d)) then begin

          ter := Abs(befoglalo.x2-befoglalo.x1)+Abs(befoglalo.y2-befoglalo.y1);

          If ter<minTer then begin

             minTer := ter;

          end;

}

             Case kod of

             1: If PontInKep(mpont.x,mpont.y,Rect2d(x1-d,y1-d,x1+d,y1+d)) then

                   begin

                      talalt:=True;

                      Cursor:=crKeret;

                   end;

             2: If IsAblakSzakaszMetszes(mpont.x,mpont.y,d,Rect2d(x1,y1,x2,y2)) then

                   begin

                      talalt:=True;

                      Cursor:=crKeret;

                   end;

             3: If IsAblakEllipszisMetszes(mpont.x,mpont.y,d,befoglalo) then

                   begin

                      talalt:=True;

                      Cursor:=crEllipszis;

                   end;

             4: If IsAblakNegyszogMetszes(mpont.x,mpont.y,d,befoglalo) then

                   begin

                      talalt:=True;

                      Cursor:=crNegyszog;

                   end;

             end;

             If talalt then begin

                jkDataCim := i;

                TalaltjkData := jkData;

                Break;

             end;

 

{         end;}

       deleteObject(rgn);

     end; {With}

 

  end; {For}

  If not talalt then Cursor:=crDefault;

  Result:=talalt;

end;

 

procedure TJelkulcsView.Kijeloles(mpont:TPoint2d;vegleges:boolean);

Var talalt : boolean;           {rajzelem megtalált}

begin

   talalt := AlakzatErzekeles(mpont);

       {Az előző kijelölések törlése}

       If not talalt and vankijelolt then begin

          SarokKijelzesek(oldjkData,False,True);

          oldjkDataCim := -1;

          jkDataCim    := -1;

          vankijelolt:=False;

       end;

       If vankijelolt and (jkDataCim<>oldjkDataCim) then begin

          SarokKijelzesek(oldjkData,vegleges,True);

          vankijelolt:=False;

       end;

       {A megtalált alakzat kijelzése}

       If talalt then begin

          If (jkDataCim<>oldjkDataCim) or vegleges then begin

             oldjkDataCim := jkDataCim;

             oldjkData := TalaltjkData;

             SarokKijelzesek(TalaltjkData,vegleges,False);

             If vegleges then begin

                TalaltjkData.kijelolt:=not TalaltjkData.kijelolt;

                SetJelkData(jkDataCim,TalaltjkData);

             end;

             vankijelolt:=True;

          end;

       end else begin

          Cursor := crDefault;

       end;

       Refresh;

end;

 

{Az alakzat sarokpontjainak kirajzolása üres/tömör négyzetekkel}

procedure TJelkulcsView.SarokKijelzesek(jkd:TJelkDataRecord;tomor,torol:boolean);

begin

With jkd.Adat do begin

Case kod of

1: Sarokpont(x1,y1,tomor,torol);

2: begin

   Sarokpont(x1,y1,tomor,torol);

   Sarokpont(x2,y2,tomor,torol);

   end;

3,4: begin

   Sarokpont(x1,y1,tomor,torol);

   Sarokpont(x2,y2,tomor,torol);

   Sarokpont(x2,y1,tomor,torol);

   Sarokpont(x1,y2,tomor,torol);

   end;

end;

end;

end;

 

{Kilelolt pont köré egy kis négyzetet rajzol}

procedure TJelkulcsView.Sarokpont(x,y:extended;tomor,torol:boolean);

var pe: TPen; Br: TBrush;

  xx,yy: integer;

begin

With Canvas do begin

 pe:=Pen; br:=Brush;

 If torol then Pen.Mode:=pmNotXor else Pen.Mode:=pmCopy;

 If tomor then begin

     Brush.Style:=bsSolid;

     Pen.Color:= clRed;

 end else begin

     Brush.Style:=bsClear;

     Pen.Color:= clBlue;

 end;

 Pen.Width:=tentativtures;

 xx := Screenx(x);

 yy := Screeny(y);

 Rectangle(xx-tentativtures div 2,yy-tentativtures div 2,

           xx+tentativtures div 2,yy+tentativtures div 2);

 Pen:=pe; Brush:=br;

end;

end;

 

end.