Delphi World - Функция возвращает колличество уникальных цветов Bitmap
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Функция возвращает колличество уникальных цветов Bitmap

Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Функция возвращает колличество уникальных цветов Bitmap

Зависимости: Graphics
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Собственное написание (Николай федоровских)
Дата:        1 июня 2002 г.
***************************************************** }

function HowManyColors(Bitmap: TBitmap): Integer;
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;

var
  i: Byte;
  x, y: Integer;
  Dest: pRGB;
  RGBArray: array[0..255, 0..255] of array of Byte;
begin
  Bitmap.PixelFormat := pf24Bit;
  Result := 0;
  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with Dest^ do
        if RGBArray[r, g] <> nil then
          for i := 0 to High(RGBArray[r, g]) do
          begin
            //если такой цвет уже есть, то выходим из цыкла
            if RGBArray[r, g][i] = b then
              Break;
            //если это последний круг цикла, то такого цвета нет
            if i = High(RGBArray[r, g]) then
            begin
              Inc(Result); //прибавляем один цвет
              SetLength(RGBArray[r, g], Length(RGBArray[r, g]) + 1);
              RGBArray[r, g][High(RGBArray[r, g])] := b;
            end;
          end
        else
        begin
          Inc(Result);
          SetLength(RGBArray[r, g], 1);
          RGBArray[r, g][0] := b;
        end;
      Inc(Dest);
    end;
  end;
end;

Пример использования:

procedure TForm1.MMHowManyColorsClick(Sender: TObject);
var
  str: string;
begin
  Screen.Cursor := crHourGlass;
  try
    str := Format('Изображение содержит %d цветов.', [HowManyColors(FBitmap)]);
  finally
    Screen.Cursor := crDefault;
  end;
  Application.MessageBox(PChar(str), PChar(Application.Title), MB_OK);
end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования