ezsystem.pas

来自「很管用的GIS控件」· PAS 代码 · 共 2,202 行 · 第 1/5 页

    Layer := selLayer.Layer;
    if Layer.LayerInfo.Locked then Exit;
    FirstRecno := Layer.SendEntityToBack( SelLayer.SelList[0] );
    {select it}
    Selection.Clear;
    Selection.Add( Layer, FirstRecno );
    Repaint;
  End;
End;

{ BringToFront }

Procedure BringToFront( DrawBox: TEzBaseDrawBox );
Var
  SelLayer: TEzSelectionLayer;
  Layer: TEzBaseLayer;
  LastRecNo: Integer;
Begin
  With DrawBox Do
  Begin
    If Selection.NumSelected <> 1 Then Exit;
    selLayer := Selection.Items[0];
    Layer := selLayer.Layer;
    if Layer.LayerInfo.Locked then Exit;
    LastRecno := Layer.BringEntityToFront( SelLayer.SelList[0] );
    {select it}
    Selection.Clear;
    Selection.Add( Layer, LastRecno );
    Repaint;
  End;
End;

{ ShowGuideLines }

Procedure ShowGuideLines( DrawBox: TEzBaseDrawBox; HGuideLines, VGuideLines: TEzDoubleList );
Var
  I, orientation: Integer;
  X, Y, coord: Double;
  TmpPt1, TmpPt2: TPoint;

  Procedure DrawGuideLine( Canvas: TCanvas );
  Begin
    With DrawBox.Grapher Do
    Begin
      Case Orientation Of
        0:
          Begin
            Y := coord;
            With CurrentParams.VisualWindow Do
              If ( Y >= Emin.Y ) And ( Y <= Emax.Y ) Then
              Begin
                { dibuja la linea guia }
                TmpPt1 := RealToPoint( Point2D( Emin.X, Y ) );
                TmpPt2 := RealToPoint( Point2D( Emax.X, Y ) );
                With Canvas Do
                Begin
                  MoveTo( TmpPt1.X, TmpPt1.Y );
                  LineTo( TmpPt2.X, TmpPt2.Y );
                End;
              End;
          End;
        1:
          Begin
            X := coord;
            With CurrentParams.VisualWindow Do
              If ( X >= Emin.X ) And ( X <= Emax.X ) Then
              Begin
                RealToPoint( Point2D( Emin.X, Y ) );
                TmpPt1 := RealToPoint( Point2D( X, Emin.Y ) );
                TmpPt2 := RealToPoint( Point2D( X, Emax.Y ) );
                With Canvas Do
                Begin
                  MoveTo( TmpPt2.X, TmpPt2.Y );
                  LineTo( TmpPt1.X, TmpPt1.Y );
                End;
              End;
          End;
      End;
    End;
  End;

Begin
  If DrawBox.IsAerial Or
    (( HGuideLines.Count = 0 ) And ( VGuideLines.Count = 0 )) Then
    Exit;
  If ( odCanvas In DrawBox.OutputDevices ) Then
    With DrawBox {.ScreenBitmap} Do
    Begin
      DrawBox.grapher.SaveCanvas( Canvas );
      With Canvas Do
      Begin
        Brush.Style := bsClear;
        Pen.Mode := pmCopy;
        Pen.Color := clBlue;
        Pen.Width := 1;
        Pen.Style := psDot;
      End;
      orientation := 0;
      For I := 0 To HGuideLines.Count - 1 Do
      Begin
        coord := HGuideLines[I];
        DrawGuideLine( Canvas );
      End;
      orientation := 1;
      For I := 0 To VGuideLines.Count - 1 Do
      Begin
        coord := VGuideLines[I];
        DrawGuideLine( Canvas );
      End;
      DrawBox.grapher.RestoreCanvas( Canvas );
    End;
End;

{ PaintDrawBoxFSGrid }

Procedure PaintDrawBoxFSGrid( DrawBox: TEzBaseDrawBox; const WCRect: TEzRect );
Var
  X, Y, AX1, AY1, AX2, AY2: Double;
  DeltaX, DeltaY: Integer;
  p: TPoint;

