Показать сообщение отдельно
Старый 01.10.2008, 22:10   #7
abcdef
Знающий
 
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений
(для 123 пользователей)
Ответ: интересные исходники или идеи реализации в MP

вот нашел простенький исходник,.. когда-то от нечего делать собирал квест по книжке Гарри Гарисона.
Из-за ограничения по памяти, грузить текстовку из ресурсов пришлось блоками,... которые подгружаются когда пользователь еще читает текст

Прикрепленный файл - текст квеста, имеет формат:
--$0
текст главы 0
....
--$117
текст главы 117
....
--$END
^- это была последняя строка файла

в тексте есть метки, вида: $183$ - таким образом добавляется переход на на нужную главу


var
  res      : resource;
  go, sss  : array[0..15] of string;
  s, l     : string;
  ch       : char;
  max,i,len: integer;
var
  exitCmd, gotoCmd, cmd : command;
  choiceIs : array[0..15] of integer;
  choiceId : integer;
  editId   : integer;
  textId   : integer;

function ansi(str : string) : string;
var  {rus_ansi to unicode}
  s   : string;
  i,c : integer;
begin
  s := '';
  for i := 0 to length(str)-1 do
  begin
    c := ord(getChar(str,i)) and 255;
    if (c>=192) then  c := c+(1040-192) else
      if (c<32) and (c<>10) then c := 32;
    s := s+chr(c);
  end;
  ansi := s;
end;

function findBlock(s : string) : string;
begin  {get text Block from resource file}
  findBlock := '';
  res := openResource('/quest.txt');
  if (resourceAvailable(res)=true) then
  begin
    s := '--'+s;
    repeat
      l := readLine(res);
      cmd := getClickedCommand;
      if cmd = exitCmd then  l := '--$END';
    until (l=s) or (l='--$END');
    s := '';
    if l<>'--$END' then
    repeat
      l := readLine(res);
      if copy(l,0,3)='--$' then  l := '';
      s := s+l+chr(10);
    until (l='');
    closeResource(res);
    findBlock := s;
  end;
end;


procedure menu;
begin  {get text points}
  max := 0;
  len := length(s);
  i := 0;
  if len>0 then
  repeat
    ch := getChar(s,i);
    if ch='$' then
    begin
      l := '';
      repeat
        l := l+ch;
        i := i+1;
        ch := getChar(s,i);
      until ch='$';
      go[max] := l;
      max := max+1;
    end;
    i := i+1;
  until (i>=len);
end;


begin
  showForm;
  exitCmd := createCommand('Exit', CM_EXIT, 1);
  gotoCmd := createCommand('Go',   CM_OK, 1);
  addCommand(exitCmd);
  s := findBlock('$0');
  repeat
    if s='' then s := 'ERROR: BLOCK NOT FOUND'+chr(10)+'to start $0$';
    textId   := formAddString(ansi(s));
    choiceId := formAddChoice('', CH_EXCLUSIVE);
    editId   := formAddTextField('', '', 10, TF_NUMERIC);{}
    menu;
    for i := 0 to max-1 do
    begin
      sss[i] := findBlock(go[i]);
      choiceIs[i] := choiceAppendString(choiceId, go[i]);
      if cmd=exitCmd then Break;
    end;
    if cmd<>exitCmd then
    begin
      addCommand(gotoCmd);
      repeat
        cmd := getClickedCommand;
      until cmd<>emptyCommand;
      removeCommand(gotoCmd);
      if cmd<>exitCmd then
      begin
        s := formGetText(editId);
        if s='' then
        begin{}
          for i := 0 to max-1 do
            if choiceIsSelected(choiceId, choiceIs[i]) then  s := sss[i];
        end
          else  s := findBlock('$'+s){}
      end;
    end;
    formRemove(editId);
    formRemove(choiceId);
    formRemove(textId);
  until cmd = exitCmd;
  removeCommand(exitCmd);
end.
Вложения
Тип файла: zip quest.zip (78.3 Кб, 702 просмотров)
(Offline)
 
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо abcdef за это полезное сообщение:
EVIL_USER (02.10.2008), Piligrim (01.10.2008), sasha_peleng (18.11.2008)