Firemonkey TBitmap einfärben

[Peter666]

Hi,

kennt jemand einen Schnellen Algorithmus, wie man eine Grafik mit einer anderen Farbe übermalt? Ich brauche nicht unbedingt ein Codeschnipsel. Eventuell gibt es da ja einen bekannten Algorithmus der das. Mein Ansatz: Bild in Schwarzweiß einfärben und dann die Farbe mit den ARGB Werten Multiplizieren und durch 2 teilen schaut fürchterlich aus.

Peter

[CHackbart]

Anbei mal meine Farbhelfer Routinen:

Delphi-Quellcode:

unit UColorhelper;

interface

uses FMX.Graphics, FMX.ImgList, FMX.MultiResBitmap;

type
  THueWeights = Array [0 .. 360] of Single;

  TColorHelper = class
  private
    class function calcHueWeights(const Data: TBitmapData): THueWeights;
    class function calcBestHSV(Data: TBitmapData; const bestHue: Integer;
      out bestH, bestS, bestV: Double): Boolean;
    class function calcBestHue(const hueWeights: THueWeights): Integer;
  public
    class procedure ColorToHSV(const Color: Cardinal; var H, S, V: Double);
    class function HSVToColor(H, S, V: Double): Cardinal;

    class procedure HSVtoRGB(const H, S, V: Double; var R, G, B: Double);
    class procedure RGBToHSV(const R, G, B: Double; VAR H, S, V: Double);

    class function CalcBestColor(const ABitmap: TBitmap): Cardinal;
    class function IsDarkColor(const Color: Cardinal): Boolean;
    class function AdjustOverlayColor(const Color: Cardinal;
      const DefaultColor: Cardinal = $FF7F7F7F): Cardinal;

    class function createBlurredImage(input: TBitmap; radius: Integer;
      blurResampleSize: Integer): TBitmap;
    class procedure FastBlur(Dst: TBitmap; radius: Integer;
      Passes: Integer = 3);
    class procedure Grayscale(ABitmap: TBitmap; AColor: Cardinal = 0); overload;
    class procedure Grayscale(AList: TImageList; ABitmap: String;
      AColor: Cardinal = 0); overload;
    class procedure Grayscale(AList: TImageList; ABitmaps: Array of String;
      AColor: Cardinal = 0); overload;
  end;

implementation

uses System.Math, System.UITypes, System.Types;

const
  BUCKET_SIZE = 5;
  GREY_THRESHOLD = 4.0E-4;
  INDEX_JUMP_SIZE = 23;
  WEIGHT_THRESHOLD = 0.1;

const
  VALUE_DAMPING_FACTOR = 0.8;

  // RGB, each 0 to 255, to HSV.
  // H = 0.0 to 360.0 (corresponding to 0..360.0 degrees around hexcone)
  // S = 0.0 (shade of gray) to 1.0 (pure color)
  // V = 0.0 (black) to 1.0 {white)

  // Based on C Code in "Computer Graphics -- Principles and Practice,"
  // Foley et al, 1996, p. 592.

class procedure TColorHelper.RGBToHSV(const R, G, B: Double;
  var H, S, V: Double);
var
  Delta: Double;
  Min: Double;
begin
  Min := MinValue([R, G, B]); // USES Math
  V := MaxValue([R, G, B]);

  Delta := V - Min;

  // Calculate saturation: saturation is 0 if r, g and b are all 0
  if V = 0.0 then
    S := 0
  else
    S := Delta / V;

  if S = 0.0 then
    H := NaN // Achromatic: When s = 0, h is undefined
  else
  begin // Chromatic
    if R = V then // between yellow and magenta [degrees]
      H := 60.0 * (G - B) / Delta
    else if G = V then // between cyan and yellow
      H := 120.0 + 60.0 * (B - R) / Delta
    else if B = V then // between magenta and cyan
      H := 240.0 + 60.0 * (R - G) / Delta;

    if H < 0.0 then
      H := H + 360.0
  end
end { RGBtoHSV };




// Based on C Code in "Computer Graphics -- Principles and Practice,"
// Foley et al, 1996, p. 593.
//
// H = 0.0 to 360.0 (corresponding to 0..360 degrees around hexcone)
// NaN (undefined) for S = 0
// S = 0.0 (shade of gray) to 1.0 (pure color)
// V = 0.0 (black) to 1.0 (white)

