teenumericgauge.pas

BCB第三方组件

  with result.Shape do
  begin
    Font.Size:=FontSize;
    Font.Color:=FGauge.GetPaletteColor(FontColor);
    Color:=FGauge.GetPaletteColor(ShapeColor);
    // TextAlignment:=?
  end;
end;

procedure TNumericMarkers.Assign(Source: TNumericMarkers);
var t : Integer;
begin
  Clear;

  for t:=0 to Source.Count-1 do
      Add('').Assign(Source[t]);
end;

function TNumericMarkers.Get(Index: Integer): TNumericMarker;
begin
  result:=TNumericMarker(inherited Get(Index));
end;

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

type
  TChartSeriesAccess=class(TChartSeries);

procedure TNumericMarkers.SetParentChart(const Value: TCustomTeePanel);
var t : Integer;
begin
  for t:=0 to Count-1 do
      Items[t].Shape.ParentChart:=Value;
end;

{ TFramedBorder }
Constructor TFramedBorder.Create(AOwner:TChartSeries);
begin
  inherited Create;
  FVisible:=True;
  FWidth:=10;

  IOwner:=AOwner;

  FShadow:=TTeeShadow.Create(TChartSeriesAccess(IOwner).CanvasChanged);

  FBrush:=TChartBrush.Create(TChartSeriesAccess(IOwner).CanvasChanged);
  FInner:=TChartBrush.Create(TChartSeriesAccess(IOwner).CanvasChanged);
  FMiddle:=TChartBrush.Create(TChartSeriesAccess(IOwner).CanvasChanged);
  FOuter:=TChartBrush.Create(TChartSeriesAccess(IOwner).CanvasChanged);

  GetPalette;
end;

Destructor TFramedBorder.Destroy;
begin
  FOuter.Free;
  FMiddle.Free;
  FInner.Free;
  FBrush.Free;
  FShadow.Free;
  inherited;
end;

procedure TFramedBorder.GetPalette;
begin
  FInner.BackColor:=TCustomGauge(IOwner).GetPaletteColor(2);
  FMiddle.BackColor:=TCustomGauge(IOwner).GetPaletteColor(1);
  FOuter.BackColor:=TCustomGauge(IOwner).GetPaletteColor(0);
end;

function TFramedBorder.CalcWidth(const R:TRect):Integer;
begin
  result:=Round(Width*Math.Min(R.Right-R.Left, R.Bottom-R.Top)*0.01);
end;

procedure TFramedBorder.Draw(R: TRect);
var
  tmp : TCanvas3D;

  procedure DrawBand(ABrush:TChartBrush);
  begin
    if ABrush.Style<>bsClear then
    begin
      tmp.AssignBrush(ABrush);

      if FCircled then
         tmp.Ellipse(R)
      else
         tmp.Rectangle(R);
    end;
  end;

var tmpWidth : Double;
begin
  tmp:=IOwner.ParentChart.Canvas;

  if Shadow.Visible and (Shadow.Size<>0) then
     if Circled then
        Shadow.DrawEllipse(tmp,R)
     else
        Shadow.Draw(tmp,R);

  tmp.Pen.Style:=psClear;

  DrawBand(FOuter);

  tmpWidth:=CalcWidth(R)*0.1;

  InflateRect(R, -Round(tmpWidth), -Round(tmpWidth));
  DrawBand(FMiddle);

  InflateRect(R, -Round(7*tmpWidth), -Round(7*tmpWidth));
  DrawBand(FInner);

  InflateRect(R, -Round(2*tmpWidth), -Round(2*tmpWidth));
  DrawBand(FBrush);
end;

function TFramedBorder.IsCircledStored:Boolean;
begin
  result:=Circled<>DefaultCircled;
end;

procedure TFramedBorder.SetCircled(const Value: Boolean);
begin
  if FCircled<>Value then
  begin
    FCircled:=Value;
    IOwner.Repaint;
  end;
end;

procedure TFramedBorder.SetInner(const Value: TChartBrush);
begin
  FInner.Assign(Value);
