Привет Люди! Как открыть в паскале dat* Картинки? Точнее даже не так. Как свои dat картинки окрыть. З.Ы.: Есть исходник кода + файлы(dat картинки). Программа работает. Если я вставляю свои dat они не отображаются( Почему? Надеюсь суть проблемы понятно объяснил... Очень надо. Спасибо!
Lapp
13.03.2011 10:10
Цитата(Vanya @ 12.03.2011 16:22)
Привет Люди! Как открыть в паскале dat* Картинки? Точнее даже не так. Как свои dat картинки окрыть. З.Ы.: Есть исходник кода + файлы(dat картинки). Программа работает. Если я вставляю свои dat они не отображаются( Почему? Надеюсь суть проблемы понятно объяснил... Очень надо. Спасибо!
Нет, не очень понятно. Точнее, совсем непонятно.
Расширение .dat не является стандартом. Обычно программисты дают его своим файлам, которые не имеют стандартной структуры. Их содержимое может понять/прочитать только сам автор программы, которая их использует (либо должно прилагаться точное описание). Если есть код программы (скажем, на Паскале), то можно попробовать разобраться, убив кучу времени и без гарантированного результата.
Vanya
13.03.2011 19:48
Вот код программы Автор: 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,'который покажет насколько вы достойны играть в данную игру '); 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,'Неплохие ответы, но все же на один вопрос вы не ответили '); 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,'У_дачи '); 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
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.
Покажи пример своего файла, который ты пытаешься ему скормить.
Vanya
13.03.2011 20:21
Файл который добавляю
-TarasBer-
13.03.2011 20:33
Ты нарисовал в пеинте обычный PNG и поменял ему расширение на DAT, поздравляю.
А формат-то у твоих датов простой: первый 2 байта - размер по икс, вторые два байта - размер по игрек, а дальше просто побайтно записано содержимое видеопамяти. Такой dat можно генерировать при помощи GetImage в своей программе, но никак не при помощи смены расширения у картинки совсеем другого формата.
Vanya
13.03.2011 20:42
Спасибо. А как сделать тогда dat файлы как те?
-TarasBer-
13.03.2011 21:07
Инициализируешь графику. Рисуешь картинку. Тебе надо сохранить часть, попавшую в прямоугольник 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^);