class procedure TColorHelper.HSVtoRGB(const H, S, V: Double;
  var R, G, B: Double);
var
  f: Double;
  i: Integer;
  hTemp: Double; // since H is CONST parameter
  p, q, t: Double;
begin
  if S = 0.0 // color is on black-and-white center line
  then
  begin
    if IsNaN(H) then
    begin
      R := V; // achromatic: shades of gray
      G := V;
      B := V
    end
    else
      exit;
  end

  else
  begin // chromatic color
    if H = 360.0 // 360 degrees same as 0 degrees
    then
      hTemp := 0.0
    else
      hTemp := H;

    hTemp := hTemp / 60; // h is now IN [0,6)
    i := TRUNC(hTemp); // largest integer <= h
    f := hTemp - i; // fractional part of h

    p := V * (1.0 - S);
    q := V * (1.0 - (S * f));
    t := V * (1.0 - (S * (1.0 - f)));

    CASE i OF
      0:
        begin
          R := V;
          G := t;
          B := p
        end;
      1:
        begin
          R := q;
          G := V;
          B := p
        end;
      2:
        begin
          R := p;
          G := V;
          B := t
        end;
      3:
        begin
          R := p;
          G := q;
          B := V
        end;
      4:
        begin
          R := t;
          G := p;
          B := V
        end;
      5:
        begin
          R := V;
          G := p;
          B := q
        end
    end
  end
end { HSVtoRGB };

function floorEven(const num: Integer): Integer; inline;
begin
  result := num and -2;
end;

function roundMult4(const num: Integer): Integer; inline;
begin
  result := (num + 2) and -4;
end;

function Fixed(S: Single): Cardinal; inline;
begin
  result := Round(S * 65536);
end;

class procedure TColorHelper.ColorToHSV(const Color: Cardinal;
  var H, S, V: Double);
begin
  RGBToHSV((Color shr 16) and $FF, (Color shr 8) and $FF,
    (Color and $FF), H, S, V);
end;

class function TColorHelper.HSVToColor(H, S, V: Double): Cardinal;
var
  R, G, B: Double;
begin
  HSVtoRGB(H, S, V, R, G, B);
  result := $FF000000 or TRUNC(R) shl 16 or TRUNC(G) shl 8 or TRUNC(B);
end;

class function TColorHelper.calcHueWeights(const Data: TBitmapData)
  : THueWeights;
var
  Hue, Saturation, Value: Double;
  product: Double;
  j, xp, yp: Integer;
begin
  xp := 0;
  yp := 0;
  fillchar(result, sizeof(result), 0);
  while (yp < Data.Height) do
  begin
    ColorToHSV(Data.GetPixel(xp, yp), Hue, Saturation, Value);
    if not IsNaN(Hue) then
    begin
      product := Saturation * Value;
      if (product >= WEIGHT_THRESHOLD) then
      begin
        j := Round(Hue);
        result[j] := result[j] + product;
      end;
    end;
    inc(xp, INDEX_JUMP_SIZE);
    if xp >= Data.Width then
    begin
      dec(xp, Data.Width);
      inc(yp);
    end;
  end;
end;

class function TColorHelper.calcBestHue(const hueWeights: THueWeights): Integer;
var
  i: Integer;
  total: Single;
  besttotal: Single;
  bestHue, hueCandidate: Integer;
begin
  total := 0;
  for i := 0 to BUCKET_SIZE - 1 do
    total := total + hueWeights[i];

  besttotal := total;
  bestHue := 2;
  for i := 1 to high(hueWeights) do
  begin
    total := (total + hueWeights[((i + BUCKET_SIZE) - 1) mod 360]) -
      hueWeights[i];
    hueCandidate := (i + 2) mod 360;
    if (total > besttotal) or (((abs(total - besttotal)) < 1.0E-6) and
      (hueWeights[hueCandidate] > hueWeights[bestHue])) then
    begin
      besttotal := total;
      bestHue := hueCandidate;
    end;
  end;
  result := bestHue;
end;