end;

procedure TFramedBorder.SetMiddle(const Value: TChartBrush);
begin
  FMiddle.Assign(Value);
end;

procedure TFramedBorder.SetOuter(const Value: TChartBrush);
begin
  FOuter.Assign(Value);
end;

procedure TFramedBorder.SetShadow(const Value: TTeeShadow);
begin
  FShadow.Assign(Value);
end;

procedure TFramedBorder.SetVisible(const Value: Boolean);
begin
  if FVisible<>Value then
  begin
    FVisible:=Value;
    IOwner.Repaint;
  end;
end;

procedure TFramedBorder.SetWidth(const Value: Integer);
begin
  if FWidth<>Value then
  begin
    FWidth:=Value;
    IOwner.Repaint;
  end;
end;

procedure TNumericGaugeEditor.CBPaletteChange(Sender: TObject);
var tmp : TChart;
begin
  case CBPalette.ItemIndex of
    1: Gauge.SetGaugePalette(LCDPalette);
    2: Gauge.SetGaugePalette(LEDPalette);
  else
    begin
      // TODO: Refactor to avoid tmp
      tmp:=TChart.Create(nil);
      try
        ColorPalettes.ApplyPalette(tmp,CBPalette.ItemIndex-3);
        Gauge.SetGaugePalette(tmp.ColorPalette);
      finally
        tmp.Free;
      end;
    end;
  end;

  Gauge.Repaint;
end;

procedure TNumericGaugeEditor.IncValue(Delta:Integer);
begin
  Gauge.Value:=Gauge.Value+Delta;
  EValue.Text:=FloatToStr(Gauge.Value);
  Gauge.Repaint;
end;

procedure TNumericGaugeEditor.RGFontClick(Sender: TObject);
begin
  (Gauge as TNumericGauge).DigitalFont:=TDigitalFont(RGFont.ItemIndex);
end;

procedure TNumericGaugeEditor.CBFrameVisibleClick(Sender: TObject);
begin
  Gauge.Frame.Visible:=CBFrameVisible.Checked;
end;

procedure TNumericGaugeEditor.EWidthChange(Sender: TObject);
begin
  if Showing then
     Gauge.Frame.Width:=UDWidth.Position;
end;

procedure TFramedBorder.Assign(Source: TPersistent);
begin
  if Source is TFramedBorder then
  with TFramedBorder(Source) do
  begin
    Self.FCircled:=FCircled;
    Self.InnerBrush:=FInner;
    Self.MiddleBrush:=FMiddle;
    Self.OuterBrush:=FOuter;
    Self.Shadow:=Shadow;
    Self.FVisible:=FVisible;
    Self.FWidth:=FWidth;
  end
  else
    inherited;
end;

procedure TNumericGaugeEditor.SpeedButton1Click(Sender: TObject);
begin
  IncValue(1);
end;

procedure TNumericGaugeEditor.SpeedButton2Click(Sender: TObject);
begin
  IncValue(-1);
end;

procedure TNumericGaugeEditor.EValueChange(Sender: TObject);
begin
  Gauge.Value:=StrToFloatDef(EValue.Text,Gauge.Value);
end;

{$IFNDEF CLR}
type
  TShadowAccess=class(TTeeShadow);
{$ENDIF}

{ TCustomGauge }

Constructor TCustomGauge.Create(AOwner: TComponent);
begin
  inherited;

  ShowInLegend:=False;
  CalcVisiblePoints:=False;

  FFrame:=TFramedBorder.Create(Self);

  FFace:=TTeeShape.Create(nil);

  with FFace.Gradient do
  begin
    Visible:=True;
    Direction:=gdBottomTop;
//    CenterXOffset := Round(INewRectangle.Width * 0.2);
//    CenterYOffset := Round(INewRectangle.Height * -0.2);
  end;

  FFace.Brush.Color:=clWhite;

  FFace.Shadow.Visible:=False;
  {$IFNDEF CLR}TShadowAccess{$ENDIF}(FFace.Shadow).DefaultVisible:=False;

  Add(100*Random);
