Системные функции в текстовом режиме ОС (Pascal)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Hardover, 9 Feb 2008.

  1. Hardover

    Hardover Banned

    Joined:
    23 Feb 2007
    Messages:
    24
    Likes Received:
    3
    Reputations:
    0
    Есть задание.
    По запросу скрытно (звездочками) ввести строку символов, затем по приглашению в цикле вводить отдельные буквы и открывать их в исходной закрытой строке (при наличии) зеленым цветом на своих местах (ПОЛЕ ЧУДЕС).
    Я ВОБЩЕ не понимаю как это реализовать. Сказали что это надо написать на паскале на системном уровне. Собственно есть ли статья на эту тему? Мне ну нужны учебники, а нужна хорошая статья направленная на решение подобных задач. Я бы сам нагуглил но я не понимаю что надо искать.
    Заранее благодарен.
     
  2. rem

    rem New Member

    Joined:
    9 Nov 2006
    Messages:
    24
    Likes Received:
    4
    Reputations:
    1
    порой та тему исходников програмки OpenPassXP или подобной там реализованы алгоритмы которые те нужны для решения етой задачи.
    Если я тя пральльно понял.
    А можешь привести текст задания слово в слово))
     
  3. !{ra!{e/\/

    !{ra!{e/\/ Banned

    Joined:
    27 Aug 2007
    Messages:
    98
    Likes Received:
    50
    Reputations:
    3
    Code:
     
    program ex1;
    uses crt;
    var b:char;
    st,s2:string;
    i:integer;
    begin
    clrscr;
    b:='8';
    s2:='';
    write('введите строку символов по нажатию нажмите пробел ');
    while (b<>' ') do begin
    st:=st+b;
    b:=readkey;
    write('*');
    end;
    clrscr;
    for i:=2 to length(st)+1  do s2:=s2+'*';
    write('ведите букву для выхода нажмите пробел  ',s2);
    b:='1';
    while (b<>' ') do begin
    b:=readkey;
    if pos(b,st)>0 then begin
    clrscr;
    s2[pos(b,st)]:=b;
    write(s2);
    end;
    end;
    write(length(st));
    end.
    
    
    Вот только написал для тебя..все работает ..сам чуть подправишь..
     
    #3 !{ra!{e/\/, 9 Feb 2008
    Last edited: 9 Feb 2008
    1 person likes this.
  4. Hardover

    Hardover Banned

    Joined:
    23 Feb 2007
    Messages:
    24
    Likes Received:
    3
    Reputations:
    0
    Спасибо посмотрю, это текст задачи слово в слово.
    !{ra!{e/\/ Спасибо, навел на мысли, программа правильная, я даже понял как ее дописать, но препод сказал что надо писать ее с подключением модуля DOS.
    Вот примеры программ взятые у препода.
    http://www.rapidshare.ru/572471
    Там 5-ть примеров и сами задания на выбор. (Я взял 29)
     
  5. Hardover

    Hardover Banned

    Joined:
    23 Feb 2007
    Messages:
    24
    Likes Received:
    3
    Reputations:
    0
    Вот вроде так надо выполнять задание.
    ВО вторник если доделаю прогу у препода спрошу, так ли надо было делать.
    Пока что есть две проблемы.
    1) Как сделать так что если в загаданном слове несколько букв одинаковых открывались все эти буквы. например слово moloko открывается только первая о.
    2)Как сделать открытые буквы зеленого цвета? Там в программах которые я выложил выше есть одна в которой звездочки меняют цвет. но как это реализовать в моейм, да еще так что бы в зеленный окрашивались только уже отгаданые буквы я не знаю.
    Code:
    uses crt,dos,objects;
    
    type ps=^string;
    
    var regs:Registers;l:ptrrec;
    
    procedure clrscr;
     begin regs.ax:=3;
           intr($10,regs);end;
    
    procedure readln(p:ps);
       begin l:=ptrrec(p);
       with regs do begin ah:=$3f;
             bx:=0;cx:=80;
             ds:=l.seg;dx:=l.ofs+1;
             msdos(regs);
             p^[0]:=chr(ax-2) end; end;
    
    procedure  write(p:ps);
       begin l:=ptrrec(p);
       with regs do begin ah:=$40;
         bx:=1;cx:=length(p^);
          ds:=l.seg;dx:=l.ofs+1;
             msdos(regs);end;end;
    
    procedure writeln(p:ps);
        var e:ps;
        begin new(e);e^:=#10#13;
        write(p);write(e) end;
    
    function readkey:char;
             begin with regs do begin
             ah:=8;msdos(regs);
             readkey:=chr(al) end end;
    procedure putc(c:char);
             begin with regs do begin
             ah:=2;dl:=ord(c);
             msdos(regs);end end;
    
    var p,s,e,st,s2:ps;
    i:integer;
    b:char;
    k:integer;
    Begin
          clrscr;new(e);e^:=#10#13;
          new(p);new(s);p^:='Введите слово, по нажатию ввода конец. ';
          new(st);new(s2);
          b:='0';
          s2^:='';
          write(p);
          repeat st^:=st^+b;
          b:=readkey;
          if b=#13 then break;
          putc('*');
          until false;
          clrscr;
          for i:=2 to length(st^)+1 do s2^:=s2^+('*');
          p^:='Введите буквы для выхода нажмите ввод ';
          write(p);
          write(s2);
          repeat b:=readkey;
          if b=#13 then break;
          if pos(b,st^)>0 then begin
          clrscr;
          s2^[pos(b,st^)]:=b;
          write (p);
          write (s2);
          end;
          until false;
          end.
    
     
    #5 Hardover, 11 Feb 2008
    Last edited: 11 Feb 2008