STSYMB

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

 

interface

 

uses

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

Graphics, Controls, Forms, Dialogs;

 

type

TRajzmod = (rNincs,rPont,rVonal,rKor,rFest,rNegyszog);

 

T2DPoint = class(TPersistent)

public

Fx : integer;

Fy : integer;

published

property x: integer read Fx write Fx;

property y: integer read Fy write Fy;

end;

 

{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,....

         fest :    5,x1,y1,x2,y2,szin,vastag;

}

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}

end;

 

{Rács objektum a rajzoláshoz}

TGridStyle = (gsDot, gsDash, gsLine);

 

TGrid = class(TPersistent)

private

FOnChange: TNotifyEvent;

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

FWidth  : integer;           {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;

procedure SetVisible(Value:boolean);

procedure SetWidth(Value:integer);

procedure SetStyle(Value:TGridStyle);

procedure SetColor(Value:TColor);

procedure Changed; dynamic;

published

property OnChange: TNotifyEvent read FOnChange write FOnChange;

property Visible: boolean read FVisible write SetVisible;

property Width : integer read FWidth write SetWidth;

property Style : TGridStyle read FStyle write SetStyle;

property Color : TColor read FColor write SetColor;

property Attach: boolean read FAttach write FAttach;

end;

 

TStSymbolEdit = class(TGraphicControl)

private

  FFilename   : string;

  FAktJelkulcs: word;

  FHotPoint   : T2DPoint;

  FOrigo      : T2DPoint;

  FColor      : TColor;

  FGrid       : TGrid;

  FRajzmod    : TRajzmod;

  FKoordLabel : TLabel;

  FRajzmodLabel : TLabel;

  FNagyitas   : integer;

  procedure SetFilename(Value:string);

  procedure SetAktJelkulcs(Value:word);

  procedure SetColor(Value:TColor);

  procedure SetRajzmod(Value:TRajzmod);

  procedure SetHotPoint(Value:T2DPoint);

  procedure SetOrigo(Value:T2DPoint);

  procedure SetNagyitas(Value:integer);

protected

  procedure Paint; override;

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); 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}

  jelkHeader    : TJelkulcsHeader;

  jelkData      : TJelkulcsRecord;

  jkData        : TJelkDataRecord;

  oldjelkHeader : TJelkulcsHeader;

  oldjelkData   : TJelkulcsRecord;

  oldjkData     : TJelkDataRecord;

  BasePoint     : TPoint;            {A képterület sarka}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure JKStreamInit;

  procedure JelkHeaderNull(var jkh:TJelkulcsHeader);

  procedure JelkNull(var jk:TJelkulcsRecord);

  Function JkFileToList(jkfnev,lstfnev:string):boolean;

  Function JkListToFile(lstfnev,jkfnev:string):boolean;

  Function LoadFromDXF(filename:string) : boolean;

  Function SaveToDXF(filename:string) : boolean;

  Function LoadJelkulcs(filename:string) : boolean;

  Function SaveToJLK(filename:string) : boolean;

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

  procedure GridDraw;

  procedure Change(Sender: TObject);

published

  Property Filename : string read FFilename write SetFilename;

  Property AktJelkulcs: word read FAktJelkulcs write SetAktJelkulcs default 1;

  Property HotPoint : T2DPoint read FHotPoint write SetHotPoint ;

  Property Origo : T2DPoint read FOrigo write FOrigo ;

  Property Color : TColor read FColor write SetColor ;

  Property Grid : TGrid read FGrid write FGrid ;

  Property Rajzmod : TRajzmod read FRajzmod write SetRajzmod ;

  Property KoordLabel : TLabel read FKoordLabel write FKoordLabel ;

  Property RajzmodLabel : TLabel read FRajzmodLabel write FRajzmodLabel ;

  property Nagyitas : integer read FNagyitas write SetNagyitas;

{    property Align;}

  property OnClick;

  property OndblClick;

  property OnMouseDown;

  property OnMouseMove;

  property OnMouseUp;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TStSymbolEdit]);

