ezthematics.pas

很管用的GIS控件

  MainExpr: TEzMainExpr;
  FThematicLayer: TEzBaseLayer;
Begin
  If FieldName = '' Then
  Begin
    MessageToUser( SExpresionNull, smsgerror, MB_ICONERROR );
    Exit;
  End;
  EdExpr := ThematicLayer + '.' + Fieldname;
  FThematicLayer := Gis.Layers.LayerByName( Thematiclayer );
  If FThematicLayer = Nil Then Exit;
  MainExpr := TEzMainExpr.Create( Gis, FThematicLayer );
  Try
    MainExpr.ParseExpression( EdExpr );
  Except
    On E: Exception Do
    Begin
      MessageToUser( E.Message, smsgerror, MB_ICONERROR );
      MainExpr.Free;
      Exit;
    End;
  End;
  DiscreteValues:= TStringList.create;
  Gis.StartProgress( SCalculatingRanges, 1, FThematicLayer.RecordCount );
  try
    cnt:= 0;
    FThematicLayer.First;
    while not FThematicLayer.Eof do
    begin
      Inc( cnt );
      Gis.UpdateProgress( cnt );

      if FThematicLayer.RecIsDeleted then
      begin
        FThematicLayer.Next;
        Continue;
      end;
      FThematicLayer.Synchronize;
      Value:= MainExpr.Expression.AsString;
      if Length(Trim(Value)) > 0 then
        DiscreteValues.Add( Value );
      FThematicLayer.Next;
    end;
    if DiscreteValues.Count = 0 then Exit;
    TStringList( DiscreteValues ).Sort;
    { now delete repeated records }
    Index:= 0;
    Pivot:= DiscreteValues[0];
    DiscreteValues.Objects[Index]:= Pointer( -1 );
    Inc(Index);
    while Index < DiscreteValues.Count do
    begin
      If DiscreteValues[Index] <> Pivot then
      begin
        DiscreteValues.Objects[Index]:= Pointer( -1 );
        Pivot := DiscreteValues[Index];
      end;
      Inc( Index );
    end;
    { now delete all non-marked records and that will be the ranges }
    for Index := DiscreteValues.Count-1 downto 0 do
      if DiscreteValues.Objects[Index] = Nil then
        DiscreteValues.Delete( Index );

    { create the ranges now. One color for every range }
    // for fill color
    BeginColor := ColorToRGB( BrushStartColor );
    EndColor := ColorToRGB( BrushStopColor );
    BeginRGBValue[0] := GetRValue( BeginColor );
    BeginRGBValue[1] := GetGValue( BeginColor );
    BeginRGBValue[2] := GetBValue( BeginColor );
    RGBDiff[0] := GetRValue( EndColor ) - BeginRGBValue[0];
    RGBDiff[1] := GetGValue( EndColor ) - BeginRGBValue[1];
    RGBDiff[2] := GetBValue( EndColor ) - BeginRGBValue[2];
    // for line color
    LineBeginColor := ColorToRGB( LineStartColor );
    LineEndColor := ColorToRGB( LineStopColor );
    LineBeginRGBValue[0] := GetRValue( LineBeginColor );
    LineBeginRGBValue[1] := GetGValue( LineBeginColor );
    LineBeginRGBValue[2] := GetBValue( LineBeginColor );
    LineRGBDiff[0] := GetRValue( LineEndColor ) - LineBeginRGBValue[0];
    LineRGBDiff[1] := GetGValue( LineEndColor ) - LineBeginRGBValue[1];
    LineRGBDiff[2] := GetBValue( LineEndColor ) - LineBeginRGBValue[2];

    ThematicRanges.Clear;

    NumRanges := DiscreteValues.Count;

    For cnt := 0 To NumRanges - 1 Do
    Begin
      R := BeginRGBValue[0] + MulDiv( cnt, RGBDiff[0], Pred( NumRanges ) );
      G := BeginRGBValue[1] + MulDiv( cnt, RGBDiff[1], Pred( NumRanges ) );
      B := BeginRGBValue[2] + MulDiv( cnt, RGBDiff[2], Pred( NumRanges ) );
      StepColor := RGB( R, G, B );
      // line color
      R := LineBeginRGBValue[0] + MulDiv( cnt, LineRGBDiff[0], Pred( NumRanges ) );
      G := LineBeginRGBValue[1] + MulDiv( cnt, LineRGBDiff[1], Pred( NumRanges ) );
      B := LineBeginRGBValue[2] + MulDiv( cnt, LineRGBDiff[2], Pred( NumRanges ) );
      LineStepColor := RGB( R, G, B );

      DiscreteValues[cnt]:= StringReplace( DiscreteValues[cnt],#34,#34#34, [rfReplaceAll]);
      TmpStr := Format( '%s = "%s"', [EdExpr, DiscreteValues[cnt]] );

      With ThematicRanges.Add Do
      Begin
        Expression := TmpStr;
        Legend := DiscreteValues[cnt];
        PenStyle.style := 1;
        PenStyle.color := LineStepColor;
        If AutoLineWidth Then
          PenStyle.Width := Gis.DrawBoxList[0].Grapher.PointsToDistY( cnt )
        Else
          PenStyle.Width := 0;
        Brushstyle.Pattern := Brushstyle.Pattern;
        Brushstyle.ForeColor := StepColor;
        Brushstyle.BackColor := clWhite;
        SymbolStyle.Index := IMin( Ez_Symbols.Count-1, cnt );
        Symbolstyle.Height := Gis.DrawBoxList[0].Grapher.PointsToDistY( 20 );
      End;
    End;

  finally
    DiscreteValues.free;
    MainExpr.Free;
    Gis.EndProgress;
  end;
End;

{ for numeric fields only }
Procedure TEzThematicBuilder.CreateAutomaticThematicRange( Gis: TEzBaseGis;
  NumRanges: Integer; const ThematicLayer, FieldName: String;
  BrushStartColor, BrushStopColor: TColor;
  BrushPattern: Integer; LineStartColor, LineStopColor: TColor;
  LineStyle: Integer; AutoLineWidth, CalcbyRange, IgnoreZero, ManualRange: boolean;
  ManualRangevalue: Double; DecimalPos: Integer );

Var
  cnt, icnt, TotalAffected, Decimals, n: Integer;
  Value, MinValue, MaxValue, Delta, LowRange, HiRange: Double;
  BeginColor, EndColor, StepColor: TColor;
  LineBeginColor, LineEndColor, LineStepColor: TColor;
  tmpStr: String;
  R, G, B: Byte;
  BeginRGBValue, LineBeginRGBValue: Array[0..2] Of Byte;
  RGBDiff, LineRGBDiff: Array[0..2] Of Integer;
  MainExpr: TEzMainExpr;
  //Accept: Boolean;
  Values: TEzDoubleList;
  EdExpr, temp1, temp2: String;
  FMax, FMin: double;
  FThematicLayer: TEzBaseLayer;
  code: integer;
Begin
  If FieldName = '' Then
  Begin
    MessageToUser( SExpresionNull, smsgerror, MB_ICONERROR );
    Exit;
  End;

  EdExpr := ThematicLayer + '.' + Fieldname;
  FThematicLayer := Gis.Layers.LayerByName( Thematiclayer );
  If FThematicLayer = Nil Then Exit;

  MainExpr := TEzMainExpr.Create( Gis, FThematicLayer );
  Try
    MainExpr.ParseExpression( EdExpr );
  Except
    On E: Exception Do
    Begin
      MessageToUser( E.Message, smsgerror, MB_ICONERROR );
      MainExpr.Free;
      Exit;
    End;
  End;

  ThematicRanges.Clear;

  Values := TEzDoubleList.Create;
  FMax := -1E20;
  FMin := 1E20;
  Try
    {Calculate min and max values}
    Gis.StartProgress( SCalculatingRanges, 1, FThematicLayer.RecordCount );
    TotalAffected := 0;
    Try
      FThematicLayer.First;
      cnt := 0;
      While Not FThematicLayer.Eof Do
      Begin
        Inc( cnt );
        Gis.UpdateProgress( cnt );
        If FThematicLayer.RecIsDeleted Then
        Begin
          FThematicLayer.Next;
          Continue;
        End;
        FThematicLayer.Synchronize;
        Value := MainExpr.Expression.AsFloat;
        Values.Add( Value );
        If CalcbyRange Then
        Begin
          If IgnoreZero And ( value = 0 ) Then
          Begin
            FThematicLayer.Next;
            Continue;
          End;
          FMin := dMin( Value, FMin );
          FMax := dMax( Value, FMax );
        End;
        Inc( TotalAffected );

        FThematicLayer.Next;
      End;
    Finally
      Gis.EndProgress;
    End;
    Values.Sort;
    If Not CalcbyRange Then
    Begin // equal number
      FMin := 1;
      FMax := TotalAffected;
      Decimals := 0;
    End
    Else
      Decimals := DecimalPos;

    If FMax - FMin = 0 Then Exit; // can't calculate
    If CalcbyRange Then
      Delta := ( FMax - FMin ) / NumRanges
    Else
      Delta := ( ( FMax - FMin + 1 ) / NumRanges + 1 );

    If ( ManualRange ) And ( CalcbyRange ) Then
      Delta := ManualRangeValue;

    MinValue := FMin;
    If Decimals = 0 Then
    Begin
      MinValue := Int( MinValue );
      Delta := Int( Delta );
    End;
    // for fill color
    BeginColor := ColorToRGB( BrushStartColor );
    EndColor := ColorToRGB( BrushStopColor );
    BeginRGBValue[0] := GetRValue( BeginColor );
    BeginRGBValue[1] := GetGValue( BeginColor );
    BeginRGBValue[2] := GetBValue( BeginColor );
    RGBDiff[0] := GetRValue( EndColor ) - BeginRGBValue[0];
    RGBDiff[1] := GetGValue( EndColor ) - BeginRGBValue[1];
    RGBDiff[2] := GetBValue( EndColor ) - BeginRGBValue[2];
    // for line color
    LineBeginColor := ColorToRGB( LineStartColor );
    LineEndColor := ColorToRGB( LineStopColor );
    LineBeginRGBValue[0] := GetRValue( LineBeginColor );
    LineBeginRGBValue[1] := GetGValue( LineBeginColor );
    LineBeginRGBValue[2] := GetBValue( LineBeginColor );
    LineRGBDiff[0] := GetRValue( LineEndColor ) - LineBeginRGBValue[0];
    LineRGBDiff[1] := GetGValue( LineEndColor ) - LineBeginRGBValue[1];
    LineRGBDiff[2] := GetBValue( LineEndColor ) - LineBeginRGBValue[2];

    For cnt := 0 To NumRanges - 1 Do
    Begin
      R := BeginRGBValue[0] + MulDiv( cnt, RGBDiff[0], Pred( NumRanges ) );
      G := BeginRGBValue[1] + MulDiv( cnt, RGBDiff[1], Pred( NumRanges ) );
      B := BeginRGBValue[2] + MulDiv( cnt, RGBDiff[2], Pred( NumRanges ) );
      StepColor := RGB( R, G, B );
      // line color
      R := LineBeginRGBValue[0] + MulDiv( cnt, LineRGBDiff[0], Pred( NumRanges ) );
      G := LineBeginRGBValue[1] + MulDiv( cnt, LineRGBDiff[1], Pred( NumRanges ) );
      B := LineBeginRGBValue[2] + MulDiv( cnt, LineRGBDiff[2], Pred( NumRanges ) );
      LineStepColor := RGB( R, G, B );

      If CalcbyRange Then
      Begin
        MaxValue := MinValue + Delta;
        If Decimals = 0 Then
          MaxValue := MaxValue - 1;
      End
      Else
      Begin
        If cnt = NumRanges - 1 Then
          MaxValue := Values.Count
        Else
        Begin
          MaxValue := MinValue + Delta;
          If Decimals = 0 Then
            MaxValue := MaxValue - 1;
        End;
      End;

      If cnt < Pred( NumRanges ) Then
        TmpStr := '(%s >= %s) And (%s < %s)'
      Else
        TmpStr := '(%s >= %s) And (%s <= %s)';
      If CalcbyRange Then
      Begin
        LowRange := MinValue;
        HiRange := MaxValue
      End
      Else
      Begin
        LowRange := Values[Trunc( MinValue ) - 1];
        HiRange := Values[Trunc( MaxValue ) - 1];
      End;

      With ThematicRanges.Add Do
      Begin
        System.Str( LowRange:30:Decimals, temp1 );
        System.Str( HiRange:30:Decimals, temp2 );
        Expression := Format( TmpStr, [EdExpr, trim(temp1), EdExpr, trim(temp2)] );
        Legend := Format( '%.*n - %.*n', [Decimals, LowRange, Decimals, HiRange] );
        PenStyle.style := 1;
        PenStyle.color := LineStepColor;
        If AutoLineWidth Then
          PenStyle.Width := Gis.DrawBoxList[0].Grapher.PointsToDistY( cnt )
        Else
          PenStyle.Width := 0;
        //PenStyle.Width := Gis.DrawBoxList[0].Grapher.PointsToDistY( cnt );
        Brushstyle.Pattern := Brushstyle.Pattern;
        Brushstyle.ForeColor := StepColor;
        Brushstyle.BackColor := clWhite;
        SymbolStyle.Index := IMin( Ez_Symbols.Count-1, cnt );
        Symbolstyle.Height := Gis.DrawBoxList[0].Grapher.PointsToDistY( 20 );
      End;
      MinValue := MaxValue;
    End;
  Finally
    MainExpr.Free;
    Values.Free;
  End;
End;


{ TEzLegendItem }

constructor TEzLegendItem.Create(Collection: TCollection);
begin
  Inherited Create( Collection );
  FPenStyle:= TEzPentool.Create;
  FPenStyle.Style:= 1;
  FBrushStyle:= TEzBrushtool.Create;
  FBrushStyle.Pattern:= 1;
  FSymbolStyle:= TEzSymboltool.Create;
end;

destructor TEzLegendItem.Destroy;
begin
  FPenStyle.free;
  FBrushStyle.Free;
  FSymbolStyle.Free;
  inherited;
end;

procedure TEzLegendItem.Assign(Source: TPersistent);
begin
  If Source Is TEzLegendItem Then
  Begin
    FLegend := TEzLegendItem( Source ).Legend;
    FPenStyle.Assign( TEzLegendItem( Source ).PenStyle );
    FBrushStyle.Assign( TEzLegendItem( Source ).BrushStyle );
    FSymbolStyle.Assign( TEzLegendItem( Source ).SymbolStyle );
    InvalidateLegend;
  End
  Else
    Inherited Assign( Source );
end;

function TEzLegendItem.GetDisplayName: String;
begin
  If FLegend = '' Then
    Result := Inherited GetDisplayName
  else
    result := FLegend;
end;

procedure TEzLegendItem.SetBrushstyle(Value: TEzBrushtool);
begin
  FBrushstyle.Assign(Value);
  InvalidateLegend;
end;

procedure TEzLegendItem.SetPenstyle(Value: TEzPentool);
begin
  FPenstyle.Assign(Value);
  InvalidateLegend;
end;

procedure TEzLegendItem.SetSymbolStyle(Value: TEzSymboltool);
begin
  FSymbolstyle.Assign(Value);
  InvalidateLegend;
end;

procedure TEzLegendItem.SetFontStyle(const Value: TEzFonttool);
begin
  FFontStyle.Assign( Value );
  InvalidateLegend;
end;

procedure TEzLegendItem.SetColor(const Value: TColor);
begin