Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создание игровых архивов

Автор: Daddy
WEB-сайт: http://daddy.mirgames.ru

Как Вы наверное уже давно знаете, каждый уважающий себя разработчик, делая большую игру, не оставляет картинки/звуки из игры в чистом виде, чтоб чьи-то умелые рученки не искаверкали всю игру и уж тем более не засовывают это ВСЁ в экзешник, а разными способами прячет ресурсы в разнообразные игровые архивы.

Конечно есть и такие, которые используют псевдо игровые архивы, тоесть обычные Zip архивы переименовывают в разные там Pak(Quake3) или Dat(IG2). Но речь идет не о них, а именно о НАСТОЯЩИХ игровых архивах.

Внимание!!! Описанные ниже алгоритмы защищены законом об авторском праве РФ. Любое распространение или использование этих алгоритмов без письменного разрешения автора противозаконно! И Вас посадят лет на 50, если Вы тут чего нить поймете! Шутка

Итак, ПОЯСНЯТЬ БУДУ ПО ХОДУ, поехали: 

unit Unit1; //Это упаковщик (отдельно от игры)

interface

uses
  Windows, SysUtils, Classes, Forms, FileCtrl, StdCtrls, Controls;

type
  TForm1 = class(TForm)
    flb: TFileListBox; //Список пакуемых файлов
    Edit2: TEdit; //Маска для списка файлов (например *.wav)
    Button5: TButton; //Кнопка к началу пакования
    procedure Edit2Change(Sender: TObject); //См. ниже
    procedure Button5Click(Sender: TObject); //Процедура пакования
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.Edit2Change(Sender: TObject);
begin
  flb.Mask := edit2.Text; //Меняем маску у списка файлов на текст Едита
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  fs, fs2: tfilestream;
  i, x: integer;
  b: byte;
  c: char;
  sn: int64;
  size: integer;
  all: int64;
begin
  fs := tfilestream.Create('My.pak', fmCreate);
  //Создаем РАК файл куда все будет запаковано
  all := 0; //Размер всех файлов архива изначально равен 0
  size := flb.Items.Count; //Количество файлов в архиве берется из списка
  fs.Write(size, sizeof(size)); //Записываем количество файлов
  for i := 0 to flb.Items.Count - 1 do //Теперь создаем список файлов в архиве
  begin
    b := strlen(pchar(flb.Items.strings[i])); //Смотрим длину имени файла
    fs.Write(b, sizeof(b)); //Записываем длину имени
    for x := 1 to b do //Далее записываем побуквенно имя файла
    begin
      c := flb.Items.strings[i][x];
      fs.Write(c, sizeof(c));
    end;
    fs2 := tfilestream.Create(flb.Items.Strings[i], fmOpenRead);
    //Загружаем файл (имя которого только что записали)
    sn := fs2.Size;
    fs.Write(sn, sizeof(sn)); //Узнаем и записываем его размер (в байтах)
    fs.Write(all, sizeof(all));
    //Записываем размер всех уже записанных (на этот момент) в архив файлов
    all := all + sn;
    fs2.Free;
  end; //Создание списка файлов завершено
  for x := 1 to size do //А тут все файлы из списка вставляются в архив!
  begin
    fs2 := tfilestream.Create(flb.Items.Strings[x - 1], fmOpenRead);
    fs.CopyFrom(fs2, fs2.Size);
    fs2.Free;
  end;
  fs.Free;
end;

end.

Запаковать запаковали, а распаковать как?

Да вот так: 

procedure Tmainform.UnPak(filename: string; arcivename: string);
  //UnPak(Имя файла в архиве, имя архива)
var
  b: byte;
  c: char;
  i, x: integer;
  fs, fs3: tfilestream;
  size: integer;
  all, nfs, np, sn: int64;
  s: string;
  index: integer;
  fini: array[1..50] of string;
begin
  fs := tfilestream.Create(arcivename + '.pak', fmOpenRead); //Открываем архив
  fs.Read(size, sizeof(size)); //Читаем количество файлов
  for i := 1 to size do //Теперь читаем имена и размеры файлов
  begin
    s := '';
    fs.Read(b, sizeof(b));
    for x := 1 to b do
    begin
      fs.Read(c, sizeof(c));
      s := s + c;
    end;
    fs.Read(sn, sizeof(sn));
    fs.Read(all, sizeof(all));
    fini[i] := s; //Заполняем таблицу имен файлов
  end;
  np := fs.position;
  fs.Free;
  for i := 1 to size do
    if lowercase(fini[i]) = lowercase(filename) then
      index := i; //Ищем номер нужного файла
  fs := tfilestream.Create(arcivename + '.pak', fmOpenRead);
    //Опять открываем архив
  fs.Read(size, sizeof(size));
  for i := 1 to size do
  begin
    fs.Read(b, sizeof(b));
    s := '';
    for x := 1 to b do
    begin
      fs.Read(c, sizeof(c));
      s := s + c;
    end;
    fs.Read(sn, sizeof(sn)); //Читаем размеры файлов и их место в архиве
    fs.Read(all, sizeof(all));
    if i = Index then //Если нужный номер файла в архиве то его распаковываем
    begin
      fs.Position := np + all;
      fs3 := tfilestream.Create(fini[index], fmCreate);
      fs3.CopyFrom(fs, sn);
      fs3.Free;
      fs.Free;
      exit;
    end;
  end;
  fs.Free;
end;

Но этот способ будет очень долго распаковывать большие файлы! Он нужен для распаковки файлов содержащих описание графики/звуков для распаковки (см. ниже).

Вот доработанная процедура динамической загрузки спрайтов: 

procedure TMainForm.LPD(FileName: string);
  //Имя файла в скобках указывает на файл содержащий описание нужной графики(сам он лежит в архиве dat.pak)
var
  index: integer;
  SectionName: string;
  SectionList: TStringList;
  Ext: string;
  item: tpicturecollectionitem;
  NewGraphic: TDIB;

  procedure UnPakBmp(filename: string); //Процедура распаковки картинок
  var
    b: byte;
    c: char;
    i, x: integer;
    fs: tfilestream;
    fs3: Tmemorystream;
    size: integer;
    all, nfs, np, sn: int64;
    s: string;
    index: integer;
    fini: array[1..500] of string;
    kkk: TJpegimage;
  begin
    fs := tfilestream.Create('images.pak', fmOpenRead);
      //Всё тоже самое что и в процедуре Unpak только файл не сохраняется на диск а сразу переносится в картинку
    fs.Read(size, sizeof(size));
    for i := 1 to size do
    begin
      s := '';
      fs.Read(b, sizeof(b));
      for x := 1 to b do
      begin
        fs.Read(c, sizeof(c));
        s := s + c;
      end;
      fs.Read(sn, sizeof(sn));
      fs.Read(all, sizeof(all));
      fini[i] := s;
    end;
    fs.Free;
    for i := 1 to size do
      if lowercase(fini[i]) = lowercase(filename) then
        index := i;
    fs := tfilestream.Create('images.pak', fmOpenRead);
    fs.Read(size, sizeof(size));
    np := 0;
    for i := 1 to size do
    begin
      fs.Read(b, sizeof(b));
      s := '';
      for x := 1 to b do
      begin
        fs.Read(c, sizeof(c));
        s := s + c;
      end;
      fs.Read(sn, sizeof(sn));
      fs.Read(all, sizeof(all));
      if i = Index then
      begin
        nfs := sn;
        np := all;
      end;
    end;
    fs.Position := fs.Position + np;
    fs3 := TmemoryStream.Create;
    fs3.CopyFrom(fs, nfs);
    fs3.position := 0;
    if ext = 'bmp' then //Из файла описания видно что это не ДжиПег то
      newgraphic.LoadFromStream(fs3) //Сразу превращаем в спрайт
    else
    begin
      kkk := tjpegimage.Create; //Если же это ДжиПег то
      kkk.LoadFromStream(fs3); //Конвертим джипег в спрайт
      newgraphic.Assign(kkk);
      kkk.Free;
    end;
    fs3.Free;
    fs.Free;
  end;

begin //Начало процедуры
  ImageList.Items.Clear;
  FileName := ChangeFileExt(FileName, '.dat');
  unpak(filename, 'dat'); //Распаковываем файл с описанием
  NewGraphic := TDIB.Create;
  SectionList := TStringList.Create;
  with TIniFile.Create(extractfilepath(application.exename) + FileName) do
    //Читаем его
  begin
    ReadSections(SectionList);
    for index := 0 to SectionList.Count - 1 do
      //Далее создаем компоненты DxImageList(у меня его зовут ImageList) и заполняем его параметрами из файла
    begin
      SectionName := SectionList[index];
      Ext := readstring(sectionname, 'ext', 'bmp');
      UnPakBmp(sectionname + '.dat');
        //А тут собственно заносим в память изображение
      item := TpictureCollectionitem.Create(ImageList.Items);
      item.picture.Graphic := NewGraphic;
      item.Name := SectionName;
      item.PatternHeight := ReadInteger(SectionName, 'PatternHeight', 0);
      item.PatternWidth := ReadInteger(SectionName, 'PatternWidth', 0);
      item.SkipHeight := 0;
      item.SkipWidth := 0;
      item.SystemMemory := false;
      item.Transparent := ReadBool(SectionName, 'Transparent', false);
      item.TransparentColor := StringToColor(ReadString(SectionName,
        'TransparentColor', 'clBlack'));
      item.restore;
    end;
  end;
  NewGraphic.Free;
  SectionList.Free;
  deletefile(filename);
end;

Далее я опишу как должен выглядеть файл с описанием графики: 

[serie16]
PatternHeight=0
PatternWidth=16
Transparent=1
TransparentColor=clBlack

[logo2]
PatternHeight=0
PatternWidth=0
Transparent=0
TransparentColor=clBlack
ext=jpg  

!!! Тоесть: 

[Название] 
PatternHeight=Высота кадра 
PatternWidth=Ширина кадра 
Transparent=Прозрачен? 
TransparentColor=Цвет прозрачности
ext=jpg или bmp

Помимо графики можно грузить и звуки и тексты и т.д. Если будет нужно это описать, то скажите об это на форуме или напишите. Надеюсь то что написано в этой статье вам поможет.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.