teemapseries.pas

BCB第三方组件

      Points.BeginUpdate;
      try
        for t:=Low(X) to High(X) do
            AddXY(tmpX+X[t],tmpY+Y[t]);

        Text:=AText;
        Z:=RandomValue(1000)/1000.0;

      finally
        Points.EndUpdate;
      end;
    end;
  end;

Const AX:Array[0..13] of Integer=(1,3,4,4,5,5,6,6,4,3,2,1,2,2);
      AY:Array[0..13] of Integer=(7,5,5,7,8,9,10,11,11,12,12,11,10,8);
      BX:Array[0..8]  of Integer=(5,7,8,8,7,6,5,4,4);
      BY:Array[0..8]  of Integer=(4,4,5,6,7,7,8,7,5);
      CX:Array[0..15] of Integer=(9,10,11,11,12,9,8,7,6,6,5,5,6,7,8,8);
      CY:Array[0..15] of Integer=(5,6,6,7,8,11,11,12,11,10,9,8,7,7,6,5);
      DX:Array[0..7]  of Integer=(12,14,15,14,13,12,11,11);
      DY:Array[0..7]  of Integer=(5,5,6,7,7,8,7,6);
      EX:Array[0..10] of Integer=(4,6,7,7,6,6,5,4,3,3,2);
      EY:Array[0..10] of Integer=(11,11,12,13,14,15,16,16,15,14,13);
      FX:Array[0..11] of Integer=(7,8,9,11,10,8,7,6,5,5,6,6);
      FY:Array[0..11] of Integer=(13,14,14,16,17,17,18,18,17,16,15,14);
      GX:Array[0..11] of Integer=(10,12,12,14,13,11,9,8,7,7,8,9);
      GY:Array[0..11] of Integer=(10,12,13,15,16,16,14,14,13,12,11,11);
      HX:Array[0..9]  of Integer=(17,19,18,18,17,15,14,13,15,16);
      HY:Array[0..9]  of Integer=(11,13,14,16,17,15,15,14,12,12);
      IX:Array[0..14] of Integer=(15,16,17,16,15,14,14,13,12,11,10,11,12,13,14);
      IY:Array[0..14] of Integer=(6,6,7,8,8,9,10,11,12,11,10,9,8,7,7);
      JX:Array[0..11] of Integer=(15,16,16,17,17,16,15,13,12,12,14,14);
      JY:Array[0..11] of Integer=(8,8,9,10,11,12,12,14,13,12,10,9);
      KX:Array[0..9]  of Integer=(17,19,20,20,19,17,16,16,17,16);
      KY:Array[0..9]  of Integer=(5,5,6,8,8,10,9,8,7,6);
      LX:Array[0..6]  of Integer=(19,20,21,21,19,17,17);
      LY:Array[0..6]  of Integer=(8,8,9,11,13,11,10);

var t : Integer;
begin
  for t:=0 to NumValues-1 do
  case t mod NumSampleValues of
    0: AddShape(AX,AY,'A');
    1: AddShape(BX,BY,'B');
    2: AddShape(CX,CY,'C');
    3: AddShape(DX,DY,'D');
    4: AddShape(EX,EY,'E');
    5: AddShape(FX,FY,'F');
    6: AddShape(GX,GY,'G');
    7: AddShape(HX,HY,'H');
    8: AddShape(IX,IY,'I');
    9: AddShape(JX,JY,'J');
   10: AddShape(KX,KY,'K');
   11: AddShape(LX,LY,'L');
  end;
end;

function TMapSeries.Clicked(x, y: Integer): Integer;
var tmpClip : Boolean;
    tmpRect : TRect;

  function IsShapeVisible(Shape:TPolygonSeries):Boolean;
  var tmp  : Integer;
      tmp2 : Integer;
  begin
    if tmpClip then
    begin
      with GetHorizAxis do
      begin
        tmp:=CalcPosValue(Shape.XValues.MinValue);

        if (tmp<tmpRect.Left) or (tmp>tmpRect.Right) then
        begin
          tmp2:=CalcPosValue(Shape.XValues.MaxValue);

          if (tmp2<tmpRect.Left) or
             ((tmp2>tmpRect.Right) and (tmp>tmpRect.Right)) then
          begin
            result:=False;
            Exit;
          end;
        end;
      end;

      with GetVertAxis do
      begin
        tmp:=CalcPosValue(Shape.YValues.MaxValue);

        if (tmp<tmpRect.Top) or (tmp>tmpRect.Bottom) then
        begin
          tmp2:=CalcPosValue(Shape.YValues.MinValue);

          result:=( (tmp2>=tmpRect.Top) and (tmp2<=tmpRect.Bottom) ) or
                  ( (tmp2>tmpRect.Bottom) and (tmp<tmpRect.Top) );
        end
        else result:=True;
      end;
    end
    else result:=True;
  end;

