AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Gauge in Firemonkey

Ein Thema von CHackbart · begonnen am 17. Apr 2014 · letzter Beitrag vom 17. Apr 2014
Antwort Antwort
CHackbart

Registriert seit: 22. Okt 2012
267 Beiträge
 
#1

Gauge in Firemonkey

  Alt 17. Apr 2014, 09:05
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.

zusammenfalten · markieren
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.
Angehängte Dateien
Dateityp: zip fmproblem.zip (11,0 KB, 12x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#2

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 09:20
Du musst Canvas-Änderungen mit BeginScene / EndScene einschließen. Und an dem Source selber läßt sich sicher noch einiges optimieren.
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#3

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 09:23
Ich würde dir empfehlen den Code erstmal zu "trocknen" (make it DRY).

Danach würde ich bestimmte Elemente, die immer wieder neu gezeichnet werden müssen, obwohl sich am Ergebnis nichts ändert, als Bitmap zwischenspeichern (Cache).

Dann zeichnest du nur noch diese Bitmaps auf den Ziel-Canvas, was erheblich schneller gehen sollte.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#4

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 09:32
Danach würde ich bestimmte Elemente, die immer wieder neu gezeichnet werden müssen, obwohl sich am Ergebnis nichts ändert, als Bitmap zwischenspeichern (Cache).

Dann zeichnest du nur noch diese Bitmaps auf den Ziel-Canvas, was erheblich schneller gehen sollte.
Das wird in Firemonkey - speziell für Android - ziemlich unangenehm da man den Bitmap-Cache in den verschiedenen Auflösungen vorhalten sollte, um eine optimale Darstelung zu erzielen. Aber generell hast Du natürlich (wie immer) Recht: Eine 7-Segment-Anzeige hat IMHO ja nur 1 grafisches Element (das Segment) das um 0° und 90° rotiert dargestellt werden kann. Im konkreten Fall käme noch der Dezimalpunkt dazu.

Sinnvoll wäre hier ein Array[0..9] of Byte wobei die gesetzten Bits die leuchtenden Segmente darstellen. Bei einer 7-Segment-Anzeige hätte man dort sogar noch Platz, ein Bit als den Dezimalpunkt zu kennzeichnen.
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
CHackbart

Registriert seit: 22. Okt 2012
267 Beiträge
 
#5

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 10:03
Ich hab die 7 Segmentanzeige durch ein Label ausgetauscht. Das ist zwar nicht so hübsch aber ich bin an einem Punkt da ist hübsch egal. Zwischenzeitig habe ich die TMS Komponente mal installiert und gegengetestet, aber die ist noch langsamer als meine Variante.

Du musst auch nicht zwangsläufig für jede Auflösung ein Bitmap vorhalten, es reicht wenn du dir den Skalierungsfaktor vom System holst und deine Zieltextur damit erstellst, also Width*Scale bzw. Height*Scale. Das hab ich wie gesagt auch schon gemacht, aber ist dennoch ziemlich langsam. Ich räume mal die Klasse auf und poste sie nachher erneut.
Beginscene und Endscene sollten prinzipiell nicht notwendig sein, sofern man alles in der Paint Routine zeichnet, da dies mindestens einmal vor und nach dem rendern von Firemonkey ausgeführt wird.

Christian
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 10:32
@Union

Ich hätte da eher an ein Konstrukt gedacht, was zu bestimmten Vorgaben ein Bitmap liefert, was dann gezeichnet wird. Wie das Konstrukt an das Bitmap kommt ist also egal.

Intern geht das Konstrukt her und sagt sich, oh, das hatte ich eben doch schon mal gepinselt, dann kann ich das doch einfach wieder abliefern (war ja schlau und habe es mir gemerkt),
oder pinselt es eben in ein Bitmap (merkt sich das) und liefert das Bitmap ab.

AFAIK ändert sich die Auflösung auf einem Gerät nicht. Die Orientierung ja, und wenn die relevant ist, dann gehört die mit zu den Vorgaben.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.880 Beiträge
 
Delphi 11 Alexandria
 
#7

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 10:41
Zum Thema Bitmap Caching
http://www.fmxexpress.com/speed-up-y...droid-and-ios/
Markus Kinzler
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#8

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 11:04
Eine kleinere Optimierung wäre vielleicht dies:
zusammenfalten · markieren
Delphi-Quellcode:
procedure TGauge.DrawDigit...
...
const
  // 01
  // 32 02
  // 64
  // 16 04
  // 08
  //
  Bitmasks : Array[0..9] of Byte =
    ( 63,
      6,
      91,
      79,
      102,
      109,
      124,
      7,
      127,
      103);
begin
  // Diese teuren Aufrufe ersetzen (weiter mit 2=2, 4=4 .. 64=64)
  // if (IsNumberAvailable(number, [0, 2, 3, 5, 6, 7, 8, 9])) then
  if Bitmasks[Number] and 1 = 1 then
end;
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
CHackbart

Registriert seit: 22. Okt 2012
267 Beiträge
 
#9

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 11:45
Ich habe das jetzt wie folgt abgeändert:

zusammenfalten · markieren
Delphi-Quellcode:
unit UGauge;

interface

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

type
  TGauge = class(TControl)
  protected
    FScale: single;
    FBitmap: TBitmap;
    FBackColor: TAlphaColor;
    FDialColor: TAlphaColor;
    FForeColor: TAlphaColor;
    FFlatMode: Boolean;
    FForceUpdate: Boolean;

    FGlossAlpha: Byte;

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

    FToAngle: single;
    FFromAngle: single;

    FNoOfDivisions: integer;
    FNoOfSubDivisions: integer;

    FGaugeName: String;

    procedure SetFlatMode(const Value: Boolean);

    procedure DrawBackground(const Canvas: TCanvas; const RealWidth, Width, Height: 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 Resize; override;

    procedure RenderBackground(const Width, Height: single);
  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;
  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 FMX.Platform;

{ TGauge }
constructor TGauge.Create(AOwner: TComponent);
var
  ScreenSvc: IFMXScreenService;
begin
  inherited;
  FBitmap := TBitmap.Create;
{$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;
  if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService,
    IInterface(ScreenSvc)) then
    FScale := ScreenSvc.GetScreenScale
  else
    FScale := 1;
  FForceUpdate := True;
end;

destructor TGauge.Destroy;
begin
  FreeAndNil(FBitmap);
  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),
      format('%0.0f', [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, 1);
  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
    Canvas.Fill.Color := (GlossAlpha div 4 and $FF) shl 24 or $FFFFFF;
    if not FFlatMode then
    begin
      Canvas.Fill.Gradient.Color := (GlossAlpha and $FF) shl 24 or $FFFFFF;
      Canvas.Fill.Gradient.Color1 := $00FFFFFF;
    end;

    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 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 := $80808080
    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 RealWidth, Width, Height: single; const Center: TPointF);
var
  R: TRectF;
  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), RealWidth, Height), FGaugeName,
    false, 1, [], TTextAlign.taCenter, TTextAlign.taLeading);

  DrawCallibration(Canvas, Width, Center);
