ezthematics.pas

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

Function TEzThematicRanges.Add: TEzThematicItem;
Begin
  Result := TEzThematicItem( Inherited Add );
End;

function TEzThematicRanges.Down( Index: Integer ): Boolean;
begin
  Result:= False;
  if ( Index < 0 ) or ( Index >= Count - 1 ) then Exit;
  GetItem( Index ).Index := Index + 1;
  Result:= True;
End;

function TEzThematicRanges.Up( Index: Integer ): Boolean;
begin
  Result:= False;
  if ( Index <= 0 ) or ( Index > Count - 1 ) then Exit;
  GetItem( Index ).Index := Index - 1;
  Result:= True;
end;

{$IFDEF DELPHI4}
Procedure TEzThematicRanges.Delete(Index: Integer );
Begin
  if ( Index < 0 ) or ( Index > Count - 1 ) then Exit;
  GetItem( Index ).Free;
End;
{$ENDIF}

{-------------------------------------------------------------------------------}
{                  Implements TEzThematicBuilder                                    }
{-------------------------------------------------------------------------------}

Constructor TEzThematicBuilder.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FThematicRanges := TEzThematicRanges.Create( Self );
  FPenStyle:= TEzPentool.Create;
  FBrushStyle:= TEzBrushtool.Create;
  FFontStyle:= TEzFonttool.Create;
  FSymbolStyle:= TEzSymboltool.Create;
  FApplyPen:=false;
  FApplyBrush:=false;
  FApplyColor:=true;
  FApplySymbol:=false;
  FApplyFont:=false;
  FShowThematic:= True;
End;

Destructor TEzThematicBuilder.Destroy;
Begin
  FThematicRanges.Free;
  FPenStyle.free;
  FBrushStyle.Free;
  FFontStyle.Free;
  FSymbolStyle.Free;
  if FExprList <> Nil then
    EndThematic;
  Inherited Destroy;
End;

function TEzThematicBuilder.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzThematicBuilder.SetAbout(const Value: TEzAbout);
begin
end;

procedure TEzThematicBuilder.Assign(Source: TPersistent);
begin
  if Source is TEzThematicBuilder then
  begin
    LayerName := TEzThematicBuilder( Source ).LayerName;
    ThematicRanges.Assign( TEzThematicBuilder( Source ).ThematicRanges );
    Title := TEzThematicBuilder( Source ).Title;
    ShowThematic := TEzThematicBuilder( Source ).ShowThematic;
    ApplyPen := TEzThematicBuilder( Source ).ApplyPen;
    ApplyBrush:= TEzThematicBuilder( Source ).ApplyBrush;
    ApplySymbol:= TEzThematicBuilder( Source ).ApplySymbol;
    ApplyFont := TEzThematicBuilder( Source ).ApplyFont;
  end else
    inherited Assign( Source );
end;

const
  ThematicFileID = 890504;

procedure TEzThematicBuilder.SaveToStream(Stream: TStream);
var
  I, n, IDFile: Integer;
begin
  IDFile:= ThematicFileID;
  with Stream do
  begin
    Write(IDFile,sizeof(IDFile));
    EzWriteStrToStream( FTitle, stream );
    EzWriteStrToStream( FLayerName, stream );
    Write(FShowThematic,sizeof(FShowThematic));
    Write(FApplyPen,sizeof(FApplyPen));
    Write(FApplyBrush,sizeof(FApplyBrush));
    Write(FApplySymbol,sizeof(FApplySymbol));
    Write(FApplyFont,sizeof(FApplyFont));

    n:= ThematicRanges.Count;
    Write(n,sizeof(n));
    for I:= 0 to n-1 do
    begin
      with ThematicRanges[I] do
      begin
        EzWriteStrToStream( FLegend, stream );
        EzWriteStrToStream( FExpression, stream );
        Write(FFrequency,sizeof(FFrequency));
        FPenStyle.SaveToStream(Stream);
        FBrushStyle.SaveToStream(Stream);
        FSymbolStyle.SaveToStream(Stream);
        FFontStyle.SaveToStream(Stream);
      end;
    end;
  end;
end;

procedure TEzThematicBuilder.LoadFromStream(Stream: TStream);
var
  I, n, IDFile: Integer;
