Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.06.24;
Скачать: [xml.tar.bz2];

Вниз

ScanLine?   Найти похожие ветки 

 
{RASkov} ©   (2007-06-02 15:31) [0]

Как можно быстрым способом получить средний цвет битмапа размером 100х100 пикселей
Нужена помощь с самим алгоритмом определения, со СканЛайн раньше никогда не работал, но думаю, что как раз с ним и нужно здесь...
Пояснение: Битмап имеет оттенки серого - нужно как бы сложить все цвета пикселей и разделить на их(пикселей) кол-во.. или как по другому?
Размер Битмапа тоже может меняться, указал средний...
Математика - это не мое, поэтому прошу помощи )


 
sergey_61   (2007-06-02 15:51) [1]

У меня есть мысли, но незнаю как реализовать.
В градациях серего, все 3 цвета имеют одинаковое значение(например: F1F1F1), может сделать проверку через яркость пикселя? или что то подобное.
Или выделить только один цвет...


 
DVM ©   (2007-06-02 15:55) [2]

Как то так:


function GetBitmapColor(Bmp: TBitmap): TColor;
const
 Pixels = MaxInt div SizeOf(TRGBTriple);
type
 PRGBArray = ^TRGBArray;
 TRGBArray = array[0..Pixels-1] of TRGBTriple;
var
 x, y: Integer;
 Row: PRGBArray;
 SumR: integer;
 SumG: integer;
 SumB: integer;
 Count: integer;
begin
 Bmp.PixelFormat := pf24bit;
 for y := 0 to Bmp.Height - 1 do
   begin
     Row := Bmp.ScanLine[y];
     for x := 0 to Bmp.Width - 1 do
       begin
         inc(SumR, Row[x].rgbtRed);
         inc(SumR, Row[x].rgbtGreen);
         inc(SumR, Row[x].rgbtBlue);
         inc(Count);
       end;
   end;
 result := RGB(SumR div Count, SumG div Count, SumB div Count);
end;


 
Вовчик   (2007-06-02 15:56) [3]

procedure Sredniy(Bitmap: TBitmap; var SR, SG, SB: Integer);
type TRGB = record
      B, G, R: Byte;
    end;
    pRGB = ^TRGB;
var Dest: pRGB;
   X, Y: Word;
   SummR, SummG, SummB: LongInt;
begin
 Bitmap.PixelFormat := pf24Bit;
 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 begin
       Inc(SummB, GT[B]);
       Inc(SummG, GT[G]);
       Inc(SummR, GT[R]);
     end;
     Inc(Dest);
   end;
 end;
 SR := Round(SummR/(Bitmap.Width*Bitmap.Height));
 SG := Round(SummG/(Bitmap.Width*Bitmap.Height));
 SB := Round(SummB/(Bitmap.Width*Bitmap.Height));
end;


 
antonn ©   (2007-06-02 16:04) [4]


>  inc(SumR, Row[x].rgbtRed);
>          inc(SumR, Row[x].rgbtGreen);
>          inc(SumR, Row[x].rgbtBlue);

очепятка, наверное? :)


 
{RASkov} ©   (2007-06-02 16:07) [5]

Спасибо... сейчас буду пробывать.


 
DVM ©   (2007-06-02 16:08) [6]


> очепятка, наверное? :)

да, конечно.


 
antonn ©   (2007-06-02 16:14) [7]

кстати, заметил, что ни SumR, ни SummR не получают стартового значения (сказал так сказал, не помню как правильно это называется, а ляпать не хочу, боквоедов много:)), код корректно отработает? просто интересно, привык всегда после введения переменной задавать ей исходное значение.


 
DVM ©   (2007-06-02 16:17) [8]


> antonn ©   (02.06.07 16:14) [7]

Стартовые значения лучше задать. Но автор вопроса сам поймет, я думаю.


 
{RASkov} ©   (2007-06-02 16:26) [9]

> Стартовые значения лучше задать. Но автор вопроса сам поймет, я думаю.

С этим не вопрос :)

С вариантом [2] разобрался.... хотел для сравнения, и лучшего понимания всего этого, заставить работать и вариант [3] но не смог...(
Не смог понять что есть GT[B], GT[G] и GT[R], т.е. не то чтобы понять, смысл - то понял, а вот заменить не пойму чем... даже с учетом [4] :(
Сейчас думаю разберусь...)
Спасибо еще раз всем.


 
{RASkov} ©   (2007-06-02 16:58) [10]

С заменой разобрался )
    with Dest^ do begin
     inc(SummR, R);
     inc(SummG, G);
     inc(SummB, B);
    end;
