как быстро записывать побайтно в файл?

← →
Вася (2013-11-19 14:24) [0]

Вот кусок процедуры:
assignfile(flb,currpath+f_GrayTMP); reset(flb); Seek(flb, 1078); count:=image1.Picture.Bitmap.Width*image1.Picture.Bitmap.Height; pix_p:=image1.Picture.Bitmap.RawImage.data; if image1.Picture.Bitmap.pixelformat=pf32bit then begin pix4out:=pix_p; inc(pix4out, count); repeat write(flb, pix4out^.rgbRed); dec(pix4out); dec(count); until count<=0; end;

очень медленно пишет в файл (файл 800 кб секунды 3-4).
как ускорить?

использую FPC 2.6, но думаю проблема не в компиляторе, а в подходе

← →
Медвешоног Порожок (2013-11-19 14:28) [1]

побайтно не быстро.
быстро не побайтно

← →
Вася (2013-11-19 14:29) [2]

Массивом?

← →
MBo © (2013-11-19 14:29) [3]

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

← →
DevilDevil © (2013-11-19 14:32) [4]

http://sourceforge.net/projects/cachedbuffers/

← →
DevilDevil © (2013-11-19 14:45) [5]

ну или да
сначала создай кусок памяти 800кб, потом заполни его, потом запиши в файл

← →
Вася (2013-11-19 15:46) [6]

переделал на массив, BlockWrite(flb, pix_map[0], sizeof(pix_map[0])*count); ничего в файл не записывает :(
assignfile(flb,currpath+f_GrayTMP); reset(flb); Seek(flb, 1078); count:=image1.Picture.Bitmap.Width*image1.Picture.Bitmap.Height; setlength(pix_map,count); i:=0; pix_p:=image1.Picture.Bitmap.RawImage.data; if image1.Picture.Bitmap.pixelformat=pf32bit then begin pix4out:=pix_p; inc(pix4out, count); repeat pix_map[i]:=pix4out^.rgbRed; dec(pix4out); dec(count); inc(i); until count<=0; end; BlockWrite(flb, pix_map[0], sizeof(pix_map[0])*count); closefile(flb);

← →
Palladin © (2013-11-19 15:47) [7]

reset(flb);
у reset есть второй параметр

← →
MBo © (2013-11-19 15:56) [8]

count после цикла чему равен?

А вообще здесь цикл for лучше подойдёт

← →
Вася (2013-11-19 15:59) [9]

> count после цикла чему равен?

точно, спасибо :)

← →
Вася (2013-11-20 13:38) [10]

теперь не получается записать динамический массив в файл, точнее массив пишется, но в файле одни нули, в отладчике данные в массиве есть
assignfile(flb,currpath+f_GrayTMP); reset(flb, 1); Seek(flb, 1078); count:=image1.Picture.Bitmap.Width*image1.Picture.Bitmap.Height; setlength(pix_map,count); i:=0; pix_p:=image1.Picture.Bitmap.RawImage.data; if image1.Picture.Bitmap.pixelformat=pf32bit then begin pix4out:=pix_p; inc(pix4out, count); for i:=0 to count-1 do begin pix_map[i]:=pix4out^.rgbRed; dec(pix4out); end; end; BlockWrite(flb, pix_map[0],length(pix_map)); closefile(flb); pix_map:=NIL;

переменные объявляются
flb: file; pix_map:array of byte;
Почему пишутся нулевые значения?

← →
MBo © (2013-11-20 14:11) [11]

А в файл вообще что-то пишется? Файл на запись открыт?

Старые методы работы с файлами преимуществ перед TFileStream не имеют, так что разумно перейти на последнее.

← →
Вася (2013-11-20 14:20) [12]

Файл пишется, увеличивается на размер массива, но всё нули.
Щас попробую через поток

← →
DevilDevil © (2013-11-20 14:20) [13]

а в каком порядке у тебя должны располагаться байты в pix_map ?

И вообще прими на заметку:

function BitmapLineSize(const Bitmap: TBitmap): integer; const // (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom) PIXEL_SIZES: array[TPixelFormat] of integer = (0, 1, 4, 8, 16, 16, 24, 32, 0); begin Result := ((PIXEL_SIZES[Bitmap.PixelFormat]*Bitmap.Width+31) and -32) shr 3); end; {$if CompilerVersion < 19} type NativeInt = Integer; {$ifend} ... BitmapData: NativeInt; LinearSize: integer; X, Y: integer; Pixel: PRGBQuad; // для pf32bit ... BitmapData := NativeInt(Bitmap.ScanLine[0]); LinearSize := -{минус!}BitmapLineSize(Bitmap); // цикл с доступом по X/Y for Y := 0 to Bitmap.Height-1 do for X := 0 to Bitmap.Width-1 do begin Pixel := Pointer(BitmapData + Y*LinearSize + X*sizeof(TRGBQuad)); // ... end;