var t    : Integer;
    tmpX : Integer;
    tmpY : Integer;
    tmpChart : TCustomAxisPanel;
    tmpshape : TTeePolygon;
begin
  result:=TeeNoPointClicked;
  tmpChart:=ParentChart;

  if Assigned(tmpChart) then
  begin
    tmpClip:=tmpChart.ClipPoints;
    tmpRect:=tmpChart.ChartRect;

    for t:=Shapes.Count-1 downto 0 do // 7.01
    begin
      tmpShape:=Shapes[t];

      if IsShapeVisible(tmpShape.FPoints) then
      begin
        tmpX:=X;
        tmpY:=Y;

        tmpChart.Canvas.Calculate2DPosition(tmpX,tmpY,CalcZPos(t));

        tmpShape.GetPoints;

        if ((tmpShape.Points.Count=1) and PointInRect(tmpShape.PointRect,tmpX,tmpY))
           or
           PointInPolygon(TeePoint(tmpX,tmpY),tmpShape.IPoints) then
        begin
          result:=t;
          break;
        end;
      end;
    end;
  end;
end;

function PolygonArea(const P:TPointArray): Double;
var N,t,tt : Integer;
begin
  result:=0;

  N:=Length(P);

  for t:=0 to N-1 do
  begin
    tt:= (t + 1) mod N;
    result:=result + (P[t].x * P[tt].y) - (P[t].y * P[tt].x);
  end;

  result:=Abs(result*0.5);
end;

function PolygonCentroid(const P:TPointArray):TPointFloat;
var tmp,
    Factor : Double;
    N,i,j : Integer;
begin
  N:=Length(P);

  if N>2 then
  begin
    result.x:=0;
    result.y:=0;

    for i:=0 to N-1 do
    begin
      j:= (i + 1) mod N;
      Factor:= ( P[i].x*P[j].y-P[j].x*P[i].y);
      result.x:=result.x+ ( P[i].x+P[j].x)*Factor;
      result.y:=result.y+ ( P[i].y+P[j].y)*Factor;
    end;

    tmp:=PolygonArea(P)*6;
    if tmp=0 then tmp:=6;

    Factor:=1.0/tmp;
    result.x:=result.x*Factor;
    result.y:=result.y*Factor;
  end
  else
  if N>1 then
  begin
    result.x:=(P[1].x+P[0].x)*0.5;
    result.y:=(P[1].y+P[0].y)*0.5;
  end
  else
  if N>0 then
  begin
    result.x:=P[0].x;
    result.y:=P[0].y;
  end;
end;

procedure TMapSeries.CalcSelectionPos(ValueIndex:Integer; out X,Y:Integer);
var P   : TPointArray;
    tmp : TPointFloat;
begin
  P:=FShapes[ValueIndex].GetPoints;
  try
    tmp:=PolygonCentroid(P);
    X:=Round(tmp.X);
    Y:=Round(tmp.Y);
  finally
    P:=nil;
  end;
end;

procedure TMapSeries.DrawMark(ValueIndex: Integer; const St: String;
  APosition: TSeriesMarkPosition);
begin
  if Shapes.Count>ValueIndex then
  begin
    with Shapes[ValueIndex].Bounds do
    begin
      APosition.LeftTop.X:=((Right+Left) div 2)-(APosition.Width div 2);
      APosition.LeftTop.Y:=((Top+Bottom) div 2)-(APosition.Height div 2);
    end;

    //    Marks.ZPosition:=CalcZPos(ValueIndex);  7.0 already done in inherited
  end;

  inherited;
end;

class function TMapSeries.GetEditorClass: String;
begin
  result:='TMapSeriesEditor';
end;

procedure TMapSeries.Clear;
begin
  inherited;

  if Assigned(Shapes) and
    (not (csLoading in ComponentState)) then
       Shapes.Clear;
end;

class procedure TMapSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_Colors);
end;

class procedure TMapSeries.SetSubGallery(ASeries: TChartSeries;
  Index: Integer);
begin
  with TMapSeries(ASeries) do
  Case Index of
    2: ColorEachPoint:=True;
  else inherited;
  end
end;

procedure TMapSeries.GalleryChanged3D(Is3D: Boolean);
begin { 5.02 }
  if Is3D then inherited
          else ParentChart.View3D:=False;
end;

Function TMapSeries.CompareOrder(a,b:Integer):Integer;
var tmpA : Double;
    tmpB : Double;
begin
  tmpA:=I3DList[a].Z;  //ZPosition;
  tmpB:=I3DList[b].Z;  //ZPosition;
  if tmpA>tmpB then result:=1
  else
  if tmpA<tmpB then result:=-1
  else
     result:=0;