end;

Destructor TCustomGauge.Destroy;
begin
  FreeAndNil(FFace);
  FreeAndNil(FFrame);
  inherited;
end;

procedure TCustomGauge.Assign(Source: TPersistent);
begin
  if Source is TCustomGauge then
  with TCustomGauge(Source) do
  begin
    Self.Face:=Face;
    Self.Frame:=Frame;
    Self.Value:=Value;
  end;

  inherited;
end;

procedure TCustomGauge.SetFrame(const Value: TFramedBorder);
begin
  FFrame.Assign(Value);
end;

procedure TCustomGauge.SetGaugePalette(const Palette:Array of TColor);
var t : Integer;
begin
  GaugeColorPalette:=nil;

  SetLength(GaugeColorPalette,High(Palette)+1);
  for t:=Low(Palette) to High(Palette) do
      GaugeColorPalette[t]:=Palette[t];

  FFace.Gradient.StartColor:=GetPaletteColor(3);
  FFace.Gradient.MidColor:=GetPaletteColor(4);
  FFace.Gradient.EndColor:=GetPaletteColor(5);

  if Assigned(FFrame) then
     Frame.GetPalette;
end;

function TCustomGauge.Clicked(x, y: Integer): Integer;
begin
  if PtInRect(IOrigRect,TeePoint(x,y)) then
     result:=0
  else
     result:=TeeNoPointClicked;
end;

Procedure TCustomGauge.SetParentChart(Const Value:TCustomAxisPanel);
begin
  inherited;

  if not (csDestroying in ComponentState) then
     Face.ParentChart:=ParentChart;
end;

procedure TCustomGauge.SetValue(const AValue: TChartValue);
begin
  if Count=0 then
  begin
    Add(AValue);

    if Assigned(FOnChange) then
       FOnChange(Self);
  end
  else
  if MandatoryValueList[0]<>AValue then
  begin
    MandatoryValueList[0]:=AValue;

    Repaint;

    if Assigned(FOnChange) then
       FOnChange(Self);
  end;
end;

function TCustomGauge.GetValue:TChartValue;
begin
  result:=MandatoryValueList[0];
end;

procedure TCustomGauge.SetFace(const Value: TTeeShape);
begin
  Face.Assign(Value);
end;

procedure TCustomGauge.DrawFace;
begin
  if Face.Pen.Visible then
  begin
    Dec(INewRect.Right,Face.Pen.Width);
    Dec(INewRect.Bottom,Face.Pen.Width);
  end;

  // Follow Frame "Circled" style:
  if Frame.Circled then
     ParentChart.Canvas.ClipEllipse(INewRect);

  Face.DrawRectRotated(ParentChart,INewRect);

  if Frame.Circled then
     ParentChart.Canvas.UnClipRectangle;
end;

procedure TCustomGauge.DrawAllValues;
var tmpR : TRect;

  procedure DrawFrame;
  begin
    if Frame.Visible then
       Frame.Draw(tmpR);
  end;

begin
  CalcOrigRect;

  tmpR:=IOrigRect;
  INewRect:=IOrigRect;

  SetValues;

//  tmpR:=IOrigRect;

  DrawFrame;
  DrawFace;
end;

procedure TCustomGauge.SetValues;
var tmp : Integer;
begin
  if Frame.Visible then
  begin
    tmp:=Frame.CalcWidth(INewRect);
    InflateRect(INewRect,-tmp,-tmp);
  end;
end;

initialization
  {$IFNDEF CLR}
  AddCustomFonts;
  {$ENDIF}
  
  RegisterTeeSeries(TNumericGauge, {$IFNDEF CLR}@{$ENDIF}TeeMsg_NumericGauge,
                                  {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryGauges,1);
  RegisterClasses([TNumericMarker,TNumericGaugeEditor]);
finalization
  RemoveCustomFonts;
  UnRegisterTeeSeries([TNumericGauge]);
end.