begin
  ThematicRanges.Clear;
  with Stream do
  begin
    Read(IDFile,sizeof(IDFile));
    if IDFile <> ThematicFileID then Exit;
    FTitle:= EzReadStrFromStream( stream );
    FLayerName:= EzReadStrFromStream( stream );
    Read(FShowThematic,sizeof(FShowThematic));
    Read(FApplyPen,sizeof(FApplyPen));
    Read(FApplyBrush,sizeof(FApplyBrush));
    Read(FApplySymbol,sizeof(FApplySymbol));
    Read(FApplyFont,sizeof(FApplyFont));

    Read(n,sizeof(n));
    for I:= 0 to n-1 do
    begin
      with ThematicRanges.Add do
      begin
        FLegend:= EzReadStrFromStream( stream );
        FExpression:= EzReadStrFromStream( stream );
        Read(FFrequency,sizeof(FFrequency));
        FPenStyle.LoadFromStream(Stream);
        FBrushStyle.LoadFromStream(Stream);
        FSymbolStyle.LoadFromStream(Stream);
        FFontStyle.LoadFromStream(Stream);
      end;
    end;
  end;
end;

procedure TEzThematicBuilder.LoadFromFile( const FileName: string );
var
  stream: TStream;
begin
  if not FileExists(FileName) then exit;
  stream:= TFileStream.create(FileName, fmOpenRead or fmShareDenyNone);
  try
    LoadFromStream(stream);
  finally
    stream.free;
  end;
end;

procedure TEzThematicBuilder.SaveToFile( const FileName: string );
var
  stream: TStream;
begin
  stream:= TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(stream);
  finally
    stream.free;
  end;
end;

Procedure TEzThematicBuilder.SetThematicRanges( Value: TEzThematicRanges );
Begin
  FThematicRanges.Assign( Value );
End;

Function TEzThematicBuilder.StartThematic( Layer: TEzBaseLayer ): Boolean;
Var
  MainExpr: TEzMainExpr;
  I: Integer;
Begin
  Result:= False;
  if (FThematicRanges.Count = 0) Or (Layer = Nil) Or Not (Layer.LayerInfo.Visible) then Exit;
  EndThematic;
  FExprList := TList.Create;
  Try
    For I := 0 To FThematicRanges.Count - 1 Do
    Begin
      if Length(FThematicRanges[I].Expression) = 0 then
        Raise EExpression.Create( SExprFail )
      else
      begin
        // evaluate expression
        MainExpr := TEzMainExpr.Create( Layer.Layers.Gis, Layer );
        MainExpr.ParseExpression( FThematicRanges[I].Expression );
        If ( MainExpr.Expression <> Nil ) And
           ( MainExpr.Expression.ExprType <> ttBoolean ) Then
        Begin
          MainExpr.Free;
          Raise EExpression.Create( SExprFail );
        End;
        If MainExpr.Expression <> Nil Then
          FExprList.Add( MainExpr )
        Else
        begin
          MainExpr.Free;
          Raise EExpression.Create( SExprFail );
        end;
      end;
    End;
  Except
    Self.FShowThematic := False;
    EndThematic;
    Raise;
  End;
  Result := True;
End;

Function TEzThematicBuilder.CalcThematicInfo( Layer: TEzBaseLayer; Recno: Integer ): Boolean;
Var
  I: Integer;
Begin
  Result:= False;
  If Layer.Recno <> Recno Then
    Layer.Recno := Recno;
  Layer.Synchronize;
  For I := 0 To FExprList.Count - 1 Do
    If TEzMainExpr(FExprList[I]).Expression.AsBoolean = true Then
      Begin
        Self.FPenStyle.Assign( FThematicRanges[I].PenStyle );
        Self.FBrushstyle.Assign( FThematicRanges[I].BrushStyle );
        Self.FSymbolstyle.Assign( FThematicRanges[I].SymbolStyle );
        Self.FFontStyle.Assign( FThematicRanges[I].FontStyle );
        Result:= True;
        Exit;
      End;
End;

Procedure TEzThematicBuilder.EndThematic;
var
  I: Integer;
Begin
  if FExprList = Nil then Exit;
  for I:= 0 to FExprList.Count - 1 do
    TEzMainExpr( FExprList[I] ).Free;
  FreeAndNil( FExprList );
End;

procedure TEzThematicBuilder.Recalculate( Gis: TEzBaseGis );
var
  Layer: TEzBaseLayer;
  I: Integer;
begin
  Layer:= Gis.Layers.LayerByName( FLayerName );
  if Layer = Nil then Exit;
  if Not StartThematic( Layer ) then Exit;
  for I:= 0 to FThematicRanges.Count-1 do
    FThematicRanges[I].FFrequency:= 0;
  Screen.Cursor:= crHourglass;
  try
    Layer.First;
    Layer.StartBuffering;
    Try
      While Not Layer.Eof Do
      Begin
        Try
          If Layer.RecIsDeleted Then Continue;
          Layer.Synchronize;
          For I := 0 To FExprList.Count - 1 Do
            If TEzMainExpr(FExprList[I]).Expression.AsBoolean = true Then
              Begin
                Inc( FThematicRanges[I].FFrequency );
                Break;
              End;
        Finally
          Layer.Next;
        End;
      End;
    Finally
      Layer.EndBuffering;
    End;
  finally
    EndThematic;
    Screen.Cursor:= crDefault;
  end;
