Помощь - Поиск - Пользователи - Календарь
Полная версия: Изображения *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,'который покажет насколько вы достойны играть в данную игру 
');
				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

   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;


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