Gauge in Firemonkey

[CHackbart]

Hi,

ich habe mit einer eigenen Komponente ein Problem welches ich nicht reproduzieren kann. Für SES Astra entwickle ich derzeit ein Tool zur Auswertung von Sat>IP Signalen. Schwerpunkt ist dabei Android als Platform. Für die Anzeige der Signal und Qualität habe ich eine einfache Gauge erstellt die jedoch ein enormer Performancekiller ist. Genauer gesagt schluckt die 7-Segment Anzeige mit ihrer Fillpolygon Routine und der Teil der die Kalibrierung zeichnet die meiste Last. Da laut Anforderung die Werte alle 200ms aktualisiert werden müssen und auch gerne schwanken muss ich die Anzeige recht oft neu zeichnen. Meine Versuche das in eine Bitmap zu rendern funktionierten nur mit meinem Testsystem. Mit einem echten Server schwanken die Werte mindestens 2x die Sekunde so das das Rendern in eine Textur noch langsamer ist.
Ein weiteres Problem ist das die gradienten nicht korrekt gerendert werden auf einigen Androiden. Da wird scheinbar alles rot und nicht mit dem angegebenen Farbverlauf gezeichnet.

Ich habe mal schnell ein Beispielprojekt (nur die optische Karkasse und die Gaugeklasse) an den Post gehängt. Vielleicht weiß ja jemand wie man das beschleunigen kann? Ohne die Gauge geht es eigentlich recht gut mit Firemonkey. Mit hakelt es extrem, insbesondere bei Geräten die eine hohe Auflösung besitzen.

Delphi-Quellcode:

unit UGauge;

interface

uses System.Types, System.Classes, System.UITypes,
  FMX.Types, FMX.Graphics, FMX.Controls;

