📄 teemapseries.pas
字号:
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 + -