Пы талась проявить фантазию, но очень осторожно и с переменным успехом. Хочу так сохранить рисунок по кускам, но в два разных файла. Из одного файла прочитать оба кусочка записанных боюсь мозгофф пока не хватит. Не могу сообразить где ошибка, может стоит с разными переменными попробовать? Если тока один кусочек копировать - работает, размер кусочка проверяла - меньше 64 кб. Подскажите пожалуйста
Написала такую процедуру:
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;
Во-первых, ты берешь память и ни разу не освобождаешь ее - это плохо.
Во-вторых, записываешь ты правильно (делаешь файл с длиной записи, равной длине картинки, а потом записываешь одну запись). А вот читаешь странно. Длина записи в файле у тебя равна длине файла, и ты пытаешься считать записей столько, какая длина файла. Уж либо делай длину записи при открытии файла равной одному байту, либо считывай одну запись (как записываешь).
Добавлено:
Гоп - стоп.. что-то я напутал сослепу.. Ты открываешь файл с длиной записи 1. Видно, не туда посмотрел. Извиняюсь.
Ну, сразу бросается в глаза то, что у тебя в программе 4 вызова GetMem, и ни одного FreeMem, причем все 4 GetMem-а для одной переменной... Могут быть накладки. Как только записала содержимое буфера в файл - освобождай память...
Я немного подкорректировал (добавил 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.
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);