end;

Function TMapSeries.GetPolygon(Index:Integer):TTeePolygon; // 7.0
begin
  result:=FShapes[Index];
end;

Procedure TMapSeries.SwapPolygon(a,b:Integer);
var tmp : TTeePolygon;
begin
  tmp:=I3DList[b];
  I3DList[b]:=I3DList[a];
  I3DList[a]:=tmp;
end;

procedure TMapSeries.SetTransparent(const Value:Boolean);
var t : Integer;
begin
  if FTransparent<>Value then
  begin
    FTransparent:=Value;

    for t:=0 to Shapes.Count-1 do
        Shapes[t].Transparent:=Transparent;

    Repaint;
  end;
end;

procedure TMapSeries.SetTransparency(const Value:TTeeTransparency);
var t : Integer;
begin
  if FTransparency<>Value then
  begin
    FTransparency:=Value;

    for t:=0 to Shapes.Count-1 do
        Shapes[t].Transparency:=Transparency;

    Repaint;
  end;
end;

procedure TMapSeries.DrawAllValues;

  Procedure DrawAllSorted;
  var t : Integer;
      tmpCount : Integer;
  begin
    tmpCount:=Shapes.Count;

    if tmpCount>0 then
    begin
      SetLength(I3DList,tmpCount);
      try
        for t:=0 to tmpCount-1 do I3DList[t]:=Shapes.Get(t);

        TeeSort(0,tmpCount-1,CompareOrder,SwapPolygon);

        for t:=tmpCount-1 downto 0 do
            I3DList[t].Draw(ParentChart.Canvas,I3DList[t].Index);
      finally
        I3DList:=nil;
      end;
    end;
  end;

var t    : Integer;
    tmpP : TPointArray;
begin
  tmpP:=nil;

  if Shadow.Visible and (Shadow.Size<>0) then
  begin
    for t:=0 to Shapes.Count-1 do
    with Shapes[t] do
    if Points.Active and (Points.Count>1) and Visible then
    begin
      Shapes[t].GetPoints;

      if ParentChart.View3D then
      begin
        tmpP:=ParentChart.Canvas.Calc3DPoints(Shapes[t].IPoints,CalcZPos(t));
        try
          Shadow.Draw(ParentChart.Canvas,tmpP);
        finally
          tmpP:=nil;
        end;
      end
      else
        Shadow.Draw(ParentChart.Canvas,Shapes[t].IPoints);
    end;
  end;

  if ParentChart.View3D then DrawAllSorted
                        else inherited;
end;

{ TPolygonSeries }
procedure TPolygonSeries.NotifyValue(ValueEvent: TValueEvent;
  ValueIndex: Integer);
begin
  inherited;

  if not (csDestroying in ComponentState) then
     if Polygon<>nil then
        Polygon.ParentSeries.Repaint;
end;

procedure TPolygonSeries.SetActive(Value: Boolean);
begin
  inherited;
  Polygon.ParentSeries.Repaint;
end;

Function TPolygonSeries.Polygon:TTeePolygon;
begin
  {$IFDEF CLR}
  result:=TTeePolygon(TObject(Tag));
  {$ELSE}
  result:=TTeePolygon(Tag);
  {$ENDIF}
end;

procedure TPolygonSeries.SetSeriesColor(AColor: TColor);
begin
  inherited;

  // Prevent changing color when caller is Chart.PaintSeriesLegend
  if not Assigned(ParentChart) then
     Polygon.ParentSeries.ValueColor[Polygon.Index]:=AColor;
end;

procedure TPolygonSeries.PrepareLegendCanvas(ValueIndex:Integer; Var BackColor:TColor;
                                   Var BrushStyle:TBrushStyle);
begin
  inherited;

  with Polygon do { 5.02 }
  begin
    ParentSeries.DoBeforeDrawChart;

    if (not Assigned(FGradient)) or (not Gradient.Visible) then
       ParentChart.Canvas.Brush.Color:=Color;
  end;
end;

procedure TPolygonSeries.DrawLegendShape(ValueIndex: Integer;
  const Rect: TRect);
begin
  if Assigned(Polygon.FGradient) then
     with Polygon.Gradient do { 5.02 }
     if Visible then Draw(ParentChart.Canvas,Rect)
                else inherited
  else
    inherited;
end;

procedure TPolygonSeries.FillSampleValues(NumValues: Integer);
begin { do nothing, sample values are provided by Owner Map Series }
end;

initialization
  RegisterTeeSeries( TMapSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryMap,
                                 {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended,1);
finalization
  UnRegisterTeeSeries([TMapSeries]);
end.