⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teemapseries.pas

📁 TeeChart7Source 控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
type TComponentAccess=class(TComponent);

function TTeePolygonList.Add: TTeePolygon;
{$IFNDEF CLR}
var p : TPolygonSeries;
{$ENDIF}
begin
  result:=inherited Add as TTeePolygon;
  {$IFNDEF CLR}
  p:=result.Points;
  TComponentAccess(p).SetDesigning(False);
  {$ENDIF}
end;

procedure TTeePolygonList.Delete(Start, Quantity: Integer);
var t: Integer;
begin
  for t:=1 to Quantity do Items[Start].Free;
end;

function TTeePolygonList.Get(Index: Integer): TTeePolygon;
begin
  result:=TTeePolygon(Items[Index]);
end;

function TTeePolygonList.GetByName(const AName: String): TTeePolygon;
var t   : Integer;
    tmp : String;
begin
  result:=nil;
  tmp:=UpperCase(AName);

  for t:=0 to Count-1 do
  if UpperCase(Polygon[t].Text)=tmp then
  begin
    result:=Polygon[t];
    break;
  end;
end;

function TTeePolygonList.Owner: TMapSeries;
begin
  result:=TMapSeries(GetOwner);
end;

procedure TTeePolygonList.Put(Index: Integer; const Value: TTeePolygon);
begin
  Items[Index]:=Value;
end;

{ TMapSeries }
Constructor TMapSeries.Create(AOwner: TComponent);
begin
  inherited;
  FShapes:=TTeePolygonList.Create(Self,TTeePolygon);
  CalcVisiblePoints:=False;
  YMandatory:=False;
  MandatoryValueList:=ZValues;
end;

Destructor TMapSeries.Destroy;
begin
  FreeAndNil(FShapes);
  inherited;
end;

procedure TMapSeries.DrawValue(ValueIndex: Integer);
begin
  if Shapes.Count>ValueIndex then
     Shapes[ValueIndex].Draw(ParentChart.Canvas,ValueIndex);
end;

Procedure TMapSeries.Delete(ValueIndex:Integer);
begin
  inherited;
  if Assigned(FShapes) then Shapes[ValueIndex].Free;
end;

Procedure TMapSeries.Delete(Start,Quantity:Integer; RemoveGap:Boolean=False);
begin
  inherited;
  if Assigned(FShapes) then FShapes.Delete(Start,Quantity);
end;

function TMapSeries.MaxXValue: Double;
var t : Integer;
begin
  if Shapes.Count=0 then result:=0
  else
  begin
    result:=Shapes[0].FPoints.MaxXValue;
    for t:=1 to Shapes.Count-1 do
      result:=Math.Max(result,Shapes[t].FPoints.MaxXValue);
  end;
end;

function TMapSeries.MaxYValue: Double;
var t : Integer;
begin
  if Shapes.Count=0 then result:=0
  else
  begin
    result:=Shapes[0].FPoints.MaxYValue;
    for t:=1 to Shapes.Count-1 do
      result:=Math.Max(result,Shapes[t].FPoints.MaxYValue);
  end;
end;

function TMapSeries.MinXValue: Double;
var t : Integer;
begin
  if Shapes.Count=0 then result:=0
  else
  begin
    result:=Shapes[0].FPoints.MinXValue;
    for t:=1 to Shapes.Count-1 do
      result:=Math.Min(result,Shapes[t].FPoints.MinXValue);
  end;
end;

function TMapSeries.MinYValue: Double;
var t : Integer;
begin
  if Shapes.Count=0 then result:=0
  else
  begin
    result:=Shapes[0].FPoints.MinYValue;
    for t:=1 to Shapes.Count-1 do
      result:=Math.Min(result,Shapes[t].FPoints.MinYValue);
  end;
end;

procedure TMapSeries.PrepareForGallery(IsEnabled:Boolean);
var t : Integer;
begin
  inherited;
  if not IsEnabled then
     for t:=0 to Count-1 do Shapes[t].Color:=clSilver;
end;

procedure TMapSeries.SwapValueIndex(a,b:Integer);
begin
  inherited;
  Shapes[a].Index:=b;
  Repaint;
end;

procedure TMapSeries.SetShapes(const Value: TTeePolygonList);
begin
  FShapes.Assign(Value);
end;

procedure TMapSeries.CalcHorizMargins(var LeftMargin,
  RightMargin: Integer);
begin
  inherited;
  if Pen.Visible then
  begin
    Inc(LeftMargin,Pen.Width);
    Inc(RightMargin,Pen.Width);
  end;
end;

procedure TMapSeries.CalcVerticalMargins(var TopMargin,
  BottomMargin: Integer);
begin
  inherited;
  Inc(BottomMargin);
  if Pen.Visible then
  begin
    Inc(TopMargin,Pen.Width);
    Inc(BottomMargin,Pen.Width);
  end;
end;

Function TMapSeries.NumSampleValues;
begin
  result:=12;
end;

procedure TMapSeries.AddSampleValues(NumValues: Integer; OnlyMandatory:Boolean=False);

  Procedure AddShape(Const X,Y:Array of Integer; Const AText:String);
  var t : Integer;
      tmpX : Integer;
      tmpY : Integer;
  begin
    if Count>NumSampleValues then
    begin
      tmpX:=RandomValue(NumSampleValues);
      tmpY:=RandomValue(NumSampleValues);
    end
    else
    begin
      tmpX:=0;
      tmpY:=0;
    end;

    With Shapes.Add do
    begin
      for t:=Low(X) to High(X) do
          AddXY(tmpX+X[t],tmpY+Y[t]);
//      Color:=AColor;  7.0 removed
      Text:=AText;
      Z:=RandomValue(1000)/1000.0;
    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:=0 to Shapes.Count-1 do
    begin
      tmpShape:=Shapes[t];

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

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

        if PointInPolygon(TeePoint(tmpX,tmpY),tmpShape.GetPoints) then
        begin
          result:=t;
          break;
        end;
      end;
    end;
  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) 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.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;

begin
  if ParentChart.View3D then DrawAllSorted
                        else inherited;
end;

{ TPolygonSeries }
procedure TPolygonSeries.NotifyValue(ValueEvent: TValueEvent;
  ValueIndex: Integer);
begin
  inherited;
  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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -