http://sulfurzona.com/
News
Service
Magazine
Software (Battle City Game, Wallpaper manager, Superpad, VG-NOW, Puzzle Game, Netler Internet Browser, ..)
Dune Game (Dune III, Dune IV, Cheats, Forum, ..)
Games free
Turbo Pascal (Assembler, Docs, Sources, Debbugers, ..)
Books (Docs for developers)
Forum
Guest book
Компьютерная диагностика двигателя автомобиля (адаптер К-линии)Компьютерная диагностика двигателя автомобиля (адаптер К-линии)
 
 
 
 

Паскаль для новичков (часть 34)

 
Спрашивали? Отвечаю…
 

Ресурсные файлы 2 (продолжение)

 
Паскаль для новичковС вашего позволения я продолжаю ;O)
  
Немного мудрёней получился метод позиционирования rSeek, который должен устанавливать указатель вложенного файла на заданную позицию Pos. Но перед этим он выполняет проверку, если заданная позиция представляет собой отрицательное число, то такая позиция непригодна и позиционирование осуществляется на начало вложения. Если же заданная позиция превышает размер вложения, то это уж ни в какие ворота не лезет, и позиционирование осуществляется на конец вложения. Тут нужно быть аккуратным, так как последующее чтение данных из вложения может позволить прочесть заголовок следующего вложения, либо вызвать ошибку чтения за пределами XMS-буфера. Иначе позиционирование проводится в соответствии с указаниями.
 
procedure TResource.rSeek( var f; Pos : longint );
var af : TFile absolute f;
begin
if Pos < 0 then Pos := 0;
if Pos > af.FSize then Pos := af.FSize;
af.FPos := Pos;
end;
 
Пока вы самостоятельно изучаете следующий метод, я спокойно сделаю паузу, съем Twix и запью горячим чаем с лимоном ;o)
 
function TResource.rFileSize( var f ) : longint;
var af : TFile absolute f;
begin
rFileSize := af.FSize;
end;
 
Немного подкрепившись, я с новыми силами перехожу к методу-трудяге rBlockread, который будет выполнять чтение данных из вложенного файла независимо от того, загружен ресурсный файл в XMS-память, или остался, роскошно лежать, на отполированной поверхности жёсткого диска.
  
В зависимости от размещения ресурсного файла может быть выполнена вложенная процедура rBlockReadXMS, которая копирует ACount байт из XMS-буфера начиная с начала размещения ресурсного файла FResOfs плюс смещение читаемого вложения af.FOfs в нём и плюс заданная позиция af.FPos. Для чтения с диска будет выполнена процедура rBlockReadDisk, которая составлена на столько традиционным для моих статей образом, что в пояснении нуждается лишь строка Seek( bf, FResOfs + af.FOfs + af.FPos ). Данная операция, несмотря на такое длинное арифметическое выражение, выполняет позиционирование указателя ресурсного файла на начало читаемого вложения af.FOfs плюс его текущая позиция af.FPos. При этом значение FResOfs, ещё при создании экземпляра объекта, для режима загрузки FResType=rtDisk получило нулевое значение, и указано лишь для сохранения аналогии в обоих вложенных процедурах, хотя с точки зрения оптимизации можно было фрагмент “FResOfs+” из данного выражения убрать.
  
В обеих процедурах значение поля FPos файловой переменной увеличивается на размер прочитанных данных.
 
procedure TResource.rBlockread( var f, DosBuf; ACount : word; var Result : word );
var af : TFile absolute f;
 
 {чтение из ресурсного файла, загруженного в XMS}
 procedure rBlockReadXMS;
 begin
 moveXMSToMem( FResBuf, DosBuf,
           FResOfs + af.FOfs + af.FPos, ACount );
 Result := ACount;
 af.FPos := af.FPos + ACount;
 end;
 
 {чтение из ресурсного файла на диске}
 procedure rBlockReadDisk;
 var bf : file;
 begin
 Assign( bf, FName ); {$I-}
 Reset( bf, 1 ); {$I+}
 FIoResult := IOresult;
 if FIoResult <> 0 then exit;
 Seek( bf, FResOfs + af.FOfs + af.FPos );
 blockread( bf, DosBuf, ACount, Result );
 af.FPos := af.FPos + Result;
 Close( bf );
 end;
 
begin
if FResType = rtXMS then rBlockReadXMS
    else rBlockReadDisk;
end;
 
