如何计算Firemonkey中TBitmap的主色?

时间:2019-07-04 14:58:52

标签: delphi firemonkey delphi-10.3-rio

在Firemonkey中是否可以快速计算位图中的主色(最常见的颜色)?

或者在FMX中有一个选项可以减少使用调色板时的颜色数量,例如就像在Vcl.Imaging.GIFImg中一样?

1 个答案:

答案 0 :(得分:0)

我已经实现了自己的解决方案,该解决方案并未针对计算快速结果进行优化。

function GetDominanteColor(Bmp: TBitmap): TAlphaColor;
var
  BMPData: TBitmapData;
  x, y: integer;
  Col: TAlphaColor;
  Count: cardinal;
  Histogram: TDictionary<TAlphaColor, cardinal>;
begin
  result := TAlphaColors.Null;
  if Bmp.Width * Bmp.Height > 0 then
    if Bmp.Map(TMapAccess.Read, BMPData) then
    begin
      Histogram := TDictionary<TAlphaColor, cardinal>.Create;
      try
        // build histogram
        for x := 0 to Bmp.Width - 1 do
          for y := 0 to Bmp.Height - 1 do
          begin
            Col := BMPData.GetPixel(x, y);
            if Histogram.TryGetValue(Col, Count) then
              Histogram.Items[Col] := Count + 1
            else
              Histogram.Add(Col, 1);
          end;
        // search color with highest score
        Count := 0;
        for Col in Histogram.Keys do
        begin
          if Histogram.Items[Col] > Count then
          begin
            Count := Histogram.Items[Col];
            result := Col;
          end;
        end;
        {$IFDEF DEBUG}
        FMX.Types.Log.d('Dominante color %s from %d colors',
          [IntToHex(result, 8), x]);
        {$ENDIF}
      finally
        Histogram.Free;
      end;
      BMP.Unmap(BMPData);
    end;
end;

在旧的CPU(i5-3360@2.8GHz)上,此功能最多需要200毫秒才能获得完整的高清图像。加速可能是限制色彩空间,或者不是使用每个像素而是使用一组代表性的像素。