ezscryacc.pas

很管用的GIS控件

     FontColor:= Colr;
     FontName:= FVectorFontName;
   end;
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_justiftext(const p1,p2:TEzPoint; const Text:String;
  const Height, Angle: Double; Color: TColor; HorzAlign, VertAlign: Byte );
var
   Ent: TEzEntity;
   box: TEzRect;
begin
   if FCheckSyntax then exit;
   box.Emin:=p1;
   box.Emax:=p2;
   box:=ReorderRect2d(box);
   Ent:= TEzJustifVectorText.CreateEntity(box, Height, Text);
   with TEzJustifVectorText(ent) do
   begin
     FontName:= FVectorFontName;
     FontColor:= Color;
     Angle:= DegToRad(Angle);
     HorzAlignment:= TEzHorzAlignment(HorzAlign);
     VertAlignment:= TEzVertAlignment(VertAlign);
   end;
   if FGroupInProgress then
      FGroup.Add(Ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_pictureref(const p1,p2:TEzPoint;
  const filename:String; AlphaChannel: Byte; const Rotangle: Double);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzPictureRef.CreateEntity(p1,p2,FileName);
   TEzPictureRef(ent).Alphachannel:= AlphaChannel;
   TEzPictureRef(ent).Rotangle:= Rotangle;
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

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

procedure TEzScrParser.do_bandsbitmap(const p1,p2:TEzPoint; const filename:String; AlphaChannel: Byte);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzBandsBitmap.CreateEntity(p1,p2,FileName);
   TEzBandsBitmap(ent).AlphaChannel:=AlphaChannel;
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_persistbitmap(const p1,p2:TEzPoint; const filename:String);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzPersistBitmap.CreateEntity(p1,p2,FileName);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

procedure TEzScrParser.do_insert(const p:TEzPoint; const blockname:String;
  const rotangle,scalex,scaley:Double;const replacer:string);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzBlockInsert.CreateEntity(blockname,p,DegToRad(rotangle),scalex,scaley);
   TEzBlockInsert(ent).Text:=replacer;
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

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

procedure TEzScrParser.do_splinetext(IsTrueType: Boolean; const AText: string; V:TEzVector);
var
   ent:TEzEntity;
begin
   if FCheckSyntax then exit;
   ent:=TEzSplineText.CreateEntity(IsTrueType, AText);
   ent.points.assign(V);
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
end;

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

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

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

procedure TEzScrParser.do_preview(const p1,p2: TEzPoint; FileNo:Integer;
 APlottedUnits, ADrawingUnits: Double; APrintFrame: Boolean;
 AProposedPrintArea: TEzRect );
var
   ent:TEzEntity;
begin
   if FCheckSyntax Or Not(FDrawBox is TEzPreviewBox) then exit;
   ent:=TEzPreviewEntity.CreateEntity(p1,p2,pmAll,FileNo);
   with TEzPreviewEntity(ent) do
   begin
     PlottedUnits:= APlottedUnits;
     DrawingUnits:= ADrawingUnits;
     PrintFrame:= APrintFrame;
     PaperUnits:= TEzPreviewBox( FDrawBox ).PaperUnits;
   end;
   if FGroupInProgress then
      FGroup.Add(ent)
   else
      do_AddEntity(Ent,true);
End;

procedure TEzScrParser.do_table;
begin
   if FCheckSyntax then
   begin
     FTableEntity.Columns.Clear;
     exit;
   end;
   do_addentity( FTableEntity,false );
   FTableEntity.Columns.Clear;
end;

procedure TEzScrParser.do_group;
begin
   if FCheckSyntax then
   begin
     FGroup.Clear;
     exit;
   end;
   do_addentity(FGroup,false);
   FGroup.Clear;
   FGroupInProgress:= False;
end;

procedure TEzScrParser.do_newlayer( const lay:String );
var
  FieldList: TStringList;
  i: Integer;
begin
   if FCheckSyntax then exit;
   with FDrawBox do
   begin
      FieldList:= nil;
      try
        if FNewLayerFields.Count > 0 then
        begin
           FieldList:= TStringList.Create;
           // create a new temp file
           for i:= 0 to FNewLayerFields.Count - 1 do
           begin
              with FNewLayerFields[i] do
                case FieldType of
                  RW_CHAR :
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'C',FieldSize,0]));
                  RW_FLOAT:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'N',FieldSize,FieldDec]));
                  RW_INTEGER:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'N',FieldSize,0]));
                  RW_BINARY:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'B',10,0]));
                  RW_MEMO:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'M',10,0]));
                  RW_LOGIC:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'L',1,0]));
                  RW_DATETIME:
                    FieldList.Add(Format('%s;%s;%d;%d',[FieldName,'D',8,0]));
                end;
           end;
        end;
        with GIS do
          layers.CreateNew( lay, FieldList );
      finally
        if FieldList<>nil then FieldList.Free;
      end;
   end;
   FNewLayerFields.Clear;