Завершающий метод простой до смешного ;O) И в самом деле, что нам закрывать, если мы ничего не открывали.
 
procedure TResource.rClose( var f );
begin
end;
 
С объектом для ресурсных файлов мы разобрались. А если кто-то ещё не всё понял из выше сказанного, пишите мне по адресу: Интернетовская область, деревня Гадюкино, последняя хата с краю, Амониту Исааковичу ;O)
  
А все те, кто до этих пор успевал за ходом моих мыслей, вместе со мной организованным стадом ушедшего года баранов мерными шагами упорно движемся дальше к намеченной цели.
  
Осталось рассмотреть подпрограмму, которая бы выполняла добавление файла с именем AddFileName в создаваемый или уже существующий ресурсный файл ResFileName. Это будет функция, возвращающая нулевое значение при успешно выполненной работе, иначе любое другое значение будет означать код ошибки.
  
В рассматриваемом блоке всё настолько напоминает многое из того, что вы уже могли видеть, что я объясню лишь вкратце. Во-первых, следует проверить наличие необходимого объёма свободной памяти для буфера копирования, иначе и не стоит затевать всю эту кутерьму. Во-вторых, пытаемся открыть файл, претендующий на перспективу быть вложенным. Если всё проходит гладко, то пытаемся открыть ещё и ресурсный файл. Если он к этому времени уже существует, то позиционируем его указатель в конец, чтобы затем добавить очередной заголовок и файл, а если ресурсного файла нет, то создаём его. Затем следует выделение памяти под временный буфер Buf для копирования. После этого определяем размер вкладываемого файла и заполняем переменную Rec данными о нём – заголовок готов. Далее следует запись заголовка и содержимого добавляемого файла в ресурсный файл. Освобождаем память. Аминь.
 
function AddFileToResource( ResFileName, AddFileName : string ) : word;
const arsize = SizeOf( TArrByte );
var rf, af : file;
       err, d, count : word;
       long : longint;
       Rec : TResFileRec;
       buf : ^TArrByte;
begin
AddFileToResource := 0;
if MaxAvail < arsize then begin
   AddFileToResource := 203;
   exit;
   end;
Assign( af, AddFileName ); {$I-}
Reset( af, 1 ); {$I-}
err := IOresult;
if err <> 0 then begin
   AddFileToResource := err;
   exit;
   end;
Assign( rf, ResFileName ); {$I-}
Reset( rf, 1 ); {$I+}
err := IOresult;
if err <> 0 then Rewrite( rf, 1 )
   else Seek( rf, FileSize( rf ) );
GetMem( buf, arsize );
long := FileSize( af );
Rec.FileName := AddFileName;
Rec.ID := ResSignature;
Rec.FOfs := FileSize( rf ) + tsize;
Rec.FSize := long;
blockwrite( rf, Rec, tsize, d );
 
repeat
 if long < arsize then count := long
    else count := arsize;
 blockread( af, buf^, count, d );
 blockwrite( rf, buf^, count, d );
 long := long – d;
until long <= 0;
Close( af );
Close( rf );
FreeMem( buf, arsize );
end;
 
end.
 
Вот собственно и весь модуль. Честно говоря, всё, что было описано выше, временами напоминало фарс ;O)
  
Ну да ладно. Это всё была присказка, а сказочка ещё впереди. Осталось написать программу добавления файла в ресурс. Состоит она из проверки количества указанных параметров в командной строке. Первым параметром должно идти имя ресурсного файла, например “MYDATA.RES”, а вторым имя добавляемого файла, например “MYFONT1.FNT”. Если указано два параметра, то выполняется функция добавления, и вся основная работа ложится на модуль.
 
Program AddRes;
Uses ResFiles;
 
begin
if ParamCount<2 then begin
   writeln('Resource file creator');
   writeln('Usage: addres.exe [resource file] [file for add]');
   halt;
   end;
if AddFileToResource(ParamStr(1),ParamStr(2))<>0
   then writeln('Addiding error.');
end.
 
Перед рассмотрением следующей и последней на этот раз программы, взываю к вашей памяти и прошу припомнить одну из предыдущих статей под названием “Работаем с текстовым режимом” из данного цикла. В ней шла речь о текстовых режимах дисплея, и упоминалось о том, как при помощи функции InstallFont модуля VESACRT.PAS можно устанавливать собственные шрифты для отображения текста на экране.
 
 
 
 
  