Begin
  With DrawBox, DrawBox.ScreenBitmap.Canvas, WCRect Do
  Begin
    If ( ScreenGrid.Step.X <= 0 ) Or ( ScreenGrid.Step.Y <= 0 ) Then
      Exit;
    Pen.Color := ScreenGrid.Color;
    Pen.Mode := pmCopy;
    Pen.Width := 1;
    DeltaX := Abs( Grapher.RealToDistX( ScreenGrid.Step.X ) );
    DeltaY := Abs( Grapher.RealToDistY( ScreenGrid.Step.Y ) );
    If ( DeltaX < 8 ) Or ( DeltaY < 8 ) Then
      Exit;
    AX1 := Trunc( Emin.X / ScreenGrid.Step.X ) * ScreenGrid.Step.X;
    AY1 := Trunc( Emin.Y / ScreenGrid.Step.Y ) * ScreenGrid.Step.Y;
    AX2 := Emax.X;
    AY2 := Emax.Y;
    X := AX1;
    While X < AX2 Do
    Begin
      Y := AY1;
      While Y < AY2 Do
      Begin
        p := Grapher.RealToPoint( Point2D( X, Y ) );
        // the horz line
        MoveTo( 0, p.Y );
        LineTo( Width, p.Y );
        // the vert line
        MoveTo( p.X, 0 );
        LineTo( p.x, Height );
        Y := Y + ScreenGrid.Step.Y;
      End;
      X := X + ScreenGrid.Step.X;
    End;
  End;
End;

{ Perimeter }

Function Perimeter( Vect: TEzVector; MustClose: Boolean ): Double;
Var
  TmpPt1, TmpPt2: TEzPoint;
  Idx1, Idx2, n, np, cnt: integer;
Begin
  Result := 0;
  If ( Vect = Nil ) Or ( Vect.Count < 2 ) Then Exit;
  np := Vect.Parts.Count;
  n := 0;
  If np < 2 Then
  Begin
    Idx1 := 0;
    Idx2 := Vect.Count - 1;
  End
  Else
  Begin
    Idx1 := Vect.Parts[n];
    Idx2 := Vect.Parts[n + 1] - 1;
  End;
  Repeat
    TmpPt1 := Vect[Idx1];
    For cnt := Idx1 + 1 To Idx2 Do
    Begin
      TmpPt2 := Vect[cnt];
      Result := Result + Dist2D( TmpPt1, TmpPt2 );
      TmpPt1 := TmpPt2;
    End;
    If MustClose Then
      Result := Result + Dist2D( Vect[Idx1], Vect[Idx2] );
    If np < 2 Then
      Break;
    Inc( n );
    If n >= np Then
      Break;
    Idx1 := Vect.Parts[n];
    If n < np - 1 Then
      Idx2 := Vect.Parts[n + 1] - 1
    Else
      Idx2 := Vect.Count - 1;
  Until false;
End;

{ BlinkEntityIndirect }

Procedure BlinkEntityIndirect( DrawBox: TEzBaseDrawBox; Entity: TEzEntity );
Var
  I: Integer;
Begin
  If ( Entity.EntityID = idNone ) Or
    Not Entity.IsVisible( DrawBox.Grapher.CurrentParams.VisualWindow ) Then Exit;

  For I := 1 To DrawBox.BlinkCount Do
  Begin
    HiliteEntity( Entity, DrawBox );
    Sleep( DrawBox.BlinkRate );
    UnHiliteEntity( Entity, DrawBox );
    Sleep( DrawBox.BlinkRate );
  End;
End;

{ BlinkEntity }

Procedure BlinkEntity( DrawBox: TEzBaseDrawBox; Layer: TEzBaseLayer; RecNo: Integer );
Var
  Entity: TEzEntity;
Begin
  Entity := Layer.LoadEntityWithRecNo( RecNo );
  If Entity = Nil Then Exit;
  Try
    BlinkEntityIndirect( DrawBox, Entity );
  Finally
    Entity.Free;
  End;
End;


Procedure HiliteEntity( Entity: TEzEntity; DrawBox: TEzBaseDrawBox );
Var
  TmpOD: TEzOutputDevices;
  TempEntity: TEzEntity;
  MustFree: Boolean;
Begin
  TempEntity := Nil;
  MustFree:= False;
  Try
    If ( Entity.EntityID In [idPlace, idNode, idPictureRef, idPersistBitmap,
      idBandsBitmap, idCustomPicture, idFittedVectText, idTable,
      idBlockInsert, idDimHorizontal, idDimVertical, idDimParallel] ) Then
    Begin
      With Entity.FBox Do
        TempEntity := TEzPolygon.CreateEntity( [Emin, Point2D( Emax.X, Emin.Y ),
                                                Emax, Point2D( Emin.X, Emax.Y ), Emin] );
      MustFree := true;
    End Else
      TempEntity:= Entity;

    With DrawBox Do
    Begin
      TmpOD:= OutputDevices;
      OutputDevices:= [odCanvas];
      DrawEntity( TempEntity, dmSelection );
      OutputDevices:= TmpOD;
    End;

  Finally
    If MustFree Then
      TempEntity.Free;
  End;
End;

Procedure UnHiliteEntity( Entity: TEzEntity; DrawBox: TEzBaseDrawBox );
Var
  TmpR: TRect;
Begin
  With DrawBox Do
  Begin
    TmpR:= Grapher.RealToRect( Entity.FBox );
    If Not Windows.IsRectEmpty(TmpR) Then
    Begin
      InflateRect(TmpR,2,2);
      Canvas.CopyRect(TmpR, ScreenBitmap.Canvas, TmpR );
    End;
  End;
End;

{ BlinkEntities }

Procedure BlinkEntities( DrawBox: TEzBaseDrawBox );
Var
  Entity: TEzEntity;
  I,J,L,S: Integer;
  Found: Boolean;
  Layer: TEzBaseLayer;
Begin

  Found:= False;
  { for every blink }
  For I := 1 To DrawBox.BlinkCount Do
  Begin
    { for every type of painting }
    for S:= 1 to 2 Do Begin

      { for every layer }
      For L:= 0 to DrawBox.GIS.Layers.Count-1 Do
      Begin
        Layer:= DrawBox.GIS.Layers[L];
        If Not Layer.LayerInfo.Visible Or Not Layer.HasBlinkers Then Continue;

        { for every entity on the layer marked for blinking }
        For J:= 0 to Layer.Blinkers.Count-1 Do
        Begin
          Entity:= Layer.LoadEntityWithRecNo(Layer.Blinkers[J]);
          If Entity= Nil Then Continue;

          If ( Entity.EntityID = idNone ) Or
            Not Entity.IsVisible( DrawBox.Grapher.CurrentParams.VisualWindow ) Then
          Begin
            Entity.Free;
            Continue;
          End;

          If S = 1 Then
          Begin
            HiliteEntity( Entity, DrawBox );
          End Else If S = 2 Then
          Begin
            UnHiliteEntity( Entity, DrawBox );
          End;
          Found:= True;
        End;
      End;

      If Not Found then Break;

      Sleep( DrawBox.BlinkRate );

    End;
    If Not Found then Break;
  End;
End;

procedure SaveFont(FStream: TIniFile; Section: string; smFont: TFont);
begin
  FStream.WriteString(Section, 'Font', smFont.Name + ',' +
                                       IntToStr(smFont.CharSet) + ',' +
                                       IntToStr(smFont.Color) + ',' +
                                       IntToStr(smFont.Size) + ',' +
                                       IntToStr(Byte(smFont.Style)));
end;

procedure LoadFont(FStream: TIniFile; Section: string; smFont: TFont);
var s, Data: string;
    i: Integer;
begin
  s := FStream.ReadString(Section, 'Font', ',,,,');
  try
    i := Pos(',', s);
    if i > 0 then
    begin
      {Name}
      Data := Trim(Copy(s, 1, i-1));
      if Data <> '' then
        smFont.Name := Data;
      Delete(s, 1, i);
      i := Pos(',', s);
      if i > 0 then
      begin
        {CharSet}
        Data := Trim(Copy(s, 1, i-1));
        if Data <> '' then
          smFont.Charset := TFontCharSet(StrToIntDef(Data, smFont.Charset));
        Delete(s, 1, i);
        i := Pos(',', s);
        if i > 0 then
        begin
          { Color }
          Data := Trim(Copy(s, 1, i-1));
          if Data <> '' then
            smFont.Color := TColor(StrToIntDef(Data, smFont.Color));
          Delete(s, 1, i);
          i := Pos(',', s);
          if i > 0 then
          begin
           {Size}
           Data := Trim(Copy(s, 1, i-1));
           if Data <> '' then
             smFont.Size := StrToIntDef(Data, smFont.Size);
           Delete(s, 1, i);
           {Style}
           Data := Trim(s);
           if Data <> '' then
             smFont.Style := TFontStyles(Byte(StrToIntDef(Data, Byte(smFont.Style))));
          end
        end
      end
    end;
  except
  end;
end;


{ DeleteDuplicatedVertexes }

Procedure DeleteDuplicatedVertexes( Ent: TEzEntity );
Var
  I: Integer;
  Found: Boolean;
Begin
  Repeat
    Found := False;
    For I := 0 To Ent.Points.Count - 2 Do
    Begin
      If EqualPoint2D( Ent.Points[I], Ent.Points[I + 1] ) Then
      Begin
        Ent.Points.Delete( I );
        Found := True;
        Break;
      End;
    End;
  Until Not Found;
End;

Function DegMinSec2Extended( Const DegMinSec: TDegMinSec ): Double;
Begin
  With DegMinSec Do
  Begin
    Result := ( Minutes * 60 + Seconds ) / 3600.0 + Abs( Degrees );
    If Degrees < 0 Then
      Result := -Result;
  End;
End;

Function Extended2DegMinSec( Const RealDeg: Double ): TDegMinSec;
Var
  Seconds, Working: Double;
Begin
  Working := Abs( RealDeg );
  Result.Degrees := Trunc( Working );
  Seconds := Frac( Working ) * 3600;
  Result.Minutes := Trunc( Seconds / 60 );
  Result.Seconds := Seconds - Result.Minutes * 60;
  If RealDeg < 0 Then