оба варианта [2] и [3] вроде бы делают одно и тоже но результаты разные...
И я тут резко так ответил, что не вопрос про инциализацию переменных, но после задумался, правильно ли я понял....
Вот как я переделал [3] вариант... вроде результат, то что надо )

function Sredniy(Bitmap: TBitmap): TColor;
type TRGB = record
     B, G, R: Byte;
   end;
   pRGB = ^TRGB;
var Dest: pRGB;
  X, Y: Word;
  SummR, SummG, SummB: LongInt;
  SR, SG, SB: Byte;
begin
Bitmap.PixelFormat := pf24Bit;
SummR:=GetRValue(Bitmap.Canvas.Pixels[0,0]);
SummG:=GetGValue(Bitmap.Canvas.Pixels[0,0]);
SummB:=GetBValue(Bitmap.Canvas.Pixels[0,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 begin
     inc(SummR, R);
     inc(SummG, G);
     inc(SummB, B);
    end;
    Inc(Dest);
  end;
end;
SR := Round(SummR/(Bitmap.Width*Bitmap.Height));
SG := Round(SummG/(Bitmap.Width*Bitmap.Height));
SB := Round(SummB/(Bitmap.Width*Bitmap.Height));
Result:=RGB(SR, SG, SB);
end;


Ну это на скорую руку, поэтому может и не так оптимально/красиво....
Верно ли я с инициализацией определился? Спасибо.


 
DVM ©   (2007-06-02 17:12) [11]


> {RASkov} ©   (02.06.07 16:58) [10]

SummR:=0;
SummG:=0;
SummB:=0;


 
{RASkov} ©   (2007-06-02 18:02) [12]

> [11] DVM ©   (02.06.07 17:12)

Точно... в первом проходе цикла они увеличатся на значения первого(нулевого) пиксела...
Спасибо...
Так в чем же различие обоих функций?
[2] по скорости работает быстрее, но результат не понятный, а [3] по скорости немного уступает, но результат, то что надо....??

На данный момент я сделал так (изменил [3])/ скорость немного повысилась, почти как у [2] стала.
С учетом, что битмап имеет только градацию серого...
function GetAverageColor(Bitmap: TBitmap): TColor;
var X, Y, Sum, Count: LongInt; B: Byte;
begin
Bitmap.PixelFormat := pf24Bit;
Sum:=0; Count:=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 begin
     inc(Sum, R);
    end;
    Inc(Dest);
    INC(Count);
  end;
end;
// B := Round(Sum/Count);
B := Sum div Count;
Result:=RGB(B, B, B);
end;

Dest вынес за пределы функции...


 
Loginov Dmitry ©   (2007-06-02 18:11) [13]

> Так в чем же различие обоих функций?


Видимо, в наличии packed record при объявлении TRGBTriple в [2]


 
DVM ©   (2007-06-02 18:16) [14]


> {RASkov} ©   (02.06.07 18:02) [12]

В моем варианте все работает как надо, надо просто поправить его как сказано выше было:


function GetBitmapColor(Bmp: TBitmap): TColor;
const
Pixels = MaxInt div SizeOf(TRGBTriple);
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..Pixels-1] of TRGBTriple;
var
x, y: Integer;
Row: PRGBArray;
SumR: integer;
SumG: integer;
SumB: integer;
Count: integer;
begin
SumR := 0;
SumG := 0;
SumB := 0;
Count := Bmp.Width * Bmp.Width;
Bmp.PixelFormat := pf24bit;
for y := 0 to Bmp.Height - 1 do
  begin
    Row := Bmp.ScanLine[y];
    for x := 0 to Bmp.Width - 1 do
      begin
        inc(SumR, Row[x].rgbtRed);
        inc(SumG, Row[x].rgbtGreen);
        inc(SumB, Row[x].rgbtBlue);
      end;
  end;
result := RGB(SumR div Count, SumG div Count, SumB div Count);
end;


 
Loginov Dmitry ©   (2007-06-02 18:18) [15]

Кстати, в [2] код "более правильный", так как там параметр pf24Bit точно соответствует размеру записи (3 байта). Видимо, способ хранения пикселей в твоем Битмапе использует 4 байта на пиксель, поэтому TRGB из [2] работает. Но лучше явно сделать структуру такой:

TRGB = record
 B, G, R, Alpha: Byte;
end;


 
DVM ©   (2007-06-02 18:18) [16]

небольшоая поправка

Count := Bmp.height * Bmp.Width;


 
homm ©   (2007-06-02 18:30) [17]

> Кстати, в [2] код "более правильный", так как там параметр
> pf24Bit точно соответствует размеру записи (3 байта). Видимо,
> способ хранения пикселей в твоем Битмапе использует 4 байта
> на пиксель, поэтому TRGB из [2] работает. Но лучше явно
> сделать структуру такой:

Лучше — всегда работать только с 32-х битным цветом.


 
antonn ©   (2007-06-02 18:34) [18]


> Лучше — всегда работать только с 32-х битным цветом.

сказал - как отрезал:)


 
DVM ©   (2007-06-02 18:34) [19]