Так вот сейчас я продемонстрирую, как можно подгружать и устанавливать шрифты из ресурсного файла. Для начала следует создать ресурсный файл, например с именем 'fonts.res', и добавить в него пять шрифтов, имена которых специально перечислены в константе Font, чтобы затем поимённо их загружать по очереди. Ранее, я уже рассказывал, где можно взять такие шрифты. Собственно, единственное существенное изменение претерпела функция InstallFont, которая теперь будет называться InstallFontFromResource, где вместо обращений к обычному файлу шрифта применён способ загрузки его из ресурса Res^. Следует заметить, что в вызовах методов rAssign, rReset, rSeek, rBlockread и rClose указана обычная файловая переменная, объявленная с идентификатором стандартного типа File. Это вполне допустимо, так как в данном случае файловая переменная используется только для доступа к вложению, и не может служить для получения информации о файле через обращение к полям данной структуры. Как это может быть вопреки всем правилам? Пускай это останется моим маленьким секретом ;O)
  
В начале главного блока программы проводится проверка наличия загруженного XMS-драйвера. Затем выполняется строка New( Res, Create( 'fonts.res', rtXMS)), создающая экземпляр объекта Res для работы с ресурсным файлом и выполняющая одновременную загрузку оного из файла 'fonts.res' в XMS, так как указана константа rtXMS в качестве второго параметра.
 
Uses VesaCrt, Keyboard, ResFiles, XMS;
 
const MaxFont = 4;
          Font : array [0..MaxFont] of string =
                  ( 'latrus1.fnt', 'latrus2.fnt',
       'vg.fnt', 'latrus4.fnt', 'year2000.fnt' );
 
var d, mode, key, FontIndex : word;
       Res : ^TResource;
       AFile : TFile;
 
procedure GetMem( var p; Size : word );
var PP : pointer absolute p;
begin
PP := nil;
if MaxAvail < Size then exit;
System.GetMem( PP, Size );
end;
 
function InstallFontFromResource( FileName : string; FirstChar, CharCount, BytePerChar : word ) : word;
type TBuf = array [0..20*256] of byte;
var Buf, Buf2 : ^TBuf;
       f : file;
       d, j : word;
       k : real;
begin
InstallFontFromResource := 0;
GetMem( Buf, 256*BytePerChar );
if Buf = nil then begin
   InstallFontFromResource := 203; exit; end;
GetMem( Buf2, 256*Screen.CharBytes );
if Buf2 = nil then begin
   InstallFontFromResource := 203;
   FreeMem( Buf, 256*BytePerChar );
   exit;
   end;
Res^.rAssign( f, FileName );
Res^.rReset( f );
d := Res^.rIOResult;
if d <> 0 then begin
   InstallFontFromResource := d;
   FreeMem( Buf2, 256*Screen.CharBytes );
   FreeMem( Buf, 256*BytePerChar );
   exit;
   end;
Res^.rSeek( f, 2 );
Res^.rBlockread( f, Buf^, 256*BytePerChar, d );
Res^.rClose( f );
if Screen.CharBytes = BytePerChar then
   SetCharTable(Buf^[FirstChar*BytePerChar],
        FirstChar, CharCount, Screen.CharBytes )
   else begin
   k := BytePerChar/(Screen.CharBytes-1);
   for d:=0 to 255 do
     for j:=0 to Screen.CharBytes-1 do
          Buf2^[d*Screen.CharBytes+j] :=
              Buf^[d*BytePerChar+trunc(k*j)];
   SetCharTable(Buf2^[FirstChar*Screen.CharBytes],
        FirstChar, CharCount, Screen.CharBytes );
   end;
FreeMem( Buf2, 256*Screen.CharBytes );
FreeMem( Buf, 256*BytePerChar );
end;
 
procedure SetFont;
begin
if InstallFontFromResource( Font[ FontIndex ],
      0, 256, 8 ) > 0 then
   if SetTextMode( 0 ) then begin
      Dispose(Res,Free);
      writeln( 'Bad font index ', FontIndex );
      halt;
      end;
end;
 
procedure NextMode;
begin
if mode < 5 then Inc( mode )
   else mode := 0;
if not SetTextMode( mode ) then begin
   Dispose(Res,Free);
   writeln( 'Bad screen mode' );
   halt;
   end;
SetFont;
SetCurSize( 0, Screen.CharHeight-1 );
end;
 