class function TColorHelper.calcBestHSV(Data: TBitmapData;
  const bestHue: Integer; out bestH, bestS, bestV: Double): Boolean;
var
  totalSaturation: Double;
  totalValue: Double;
  numCloseToHue: Integer;
  numConsidered: Integer;
  xp, yp: Integer;
  Hue, Saturation, Value: Double;
begin
  result := false;
  if Data.Width > 4096 then
    exit;

  totalSaturation := 0.0;
  totalValue := 0.0;
  numCloseToHue := 0;
  numConsidered := int64((Data.Width * Data.Height + INDEX_JUMP_SIZE) - 1)
    div INDEX_JUMP_SIZE;
  xp := 0;
  yp := 0;

  while yp < Data.Height do
  begin
    ColorToHSV(Data.GetPixel(xp, yp), Hue, Saturation, Value);

    if not IsNaN(Hue) and (abs(TRUNC((Hue - (bestHue)) + 2.0) mod 360) < 5.0)
      and (Saturation * Value >= WEIGHT_THRESHOLD) then
    begin
      totalSaturation := totalSaturation + Saturation;
      totalValue := totalValue + Value;
      inc(numCloseToHue);
    end;
    inc(xp, INDEX_JUMP_SIZE);
    if xp > Data.Width then
    begin
      dec(xp, Data.Width);
      inc(yp);
    end;
  end;

  if (numCloseToHue = 0) or (numConsidered = 0) then
  begin
    bestH := bestHue;
    bestS := 0.0;
    bestV := 0.0;
  end
  else
  begin
    bestH := bestHue;
    bestS := totalSaturation / numCloseToHue;
    bestV := totalValue / numCloseToHue;
    result := ((totalSaturation + totalValue) / numConsidered) >=
      GREY_THRESHOLD;
  end;
end;

class function TColorHelper.IsDarkColor(const Color: Cardinal): Boolean;
//Var H, S, V: Double;
var Col: TAlphaColorRec absolute Color;
begin
// ColorToHSV(Color, H, S, V);result := V < 220;
 result := (1-(0.299* Col.R + 0.587*Col.G + 0.114*Col.B)/255)>0.5;
end;

class function TColorHelper.CalcBestColor(const ABitmap: TBitmap): Cardinal;
var
  Data: TBitmapData;
  bestHue: Integer;
  Hue, Saturation, Value: Double;
  isColorfulEnough: Boolean;
begin
  result := 0;
  if not assigned(ABitmap) then
    exit;

  ABitmap.Map(TMapAccess.Read, Data);

  bestHue := calcBestHue(calcHueWeights(Data));

  isColorfulEnough := calcBestHSV(Data, bestHue, Hue, Saturation, Value);
  if isColorfulEnough then
    result := HSVToColor(Hue, Saturation, Value)
  else
    result := $FFFFFFFF;

  ABitmap.Unmap(Data);
end;

class procedure TColorHelper.FastBlur(Dst: TBitmap; radius: Integer;
  Passes: Integer = 3);
type
  PARGB32 = ^TARGB32;

  TARGB32 = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    a: Byte;
  end;

  TLine32 = array [0 .. MaxInt div sizeof(TARGB32) - 1] of TARGB32;
  PLine32 = ^TLine32;

  PSumRecord = ^TSumRecord;

  TSumRecord = packed record
    saB, sag, saR, saA: Cardinal;
  end;

var
  j, X, Y, w, H, ny, tx, ty: Integer;
  ptrD: Integer;
  s1: PLine32;
  C: TAlphaColor;
  sa: array of TSumRecord;
  sr1, sr2: TSumRecord;
  n: Cardinal;
  Data: TBitmapData;