end;

Procedure TEzThematicBuilder.Prepare( Layer: TEzBaseLayer );
Begin
  If FShowThematic And ( AnsiCompareText( Layer.Name, Self.FLayerName ) = 0 ) then
  begin
    FThematicOpened := Self.StartThematic( Layer );

    If FThematicOpened then
    begin
      //FSaveBeforePaintEntity := Layer.OnBeforePaintEntity;
      //FIsBeforePaintEntity := Assigned( FSaveBeforePaintEntity );

      Layer.OnBeforePaintEntity := Self.BeforePaintEntity;
    end;
  end;
End;

Procedure TEzThematicBuilder.UnPrepare( Layer: TEzBaseLayer );
Begin
  If FThematicOpened And ( AnsiCompareText( Layer.Name, Self.FLayerName ) = 0 ) then
  begin
    EndThematic;
    //Layer.OnBeforePaintEntity := FSaveBeforePaintEntity;
    Layer.OnBeforePaintEntity := Nil;
  end;
  FThematicOpened := False;
End;

Procedure TEzThematicBuilder.BeforePaintEntity( Sender: TObject;
  Layer: TEzBaseLayer; Recno: Integer; Entity: TEzEntity;
  Grapher: TEzGrapher; Canvas: TCanvas; Const Clip: TEzRect;
  DrawMode: TEzDrawMode; Var CanShow: Boolean; Var EntList: TEzEntityList;
  Var AutoFree: Boolean );
Begin
  { call the old event handler }
  {If FIsBeforePaintEntity And (FSaveBeforePaintEntity <> BeforePaintEntity) Then
    FSaveBeforePaintEntity( Sender, Layer, Recno, Entity, Grapher, Canvas,
      Clip, DrawMode, CanShow ); }
  if not CanShow then Exit;

  With Layer Do
  Begin
    If FThematicOpened And ( Entity.EntityID In [idPoint, idPlace,
      idPolyline, idPolygon, idRectangle, idArc, idEllipse, idSpline] ) Then
    Begin
      if not Self.CalcThematicInfo( Layer, Recno ) then Exit;

      if (Entity is TEzOpenedEntity) and FApplyPen then
      begin
        TEzOpenedEntity(Entity).Pentool.Assign(Self.FPenstyle);
      end;
      if Entity is TEzClosedEntity and FApplyBrush then
      begin
        TEzClosedEntity(Entity).Brushtool.Assign(Self.FBrushstyle);
      end;
      if (Entity.EntityID = idPoint) and FApplyPen then
      begin
        TEzPointEntity(Entity).Color:= Self.FPenstyle.Color;
      end;
      if (Entity.EntityID = idPlace) and FApplySymbol then
      begin
        TEzPlace(Entity).Symboltool.Assign( Self.FSymbolStyle );
      end;
      if (Entity.EntityID = idTrueTypeText) and FApplyFont then
      begin
        TEzTrueTypeText(Entity).Fonttool.Assign( Self.FFontStyle );
      end;
      if (Entity.EntityID = idJustifVectText) and FApplyFont then
      begin
        with TEzJustifVectorText(Entity) do
        begin
          FontName:= self.FFontStyle.Name;
          Height:= self.FFontStyle.Height;
          Fontcolor:= self.FFontStyle.Color;
        end;
      end;
      if (Entity.EntityID = idFittedVectText) and FApplyFont then
      begin
        with TEzFittedVectorText(Entity) do
        begin
          FontName:= self.FFontStyle.Name;
          Height:= self.FFontStyle.Height;
          Fontcolor:= self.FFontStyle.Color;
        end;
      end;
    End;
  End;
End;

{ for string fields only }
Procedure TEzThematicBuilder.CreateAutomaticThematicRangeStrField( Gis: TEzBaseGis;
  const ThematicLayer, FieldName: String;
  BrushStartColor, BrushStopColor: TColor; BrushPattern: Integer;
  LineStartColor, LineStopColor: TColor; LineStyle: Integer; AutoLineWidth: Boolean );
var
  Layer: TEzBaseLayer;
  DiscreteValues: TStrings;
  EdExpr, TmpStr, Pivot, Value: string;
  Cnt, NumRanges, Index: Integer;
  BeginColor, EndColor, StepColor: TColor;
  LineBeginColor, LineEndColor, LineStepColor: TColor;
  R, G, B: Byte;
  BeginRGBValue, LineBeginRGBValue: Array[0..2] Of Byte;
  RGBDiff, LineRGBDiff: Array[0..2] Of Integer;