← →
MBo © (2013-11-20 14:30) [14]

>-{минус!}
не всегда

← →
Sapersky (2013-11-20 14:32) [15]

> BitmapLineSize

Есть же Graphics.BytesPerScanline.

← →
Вася (2013-11-20 14:34) [16]

Задача такая: взять рисунок (32битный, тоесть выравнивание не нужно учитывать), преобразовать его в оттенки серого и сохранить в 8-ми битный с палитрой.
я не нашел где в FPC можно создать палитру в классе битмапе, потому просто пишу в файл сначала заголовок с палитрой, а за ним сами индексы в обратном порядке относительно открытого битмапа

← →
DevilDevil © (2013-11-20 14:36) [17]

> MBo © (20.11.13 14:30) [14]
> >-{минус!}
> не всегда

Я решил, что так проще. Когда базой считается линия [0]
Кроме того не нужно париться с махинациями переворачивания Y от Height

> Sapersky (20.11.13 14:32) [15]
> Есть же Graphics.BytesPerScanline.

Смысл тот же, действий меньше

← →
MBo © (2013-11-20 14:42) [18]

>Я решил, что так проще. Когда базой считается линия [0]

Но нулевая линия не всегда в конце лежит

← →
DevilDevil © (2013-11-20 14:45) [19]

> Вася (20.11.13 14:34) [16]
> Задача такая: взять рисунок (32битный, тоесть выравнивание
> не нужно учитывать), преобразовать его в оттенки серого
> и сохранить в 8-ми битный с палитрой.
> я не нашел где в FPC можно создать палитру в классе битмапе,
> потому просто пишу в файл сначала заголовок с палитрой,
> а за ним сами индексы в обратном порядке относительно открытого битмапа

Дак результирующий файл тебе тоже нужно будет в формате Bitmap - т.е. линии снизу вверх + выравнивание на 4 байта

var Width, Height, X, Y: integer; Gap; Pixels, dest: pbyte; src: PRGBQuad; begin Width := Bitmap.Width; Height := Bitmap.Height; GetMem(Pixels, ((Width+3) and -4)*Height); Gap := ((Width+3) and -4) - Width; dest := Pixels; src := Bitmap.ScanLine[Height-1]; for Y := 0 to Height-1 do begin for X := 0 to Width-1 do begin // grey algorithm dest^ := src.rgbRed; // next pixel inc(src); inc(dest); end; inc(dest, Gap); end;

← →
DevilDevil © (2013-11-20 14:50) [20]

> MBo © (20.11.13 14:42) [18]
> Но нулевая линия не всегда в конце лежит

Ты прав. На практике я таких файлов не встречал, но судя по исходникам Graphics, такая вероятность есть

Значит:
function BitmapLinearSize(const Bitmap: TBitmap): integer; begin if (Bitmap.Heigth <= 1) then Result := 0 else Result := NativeInt(Bitmap.ScanLine[1])-NativeInt(Bitmap.ScanLine[0]); end; LinearSize := BitmapLinearSize(Bitmap); {без минуса}

← →
Sapersky (2013-11-20 15:03) [21]

> На практике я таких файлов не встречал

Самому можно использовать, поскольку рано или поздно надоедает возиться с этой перевёрнутостью.
Но в TBitmap (по крайней мере старых версий) оно как-то криво сделано. Если задать отрицательную высоту - битмап будет "нормальный", но Height останется положительным... может, в новых версиях лучше.

> Sapersky (20.11.13 15:03) [21]

Ну дак как высота изображения (TBitmap.Height) может быть отрицательной? Она всегда положительная. А внутренний biHeight используется уже как надо при ScanLine

function TBitmap.GetHeight: Integer; begin Result := Abs(FImage.FDIB.dsbm.bmHeight); end;

← →
Sapersky (2013-11-20 16:24) [24]

Когда я пробовал, внутренний biHeight или bmHeight вроде бы тоже получался положительный, и в результате GetScanline работал неправильно.

← →
Вася (2013-11-20 17:28) [25]

вопрос в другом: как правильно массив записать в файл?

← →
удав (2013-11-20 17:38) [26]

http://articles.org.ru/cfaq/index.php?qid=708

> Вася (20.11.13 17:28) [25]
> вопрос в другом: как правильно массив записать в файл?

нормально у тебя записывается
у тебя он не заполняется
можешь ради теста заполнить его например значением 255 перед записью

← →
Вася (2013-11-21 11:02) [28]

> у тебя он не заполняется

действительно не заполняется, счетчик цикла с какого-то перепугу определил i:byte; поменял на integer, все заработало, разве компилятор не должен был указать на эту ошибку?

не должен был

я тебе ещё раз настоятельно рекомендую разобраться с пониманием расположения линий

потому что у тебя заполнение из начала в конец, из конца в начало, нет выравнивания на 4 байта. что приведёт к некорректной работе

как быстро записывать побайтно в файл? Найти похожие ветки