begin
  if radius = 0 then
    exit;
  Dst.Map(TMapAccess.ReadWrite, Data);
  try
    n := Fixed(1 / ((radius * 2) + 1));
    w := Dst.Width - 1;
    H := Dst.Height - 1;

    SetLength(sa, w + 1 + (radius * 2));

    s1 := PLine32(Data.GetScanline(0));
    ptrD := Integer(Data.GetScanline(1)) - Integer(s1);

    ny := Integer(s1);
    for Y := 0 to H do
    begin
      for j := 1 to Passes do
      begin
        X := -radius;
        while X <= w + radius do
        begin
          tx := X;
          if tx < 0 then
            tx := 0
          else if tx >= w then
            tx := w;
          if X + radius - 1 < 0 then
            sr1 := sa[0]
          else
            sr1 := sa[X + radius - 1];
          C := PAlphaColor(ny + tx shl 2)^;
          with sa[X + radius] do
          begin
            saA := sr1.saA + C shr 24;
            saR := sr1.saR + C shr 16 and $FF;
            sag := sr1.sag + C shr 8 and $FF;
            saB := sr1.saB + C and $FF;
          end;
          inc(X);
        end;
        for X := 0 to w do
        begin
          tx := X + radius;
          sr1 := sa[tx + radius];
          if tx - 1 - radius < 0 then
            sr2 := sa[0]
          else
            sr2 := sa[tx - 1 - radius];
          PAlphaColor(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and
            $FF000000 or (sr1.saR - sr2.saR) * n and $FF0000 or
            (sr1.sag - sr2.sag) * n shr 8 and $FF00 or (sr1.saB - sr2.saB)
            * n shr 16;
        end;
      end;
      inc(ny, ptrD);
    end;

    SetLength(sa, H + 1 + (radius * 2));
    for X := 0 to w do
    begin
      for j := 1 to Passes do
      begin
        ny := Integer(s1);
        Y := -radius;
        while Y <= H + radius do
        begin
          if (Y > 0) and (Y < H) then
            inc(ny, ptrD);
          if Y + radius - 1 < 0 then
            sr1 := sa[0]
          else
            sr1 := sa[Y + radius - 1];
          C := PAlphaColor(ny + X shl 2)^;
          with sa[Y + radius] do
          begin
            saA := sr1.saA + C shr 24;
            saR := sr1.saR + C shr 16 and $FF;
            sag := sr1.sag + C shr 8 and $FF;
            saB := sr1.saB + C and $FF;
          end;
          inc(Y);
        end;
        ny := Integer(s1);
        for Y := 0 to H do
        begin
          ty := Y + radius;
          sr1 := sa[ty + radius];
          if ty - 1 - radius < 0 then
            sr2 := sa[0]
          else
            sr2 := sa[ty - 1 - radius];

          PAlphaColor(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and
            $FF000000 or (sr1.saR - sr2.saR) * n and $FF0000 or
            (sr1.sag - sr2.sag) * n shr 8 and $FF00 or (sr1.saB - sr2.saB)
            * n shr 16;
          inc(ny, ptrD);
        end;
      end;
    end;
    SetLength(sa, 0);
  finally
    Dst.Unmap(Data);
  end;
end;

class function TColorHelper.createBlurredImage(input: TBitmap; radius: Integer;
  blurResampleSize: Integer): TBitmap;
var
  mAspectRatio: Single;
  scaledHeight: Integer;
begin
  mAspectRatio := input.Width / input.Height;
  scaledHeight := max(2, floorEven(input.Height div blurResampleSize));
  result := TBitmap.Create
    (max(4, roundMult4(TRUNC((scaledHeight) * mAspectRatio))), scaledHeight);
  result.Canvas.BeginScene(nil);
  result.Canvas.DrawBitmap(input, rectf(0, 0, input.Width, input.Height),
    rectf(0, 0, result.Width, result.Height), 1);
  result.Canvas.EndScene;
  TColorHelper.FastBlur(result, radius);
end;

class function TColorHelper.AdjustOverlayColor(const Color: Cardinal;
  const DefaultColor: Cardinal = $FF7F7F7F): Cardinal;
var
  H, S, V, MinValue: Double;
begin
  if (Color = 0) then
    result := $FF7F7F7F
  else
  begin
    TColorHelper.ColorToHSV(DefaultColor, H, S, MinValue);

    TColorHelper.ColorToHSV(Color, H, S, V);
    V := V * VALUE_DAMPING_FACTOR;
    if (V < MinValue) then
      V := MinValue;
    result := TColorHelper.HSVToColor(H, S, V);
  end;
end;

class procedure TColorHelper.Grayscale(AList: TImageList; ABitmaps: Array of String;
  AColor: Cardinal = 0);
var i: integer;
begin
  for i := 0 to high(ABitmaps) do
     GrayScale(AList, ABitmaps[i], AColor);
end;

class procedure TColorHelper.Grayscale(AList: TImageList; ABitmap: String;
  AColor: Cardinal = 0);
var
  Size: TSize;
  Item: TCustomBitmapItem;
begin
  if not assigned(AList) then
    exit;
  Size := TSize.Create(0, 0);

  if AList.BitmapItemByName(ABitmap, Item, Size) then
    Grayscale(Item.Bitmap, AColor);
end;

class procedure TColorHelper.Grayscale(ABitmap: TBitmap; AColor: Cardinal = 0);
var
  X: Integer;
  Y: Integer;
  Gray: Byte;
  Data: TBitmapData;
  Pixel: PAlphaColorRec;
  Color: TAlphaColorRec absolute AColor;
  amount: Single;
begin
  amount := 0.5;

  Color.R := TRUNC(Color.R * amount);
  Color.G := TRUNC(Color.G * amount);
  Color.B := TRUNC(Color.B * amount);

  ABitmap.Map(TMapAccess.ReadWrite, Data);
  for Y := 0 to Data.Height - 1 do
  begin
    Pixel := Data.GetScanline(Y);
    for X := 0 to Data.Width - 1 do
    begin
      Gray := Round((0.299 * Pixel.R) + (0.587 * Pixel.G) + (0.114 * Pixel.B));
      if Pixel.a > 0 then
      begin
        if AColor = 0 then
        begin
          Pixel.R := Gray;
          Pixel.G := Gray;
          Pixel.B := Gray;
        end
        else
        begin
          Gray := TRUNC(Gray * (1 - amount));

{$IFDEF POSIX}
          Pixel.R := Color.B + Gray;
          Pixel.G := Color.G + Gray;
          Pixel.B := Color.R + Gray;
{$ELSE}
          Pixel.R := Color.R + Gray;
          Pixel.G := Color.G + Gray;
          Pixel.B := Color.B + Gray;
{$ENDIF}
        end;
      end;
      inc(Pixel);
    end;
  end;
  ABitmap.Unmap(Data);
end;


end.

Christian

[Medium]

Zitat:

Zitat von Peter666 (Beitrag 1458227)

Hi,

kennt jemand einen Schnellen Algorithmus, wie man eine Grafik mit einer anderen Farbe übermalt? Ich brauche nicht unbedingt ein Codeschnipsel. Eventuell gibt es da ja einen bekannten Algorithmus der das. Mein Ansatz: Bild in Schwarzweiß einfärben und dann die Farbe mit den ARGB Werten Multiplizieren und durch 2 teilen schaut fürchterlich aus.

Peter

Was genau möchtest du?

Mit einer anderen Farbe übermalen: Canvas.FillRect()
Oder wie beschrieben eine monochrome Version des Bildes so einfärben, dass 50% Grau einer Zielfarbe entspricht? Oder vielleicht eine Farbe transparent über das (farbige) Originalbild malen? Das sind 3 sehr unterschiedliche Dinge, und mir ist nicht ganz klar was davon dein konkretes Ziel ist.

[Peter666]

Ich will im Prinzip ein Farbiges Bild in ein schwarz weißes umwandeln und die Graustufe durch eine Basisfarbe ersetzen. Mein Plan ist die Bilder in den Styles einzufärben. Sprich aus einem blauen Hintergrund einen grünen machen usw.
Aktuell ziehe ich die Grafiken aus dem gewünschten Style, öffne einen Grafikeditor, passe die Farbe an und lade die Bilder wieder in den Style. Leider gibt es ja keinen sinnvollen Editor für Styles.

Peter

[stahli]

Falls Du bei den bisherigen (sicherlich viel besseren) Tipps nicht fündig wirst, kannst Du mal noch hier stöbern: https://www.delphipraxis.net/88775-f...eraendern.html

[himitsu]

Im FMX gibt es doch auch eine Komponente, die man in einer anderen Komponente (TImage) plazieren kann und die dann alles umfärbt.

Vergessen wie die hieß (bestimmt irgendwas mit Color), vor allem da die nicht wirklich gut funktionierte (oder ich war zu doof die richtig zu nutzen), als ich sie vorgestern zufällig ausversehn auf die Form pappte.


Nunja, genau eine bestimmte Farbe zu ersetzen ist einfach.
Aber z.B. bei Fotos eine "Farbe" zu ändern, wird etwas schwerer ... da braucht es dann erstmal einen guten Algorithmus, um "ähnliche" Farben zu erkennen und dann ein passendes Farbschema, mit dem man dann diese Farben in korrespondierende Farben umrechnet.

Aber da gibt es oft auch schon was mehr oder weniger gut arbeitendes Fertiges (siehe z.B. da oben), bis hin zu Cloud+KI-unterstützten Filtern so manch teurer Grafikprogramme.

[Medium]

Zitat:

Zitat von Peter666 (Beitrag 1458256)

Ich will im Prinzip ein Farbiges Bild in ein schwarz weißes umwandeln und die Graustufe durch eine Basisfarbe ersetzen. Mein Plan ist die Bilder in den Styles einzufärben. Sprich aus einem blauen Hintergrund einen grünen machen usw.
Aktuell ziehe ich die Grafiken aus dem gewünschten Style, öffne einen Grafikeditor, passe die Farbe an und lade die Bilder wieder in den Style. Leider gibt es ja keinen sinnvollen Editor für Styles.

Peter

In dem Fall ist dein ursprünglicher Ansatz doch gar nicht so falsch. Im Gegenteil. Ich würde ggf. lediglich einen Zwischenschritt über Gleitkommaarithmetik machen.
Illustriert: Ziel[x, y] := Round(((OriginalAlsSW[x, y]/255) * (Wunschfarbe/255)) * 255)

Das gleicht weitestgehend deinem Ansatz, nimmt aber eventuelle Rundungsfehler raus, die je nach Reihenfolge bzw. Klammerung sonst auftreten können. Warum findest du, dass dein Ansatz fürchterlich aussieht?

Vielleicht ist deine Umwandlung in SW auch ungeeignet. Reines (R+G+B) / (255*3) ist zwar streng genommen richtig, beachtet aber nicht die menschliche Helligkeitswahrnehmung der Farben. Daher wandelt man bei RGB->YCC (u.a. bei MPEG Codierung verwendet) den Y-Kanal (Luminanz) meist mit

Y = 0,299R + 0,587G + 0,114B

bzw. je nach Standard auch

Y = 0,2126R + 0,7152G + 0,0722B

um. Vielleicht hilft das ja schon ein wenig.

[Rollo62]

Schonmal das ausprobiert ?

[Luckie]

Zitat:

Zitat von Peter666 (Beitrag 1458256)

Ich will im Prinzip ein Farbiges Bild in ein schwarz weißes umwandeln und die Graustufe durch eine Basisfarbe ersetzen. Mein Plan ist die Bilder in den Styles einzufärben. Sprich aus einem blauen Hintergrund einen grünen machen usw.
Aktuell ziehe ich die Grafiken aus dem gewünschten Style, öffne einen Grafikeditor, passe die Farbe an und lade die Bilder wieder in den Style. Leider gibt es ja keinen sinnvollen Editor für Styles.

Peter

Nur zum Verständnis. (Ich kann jetzt nichts zur Lösung beitragen, das mal vorweg.) Du willst also so was wie das kontrastreiche Farbschema bei Windows machen, welches sich Nutzer mit einer Sehschwäche wählen können?

[HerbertErhardt]

Zitat:

Zitat von Peter666 (Beitrag 1458227)

Hi,

kennt jemand einen Schnellen Algorithmus, wie man eine Grafik mit einer anderen Farbe übermalt? Ich brauche nicht unbedingt ein Codeschnipsel. Eventuell gibt es da ja einen bekannten Algorithmus der das. Mein Ansatz: Bild in Schwarzweiß einfärben und dann die Farbe mit den ARGB Werten Multiplizieren und durch 2 teilen schaut fürchterlich aus.

Peter

Ich möchte die Grafikqualität eines Videospiels namens Age of Earth verbessern. Alle Ihnen bekannten Tipps sind hilfreich.