end;

procedure TEzScrParser.do_activelayer(const lay:String);
begin
   if FCheckSyntax then exit;
   FDrawBox.GIS.CurrentLayerName:=lay;
end;

procedure TEzScrParser.updatefield(const fieldname, fieldvalue:String);
var
  layer: TEzBaseLayer;
begin
  if FCheckSyntax then exit;
  layer := FDrawBox.GIS.CurrentLayer;
  if (layer=nil) or not Assigned(layer.DBTable) then Exit;
  layer.DBTable.Edit;
  layer.DBTable.StringPut(fieldname,fieldvalue);
  layer.DBTable.Post;
end;

{ TNewLayerFields class implementation }
constructor TNewLayerFields.Create;
begin
   inherited Create;
   FItems:= TList.Create;
end;

destructor TNewLayerFields.Destroy;
begin
   Clear;
   FItems.Free;
   inherited Destroy;
end;

function TNewLayerFields.GetCount: Integer;
begin
   Result := FItems.Count;
end;

function TNewLayerFields.GetItem(Index: Integer): TNewLayerField;
begin
   Result := FItems[Index];
end;

function TNewLayerFields.Add: TNewLayerField;
begin
   Result := TNewLayerField.Create;
   FItems.Add(Result);
end;

procedure TNewLayerFields.Clear;
var
   I: Integer;
begin
   for I:= 0 to FItems.Count - 1 do
      TNewLayerField(FItems[I]).Free;
   FItems.Clear;
end;

procedure TNewLayerFields.Delete(Index: Integer);
begin
   TNewLayerField(FItems[Index]).Free;
   FItems.Delete(Index);
end;

// function yylex : Integer; forward;  // addition 1

function TEzScrParser.yyparse : Integer; // addition 2

var yystate, yysp, yyn : SmallInt;
    yys : array [1..yymaxdepth] of SmallInt;
    yyv : array [1..yymaxdepth] of YYSType;
    yyval : YYSType;

    TickStart: DWORD;
    Msg: TMsg;

procedure yyaction ( yyruleno : Integer );
  (* local definitions: *)
  var i: Integer;
      gstyle: TEzTableBorderStyle;
      fnt: TEzFontStyle;