procedure NextFont;
begin
if FontIndex < MaxFont then Inc( FontIndex )
   else FontIndex := 0;
SetFont;
end;
 
function IntToStr( value : longint ) : string;
var s : string;
begin
Str( value, s );
IntToStr := s;
end;
 
begin
mode := 0;
FontIndex := 0;
if not InitXMS then begin
   writeln( 'XMS driver not found.' );
   halt;
   end;
Res := nil;
New( Res, Create( 'fonts.res', rtXMS ) );
if Res = nil then begin
   writeln( 'Create object error.' );
   halt;
   end;
if not SetTextMode( mode ) then begin
   Dispose(Res,Free);
   writeln( 'Bad screen mode' );
   halt;
   end;
SetCurSize( 0, Screen.CharHeight-1 );
SetFont;
repeat
 FillScr( ' ', clWhite, clLightGray );
 SetTextColor( clWhite );
 TextOut( 0, 1,'Hello украинцы!' );
 TextOut( 0, 2,'Режим: ' + IntToStr( mode ));
 TextOut( 0, 3,'Current Font: '+Font[FontIndex]);
 TextOut( 0, 5,'Files:' );
 for d := 0 to Res^.Count-1 do begin
       Res^.GetFile( d, AFile );
       TextOut( 0, d + 7, 'File ' + IntToStr(d) +
         ' : ' + AFile.Name + ' , ' +
         IntToStr( AFile.Index ));
       end;
 for d := 0 to 127 do
       TextOut( d, Screen.MaxY-3, char( d ));
 for d := 128 to 255 do
       TextOut( d-128, Screen.MaxY-1, char( d ));
 key := waitkey;
 if key = VK_Enter then NextMode;
 if key = VK_Space then NextFont;
until key = VK_Esc;
Dispose(Res,Free);
if SetTextMode( 0 ) then;
end.
 
Программа работает таким образом, что при каждом нажатии клавиши “пробел” будет меняться шрифт от первого в списке константы Font и до последнего, и снова с первого и так по кругу. На экране будет отображаться информация о номере текущего текстового режима, изменять который можно нажатием клавиши ENTER. Помимо этого, будет выводиться информация о названии текущего шрифта, и даже список всех имеющихся шрифтов в ресурсном файле. При этом доступ к информации о вложенном файле будет осуществляться при помощи вызова метода Res^.GetFile(d, AFile), где переменная AFile, объявленная с идентификатором TFile, получает данные о файле, и эти данные могут быть доступны через поля этой переменной. Завершить выполнение программы можно нажатием клавиши ESCAPE.
  
Вот, собственно, так легко можно использовать ресурсные файлы системы Amonit ;O)
 
Продолжение следует…
 
© Владислав Демьянишин
 
Вы находитесь на официальном сайте Владислава Демьянишина - разработчика игры Dune IV (Dune 4). На нашем сайте Вы можете бесплатно скачать игры Dune IV (Dune 4), Battle City (Танчики с Dendy/Nintendo), читы к играм и многое другое. Также Вы можете скачать бесплатно программы и полезные утилиты. Все программы чистые, т.е. не содержат вирусов и иного вредоносного ПО.
 
Среди доступных программ есть мобильная читалка книг, менеджер переноса файлов с фото- и видеокамер на компьютер, текстовый редактор, WYSIWYG редактор, 3D аниматор, GIF аниматор, AVI аниматор, пакетный конвертор изображений, редактор электрических схем, программа для скриншотов, диспетчер тем рабочего стола и другие.
 
На нашем сайте можно не только бесплатно скачать игры, но и документацию и книги по программированию на MIDLetPascal, Turbo Pascal 6, Turbo Pascal 7, Borland Pascal, по программированию устройств Sound Blaster, Adlib, VESA BIOS, справочник Norton Guide и много другой полезной информации для программистов, включая примеры решения реальных задач по созданию резидентных программ. Предлагаю также посетить Марья искусница - сайт о рукоделии (http://mariya-iskusnica.ru).
 
 

Журнал > Программирование > Паскаль для новичков (Turbo Pascal, Assembler) > Паскаль для новичков (часть 34): Ресурсные файлы 2 (продолжение)
 
 
 
81
 
ВКонтакте
Facebook
 
 
 
На главную страницу На предыдущую страницу На начало страницы
 
 
Украинский портАл Украина онлайн Рейтинг@Mail.ru Рейтинг Сайтов YandeG Rambler's Top100