end;

 

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

procedure TGrid.Changed;

begin                        {A property változásokat átadja az ős objektumnak}

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.SetWidth(Value:integer);

begin

If FWidth<>Value then begin

   If Value<1 then Value:=1;

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

 

 

constructor TStSymbolEdit.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FHotPoint := T2DPoint.Create;

   FOrigo := T2DPoint.Create;

   FGrid  := TGrid.Create;

   FGrid.OnChange := Change;

   With FGrid do begin

        Visible := True;

        Width:=1;

        Style:=gsDot;

        Color:=clYellow;

   end;

   FOrigo.x:=0; FOrigo.y:=0;

   JKStreamInit;

   valtozott      := False;

   jkvaltozott    := False;

   FAktJelkulcs   := 1;

   FNagyitas      := 4;

   FColor         := clBlue;

   Width          := 50;

   Height         := 50;

end;

 

destructor TStSymbolEdit.Destroy;

begin

   HotPoint.Free;

   Origo.Free;

   Grid.Free;

   TWM.Free;

   inherited Destroy;

end;

 

 

procedure TStSymbolEdit.Change(Sender: TObject);

begin

invalidate;

end;

 

procedure TStSymbolEdit.SetFilename(Value:string);

Var ext: string;

begin

If FFilename<>Value then

   If Fileexists(Value) then begin

      ext := ExtractFileExt(Value);

      If ext='.JLK' then LoadJelkulcs(Value);

      if ext='.DXF' then LoadJelkulcs(Value);

      FFilename:=Value;

      invalidate;

   end;

end;

 

procedure TStSymbolEdit.SetAktJelkulcs(Value:word);

begin

If FAktJelkulcs<>Value then begin

   FAktJelkulcs:=Value;

   invalidate;

end;

end;

 

procedure TStSymbolEdit.SetHotPoint(Value:T2DPoint);

begin

If FHotPoint<>Value then begin

   FHotPoint:=Value;

   invalidate;

end;

end;

 

procedure TStSymbolEdit.SetOrigo(Value:T2DPoint);

begin

If FOrigo<>Value then begin

   FOrigo:=Value;

   invalidate;

end;

end;

 

procedure TStSymbolEdit.SetNagyitas(Value:integer);

begin

If FNagyitas<>Value then begin

   FNagyitas:=Value;

   invalidate;

end;

end;

 

procedure TStSymbolEdit.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   invalidate;

end;

end;

 

procedure TStSymbolEdit.SetRajzmod(Value:TRajzmod);

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;

   invalidate;

end;

end;

 

{Törli a TWM munkastream-et}

procedure TStSymbolEdit.JKStreamInit;

var i: integer;

begin

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

end;

 

{Üres jelkulcs header rekordot ad}

procedure TStSymbolEdit.JelkHeaderNull(var jkh:TJelkulcsHeader);

begin

With jkh do begin

jkkod  := 0;

jkcim  := 0;

jkdb   := 0;        {Jelkulcs rajzelemek száma}

jknev  := '                    ';

end;

end;

 

{Üres jelkulcs data rekordot ad}

procedure TStSymbolEdit.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 JelkulcsIr(JKS: TMemoryStream;jkDATA:TJelkDataRecord;ap:longint);

begin

JKS.Seek(ap*SizeOf(jkDATA),1);

JKS.Write(jkdata,SizeOf(jkDATA));

end;

 

 

{ JkFileToList(jelkulcsfile,listafile neve)

A StellaMAP JLK file szerkezetet a listafileba írja TXT formátumban }

Function TStSymbolEdit.JkFileToList(jkfnev,lstfnev:string):boolean;

var i: integer;

  f1: file;

  f2: TextFile;

  resu: word;

begin

end;

 

{ JkListToFile(listafile,jelkulcsfile neve)

Jelkulcs listafile (TXT formátumú) tartalmát átkonvertálja StellaMAP JLK fileá

}