type
  TGauge = class(TControl)
  protected
    FFlatMode: Boolean;
    FBackColor: TAlphaColor;
    FDialColor: TAlphaColor;
    FForeColor: TAlphaColor;

    FGlossAlpha: Byte;

    FCurrentValue: Single;
    FThreshHold: Single;
    FCaptureThresh: Boolean;
    FMaxValue: Single;
    FMinValue: Single;

    FToAngle: Single;
    FFromAngle: Single;

    FNoOfDivisions: integer;
    FNoOfSubDivisions: integer;

    FGaugeName: String;

    procedure DrawDigit(const Canvas: TCanvas; const number: integer;
      const position: TPointF; const dp: Boolean; const height: Single);

    procedure DisplayNumber(const Canvas: TCanvas;
      const X, Y, Width, height: Single; const number: Single);
    procedure DrawBackground(const Canvas: TCanvas; const Width: Single;
      const Center: TPointF);
    procedure DrawCenterPoint(const Canvas: TCanvas; const Width: Single;
      const Center: TPointF);
    procedure DrawCallibration(const Canvas: TCanvas; const Width: Single;
      const Center: TPointF);
    procedure DrawPointer(const Canvas: TCanvas; const Width: Single;
      const Center: TPointF; const Thresh: Boolean = false);
    procedure DrawGloss(const Canvas: TCanvas; const Width: Single;
      const Center: TPointF);

    procedure SetCurrentValue(const Value: Single);
    procedure Paint; override;
    procedure SetFlatMode(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ResetThreshold;

    property BackColor: TAlphaColor read FBackColor write FBackColor;
    property ForeColor: TAlphaColor read FForeColor write FForeColor;
    property DialColor: TAlphaColor read FDialColor write FDialColor;
    property GlossAlpha: Byte read FGlossAlpha write FGlossAlpha;
    property CurrentValue: Single read FCurrentValue write SetCurrentValue;
    property MaxValue: Single read FMaxValue write FMaxValue;
    property MinValue: Single read FMinValue write FMinValue;
    property ToAngle: Single read FToAngle write FToAngle;
    property FromAngle: Single read FFromAngle write FFromAngle;
    property noOfDivisions: integer read FNoOfDivisions write FNoOfDivisions;
    property noOfSubDivisions: integer read FNoOfSubDivisions
      write FNoOfSubDivisions;
    property GaugeName: String read FGaugeName write FGaugeName;
    property CaptureThresh: Boolean read FCaptureThresh write FCaptureThresh;
    property FlatMode: Boolean read FFlatMode write SetFlatMode default false;
  published
    property Align;
    property Anchors;
    property ClipChildren default false;
    property ClipParent default false;
    property DesignVisible default True;
    property Enabled default True;
    property Locked default false;
    property height;
    property HitTest default True;
    property Padding;
    property Opacity;
    property Margins;
    property PopupMenu;
    property position;
    property RotationAngle;
    property RotationCenter;
    property Scale;
    property Visible default True;
    property Width;
    { Mouse events }
    property OnClick;
    property OnDblClick;

    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseEnter;
    property OnMouseLeave;

    property OnPainting;
    property OnPaint;
    property OnResize;
  end;

implementation

uses System.SysUtils, System.Character, FMX.Platform;

{ TGauge }
constructor TGauge.Create{$IFDEF COMPONENT}(AOwner: TComponent){$ENDIF};
begin
  inherited;
{$IFDEF ANDROID}
  FFlatMode := True;
{$ENDIF}
  FBackColor := $FF000080;
  FDialColor := $FFE6E6FA;
  FForeColor := $FF000000;

  MaxValue := 100;
  MinValue := 0;
  CurrentValue := 0;

  FromAngle := 135;
  ToAngle := 405;

  noOfDivisions := 10;
  noOfSubDivisions := 3;
  FGaugeName := '';

  GlossAlpha := 200;
end;

destructor TGauge.Destroy;
begin
  inherited;
end;

procedure TGauge.DrawCallibration(const Canvas: TCanvas; const Width: Single;
  const Center: TPointF);
var
  currentAngle: Single;
  gap: integer;
  X, Y, x1, y1, tx, ty, radius: Single;
  rulerValue, incr, totalAngle: Single;
  i, j: integer;
begin
  gap := trunc(Width * 0.01);
  radius := Width / 2 - gap * 5;

  currentAngle := FromAngle * PI / 180;
  totalAngle := ToAngle - FromAngle;

  incr := totalAngle / (noOfDivisions * noOfSubDivisions) * PI / 180;
  rulerValue := MinValue;

  Canvas.stroke.Kind := TBrushKind.bkSolid;
  Canvas.stroke.Color := $FF000000;

  Canvas.Fill.Color := $FF000000 or (FForeColor and $FFFFFF);
  Canvas.Font.Size := Width / 24;

  for i := 0 to noOfDivisions do
  begin
    // Draw Thick Line
    X := (Center.X + radius * Cos(currentAngle));
    Y := (Center.Y + radius * Sin(currentAngle));
    x1 := (Center.X + (radius - Width / 20) * Cos(currentAngle));
    y1 := (Center.Y + (radius - Width / 20) * Sin(currentAngle));
    Canvas.DrawLine(PointF(X, Y), PointF(x1, y1), 1);

    // Draw Strings
    tx := (Center.X + (radius - Width / 10) * Cos(currentAngle));
    ty := (Center.Y - Width / 25 + (radius - Width / 10) * Sin(currentAngle));

    Canvas.FillText(RectF(tx, ty, tx + 1024, ty + 1024), floattostr(rulerValue),
      false, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);

    rulerValue := rulerValue + round((MaxValue - MinValue) / noOfDivisions);

    if i < noOfDivisions then
      for j := 0 to noOfSubDivisions - 1 do
      begin
                    // Draw thin lines
        currentAngle := currentAngle + incr;
        X := (Center.X + radius * Cos(currentAngle));
        Y := (Center.Y + radius * Sin(currentAngle));
        x1 := (Center.X + (radius - Width / 50) * Cos(currentAngle));
        y1 := (Center.Y + (radius - Width / 50) * Sin(currentAngle));
        Canvas.DrawLine(PointF(X, Y), PointF(x1, y1), 1);
      end;
  end;
end;

procedure TGauge.DrawPointer(const Canvas: TCanvas; const Width: Single;
  const Center: TPointF; const Thresh: Boolean = false);
var
  radius: Single;
  val: Single;
  angle: Single;
  pts: TPolygon;
  Value, w, len: Single;

begin
  radius := Width / 2 - (Width * 0.12);
  val := MaxValue - MinValue;

  if Thresh then
  begin
    w := 6;
    Value := FThreshHold;
    len := 0.09;
  end
  else
  begin
    w := 20;
    Value := CurrentValue;
    len := 0.09;
  end;

  val := (100 * (Value - MinValue)) / val;
  val := ((ToAngle - FromAngle) * val) / 100;
  val := val + FromAngle;

  angle := val * PI / 180;

  setlength(pts, 5);
  pts[0].X := (Center.X + radius * Cos(angle));
  pts[0].Y := (Center.Y + radius * Sin(angle));

  pts[4].X := (Center.X + radius * Cos(angle - 0.02));
  pts[4].Y := (Center.Y + radius * Sin(angle - 0.02));

  angle := (val + w) * PI / 180;
  pts[1].X := (Center.X + (Width * len) * Cos(angle));
  pts[1].Y := (Center.Y + (Width * len) * Sin(angle));

  pts[2].X := Center.X;
  pts[2].Y := Center.Y;

  angle := (val - w) * PI / 180;
  pts[3].X := (Center.X + (Width * len) * Cos(angle));
  pts[3].Y := (Center.Y + (Width * len) * Sin(angle));

  if Thresh then
    Canvas.Fill.Color := $FFFF0000
  else
    Canvas.Fill.Color := $FF000000;
  Canvas.FillPolygon(pts, 1);

  if Thresh then
    exit;

  setlength(pts, 3);
  angle := val * PI / 180;
  pts[0].X := (Center.X + radius * Cos(angle));
  pts[0].Y := (Center.Y + radius * Sin(angle));

  angle := (val + w) * PI / 180;
  pts[1].X := (Center.X + (Width * len) * Cos(angle));
  pts[1].Y := (Center.Y + (Width * len) * Sin(angle));

  pts[2].X := Center.X;
  pts[2].Y := Center.Y;

  if FFlatMode then
  begin
    Canvas.Fill.Color := $FF808080;
    Canvas.FillPolygon(pts, 2);
  end
  else
  begin
    Canvas.Fill.Kind := TBrushKind.bkGradient;
    try
      Canvas.Fill.Gradient.Color := $FF808080;
      Canvas.Fill.Gradient.Color1 := $0F000000;
      Canvas.FillPolygon(pts, 1);
    finally
      Canvas.Fill.Kind := TBrushKind.bkSolid;
    end;
  end;
end;

procedure TGauge.DrawGloss(const Canvas: TCanvas; const Width: Single;
  const Center: TPointF);
var
  R: TRectF;
  X, Y: Single;
begin
  R := RectF(Center.X - Width / 2, Center.Y - Width / 2, Center.X + Width / 2,
    Center.Y + Width / 2);
  if not FFlatMode then
    Canvas.Fill.Kind := TBrushKind.bkGradient;

  try
    if not FFlatMode then
    begin
      Canvas.Fill.Gradient.Color := (GlossAlpha and $FF) shl 24 or $FFFFFF;
      Canvas.Fill.Gradient.Color1 := $00FFFFFF;
    end
    else
      Canvas.Fill.Color := $20303030;

    X := R.Left + (Width * 0.10);
    Y := R.Top + (Width * 0.07);
    Canvas.FillEllipse(RectF(X, Y, X + (Width * 0.80), Y + (Width * 0.7)), 1);
    Canvas.Fill.Color := ((GlossAlpha div 3) and $FF) shl 24 or
      (FBackColor and $FFFFFF);

    if not FFlatMode then
    begin
      Canvas.Fill.Gradient.Color := $00FFFFFF;
      Canvas.Fill.Gradient.Color1 := Canvas.Fill.Color;
    end;

    X := R.Left + Width * 0.25;
    Y := R.Top + Width * 0.77;
    Canvas.FillEllipse(RectF(X, Y, X + Width * 0.5, Y + Width * 0.2), 1);
  finally
    Canvas.Fill.Kind := TBrushKind.bkSolid;
  end;
end;

procedure TGauge.DrawCenterPoint(const Canvas: TCanvas; const Width: Single;
  const Center: TPointF);
var
  R: TRectF;
  shift: Single;
begin
  shift := Width / 5;
  R := RectF(Center.X - (shift / 2), Center.Y - (shift / 2),
    Center.X + (shift / 2), Center.Y + (shift / 2));

  if not FFlatMode then
    Canvas.Fill.Kind := TBrushKind.bkGradient;

  try
    Canvas.Fill.Color := 100 shl 24 or (FDialColor and $FFFFFF);
    if not FFlatMode then
    begin
      Canvas.Fill.Gradient.Color := $FF000000;
      Canvas.Fill.Gradient.Color1 := Canvas.Fill.Color;
    end;
    Canvas.FillEllipse(R, 1);

    shift := Width / 7;
    R := RectF(Center.X - (shift / 2), Center.Y - (shift / 2),
      Center.X + (shift / 2), Center.Y + (shift / 2));

    if FFlatMode then
      Canvas.Fill.Color := $FF808080
    else
    begin
      Canvas.Fill.Gradient.Color := $FF808080;
      Canvas.Fill.Gradient.Color1 := $FF000000;
    end;

    Canvas.FillEllipse(R, 1);
  finally
    Canvas.Fill.Kind := TBrushKind.bkSolid;
  end;
end;

procedure TGauge.DrawBackground(const Canvas: TCanvas; const Width: Single;
  const Center: TPointF);
var
  R: TRectF;
  X, Y: Single;
begin
  R := RectF(Center.X - (Width / 2), Center.Y - (Width / 2),
    Center.X + (Width / 2), Center.Y + (Width / 2));
  Canvas.Fill.Color := 120 shl 24 or (FDialColor and $FFFFFF);
  Canvas.FillEllipse(R, 1);

  // Draw Rim
  Canvas.stroke.Kind := TBrushKind.bkSolid;
  Canvas.stroke.Color := $64808080;
  Canvas.DrawEllipse(R, 1);

  Canvas.stroke.Color := $FF808080;
  Canvas.DrawEllipse(R, 1);

  Canvas.Fill.Color := $FF000000 or (FForeColor and $FFFFFF);
//  Canvas.Font.Size := Width / 18;

  Canvas.FillText(RectF(0, Center.Y + (Width / 4.5), Width, Height), FGaugeName, false, 1,
    [], TTextAlign.taCenter, TTextAlign.taLeading);

  DrawCallibration(Canvas, Width, Center);

  X := Center.X - Width / 4.8;
  Y := Center.Y + Width / 3.2;

  DisplayNumber(Canvas, X, Y, Width, Width / 8, CurrentValue);
end;

procedure TGauge.DisplayNumber(const Canvas: TCanvas;
  const X, Y, Width, height: Single; const number: Single);
var
  num: string;
  shift: Single;
  drawDPS: Boolean;
  c: char;
  i: integer;
begin
  num := formatfloat('000.0', number);

  shift := 0;
  if (number < 0) then
    shift := shift - Width / 17;

  for i := low(num) to high(num) do
  begin
    c := num[i];
    drawDPS := (i < high(num)) and (num[i + 1].IsInArray([',', '.']));

    if (c <> '.') and (c <> ',') then
    begin
      if (c = '-') then
        DrawDigit(Canvas, -1, PointF(X + shift, Y), drawDPS, height)
      else
        DrawDigit(Canvas, StrToInt(c), PointF(X + shift, Y), drawDPS, height);
      shift := shift + 24 * Width / 250;
    end
    else
      shift := shift + 8 * Width / 250;
  end;
end;

procedure TGauge.DrawDigit(const Canvas: TCanvas; const number: integer;
  const position: TPointF; const dp: Boolean; const height: Single);
var
  Width: Single;
  outline, fillpen: Cardinal;
  Segment: TPolygon;

  function GetX(const X, Width: Single): Single; inline;
  begin
    result := X * Width / 12;
  end;

  function GetY(const Y, height: Single): Single; inline;
  begin
    result := Y * height / 15;
  end;

  function IsNumberAvailable(const number: integer;
    const list: array of integer): Boolean;
  var
    i: integer;
  begin
    result := false;
    for i := low(list) to high(list) do
      if (number = list[i]) then
      begin
        result := True;
        exit;
      end;
  end;

begin
  Width := 10 * height / 13;

  outline := 40 shl 24 or (FDialColor and $FFFFFF);
  fillpen := $FF000000;

  Canvas.Fill.Color := outline;

            // Segment A
  setlength(Segment, 5);
  Segment[0] := PointF(position.X + GetX(2.8, Width),
    position.Y + GetY(1, height));
  Segment[1] := PointF(position.X + GetX(10, Width),
    position.Y + GetY(1, height));
  Segment[2] := PointF(position.X + GetX(8.8, Width),
    position.Y + GetY(2, height));
  Segment[3] := PointF(position.X + GetX(3.8, Width),
    position.Y + GetY(2, height));
  Segment[4] := Segment[0];

  if (IsNumberAvailable(number, [0, 2, 3, 5, 6, 7, 8, 9])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;
  Canvas.FillPolygon(Segment, 1);

// Segment B
  Segment[0] := PointF(position.X + GetX(10, Width),
    position.Y + GetY(1.4, height));
  Segment[1] := PointF(position.X + GetX(9.3, Width),
    position.Y + GetY(6.8, height));
  Segment[2] := PointF(position.X + GetX(8.4, Width),
    position.Y + GetY(6.4, height));
  Segment[3] := PointF(position.X + GetX(9, Width),
    position.Y + GetY(2.2, height));
  Segment[4] := Segment[0];
  if (IsNumberAvailable(number, [0, 1, 2, 3, 4, 7, 8, 9])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;
  Canvas.FillPolygon(Segment, 1);

            // Segment C
  Segment[0] := PointF(position.X + GetX(9.2, Width),
    position.Y + GetY(7.2, height));
  Segment[1] := PointF(position.X + GetX(8.7, Width),
    position.Y + GetY(12.7, height));
  Segment[2] := PointF(position.X + GetX(7.6, Width),
    position.Y + GetY(11.9, height));
  Segment[3] := PointF(position.X + GetX(8.2, Width),
    position.Y + GetY(7.7, height));
  Segment[4] := Segment[0];

  if (IsNumberAvailable(number, [0, 1, 3, 4, 5, 6, 7, 8, 9])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;

  Canvas.FillPolygon(Segment, 1);

            // Segment D
  Segment[0] := PointF(position.X + GetX(7.4, Width),
    position.Y + GetY(12.1, height));
  Segment[1] := PointF(position.X + GetX(8.4, Width),
    position.Y + GetY(13, height));
  Segment[2] := PointF(position.X + GetX(1.3, Width),
    position.Y + GetY(13, height));
  Segment[3] := PointF(position.X + GetX(2.2, Width),
    position.Y + GetY(12.1, height));
  Segment[4] := Segment[0];

  if (IsNumberAvailable(number, [0, 2, 3, 5, 6, 8, 9])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;

  Canvas.FillPolygon(Segment, 1);

            // Segment E
  Segment[0] := PointF(position.X + GetX(2.2, Width),
    position.Y + GetY(11.8, height));
  Segment[1] := PointF(position.X + GetX(1, Width),
    position.Y + GetY(12.7, height));
  Segment[2] := PointF(position.X + GetX(1.7, Width),
    position.Y + GetY(7.2, height));
  Segment[3] := PointF(position.X + GetX(2.8, Width),
    position.Y + GetY(7.7, height));
  Segment[4] := Segment[0];
  if (IsNumberAvailable(number, [0, 2, 6, 8])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;

  Canvas.FillPolygon(Segment, 1);

            // Segment F
  Segment[0] := PointF(position.X + GetX(3, Width),
    position.Y + GetY(6.4, height));
  Segment[1] := PointF(position.X + GetX(1.8, Width),
    position.Y + GetY(6.8, height));
  Segment[2] := PointF(position.X + GetX(2.6, Width),
    position.Y + GetY(1.3, height));
  Segment[3] := PointF(position.X + GetX(3.6, Width),
    position.Y + GetY(2.2, height));
  Segment[4] := Segment[0];
  if (IsNumberAvailable(number, [0, 4, 5, 6, 7, 8, 9])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;
  Canvas.FillPolygon(Segment, 1);

            // Segment G
  setlength(Segment, 7);
  Segment[0] := PointF(position.X + GetX(2, Width),
    position.Y + GetY(7, height));
  Segment[1] := PointF(position.X + GetX(3.1, Width),
    position.Y + GetY(6.5, height));
  Segment[2] := PointF(position.X + GetX(8.3, Width),
    position.Y + GetY(6.5, height));
  Segment[3] := PointF(position.X + GetX(9, Width),
    position.Y + GetY(7, height));
  Segment[4] := PointF(position.X + GetX(8.2, Width),
    position.Y + GetY(7.5, height));
  Segment[5] := PointF(position.X + GetX(2.9, Width),
    position.Y + GetY(7.5, height));
  Segment[6] := Segment[0];
  if (IsNumberAvailable(number, [2, 3, 4, 5, 6, 8, 9, -1])) then
    Canvas.Fill.Color := fillpen
  else
    Canvas.Fill.Color := outline;

  Canvas.FillPolygon(Segment, 1);

// Draw decimal point
  if dp then
  begin
    Canvas.Fill.Color := fillpen;
    Canvas.FillEllipse(RectF(position.X + GetX(10, Width), position.Y + GetY(12,
      height), position.X + GetX(10, Width) + Width / 7, position.Y + GetY(12,
      height) + Width / 7), 1);
  end;
end;

procedure TGauge.Paint;
var
  Center: TPointF;
  w: Single;
begin
  Center := PointF(Width / 2, height / 2);
  w := 0.95 * Width;

  DrawBackground(Canvas, w, Center);
  if FThreshHold >= FMinValue then
    DrawPointer(Canvas, w, Center, True);
  DrawPointer(Canvas, w, Center);
  DrawCenterPoint(Canvas, w, Center);
  DrawGloss(Canvas, w, Center);
end;

procedure TGauge.SetFlatMode(const Value: Boolean);
begin
  if FFlatMode <> Value then
  begin
    FFlatMode := Value;
//    Repaint;
  end;
end;

procedure TGauge.SetCurrentValue(const Value: Single);
begin
  if abs(FCurrentValue - Value) >= 0.1 then
  begin
    FCurrentValue := Value;
    if (CaptureThresh) and (FThreshHold < Value) then
      FThreshHold := Value;

//    Repaint;
  end;
end;

procedure TGauge.ResetThreshold;
begin
  CaptureThresh := false;
  FThreshHold := FMinValue - 1;
//  Repaint;
end;

end.

Christian
PS: Die Gaugeklasse ist Public Domain und kann sofern wer die braucht gerne ohne Angabe von Quellen verwendet werden.