ezscryacc.pas

很管用的GIS控件

(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)

(* global definitions: *)

unit EzScrYacc;

{$I EZ_FLAG.PAS}
{$R Ezscryacc.res}
interface

uses
   SysUtils, Classes, Dialogs, Graphics, Windows, Messages,
   EzYaccLib, EzLib, EzSystem, EzCmdLine, ezbase, EzBaseGIS, EzEntities,
   EzMiscelEntities;

type

  TNewLayerField = class
  private
    FFieldName: String;
    FFieldType: Integer;
    FFieldSize: Integer;
    FFieldDec: Integer;
  public
    property FieldName: String read FFieldName write FFieldName;
    property FieldType: Integer read FFieldType write FFieldType;
    property FieldSize: Integer read FFieldSize write FFieldSize;
    property FieldDec: Integer read FFieldDec write FFieldDec;
  end;

  TNewLayerFields = class
     FItems: TList;
     function GetCount: Integer;
     function GetItem(Index: Integer): TNewLayerField;
  public
     constructor Create;
     destructor Destroy; override;
     function Add: TNewLayerField;
     procedure Clear;
     procedure Delete(Index: Integer);

     property Count: Integer read GetCount;
     property Items[Index: Integer]: TNewLayerField read GetItem; default;
  end;

  TEzScrParser = Class(TCustomParser)
  private
     FDrawBox : TEzBaseDrawBox;
     { This is used for parsing user typed command on command line TEzCmdLine }
     FCmdLine : TEzCmdLine;
     FMustRepaint: Boolean;
     FVector: TEzVector;
     FNewLayerFields: TNewLayerFields;
     FTmpFieldType: Integer;
     FTmpFieldSize: Integer;
     FTmpFieldDec: Integer;
     FSavePenStyle: TEzPenStyle;
     FSaveBrushStyle: TEzBrushStyle;
     FSaveSymbolStyle: TEzSymbolStyle;
     FSaveFontStyle: TEzFontStyle;
     FSaveTTFontStyle: TEzFontStyle;
     FCheckSyntax: Boolean;
     FGroupInProgress: Boolean;
     FGroup: TEzGroupEntity;
     FProjParams: TStringList;
     FJustCreateEntity: Boolean;
     FEntityCreated: TEzEntity;
     { for saving configuration}
     FSavedNegCurrFormat: Byte;
     FSavedThousandSeparator: Char;
     FSavedDecimalSeparator: Char;
     FVectorFontName: string;
     FCode, FIntValue: Integer;
     FTableEntity: TEzTableEntity;
     FNumRows, FNumCols, FColIndex, FDataIndex: Integer;
     Function GetBoolean(const Value: string): Boolean;
     procedure updatefield(const fieldname, fieldvalue:String);
     { the commands executors }
     procedure do_addentity(Ent: TEzEntity;freeit:boolean);
     procedure do_penstyle(St:Integer;Cl:TColor;W:Double);
     procedure do_fillstyle(St:Integer;foreClr,backClr:TColor) ;
     procedure do_ttfontstyle(const Fontn:String; bold,ital,under,strike: boolean;
       Cl:TColor; Charset: Integer);
     procedure do_symbolstyle(St:Integer;const RotAng,aSize:Double);
     procedure do_none;
     procedure do_preview(const p1,p2: TEzPoint; FileNo:Integer;
       APlottedUnits, ADrawingUnits: Double; APrintFrame: Boolean;
       AProposedPrintArea: TEzRect );
     procedure do_point(const p:TEzPoint);
     procedure do_place(const p:TEzPoint;const Text:String);
     procedure do_polyline(V:TEzVector);
     procedure do_polygon(V:TEzVector);
     procedure do_line(const p1, p2: TEzPoint );
     procedure do_rectangle(const p1,p2:TEzPoint;const Rotangle:Double);
     procedure do_arc(const p:TEzPoint;
      const radius,start_angle,NumDegrees:Double;IsCounterClockWise:Boolean);
     procedure do_arc2(const p1,p2,p3:TEzPoint);
     procedure do_ellipse(const p1,p2:TEzPoint;const Rotangle:Double);
     procedure do_truetypetext(const BasePt: TEzPoint;
       const Text: string; Align: Integer; Const Height, Angle: Double );
     procedure do_fittedtext(const BasePt: TEzPoint;
       const Text: string; const H,W,Angle: Double; Colr: TColor);
     procedure do_justiftext(const p1,p2:TEzPoint; const Text:String;
       const Height, Angle: Double; Color: TColor; HorzAlign, VertAlign: Byte );
     procedure do_pictureref(const p1,p2:TEzPoint; const filename:String; AlphaChannel: Byte;const Rotangle:Double);
     procedure do_bandsbitmap(const p1,p2:TEzPoint; const filename:String; AlphaChannel: Byte);
     procedure do_custpict(const p1,p2:TEzPoint);
     procedure do_persistbitmap(const p1,p2:TEzPoint; const filename:String);
     procedure do_insert(const p:TEzPoint; const blockname:String;
       const rotangle,scalex,scaley:Double;const replacer:string);
     procedure do_spline(V:TEzVector);
     procedure do_splinetext(IsTrueType: Boolean; const AText: string; V:TEzVector);
     procedure do_dimhorizontal(const p1,p2: TEzPoint; const TextLineY: Double);
     procedure do_dimvertical(const p1,p2: TEzPoint; const TextLineX: Double);
     procedure do_dimparallel(const p1,p2: TEzPoint; const TextLineDistanceApart: Double);
     procedure do_group;
     procedure do_table;
     procedure do_newlayer( const lay:String );
     procedure do_activelayer(const lay:String);

     function GetString( const s: string ): string;
  public
     constructor create;
     destructor Destroy; override;

     function yyparse : integer; override;
     procedure yyerror(const msg : string);

     property DrawBox: TEzBaseDrawBox read FDrawBox write FDrawBox;
     property CheckSyntax: Boolean read FCheckSyntax write FCheckSyntax;
     property Vector: TEzVector read FVector;
     property ProjParams: TStringList read FProjParams;
     property CmdLine: TEzCmdLine read FCmdLine write FCmdLine;
     property MustRepaint: Boolean read FMustRepaint write FMustRepaint;
     property JustCreateEntity: Boolean read FJustCreateEntity write FJustCreateEntity;
     property EntityCreated: TEzEntity read FEntityCreated write FEntityCreated;
  end;