> Лучше — всегда работать только с 32-х битным цветом.

С чего бы это?


 
homm ©   (2007-06-02 19:05) [20]

> С чего бы это?

Выравнивание памяти по 4 байта думаете с потолка во всех языках? 1 пиксель - одно машинное двойное слово, величина разрдности процессора. Напрямую читаем, напряму работаем, складываем, вычитаем, делим, и кладем обратно. Все это без лишнего очищения старшегго байта. Посмотрите в отладчике такой код, все врзу на места встанет.
var
 a, b: TRGBTriple;
 c, d: TRGBQuad;
 i: DWORD;
begin
 b := TRGBTriple((@i)^);
 a := b;

 d := TRGBQuad(i);
 c := d;

 form1.tag := a.rgbtBlue;
 form1.tag := c.rgbBlue;


 
{RASkov} ©   (2007-06-03 00:40) [21]

> [14] DVM ©   (02.06.07 18:16)

Работает отлично... и с моими поправками(См в [12]) применеными к [2,14]) даже еще чуть-чуть быстрее, и на порядок выше по скорости чем [3,12].
>
Всем спасибо.


 
Andy BitOff ©   (2007-06-03 03:35) [22]

Попробуй еще вот это:
function Sredniy(Source: TBitMap): TColor;
var
 i, j: integer;
 r: byte;
 qSource: TQuickPixels;
begin
 qSource := TQuickPixels.Create;
 Source.PixelFormat := pf24Bit;
 try
   qSource.Attach(Source);
   r := 0;
   for i := 0 to qSource.Height - 1 do begin
     for j := 0 to qSource.Width - 1 do begin
       r := r + GetRValue(qSource.GetPixel(j, i));
     end;
   end;
   r := r div (qSource.height * qSource.Width);
   Result := RGB(r, r, r);
 finally
   qSource.Free;
 end;
end;

И подивись скорости.

TQuickPixels = http://www.delphimaster.ru/articles/pixels/index.html


 
{RASkov} ©   (2007-06-04 02:42) [23]

> [22] Andy BitOff ©   (03.06.07 03:35)
> И подивись скорости.


Самый медленный вариант(

---------------------------------
GetBitmapColor 60
GetAverageBitmapColor 80
Sredniy 120
GetAverageColor 100
GetAverageBitmapColorGray 50
QPixSredniy 381
__________________
96 - $00000060
5066061 - $004D4D4D
13355979 - $00CBCBCB
13290186 - $00CACACA
5066061 - $004D4D4D
0 - clBlack
И результат не понятный...

Это с учетом того, что создание и убиение я вынес за приделы функции... хотя скорости это нисколько не добавило к исходному варианту в [22]

Вот код теста:
 Memo1.Lines.Add("---------------------------------");
 T:=GetTickCount;
 for N := 0 to 255 do Cl:=GetBitmapColor(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 Memo1.Lines.Add("GetBitmapColor "+IntToStr(T1));
 T:=GetTickCount;
 for N := 0 to 255 do Cl2:=GetAverageBitmapColor(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 Memo1.Lines.Add("GetAverageBitmapColor "+IntToStr(T1));
 T:=GetTickCount;
 for N := 0 to 255 do SrCl:=Sredniy(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 Memo1.Lines.Add("Sredniy "+IntToStr(T1));
 T:=GetTickCount;
 for N := 0 to 255 do ClAv:=GetAverageColor(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 Memo1.Lines.Add("GetAverageColor "+IntToStr(T1));
 T:=GetTickCount;
 for N := 0 to 255 do ClG:=GetAverageBitmapColorGray(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 Memo1.Lines.Add("GetAverageBitmapColorGray "+IntToStr(T1));

 qSource := TQuickPixels.Create;
 Image1.Picture.Bitmap.PixelFormat := pf24Bit;
 qSource.Attach(Image1.Picture.Bitmap);
 T:=GetTickCount;
 for N := 0 to 255 do QClG:=QPixSredniy(Image1.Picture.Bitmap);
 T1:=GetTickCount-T;
 qSource.Free;
 Memo1.Lines.Add("QPixSredniy "+IntToStr(T1));

Собственно все на равных условиях... Да... это до ужаса криво все, но мне нужно было только узнать скорость работы данных функций...
Еще пять это все модификации [2] и [3]....

GetBitmapColor 60
GetAverageBitmapColor 80
GetAverageBitmapColorGray 50
это [2]
остальные это - два(Sredniy и GetAverageColor) варианта[3] и функция с классом TQuickPixels из [22]
Вот так вот...


 
homm ©   (2007-06-04 04:20) [24]

GetBitmapColor 60
GetAverageBitmapColorGray 50

Учитывая разрешение выбраной функции для подсчета производительности, результат РАВНЫЙ. Тестируй тчательнее. А вообще не понятно, как так от выбора алгоритма (а точнее реализации, алгоритм один и тот-же) может зависить результат.


 
{RASkov} ©   (2007-06-04 13:46) [25]

> [24] homm ©   (04.06.07 04:20)

60 и 50 - я не беру во внимание разницу (10) , а вот 381 и 50 - здесь разница ощутимая...

> А вообще не понятно, как так от выбора алгоритма (а точнее
> реализации, алгоритм один и тот-же) может зависить результат.

Не знаю... возвращаемые результаты ниже скоростей данных функций и в том же порядке...
Типы данных разные... вот и результаты разные.... я не беру в счет, где я переделывал под
оттенки серого...


 
{RASkov} ©   (2007-06-04 13:54) [26]

GetAverageBitmapColor     - 80 - 5066061 - $004D4D4D
GetAverageBitmapColorGray - 50 - 5066061 - $004D4D4D
И даже переделанная только под оттенки серого она возвратила одинаковый результат... по скорости чуть стала быстрее...


 
DVM ©   (2007-06-04 14:01) [27]


> {RASkov} ©   (04.06.07 13:54) [26]

Используй лучше счетчики производительности:


unit PerfTimer;

interface

procedure TimeReset;
function TimeMs: Integer;
function TimeMks: Integer;
function TimeRealMks: Double;
function TimeStrMs: String;
function TimeStrMks: String;
procedure TimeShowMks;

implementation

uses Windows;

var
 PCTime1, PCTime2, PCFreq: Int64;
 PCEnabled: boolean = False;

//------------------------------------------------------------------------------

procedure QueryPerformanceCounter(var Cnt : Int64);
var
 Thread, OldMask : DWord;
begin
 Thread := GetCurrentThread;
 OldMask := SetThreadAffinityMask(Thread, 1);
 QueryPerformanceFrequency(PCFreq);
 PCEnabled := (PCFreq <> 0);
 Windows.QueryPerformanceCounter(Cnt);
 SetThreadAffinityMask(Thread, OldMask)
end;

//------------------------------------------------------------------------------

procedure TimeReset;
begin
 QueryPerformanceCounter(PCTime1);
end;

//------------------------------------------------------------------------------

function TimeMs: Integer;
begin
 if PCEnabled then
   begin
     QueryPerformanceCounter(PCTime2);
     Result := ((PCTime2 - PCTime1) * 1000 ) div PCFreq;
     PCTime1 := PCTime2;
   end
 else
   Result := 0;
end;

//------------------------------------------------------------------------------

function TimeMks: Integer;
begin
 if PCEnabled then
   begin
     QueryPerformanceCounter(PCTime2);
     Result := ((PCTime2 - PCTime1) * 1000000 ) div PCFreq;
     PCTime1 := PCTime2;
   end
 else
   Result:=0;
end;

//------------------------------------------------------------------------------

function TimeRealMks: Double;
begin
 if PCEnabled then
   begin
     QueryPerformanceCounter(PCTime2);
     Result := ((PCTime2 - PCTime1) * 1000000 ) / PCFreq;
     PCTime1 := PCTime2;
   end
 else
   Result := 0;
end;

//------------------------------------------------------------------------------

function TimeStrMs: String;
var
 i: Integer;
begin
 i := TimeMs;
 Str(i, Result);
end;

//------------------------------------------------------------------------------

function TimeStrMks: String;
var
 i: Integer;
begin
 i := TimeMks;
 Str(i, Result);
end;

//------------------------------------------------------------------------------

procedure TimeShowMks;
var
 i: Integer;
 s: String;
begin
 i := TimeMks; Str(i, s);
 MessageBox(0, PChar(s), "Time elapsed, mks ", MB_OK or MB_ICONWARNING);
end;

//------------------------------------------------------------------------------

initialization
 QueryPerformanceFrequency(PCFreq);
 PCEnabled := (PCFreq <> 0);

finalization

end.


 
DVM ©   (2007-06-04 14:02) [28]

Используй так:

TimeReset;
// делаем что-то;
TimeShowMks;


 
{RASkov} ©   (2007-06-04 14:09) [29]

> [28] DVM ©   (04.06.07 14:02)

Спасибо, но я думаю, в общем-то картина не измениться...
Т.е. однозначно твой вариант (и его модификации) самый быстрый в этой ветке :)


 
{RASkov} ©   (2007-06-04 14:27) [30]

После знака равно время показанное модулем PerfTimer.

GetBitmapColor 70 = 67828
GetAverageBitmapColor 70 = 66896
Sredniy 111 = 115364
GetAverageColor 100 = 94116
GetAverageBitmapColorGray 40 = 45899
QPixSredniy 380 = 371410
__________________
96 - $00000060
5066061 - $004D4D4D
13355979 - $00CBCBCB
13290186 - $00CACACA
5066061 - $004D4D4D
0 - clBlack
В Image1 загружена небольшая(350х135) картинка в оттенках серого..


 
DVM ©   (2007-06-04 14:41) [31]


> {RASkov} ©

А зачем тебе вообще понадобился этот средний цвет, если не секрет?


 
Sapersky   (2007-06-04 14:42) [32]

Лучше — всегда работать только с 32-х битным цветом.

Я бы не рискнул так категорично.
В некоторых случаях - да:
http://delphimaster.net/view/9-1180439487/ [12]
Но для попиксельной обработки, ИМХО, особого преимущества 32bpp не даёт (за исключением MMX, и то не всегда), а места занимает больше.

Посмотрите в отладчике такой код, все врзу на места встанет.

Ну, 2 mov вместо 1. Но меньший объём перемещаемых данных это часто компенсирует. А уж тупой Move (BitBlt) 24->24 точно быстрее, хотя вообще, конечно, лишних "тупых Move" следует избегать.
При покомпонентной обработке (r, g, b отдельно) вообще должно быть без разницы, а если она и есть, то из-за интенсивного использования массивов-указателей вроде PRGBArray (для 24 бит Дельфи расписывает умножение x * 3 как x * 2 + x, из-за чего добавляется лишнее действие). Через обычные указатели разницы почти нет, где-то 3-5% (проверено на FastLIB"овских FastResize/Bilinear).

Кстати, в [2] код "более правильный", так как там параметр pf24Bit точно соответствует размеру записи (3 байта)

Размер записи и там, и там 3 байта.


 
{RASkov} ©   (2007-06-04 15:09) [33]

> [31] DVM ©   (04.06.07 14:41)

Да собственно это не совсем мне нужно, да и рассказать в двух словах фик знаю как.
Нужно массив заполнить значениями = среднему цвету каждого пикселя данной картинки.
Двумерный Массив Byte Т.е. нужна одна состовляющая RGB - они же в оттенках серого все одинаковые
R=G=B, после нужно строить другой массив с использование данных из данного массива, но с учетом
некоторой переменной, и массив, грубо говоря, булевый.....массимы меньше размерностями, чем исходная картинка.
грубо говоря, тот битмап, что в сабже это часть общей картинки в оттенках серого..... в общем думаю понятно?



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.06.24;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.62 MB
Время: 0.038 c
15-1180122602
SerJaNT
2007-05-25 23:50
2007.06.24
Разбить bitmap


15-1180213750
Kostafey
2007-05-27 01:09
2007.06.24
С днем рождения ! 27 мая


2-1180574560
Ш-К
2007-05-31 05:22
2007.06.24
Отобразить 4 байта


2-1181029853
CodeGear Delphi for Win 32
2007-06-05 11:50
2007.06.24
как распокавать zip


15-1180034182
flaxe
2007-05-24 23:16
2007.06.24
Срочно Лаба, завтра сдавать, маленьткий вопросик)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский