Помощь - Поиск - Пользователи - Календарь
Полная версия: Изображения *dat для паскаль
Форум «Всё о Паскале» > Pascal, Object Pascal > Теоретические вопросы
Vanya
Привет Люди! smile.gif Как открыть в паскале dat* Картинки? Точнее даже не так. Как свои dat картинки окрыть.
З.Ы.: Есть исходник кода + файлы(dat картинки). Программа работает. Если я вставляю свои dat они не отображаются( Почему?
Надеюсь суть проблемы понятно объяснил...
Очень надо. Спасибо!
Lapp
Цитата(Vanya @ 12.03.2011 16:22) *
Привет Люди! smile.gif Как открыть в паскале dat* Картинки? Точнее даже не так. Как свои dat картинки окрыть.
З.Ы.: Есть исходник кода + файлы(dat картинки). Программа работает. Если я вставляю свои dat они не отображаются( Почему?
Надеюсь суть проблемы понятно объяснил...
Очень надо. Спасибо!

Нет, не очень понятно. Точнее, совсем непонятно.

Расширение .dat не является стандартом. Обычно программисты дают его своим файлам, которые не имеют стандартной структуры. Их содержимое может понять/прочитать только сам автор программы, которая их использует (либо должно прилагаться точное описание). Если есть код программы (скажем, на Паскале), то можно попробовать разобраться, убив кучу времени и без гарантированного результата.
Vanya
Вот код программы
Автор: dushik - с этого форума.

 program gamme;
Uses Crt, Graph,Dos;
Const DELAY_D = 10;S_T_S=15;
Var Gd,Gm,i,j,x,y,x1,y1,x2,y2,x3,y3,x4,y4,ranx,rany,ranr,men : integer;
key : char;
r : byte;
p,p1,p2,p3,p4,p5,p6 : pointer;
size : integer;
f : File;
derx : array[1..20] of integer;
dery : array[1..20] of integer;
s_x : array[1..60] of integer; {massiwy s dollarami}
s_y : array[1..60] of integer; {massiwy s dollarami}
s_flags : array[1..60] of integer; {massiw kluchej, dobawlenitya ochkow}
fun,s_count,n_doll :integer;
GAME_TIME,game_start_time,remain_time : word;
kol_vo :boolean;
score :byte;
procedure test;
var
i,Flag:integer;
s:string;
begin
score:=0;
settextstyle(0,0,1);
setbkcolor(2);

setcolor(15);
outtextxy(70,15,'Перед игрой, вы должны пройти элементарный тест,');
outtextxy(70,30,'который покажет насколько вы достойны играть в данную игру smile.gif');
settextstyle(0,0,1);
setcolor(4);
{---1---}
outtextxy(130,70,'Напишите формулу площади параллелограмма');
outtextxy(130,90,'с высотой h проведеннов к стороне a');
readln(s);
outtextxy(130,110, s);
if (s<> 's=ah') and (s<> 'S=ah') then begin Flag:=1;
outtextxy(400,100,'Ошибка!'); readln;end
else begin
outtextxy(400,90,''); score:=score+1; end;
{---2---}
outtextxy(130,130,'Напишите формулу второго');
outtextxy(130,150,'закона Ньютона');
readln(s);
outtextxy(130,170, s);
if (s<> 'F=ma') and (s<> 'f=ma') then begin Flag:=1;
outtextxy(400,150,'Ошибка!'); readln;end
else begin
outtextxy(400,150,''); score:=score+1; end;
{---3---}
outtextxy(130,190,'Напишите формулу');
outtextxy(130,200,'теоремы Пифагора');
readln(s);
outtextxy(130,210, s);
if (s<> 'cc=aa+bb') and (s<> 'c^2=a^2+b^2') then begin Flag:=1;
outtextxy(400,190,'Ошибка!'); readln;end
else begin
outtextxy(400,190,''); score:=score+1; end;
{---4---}
outtextxy(130,230,'Напишите формулу');
outtextxy(130,240,'центростремительного ускорения');
readln(s);
outtextxy(130,250, s);
if (s<> 'a=vv/r') and (s<>'a=v^2/r') then begin Flag:=1;
outtextxy(400,250,'Ошибка!'); readln;end
else begin
outtextxy(400,250,''); score:=score+1; end;
{---5---}
outtextxy(130,280,'Человека скинули с самолета без парашюта');
outtextxy(130,290,'с каким ускорением он летит вниз?');
readln(s);
outtextxy(130,300, s);
if s<>'g' then begin Flag:=1;
outtextxy(400,290,'Ошибка!'); readln;end
else begin
outtextxy(400,270,''); score:=score+1; end;

case score of
0:begin outtextxy(130,350,'абсолютно пустой ответ, и оценку вам не зачто ставить'); readln; exit; end;
1:begin outtextxy(130,350,'вам кол, отдыхайте...'); readln; exit; end;
2:begin outtextxy(130,350,'слабо, очень слабо, двойка...'); readln; exit; end;
3:begin outtextxy(130,350,'Удовлетворительно, можете приступать к игре,');
outtextxy(130,370,'но все же тест вы прошли далеко не идеально...'); readln; end;
4:begin outtextxy(130,350,'Неплохие ответы, но все же на один вопрос вы не ответили smile.gif');
outtextxy(130,370,'можете присткпать к игре...'); readln; end;
5:begin outtextxy(130,350,'Поздравляю! Вы ответили абсолютно на все вопросы!');
outtextxy(130,370,'Можете приступать к игре с совершенно трезвым разумом.'); readln; end;
end;
end;
procedure kvg;
var i,j,r : integer;
begin
r:=getmaxx div 2;
for i:=1 to r do
begin
setcolor(7);
line(0+i,0,0+i,480);
line(getmaxx-i,0,getmaxx-i,480);
delay(10*DELAY_D);
end;
nosound;
end;

procedure kvg1;
var i,j,r : integer;
begin
r:=200;
for i:=1 to r do
begin
setcolor(black);
line(r-i+1,0,r-i+1,480);
line(r+i,0,r+i,480);
delay(10*DELAY_D);
end;
nosound;
end;


procedure nazvanie(i:integer;s:string);
begin
kvg;
setcolor(red);
settextstyle(0,0,4);
outtextxy(80,40,s);
setcolor(green);
settextstyle(0,0,4);
outtextxy(80,42,s);
for i:=1 to 4 do
delay(1000*DELAY_D);
cleardevice;
end;
procedure put_angle_text( text:string;flag:integer);
var txt : string;
begin
setcolor(red);
settextstyle(0,0,1);
setfillstyle(solidfill,black);
bar(getmaxx-110,0,getmaxx,10);
bar(getmaxx-110,10,getmaxx,20);
if(flag=0)then
begin
outtextxy(getmaxx-110,0,text);
outtextxy(getmaxx-110,10,'remain(sec):_____');
end
else
begin
outtextxy(getmaxx-110,0,'score:');
str(s_count,txt);
outtextxy(getmaxx-50,0,txt);
outtextxy(getmaxx-110,10,'remain:');
str(remain_time,txt);
outtextxy(getmaxx-20,10,txt);
end;

end;
{file load}

function loader(namef:string):pointer;
begin
assign(f,namef);
reset(f,1);
size:=filesize(f);
getmem(p,size);
blockread(f,p^,size);
putimage(x,y,p^,1);
cleardevice;
loader:=p;
end;
function is_in_s(xxx:integer ;yyy:integer):integer;
var m : integer;
begin
is_in_s:=0;
for m:=1 to n_doll do
begin
if( (s_x[m]<xxx) and (s_x[m]+S_T_S+2>xxx) and
(s_y[m]<yyy) and (s_y[m]+S_T_S+2>yyy) )then
begin
{ Write('okkkkkkkk');}
is_in_s:=m;
end
end;
end;

function is_color_in(xx1,yy1,xx2,yy2:integer):integer;
var m,n : integer;
begin
is_color_in:=0;
for m:=xx1 to xx2 do
begin
for n:=yy1 to yy2 do
begin
if(getpixel(m,n) <> black) then
is_color_in :=1;
end;
end;
end;
procedure add_s;
var x2,y2,flag,k,newm:integer;
begin
setcolor(cyan);
settextstyle(0,0,2);
flag:=1;
while flag=1 do
begin
x2:=random(620);y2:=random(460);
flag:=is_color_in(x2,y2,x2+S_T_S,y2+S_T_S);
end;
rectangle(x2,y2,x2+S_T_S,y2+S_T_S);

outtextxy(x2,y2,'$');
newm :=-1;
for k:=1 to n_doll do
begin
if(s_flags[k]=0) then
newm:=k;
end;
if(newm<0)then
begin
newm:=n_doll+1;
n_doll :=newm;
end;
s_x[newm]:=x2;
s_y[newm]:=y2;
s_flags[newm]:=1;
end;
procedure picture;
begin
p1:=loader('chel.dat');
p2:=loader('bereza.dat');
p3:=loader('elka.dat');
p4:=loader('sunduk.dat');
p5:=loader('kamen.dat');
end;
{/file load}

procedure text(x,y:integer;s:string);
begin
settextstyle(0,0,2);
outtextxy(x,y,s);
end;

procedure Help;
begin
setbkcolor(7);
setcolor(1);
settextstyle(0,0,1);
outtextxy(30,20,'Игра - Последний грой. Вам нужно за определенное время');
outtextxy(30,30,'найти, и собрать как можно большее колличество очков (денег)');
outtextxy(30,40,'У_дачи smile.gif');
readln;
end;

procedure menu1;
const
xpoz = 230;
ct = 1;
ctt = 12;
ypoz:array[1..3] of integer = (100,150,200);
text:array[1..3] of string = ('hard', 'meium', 'easy');
var
poz,i : integer;
key : char;
begin
setbkcolor(7);
setcolor(ct);
settextstyle(0,0,3);
for i:=1 to 3 do
outtextxy(xpoz,ypoz[i],text[i]);
setcolor(15);
line(200,70,400,70);
line(200,70,200,270);
setcolor(6);
line(200,270,400,270);
line(400,270,400,70);
poz:=1;
while key<>#13 do
begin
setcolor(ctt);
outtextxy(xpoz,ypoz[poz],text[poz]);
key:=readkey;
if key=#0 then key:=readkey;
case key of
#72 : begin setcolor(ct); outtextxy(xpoz,ypoz[poz],text[poz]);
if poz=1 then poz:=3 else poz:=poz-1;
end;
#80 : begin setcolor(ct); outtextxy(xpoz,ypoz[poz],text[poz]);
if poz=3 then poz:=1 else
poz:=poz+1; end;
#13 : key:=#13;
end; { case }

end;
GAME_TIME := 2000*poz;
end;

procedure Up_dv;
const r_s_x = 35;r_s_y=40;s_xy=10;
var
xx,yy,sh,dsh,loop,xy_flg,k,flag,i,sgn,strt,flag_s : integer;
begin

putimage(x1,y1,p1^,2); putimage(x1,y1,p1^,1);
strt:=1;
delay(10);

key:=readkey;

if key=#0 then key:=readkey;
begin
xx:=x1; yy:=y1;
sh:=0;
case key of
#72 : begin y1:=y1-s_xy; sh:=0; loop:=r_s_x; xy_flg:=1; end;
#80 : begin y1:=y1+s_xy; sh:=r_s_y;loop:=r_s_x; xy_flg:=1;end;
#75 : begin x1:=x1-s_xy; sh:=0; sgn:=-1;loop:=r_s_y;xy_flg:=0;end;
#77 : begin x1:=x1+s_xy; sh:=r_s_x;sgn:=1; loop:=r_s_y;xy_flg:=0;end;
end;
flag:=0;flag_s:=0;

for i:=0 to loop do
begin
if(xy_flg=1)then
begin
strt:= getpixel(x1+i,y1+sh);
if ((strt<>black) and (strt>0)) then
flag:=1;
strt:= is_in_s(x1+i,y1+sh);
if(strt <>0 )then
begin
flag_s:=strt;
flag:=0;
end;
end;
if(xy_flg=0)then
begin
for k:=0 to s_xy do
begin
strt:= getpixel(x1-k*sgn+sh,y1+i);
if ((strt<>black) and(strt>0)) then
flag:=1;
strt:=is_in_s(x1-k*sgn+sh,y1+i);
if(strt<>0)then
begin
flag_s:=strt;
flag:=0;
end;
end;
end;
end;

if(flag=1)then
begin
x1:=xx;y1:=yy;
end;
if(flag_s<>0)then
begin
SetFillStyle(solidfill,black);
bar(s_x[flag_s],s_y[flag_s],s_x[flag_s]+S_T_S,s_y[flag_s]+S_T_S);
if(s_flags[flag_s]=1)then
begin
s_flags[flag_s]:=0;
s_count:=s_count+1;
end;
end;
putimage(x1,y1,p1^,1);
end;
end;

procedure Np_dv;
var flag,m,n: integer;
begin
j:=0;
put_angle_text('press any key',0);
setcolor(red);
for i:=1 to 5 do
begin
flag:=1;
while flag=1 do
begin
x2:=random(640);y2:=random(480);
flag:=is_color_in(x2,y2,x3+45,y3+20);
end;
putimage(x2,y2,p5^,1);
end;
for i:=1 to 5 do
begin
flag:=1;
while flag=1 do
begin
x2:=random(640);y2:=random(480);
flag:=is_color_in(x2,y2,x2+40,y2+60);
end;
{ rectangle(x2,y2,x2+40,y2+60);}
putimage(x2,y2,p2^,1);
end;
for i:=1 to 5 do
begin
flag:=1;
while flag=1 do
begin
x3:=random(640);y3:=random(480);
flag:=is_color_in(x3,y3,x3+35,y3+40);
end;
{ rectangle(x3,y3,x3+35,y3+40);}
putimage(x3,y3,p3^,1);
end;
n_doll:=0;
for i:=1 to 5 do
begin
add_s;
end;
end;
function our_time: word;
var
hour,min,sec,s100 : word;
begin
gettime(hour,min,sec,s100);
our_time:=(3600*hour+60*min+sec)*100+s100;
end;
procedure GAME;
var
interval,now_time,cur_time,cur_time_1:word;
text: string;
begin
x1:=getmaxx div 2+30; y1:=getmaxy-50;
menu1;
kvg1;
setbkcolor(0);
s_count:=0;
Np_dv;
game_start_time := our_time; cur_time:=game_start_time;
cur_time_1 :=game_start_time;
interval:=50;
repeat
now_time:=our_time;
remain_time:=(GAME_TIME - (our_time-game_start_time)) div 100;
if(now_time-cur_time>interval)then
begin
add_s;
interval := random(300)+50;
cur_time:=now_time;
end;
if((now_time-cur_time_1)>100)then
begin
cur_time_1:=now_time;
put_angle_text('',1);
end;
if KeyPressed then
begin
Up_dv;
end;
until (key=#27) or (now_time-game_start_time>GAME_TIME);
cleardevice;
setcolor(green);
settextstyle(0,0,4);
outtextxy(100,200,'score: $');
str(s_count,text);
outtextxy(100+340,200,text);
setcolor(red);
outtextxy(100,300,'press [enter]');
readln;
end;

procedure menu;
const
xpoz = 230;
ct = 1;
ctt = 12;
ypoz:array[1..3] of integer = (100,150,200);
text:array[1..3] of string = ('Help', 'Game', 'Exit');
var
poz,i : integer;
key : char;
begin
setbkcolor(7);
setcolor(ct);
settextstyle(0,0,3);
for i:=1 to 3 do
outtextxy(xpoz,ypoz[i],text[i]);
setcolor(15);
line(200,70,400,70);
line(200,70,200,270);
setcolor(6);
line(200,270,400,270);
line(400,270,400,70);
poz:=1;
while key<>#13 do
begin
setcolor(ctt);
outtextxy(xpoz,ypoz[poz],text[poz]);
key:=readkey;
if key=#0 then key:=readkey;
case key of
#72 : begin setcolor(ct); outtextxy(xpoz,ypoz[poz],text[poz]);
{ putimage(x,y,p1^,1); y:=y+40; putimage(x,y,p1^,1); }
if poz=1 then poz:=3 else poz:=poz-1;
end;
#80 : begin setcolor(ct); outtextxy(xpoz,ypoz[poz],text[poz]);
{ putimage(x,y,p1^,1); y:=y-40; putimage(x,y,p1^,1); }
if poz=3 then poz:=1 else
poz:=poz+1; end;
#13:case poz of
1 : begin cleardevice; Help; cleardevice;{key:=readkey;} menu; end;
2 : begin cleardevice; Game; cleardevice;{key:=readkey;} menu; end;
3 : key:=#13;
end;
end; { case }
end;
end;

Begin
Gd:=Detect;
InitGraph(Gd, Gm, '');
{PRO}
kol_vo:=true;
test;
if (score<3) then exit;
nazvanie(5,'последний герой');
picture;
menu;
{/PRO}
CloseGraph;
End.



А вот файлы(картинки*dat): http://www.multexe.narod.ru/files.zip
-TarasBer-
Покажи пример своего файла, который ты пытаешься ему скормить.
Vanya
Файл который добавляю
-TarasBer-
Ты нарисовал в пеинте обычный PNG и поменял ему расширение на DAT, поздравляю.

А формат-то у твоих датов простой: первый 2 байта - размер по икс, вторые два байта - размер по игрек, а дальше просто побайтно записано содержимое видеопамяти. Такой dat можно генерировать при помощи GetImage в своей программе, но никак не при помощи смены расширения у картинки совсеем другого формата.

Vanya
Спасибо. А как сделать тогда dat файлы как те?
-TarasBer-
Инициализируешь графику.
Рисуешь картинку.
Тебе надо сохранить часть, попавшую в прямоугольник X1,Y1,X2,Y2

Делаешь примерно так:
(я не проверял, писал сразу в браузер)


procedure Save(X1, Y1, X2, Y2: integer; const FileName: string);
var
f: file of byte;
size: integer;
p: pointer;
begin
Size := ImageSize(X1,Y1,X2,Y2);
GetMem(P, Size); { Распределяем память в куче }
GetImage(X1,Y1,X2,Y2, P^);

Assign(f, FileName);
Rewrite(f);
BlockWrite(f, P^, Size);
Close(F);

FreeMem(P, Size);
end;


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