const _IDENTIFIER = 257;
const _NUMERIC = 258;
const _STRING = 259;
const _HEXADECIMAL = 260;
const _EQ = 261;
const _AT = 262;
const _LT = 263;
const _COMA = 264;
const _LPAREN = 265;
const _RPAREN = 266;
const _SEMICOLON = 267;
const _COMMENT = 268;
const _BLANK = 269;
const _TAB = 270;
const _NEWLINE = 271;
const _LBRACKET = 272;
const _RBRACKET = 273;
const _COLON = 274;
const _ILLEGAL = 275;
const RW_TRUE = 276;
const RW_FALSE = 277;
const RW_PEN = 278;
const RW_BRUSH = 279;
const RW_FONT = 280;
const RW_VECTORFONT = 281;
const RW_SYMBOL = 282;
const RW_NONE = 283;
const RW_POINT = 284;
const RW_PLACE = 285;
const RW_POLYLINE = 286;
const RW_POLYGON = 287;
const RW_LINE = 288;
const RW_RECTANGLE = 289;
const RW_ARC = 290;
const RW_ELLIPSE = 291;
const RW_TRUETYPETEXT = 292;
const RW_FITTEDTEXT = 293;
const RW_JUSTIFTEXT = 294;
const RW_PICTUREREF = 295;
const RW_BANDSBITMAP = 296;
const RW_PERSISTBITMAP = 297;
const RW_CUSTPICT = 298;
const RW_TABLE = 299;
const RW_PREVIEW = 300;
const RW_SPLINE = 301;
const RW_SPLINETEXT = 302;
const RW_GROUP = 303;
const RW_DIMHORIZONTAL = 304;
const RW_DIMVERTICAL = 305;
const RW_DIMPARALLEL = 306;
const RW_INSERT = 307;
const RW_NEWLAYER = 308;
const RW_ACTIVELAYER = 309;
const RW_DATA = 310;
const RW_INFO = 311;
const RW_CHAR = 312;
const RW_FLOAT = 313;
const RW_INTEGER = 314;
const RW_DATETIME = 315;
const RW_LOGIC = 316;
const RW_MEMO = 317;
const RW_BINARY = 318;
const RW_COORDSYS = 319;
const RW_COLUMN = 320;
const RW_TITLE = 321;