begin
  (* actions: *)
  case yyruleno of
   1 : begin
         yyval := yyv[yysp-0];
       end;
   2 : begin
         yyval := yyv[yysp-1];
       end;
   3 : begin
         yyval := yyv[yysp-0];
       end;
   4 : begin
         yyval := yyv[yysp-0];
       end;
   5 : begin
         yyval := yyv[yysp-0];
       end;
   6 : begin
         yyval := yyv[yysp-0];
       end;
   7 : begin
         yyval := yyv[yysp-0];
       end;
   8 : begin
         yyval := yyv[yysp-0];
       end;
   9 : begin
         yyval := yyv[yysp-0];
       end;
  10 : begin
         yyval := yyv[yysp-0];
       end;
  11 : begin
         yyval := yyv[yysp-0];
       end;
  12 : begin
         yyval := yyv[yysp-0];
       end;
  13 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.AddPointToCurrentAction( Point2D(StrToFloat(yyv[yysp-2].yystring),StrToFloat(yyv[yysp-0].yystring) ) );
         end;
       end;
  14 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.AddRelativePointToCurrentAction(Point2D( StrToFloat(yyv[yysp-2].yystring),StrToFloat(yyv[yysp-0].yystring) ) );
         end;
       end;
  15 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.AddRelativeAngleToCurrentAction( StrToFloat(yyv[yysp-2].yystring),StrToFloat(yyv[yysp-0].yystring) );
         end;
       end;
  16 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.AddPointListToCurrentAction( FVector );
         FVector.Clear;
         end;
       end;
  17 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.CurrentAction.UserValue:= StrToFloat(yyv[yysp-0].yystring);
         FCmdLine.CurrentAction.UserCommand:= itFloatValue;
         end;
       end;
  18 : begin
         if Assigned(FCmdLine) then
         begin
         FCmdLine.CurrentAction.UserString:= GetString( yyv[yysp-0].yystring );
         FCmdLine.CurrentAction.UserCommand:= itString;
         end;
       end;
  19 : begin
         do_penstyle(StrToInt(yyv[yysp-4].yystring), StrToInt(yyv[yysp-2].yystring), StrToFloat(yyv[yysp-0].yystring));
       end;
  20 : begin
         do_fillstyle( StrToInt(yyv[yysp-4].yystring), StrToInt(yyv[yysp-2].yystring), StrToInt(yyv[yysp-0].yystring) ) ;
       end;
  21 : begin
         do_ttfontstyle(GetString( yyv[yysp-12].yystring ), GetBoolean(yyv[yysp-10].yystring),
         GetBoolean(yyv[yysp-8].yystring), GetBoolean(yyv[yysp-6].yystring), GetBoolean(yyv[yysp-4].yystring),
         StrToInt(yyv[yysp-2].yystring), StrToInt(yyv[yysp-0].yystring) );
       end;
  22 : begin
         Ez_Preferences.DefFontStyle.Name:= yyv[yysp-0].yystring;
       end;
  23 : begin
         do_symbolstyle(StrToInt(yyv[yysp-4].yystring), StrToFloat(yyv[yysp-2].yystring), StrToFloat(yyv[yysp-0].yystring));
       end;
  24 : begin
         yyval := yyv[yysp-0];
       end;
  25 : begin
         yyval := yyv[yysp-0];
       end;
  26 : begin
         yyval := yyv[yysp-0];
       end;
  27 : begin
         yyval := yyv[yysp-2];
       end;
  28 : begin
         FVector.AddPoint(StrToFloat(yyv[yysp-3].yystring), StrToFloat(yyv[yysp-1].yystring));
       end;
  29 : begin
         yyval := yyv[yysp-0];
       end;
  30 : begin
         yyval := yyv[yysp-2];
       end;
  31 : begin
         if FVector.Parts.Count=0 then
         FVector.Parts.Add(0);
         FVector.Parts.Add(FVector.Count);
       end;
  32 : begin
         yyval := yyv[yysp-0];
       end;
  33 : begin
         yyval := yyv[yysp-1];
       end;
  34 : begin
         updatefield(yyv[yysp-2].yystring, GetString( yyv[yysp-0].yystring ) );
       end;
  35 : begin
         yyval := yyv[yysp-0];
       end;
  36 : begin
         yyval := yyv[yysp-0];
       end;
  37 : begin
         yyval := yyv[yysp-0];
       end;
  38 : begin
         yyval := yyv[yysp-0];
       end;
  39 : begin
         yyval := yyv[yysp-5];
       end;
  40 : begin
         yyval := yyv[yysp-0];
       end;
  41 : begin
         yyval := yyv[yysp-0];
       end;
  42 : begin
         yyval := yyv[yysp-0];
       end;
  43 : begin
         yyval := yyv[yysp-0];
       end;
  44 : begin
         yyval := yyv[yysp-0];
       end;
  45 : begin
         yyval := yyv[yysp-0];
       end;
  46 : begin
         yyval := yyv[yysp-0];
       end;
  47 : begin
         yyval := yyv[yysp-0];
       end;
  48 : begin
         yyval := yyv[yysp-0];
       end;
  49 : begin
         yyval := yyv[yysp-0];
       end;
  50 : begin
         yyval := yyv[yysp-0];
       end;
  51 : begin
         yyval := yyv[yysp-0];
       end;
  52 : begin
         yyval := yyv[yysp-0];
       end;
  53 : begin
         yyval := yyv[yysp-0];