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

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