Function TStSymbolEdit.JkListToFile(lstfnev,jkfnev:string):boolean;

begin

end;

 

Function TStSymbolEdit.LoadFromDXF(filename:string) : boolean;

begin

end;

 

Function TStSymbolEdit.SaveToDXF(filename:string) : boolean;

begin

 

end;

 

{ A jelkulcsfileból 1 jelkulcs betöltése a TWM munkastream-re}

Function TStSymbolEdit.LoadJelkulcs(filename:string) : boolean;

VAR i,j   : integer;

begin

Try

Try

   Result := True;

   jelkulcsStream:=TFileStream.Create(filename,fmOpenRead);

   JKStreamInit;

   For i:=1 to 1000 do begin

       jelkulcsStream.Read(jelkHeader,SizeOf(jelkHeader));

       If jelkHeader.jkkod=Aktjelkulcs then begin

          jelkulcsStream.Seek(jelkHeader.jkcim,0);

          For j:=1 to jelkHeader.jkdb do begin

           jkData.jkkod:=jelkHeader.jkKod;

           jelkulcsStream.Read(jkData.Adat,SizeOf(jkData.Adat));

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

          end;

       end;

   end;

except

   Result := False;

end;

finally

   jelkulcsStream.Free;

end;

end;

 

Function TStSymbolEdit.SaveToJLK(filename:string) : boolean;

VAR i  : integer;

begin

{     jelkulcsStream:=TFileStream.Create(filename,fmOpenWrite);

   TH.Seek(0,0); TM.Seek(0,0);

   For i:=1 to 1000 do begin

       TH.Read(jelkHeader,SizeOf(jelkHeader));

       jelkulcsStream.Write(jelkHeader,SizeOf(jelkHeader));

   end;

   jelkulcsStream.Free;}

end;

 

procedure TStSymbolEdit.cls(i: TCanvas; co: TColor);

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

begin

with i as TCanvas do

begin

    pe:= Pen; br:=Brush; Pen.color:=co;

    brush.style:=bsSolid;

    Brush.color:=co;

    c:=cliprect;

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

    Pen:=pe; Brush := br;

end;

end;

 

{A rácsozat megjelenítése}

procedure TStSymbolEdit.GridDraw;

var i,j,grw: integer;

  grxdb, grydb : integer;

begin

If Grid.Visible then begin

   grw := Grid.Width * nagyitas;

   grxdb:= Width div grw; grydb:= Height div grw;

   For i:=0 to grxdb do

      For j:=0 to grydb do

      Case Grid.Style of

      gsDot : Canvas.Pixels[i*grw,j*grw]:=Grid.Color;

      gsDash: begin

                Canvas.Pen.Style := psDash;

                Canvas.Moveto(0,j*grw); Canvas.LineTo(Width,j*grw);

                Canvas.Moveto(i*grw,0); Canvas.LineTo(j*grw,Height);

              end;

      gsLine: begin

                Canvas.Pen.Style := psSolid;

                Canvas.Moveto(0,j*grw); Canvas.LineTo(Width,j*grw);

                Canvas.Moveto(i*grw,0); Canvas.LineTo(j*grw,Height);

              end;

      end;

end;

end;

 

procedure TStSymbolEdit.Paint;

var c: Trect;

  i,meret: longint;

begin

cls(Canvas,Color);

BasePoint.x:=Origo.x - ((Width div 2) div Nagyitas);

BasePoint.y:=Origo.y - ((Height div 2) div Nagyitas);

GridDraw;

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

TWM.Seek(0,0);

With Canvas do begin

  For i:=1 to meret do begin

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

     With jkData.Adat do begin

          Pen.Color:= szin;

          Pen.Width:= vastag;

          Case kod of

          1: begin end;

          2: begin end;

          3: begin end;

          4: begin end;

          5: begin end;

          end;

     end;

  end;

end;

Inherited Paint;

end;

 

procedure TStSymbolEdit.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = StellaMapSource)

then StellaMapSource := nil;

end;

 

end.