end;

procedure TGauge.Resize;
begin
  inherited;
  FForceUpdate := True;
end;

procedure TGauge.RenderBackground(const Width, Height: single);
var
  Center: TPointF;
begin
  if not FForceUpdate then
    exit;
  FForceUpdate := false;

  FBitmap.Resize(trunc(Width * FScale), trunc(Height * FScale));

  Center := PointF(FBitmap.Width / 2, FBitmap.Height / 2);

  FBitmap.Clear(0);
  FBitmap.Canvas.BeginScene(nil);
  DrawBackground(FBitmap.Canvas, FBitmap.Width, 0.98*FBitmap.Width, FBitmap.Height, Center);
  FBitmap.Canvas.EndScene;
end;

procedure TGauge.SetFlatMode(const Value: Boolean);
begin
  if FFlatMode <> Value then
  begin
    FFlatMode := Value;
    FForceUpdate := True;
    repaint;
  end
end;

procedure TGauge.Paint;
var
  Center: TPointF;
  w, Y: single;
begin
  RenderBackground(Width, Height);

  if Canvas.BeginScene(nil) then
    try
      Center := PointF(Width / 2, Height / 2);

      Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height),
        RectF(0, 0, Width, Height), 1);

      Y := Center.Y + Height / 3.5;
      w := 0.98*Width;

      Canvas.Font.Size := Width / 10;
      Canvas.Fill.Color := $FF000000 or (FForeColor and $FFFFFF);
      Canvas.FillText(RectF(0, Y, Width, Height),
        format('%0.1f', [CurrentValue]), false, 1, [], TTextAlign.taCenter,
        TTextAlign.taLeading);

      if FThreshHold >= FMinValue then
        DrawPointer(Canvas, w, Center, True);

      DrawPointer(Canvas, w, Center);

      DrawCenterPoint(Canvas, w, Center);
      DrawGloss(Canvas, w, Center);

    finally
      Canvas.EndScene;
    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.
Das läuft jetzt etwas besser, aber in Summe ist es immer noch nicht wirklich performant.
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#10

AW: Gauge in Firemonkey

  Alt 17. Apr 2014, 11:52
Eventuell solltest Du lieber die generischen Routinen FillPath und DrawPath verwenden, dann muss Firemonkey Deine TPointF-Arrays nicht mehr umkopieren.
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
Antwort Antwort

« Vorheriges Thema | Nächstes Thema »

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:12 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz