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

Вниз

Fill pointer.   Найти похожие ветки 

 
Б   (2010-03-09 04:50) [0]

Здрасти!

Загоняю данные растра в P функцией GetDIBits. (Где P: Pointer)
Вопрос: как можно МАКСИМАЛЬНО БЫСТРО залить все пиксели растра через этот указатель цветом TColor?

P.S. Растры 24-х и 32-х битные.


 
miek   (2010-03-09 21:40) [1]

Написать процедурку на ассемблере или использовать чужую (FastLib, Graphics32, SpriteUtils).


 
Б   (2010-03-21 05:41) [2]

Процедурку вытащил из GR32.
Но почему-то растр заливается не корректно - становится полосатым.



procedure FillLongword(var X; Count: Integer; Value: Longword);
asm
 PUSH    EDI
 MOV     EDI,EAX  // Point EDI to destination
 MOV     EAX,ECX
 MOV     ECX,EDX
 TEST    ECX,ECX
 JS      @exit
 REP     STOSD    // Fill count dwords
@exit:
 POP     EDI
end;

Type
 PArrColorQ = ^TArrColorQ;
 TArrColorQ = array [0..0] of LongWord;
Var
 Bits : PArrColorQ;
begin
// В Bits загружен 24-х битный растр.

 FillLongword(FBits[0],  FW * FH, clRed); // *
 // ZeroMemory(FBits, FW * FH * 4);       // Корректно заполняет чёрным.

End;



 
Sapersky   (2010-03-21 14:26) [3]

Процедурка предназначена для заполнения 32-битных растров.
FastLib, 24 бита:

pc:=Pointer(Bmp.Bits);
for i:=0 to Bmp.Width-1 do begin
 pc^:=PFColor(@c)^; Inc(pc);
end;
for i:=1 to Bmp.AbsHeight-1 do
 Move(Bmp.Bits^,Bmp.Scanlines[i]^,Bmp.BWidth-Bmp.Gap);


 
Б   (2010-03-21 16:02) [4]

А чему будут равны?:
Bmp.Scanlines[i],
Bmp.BWidth
Bmp.Gap

Scanline в TFastDIB.LoadFromFile что-то не заполняется.


 
Sapersky   (2010-03-21 18:01) [5]

Scanlines и прочее заполняется в SetInterface. По сути тот же сканлайн, что и в TBitmap, только более быстрый и не перевёрнутый, в Медиа я уже писал.
BWidth - полная ширина строки (с "хвостом" в конце), Gap - длина "хвоста". В общем, берётся размер строки в байтах, можно было и Width * 3 написать.


 
Б   (2010-03-21 20:27) [6]

Вообщем так.
Программа вылетает, если раскомментировать Clear24.
Что не так?


Type
 PFColor =^TFColor;
 TFColor = packed record
   b,g,r: Byte;
 end;

 PArrColorQ = ^TArrColorQ;
 TArrColorQ = array [BYTE] of TColor;

 PLines = ^TLines;
 TLines = array[BYTE]of Pointer;

Var
 FBits: PArrColorQ;
 Scan : PLines;
 FW, FH: LongWord;
 BWidth, Gap: LongInt;

 FDC: LongWord;
 FHB: LongWord;

Function XLoadBMP(const FileName: string): boolean;
Var
 BMP : Bitmap;
 x, i: LongInt;
begin
 Result:= False;

 FHB:= LoadImage(0, PCHAR(FileName), 0, 0, 0, LR_LOADFROMFILE or LR_CREATEDIBSECTION);
 If (FHB = 0) then Exit;

 GetObject(FHB,  SizeoF(BMP), @BMP);
 With BMP do
 begin
   If (bmBitsPixel <> 24) then Exit;
   FW:= bmWidth;
   FH:= bmHeight;

   GetMem(FBits, FW * FH * 3);
   FBits := bmBits;
   Result:= (FBits <> nil);
 end;

 FDC:= CreateCompatibleDC(0);
 DeleteObject(SelectObject(FDC, FHB));

 BWidth:=(((FW * 24) + 31) and - 32) shr 3;
 Gap   := BWidth - ((FW shl 1) + FW);

 ReallocMem(Scan, FH shl 2);
 x:= Integer(FBits);
 for i:= 0 to FH-1 do
 begin
   Scan[i]:= Ptr(x);
   Inc(x, BWidth);
 end;
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
 If not XLoadBMP("C:\Texture.bmp") then Close;    (* Texture - 256 x 256 *)
End;

Procedure Clear24(Color: TColor);
Var
 pc: PFColor;
 i: LongWord;
begin
 pc:=Pointer(FBits);
 for i:=0 to FW-1 do
 begin
   pc^:=PFColor(@Color)^;
   Inc(pc);
 end;
 for i:=1 to FH-1 do
   Move(FBits^, Scan[i], BWidth - Gap);
End;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 // ZeroMemory(FBits, FW * FH * 3);

// Clear24(clBlue);

 BitBlt(Form1.Canvas.Handle, X, Y, FW, FH, FDC, 0, 0, SRCCOPY);
End;


 
Sapersky   (2010-03-21 21:33) [7]

Там где не надо - скопировал 1 в 1 (сканлайны для данной задачи не очень нужны), там где надо - пропустил символ :)
Move(FBits^, Scan[i]^, BWidth - Gap);
(Scan[i] - указатель, а в Move нужно передавать переменную).
И не факт, что TColor будет корректно воспринят в данном случае. Возможно, потребуется сдвинуть... к тому же в TColor может быть системный цвет - см. функцию ColorToRGB в Graphics.pas.


 
Б   (2010-03-21 22:22) [8]

Какой же я не внимательный. ;)
Всё работает.
Только цвет заливки воспринимался не правильно, пока не поменял каналы R-B.

У меня ещё такой вопрос:
Если убрать флаг LR_CREATEDIBSECTION, то приложение вылетает.
Почему не коректно ведёт себя DDB?


 
Sapersky   (2010-03-22 13:19) [9]

Возможно, GetObject не поддерживает DDB. У DDB вроде бы вообще нет нормального доступа к пикселям, так что (ИМХО) смысла использовать его немного.


 
Б   (2010-03-22 14:02) [10]


> так что (ИМХО) смысла использовать его немного.


Смысл использования DDB есть.
Об этом я отписал тут:
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=75631

P.S. В целом, при таком раскладе, заливать растр можно и обычными WinAPI-функциями.


 
Sapersky   (2010-03-22 16:04) [11]

Ну если всё что тебе нужно - заливать цветом (рисовать прямоугольники) и выводить через BitBlt - то да, DDB "уделывает всех". Это те немногие функции, что GDI умеет аппаратно ускорять. Но для того, чтобы нарисовать что-то более-менее интересное их, мягко говоря, недостаточно.
А доступ к пикселям DDB тормозит катастрофически. На том же Королевстве есть статья и тесты Антона Григорьева.


 
Б   (2010-03-22 19:53) [12]


> Ну если всё что тебе нужно - заливать цветом (рисовать прямоугольники)
> и выводить через BitBlt - то да, DDB "уделывает всех".


В целом мне не так уж много и надо: быстрая заливка, поворот, альфа-наложение, поддержка цветового ключа, быстрый блиттинг, доступ к пикселям. Все пункты почти решены.


> А доступ к пикселям DDB тормозит катастрофически.


Я предлагаю след. способ: создавать DIB, что даёт скорость в обработке, а при выводе переводить в DIB, этим самым получаем быстрый вывод.


  B.Canvas...                // Рисуем.
   B.ScanLine...              // Обрабатываем пиксели.

   B.PixelFormat:= pfDevice;
   B.Canvas.Draw...           // Шустрый блиттинг.
   B.PixelFormat:= pf24bit;   // Восстанавливаемся.



 
Sapersky   (2010-03-23 12:29) [13]

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

Аппаратная графика, конечно, не рассматривается по принципиальным соображениям? Ну дело твоё...

B.PixelFormat:= pfDevice;

Каждая такая строчка означает "создаём новый битмап, копируем в него, старый уничтожаем". Какое уж тут ускорение.
Даже если не создавать - пророчествую: копия в DDB + блиттинг DDB на экран по времени будет равно или почти равно блиттингу DIB на экран (или в бэкбуфер).


 
Б   (2010-03-25 19:01) [14]


> Аппаратная графика, конечно, не рассматривается по принципиальным
> соображениям? Ну дело твоё...


Занимаюсь изучением OpenGL и параллельно GDI, для общего ознакомления.


> Какое уж тут ускорение.


Тестил в по примеру BitmapSpeed от Антона Григорьева.


 
Sapersky   (2010-03-26 18:33) [15]

Тестил в по примеру BitmapSpeed от Антона Григорьева.

Погонял блиттинг на GF220 / Win 7. DIB 24 бита - в 2 раза медленнее DDB, 32 бита (1000 раз говорили - 32->32 быстрее!) - почти без разницы, DIB даже немного быстрее.
Заполнение через сканлайн + блиттинг - "чистый" DIB-32 в 2 с лишним раза быстрее варианта с преобразованиями DDB<->DIB.



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

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

Наверх




Память: 0.49 MB
Время: 0.061 c
2-1265742686
Константин
2010-02-09 22:11
2010.08.27
Интернационализация приложения


10-1165502198
YCH.Del
2006-12-07 17:36
2010.08.27
Excel, реализовать в Delphi VB шный оператор Set


15-1274214590
Юрий
2010-05-19 00:29
2010.08.27
С днем рождения ! 19 мая 2010 среда


2-1265975826
ExGen
2010-02-12 14:57
2010.08.27
ADOTable


2-1274633276
georgeted
2010-05-23 20:47
2010.08.27
Работа с БД в оперативной памяти





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский