Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
8
Добавлен:
01.05.2014
Размер:
2 Кб
Скачать

uses crt;
var max,er:integer;
    str_,out_s:string;
    answer:char;

procedure print_str(s:string;x,y:byte);
begin
  asm
    push   bp
    push   di
    cld
    lea    si,s
    SEGSS  lodsb
    xor    ah,ah
    xor    bh,bh
    xchg   ax,cx
    push   cx

    segss rep movsb

    pop    cx
    pop    di
    mov    al,0
    mov    dh,y
    mov    dl,x
    mov    bl,00000111b
    mov    bp,di
    mov    ah,13h
    int    10h
    pop    bp
  end
end;

function transform(S: String): String;
begin
    asm
	 push di
	 cld
	 mov    er,0
	 lea    si,S
	 les    di,@Result
	 SEGSS  lodsb
	 stosb
	 xor    ah,ah
	 xor    bh,bh
	 xchg   ax,cx
	 jcxz   @out_
	 cmp    cx,max
	 jg @error
    @next:
	 SEGSS  lodsb
	 cmp al,30h
	 jge @g_e
	 jmp @cont

    @g_e:
	 cmp al,39h
	 jg @cont
	 inc bh
	 stosb
    @cont:
	 loop @next
	 jmp @out_
    @error:
	 mov er,1
    @out_:
	 pop di
	 les di,@Result
	 mov al,bh
	 stosb

    end;
end;

procedure About;
begin
  clrscr;
  print_str('‹ Ў®а в®а­ п а Ў®в  ь4',28,9);
  print_str('Ї® ¤ЁбжЁЇ«Ё­Ґ',32,10);
  print_str('"ЋаЈ ­Ё§ жЁп Ё дг­ЄжЁ®­Ёа®ў ­ЁҐ  ЇЇ а в­ле',18,11);
  print_str('Ё Їа®Ја ¬¬­ле  б।бвў  ќ‚Њ"',26,12);
  print_str('„«п Їа®¤®«¦Ґ­Ёп ­ ¦¬ЁвҐ ENTER...',25,24);
  repeat
    answer:=readkey
  until answer=#13;
end;

procedure process;
begin
  repeat
    clrscr;
    writeln;
    write('  ‚ўҐ¤ЁвҐ ¬ ЄбЁ¬ «м­®Ґ зЁб«® бЁ¬ў®«®ў:                 ');readln(max);
    writeln;
    write('  ‚ўҐ¤ЁвҐ бва®Єг бЁ¬ў®«®ў ¤«Ё­®© ­Ґ Ў®«ҐҐ ',max,' бЁ¬ў®«®ў:  ');readln(str_);
    writeln;
    out_s:=transform(str_);
    if er=1 then writeln('  „«Ё­  бва®ЄЁ ­Ґ ¤®«¦­  ЇаҐўли вм ',max,' бЁ¬ў®«®ў!')
	    else writeln('  ‘ва®Є ,б®бв®пй п в®«мЄ® Ё§ жЁда Ёб室­®© бва®ЄЁ:     ',out_s);
    writeln;
    writeln(' ==========================================================');
    writeln;
    writeln ('     -=Џа®¤®«¦Ёвм?(1-¤ /2-­Ґв)=-    ');
    repeat
      answer:=readkey
    until ((answer='1')or (answer='2'))
  until answer='2';
end;

begin

  max:=2;
  about;
  process;

end.
Соседние файлы в папке built_in