Показать сообщение отдельно
  #2  
Старый 10.06.2012, 16:49
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию

Интересная задачка. Функция работает относительно быстро, я не оптимизировал. Проверял на рис(1920х1080) 2-3 сек гдето.
Код:
Function GetMaxColorBmp(B: TBitmap): TColor;
Const
 Pixels = MaxInt div SizeOf(TRGBTriple);
Type
 PRGBArray = ^TRGBArray;
 TRGBArray = Array[0..Pixels - 1] of TRGBTriple;
Var
 Line: PRGBArray;
 Mx, My: Array of Integer;
 i, j: Integer;
 Function GetMaxPovtor(M: Array of Integer): Integer;
 Var
  x, y, mi, mk, k: Integer;
 begin
  mi:= M[1]; mk:= 1; k:= 0;
  For x:= 0 To High(M) Do
   begin
    For y:= 0 To High(M) Do if M[x] = M[y] Then Inc(k);
    if ((mk = k) And (mi > M[x])) Or (mk < k) Then
     begin
      mi:= M[x];
      mk:= k;
     end;
    k:= 0;
   end;
  Result:= mi;
 end;
begin
 Result:= clWhite;
 B.PixelFormat:= pf24bit;
 SetLength(Mx, B.Width);
 SetLength(My, B.Height);
 For j:= 0 To B.Height - 1 Do
  begin
   Line:= B.ScanLine[j];
   For i:= 0 To B.Width - 1 Do
    begin
     Mx[i]:= Line[i].rgbtRed + (Line[i].rgbtGreen Shl 8) + (Line[i].rgbtBlue Shl 16);
    end;
   My[j]:= GetMaxPovtor(Mx);
  end;
 Result:= GetMaxPovtor(My);
end;
__________________
If end Then begin;
Ответить с цитированием