Помощь - Поиск - Пользователи - Календарь
Полная версия: Опять же графика!
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
-=АнЮтА=-
Пы талась проявить фантазию, но очень осторожно и с переменным успехом. Хочу так сохранить рисунок по кускам, но в два разных файла. Из одного файла прочитать оба кусочка записанных боюсь мозгофф пока не хватит. Не могу сообразить где ошибка, может стоит с разными переменными попробовать? Если тока один кусочек копировать - работает, размер кусочка проверяла - меньше 64 кб. Подскажите пожалуйста blink.gif
Написала такую процедуру:
Procedure Copy_image;
var size:word;
buffer,:pointer;
f:file;
begin
size:=imagesize(200,20,400,220); {копирую первый кусочек}
getmem(buffer,size);
getimage(200,20,400,220,buffer^);
assign(f,'pic.dat');
rewrite(f,size);
blockwrite(f,buffer^,1);
close(f);

size:=imagesize(400,220,630,435); {копирую второй}
getmem(buffer,size);
getimage(400,220,630,435,buffer^);
assign(f,'pic1.dat');
rewrite(f,size);
blockwrite(f,buffer^,1);
close(f);

assign(f,'pic.dat'); {воспроизвожу первый}
reset(f,1);
getmem(buffer,filesize(f));
blockread(f,buffer^,filesize(f));
close(f);
putimage(200,20,buffer^,normalput);

assign(f,'pic1.dat'); { воспроизвожу второй}
reset(f,1);
getmem(buffer,size);
blockread(f,buffer^,filesize(f));
close(f);
putimage(400,220,buffer^,normalput);
end;
Lapp
Во-первых, ты берешь память и ни разу не освобождаешь ее - это плохо.
Во-вторых, записываешь ты правильно (делаешь файл с длиной записи, равной длине картинки, а потом записываешь одну запись). А вот читаешь странно. Длина записи в файле у тебя равна длине файла, и ты пытаешься считать записей столько, какая длина файла. Уж либо делай длину записи при открытии файла равной одному байту, либо считывай одну запись (как записываешь).

Добавлено:
Гоп - стоп.. что-то я напутал сослепу.. Ты открываешь файл с длиной записи 1. Видно, не туда посмотрел. Извиняюсь.
volvo
Ну, сразу бросается в глаза то, что у тебя в программе 4 вызова GetMem, и ни одного FreeMem, причем все 4 GetMem-а для одной переменной... Могут быть накладки. Как только записала содержимое буфера в файл - освобождай память...
Lapp
Я немного подкорректировал (добавил freemem и разбил процедуру на две) - и у меня все получилось.
Больших изменений не вносил.
uses
Graph;

var
gd:integer=vga;
gm:integer=vgahi;

Procedure WriteImage;
var size:word;
buffer:pointer;
f:file;
begin
size:=imagesize(0,0,99,99); {копирую первый кусочек}
getmem(buffer,size);
getimage(0,0,99,99,buffer^);
assign(f,'pic.dat');
rewrite(f,size);
blockwrite(f,buffer^,1);
FreeMem(buffer);
close(f);

size:=imagesize(100,100,199,199); {копирую второй}
getmem(buffer,size);
getimage(100,100,199,199,buffer^);
assign(f,'pic1.dat');
rewrite(f,size);
blockwrite(f,buffer^,1);
FreeMem(buffer);
close(f);
end;


Procedure ReadImage;
var size:word;
buffer:pointer;
f:file;
begin
assign(f,'pic.dat'); {воспроизвожу первый}
reset(f,1);
size:=FileSize(f);
getmem(buffer,Size);
blockread(f,buffer^,filesize(f));
close(f);
putimage(100,0,buffer^,normalput);
FreeMem(buffer);

assign(f,'pic1.dat'); { воспроизвожу второй}
reset(f,1);
size:=FileSize(f);
getmem(buffer,Size);
blockread(f,buffer^,filesize(f));
close(f);
putimage(0,100,buffer^,normalput);
FreeMem(buffer);
end;

begin
InitGraph(gd,gm,'');
Line(0,0,200,200);
Line(200,0,0,200);
WriteImage;
ReadLn;
ClearDevice;
ReadLn;
ReadImage;
ReadLn;
end.

Да, еще размер картинки уменьшил - она все же была очень большая...
volvo
Цитата
еще размер картинки уменьшил - она все же была очень большая...
smile.gif А ты откуда знаешь, что было у автора во время вызова процедуры на экране? Может был пустой экран и несколько красных линий, тогда можно и все 640*480 запихнуть в один файл, ибо ImageSize возвращает размеры картинки, учитывая все особенности расположения ее в ОЗУ...
Lapp
Цитата(volvo @ 18.01.2007 12:45) *

smile.gif А ты откуда знаешь, что было у автора во время вызова процедуры на экране?

Именно так - я даже не знаю, какую моду использовала -=АнЮтА=-. Поэтому я не катил бочку, а тихо сказал про то, что было у меня.. smile.gif Надеюсь, -=АнЮтА=- все же сделает выводы (поэкспериментировав в этом направлении).

Что же касается обобщения программы на запись любых картинок в один файл - оно очевидно. Нужно найти правильное разбиение на прямоугольники (не думаю, чтобы при этом надо было стремиться к максимальному размеру имеджа, лучше заведомо не промахнуться с размером), а потом записывать в файл последовательно все куски, перемежая их информацией об относительном положении куска и его размере. То есть примерно так:
  ReWrite(f,1);
x:=x1;
y:=y1;
while y<=y2 do begin
y0:=y+dy;
if y0>y2 then y0:=y2;
while x<=x2 begin
x0:=x+dx;
if x0>x2 then x0:=x2;
Size:=ImageSize(x,y,x0,y0);
BlockWrite(f,x,SizeOf(x));
BlockWrite(f,y,SizeOf(y));
BlockWrite(f,Size,SizeOf(Size));
GetMem(Buffer,Size);
GetImage(x,y,x0,y0,Buffer^);
BlockWrite(f,Buffer^,Size);
FreeMem(Buffer)
end
end;
Close(f);

Главное тут не перебрать при выборе dx и dy.
Читать все в одном цикле до конца файла.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.