type YYSType = record
               yystring : string
               end(*YYSType*);

var yylval : YYSType;

implementation

uses
   Math, EzPreview, ezConsts, ezDims, EzScrLex;

(*----------------------------------------------------------------------------*)
constructor TEzScrParser.create;
begin
   inherited Create;
   FVector := TEzVector.Create(4);
   FVector.CanGrow:= True;
   FNewLayerFields:= TNewLayerFields.Create;
   FProjParams:= TStringList.Create;

   With Ez_Preferences Do
   Begin
     FSavePenStyle:= DefPenStyle.FPenStyle;
     FSaveBrushStyle:= DefBrushStyle.FBrushStyle;
     FSaveSymbolStyle:= DefSymbolStyle.FSymbolStyle;
     FSaveFontStyle:= DefFontStyle.FFontStyle;
     FSaveTTFontStyle:= DefTTFontStyle.FFontStyle;
   end;

   { save configuration }
   FSavedNegCurrFormat:= NegCurrFormat;
   FSavedThousandSeparator:= ThousandSeparator;
   FSavedDecimalSeparator:= DecimalSeparator;
   NegCurrFormat:= 1;
   ThousandSeparator:= ',';
   DecimalSeparator:= '.';
   FVectorFontName:= Ez_Preferences.DefFontStyle.Name;

   FGroup:= TEzGroupEntity.CreateEntity;
   FTableEntity:= TEzTableEntity.CreateEntity(Point2d(0,0),Point2d(0,0));
end;

destructor TEzScrParser.Destroy;
begin
   With Ez_Preferences Do
   Begin
     DefPenStyle.FPenStyle:= FSavePenStyle;
     DefBrushStyle.FBrushStyle:= FSaveBrushStyle;
     DefSymbolStyle.FSymbolStyle:= FSaveSymbolStyle;
     DefFontStyle.FFontStyle:= FSaveFontStyle;
     DefTTFontStyle.FFontStyle:= FSaveTTFontStyle;
   End;
   FVector.Free;
   FNewLayerFields.Free;
   FGroup.Free;
   FTableEntity.Free;
   FProjParams.Free;
   if FEntityCreated <> nil then
     FEntityCreated.Free;
   { restore configuration }
   NegCurrFormat:=  FSavedNegCurrFormat;
   ThousandSeparator:= FSavedThousandSeparator;
   DecimalSeparator:= FSavedDecimalSeparator;
   inherited Destroy;
end;

Function TEzScrParser.GetBoolean(const Value: string): Boolean;
Begin
  Result:= AnsiCompareText(Value,'True')=0;
End;

function TEzScrParser.GetString( const s: string ): string;
begin
  Result:= Copy( s, 2, Length(s) - 2 );
end;

procedure TEzScrParser.yyerror(const msg : string);
begin
   yyerrormsg := msg;
   (* MessageToUser(IntToStr(yyLexer.yylineno)+
      ': ' + msg + ' at or before '+ yyLexer.yytext,mtError); *)
end;

// execute the commands - section
procedure TEzScrParser.do_penstyle(St:Integer;Cl:TColor;W:Double);
begin
   if FCheckSyntax then exit;
   with Ez_Preferences.DefPenStyle.FPenStyle do
   begin
      style:=St;
      color:=Cl;
      Scale:=W;
   end;
end;

procedure TEzScrParser.do_fillstyle(St:Integer;foreClr,backClr:TColor) ;
begin
   if FCheckSyntax then exit;
   with Ez_Preferences.DefBrushstyle.FBrushStyle do
   begin
      pattern:=St;
      forecolor:=foreClr;
      backcolor:=backClr;
      //Scale:=Scl;
      //Angle:=Ang;
   end;
end;

procedure TEzScrParser.do_ttfontstyle(const Fontn:String; bold,ital,under,strike: boolean;
  Cl:TColor; Charset: Integer);
begin
  if FCheckSyntax then exit;
  with Ez_Preferences.DefTTFontStyle.FFontStyle do
  begin
    name:=fontn;
    style:=[];
    if bold then Include(style,fsbold);
    if ital then Include(style,fsitalic);
    if under then Include(style,fsunderline);
    if strike then Include(style,fsstrikeout);
    color:=Cl;
    //CharSet:= aCharset;
  end;
end;

procedure TEzScrParser.do_symbolstyle(St:Integer;const RotAng,aSize:Double);
begin
   if FCheckSyntax then exit;
   with Ez_Preferences.DefSymbolStyle.FSymbolStyle do
   begin
     Index:=St;
     Rotangle:=DegToRad(RotAng);
     Height:=aSize;
   end;
end;

procedure TEzScrParser.do_addentity(Ent: TEzEntity;freeit:boolean);
var
  Layer: TEzBaseLayer;
begin
  if FJustCreateEntity then
  begin
    FEntityCreated:= Ent;
    Exit;
  end;
  Layer:= FDrawBox.GIS.CurrentLayer;
  if Layer = nil then
  begin
     If freeit then Ent.Free;
     Exit;
  end;
  Layer.AddEntity( Ent );
  // this option is only used when parsing a command from the command line
  If FMustRepaint then
    FDrawBox.RepaintRect(Ent.FBox);
  If freeit then Ent.free;
end;

procedure TEzScrParser.do_none;
var
   Ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:=TEzNone.CreateEntity;
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
     do_addentity(Ent,true);
end;

procedure TEzScrParser.do_point(const p:TEzPoint);
var
   Ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:=TEzPointEntity.CreateEntity(p,Ez_Preferences.DefPenstyle.Color);
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
     do_addentity(Ent,true);
end;

procedure TEzScrParser.do_place(const p:TEzPoint; const Text: String);
var
   Ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:=TEzPlace.CreateEntity(p);
   TEzPlace(Ent).Text:=Text;
   with TEzPlace(ent).SymbolTool do
   begin
     Height:= FDrawBox.Grapher.GetRealSize( Height );
   End;
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
     do_addentity(Ent,true);
end;

procedure TEzScrParser.do_polyline(V: TEzVector);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzPolyline.CreateEntity([Point2D(0,0)]);
   ent.Points.assign(V);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_polygon(V: TEzVector);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzPolygon.CreateEntity([Point2D(0,0)]);
   ent.Points.assign(V);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_line(const p1, p2: TEzPoint );
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzPolyLine.CreateEntity([p1,p2]);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_rectangle(const p1,p2:TEzPoint;const Rotangle:Double);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzRectangle.CreateEntity(p1,p2);
   TEzRectangle(ent).Rotangle:= DegToRad(Rotangle);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_arc(const p:TEzPoint;
  const radius,start_angle,NumDegrees:Double;IsCounterClockWise:Boolean);
var
   Ent: TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:= TEzArc.CreateEntity(NULL_POINT,NULL_POINT,NULL_POINT);
   TEzArc(Ent).SetArc(p.x,p.y,Radius,DegToRad(Start_Angle),DegToRad(NumDegrees),IsCounterClockWise);
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_arc2(const p1,p2,p3:TEzPoint);
var
   Ent: TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:= TEzArc.CreateEntity(p1,p2,p3);
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_ellipse(const p1,p2:TEzPoint;const Rotangle:Double);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzEllipse.CreateEntity(p1,p2);
   TEzEllipse(Ent).Rotangle:=DegToRad(Rotangle);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_truetypetext(const BasePt: TEzPoint;
  const Text: string; Align: Integer; Const Height, Angle: Double );
var
  Ent: TEzEntity;
begin
  if FCheckSyntax then exit;
  Ent:= TEzTrueTypeText.CreateEntity(BasePt, Text, Height, DegToRad(Angle));
  TEzTrueTypeText(ent).Alignment:= TAlignment(Align);
  if FGroupInProgress then
     FGroup.Add(Ent)
  else
     do_AddEntity(Ent, true);
end;

procedure TEzScrParser.do_fittedtext(const BasePt: TEzPoint;
  const Text: string; const H,W,Angle: Double; Colr: TColor);
var
   Ent: TEzEntity;
begin
   if FCheckSyntax then exit;
   Ent:= TEzFittedVectorText.CreateEntity(BasePt, Text, H, W, DegToRad(Angle));
   with TEzFittedVectorText(Ent) do
   begin