VPF::Замечательная программа! - Форум программистов

Данкинг

Дата 2.11.2009, 00:21 (ссылка)

(голосов:1)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Вот нашёл своё творчество образца 2000 года. smile

Код


color 14,9:cls
on error goto 100
key(10) on:on key(10) gosub 95

dim d$(15)
d$( 1)="АПАКОВА"
d$( 2)="Адрес: ул. Шаболовка, 9"
d$( 3)="Телефон: 236-8040"
d$( 4)="БАУМАНА"
d$( 5)="Адрес: ул. Сельскохозяйственная, 9/2"
d$( 6)="Телефон: 181-0381"
d$( 7)="КРАСНОПРЕСНЕНСКОЕ"
d$( 8)="Адрес: ул. Ходынская, 5"
d$( 9)="Телефон: 253-5468"
d$( 10)="ОКТЯБРЬСКОЕ"
d$( 11)="Адрес: ул. Большая Калитниковская, 44"
d$( 12)="Телефон: 270-7859"
d$( 13)="РУСАКОВА"
d$( 14)="Адрес: Русаковская наб., 1"
d$( 15)="Телефон: 268-7871"
r$=string$(80,chr$(220))
3 cls
?"                       ┌──────────────────────────┐"
?"                       │ТРАМВАЙНЫЕ МАРШРУТЫ МОСКВЫ│"
?"                       └──────────────────────────┘"
?:?
?"            ╔══════════════════════════════════════════════════╗"
?"            ║   <ENTER> - - - Данные по маршрутам трамваев.    ║"
?"            ║   <TAB>   - - - Данные по трамвайным депо.       ║"
?"            ║   <F10>   - - - Конец рабочей смены.             ║"
?"            ╚══════════════════════════════════════════════════╝"
?:?
5 a$=inkey$
if a$=chr$(13) then
cls:?
6 ?:input "Введите номер маршрута (1-50) ",nm:nm=int(nm)
if nm=0 then goto 3
if nm<1 or nm>50 then ?"Что за извращение??!!!":beep 2:goto 6
open "trambasa.dat" for input as #1
while not eof (1)
line input #1,w$
if val(left$(w$,2))=nm then
m$=right$(w$,len(w$)-8)
d=val(mid$(w$,7,1))
select case d
case 0:dd$="неизвестным депо."
case 1:dd$="Апаковским депо."
case 2:dd$="Бауманским депо."
case 3:dd$="Краснопресненским депо."
case 4:dd$="Октябрьским депо."
case 5:dd$="Русаковским депо."
case else:dd$="Проверьте правильность заполнения файла!!! Депо номер "+str$(d)+"- это полная лажа!"
end select
?:?" МАРШРУТ НОМЕР "nm": " m$
?"Обслуживается "dd$
end if
wend:close #1:goto 13
end if
if a$=chr$(9) then
cls:?
?"1 АПАКОВА"
?"2 БАУМАНА"
?"3 КРАСНОПРЕСНЕНСКОЕ"
?"4 ОКТЯБРЬСКОЕ"
?"5 РУСАКОВА"
10 ?:input "Введите цифру 1-5 : ",c:c=int (c)
if c=0 then goto 3
if c<1 or c>5 then ?"Ну что же здесь непонятного: от 1 до 5 !!!":beep 3:goto 10
select case c
case 1:cc=2:m$="ТРАМВАЙНОЕ ДЕПО ИМЕНИ П.П. АПАКОВА"
case 2:cc=5:m$="ТРАМВАЙНОЕ ДЕПО ИМЕНИ Н.Э. БАУМАНА"
case 3:cc=8:m$="КРАСНОПРЕСНЕНСКОЕ ТРАМВАЙНОЕ ДЕПО "
case 4:cc=11:m$="ОКТЯБРЬСКОЕ ТРАМВАЙНОЕ ДЕПО"
case 5:cc=14:m$="ТРАМВАЙНОЕ ДЕПО ИМЕНИ И.В. РУСАКОВА"
end select
cls:?:?:?m$
for j=cc to cc+1:?d$(j):next j
13 ?:?"Нажмите <ENTER>
15 if inkey$=chr$(13) then goto 3 else 15
end if
goto 5


95 cls:sound 1200,15:?"ALL RIGHTS ARE RESERVED !!!":end
100 if err=53 then ?"Не найден файл TRAMBASA.DAT !!!":beep 5: resume 3
?"Ошибка "err:end

--------------------

There's nothing left but silent epitaphs.

pycha

Дата 2.11.2009, 01:46 (ссылка)

(нет голосов)

Загрузка ...

главный анастазиолог

Профиль
Группа: Участник
Сообщений: 239
Регистрация: 20.6.2008
Где: Украина

ищи дальше , я опять поржу smile

--------------------

ищу хакера со знанием компьютера длятехкт

Данкинг

Дата 2.11.2009, 01:52 (ссылка)

(голосов:2)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

pycha, специально для тебя. smile

Код


color 10,9:cls
key 10, "ВЫХОД":key on
on key (10) gosub 100:key (10) on
?"              НАСКОЛЬКО ВЫ ПРИТЯГАТЕЛЬНЫ ДЛЯ ЖЕНЩИН?"
?"(тест из газеты 'МК-Воскресенье' от 19 ноября 2000 года)":?:?
?"Нажимайте клавишу с нужной цифрой, отвечая на вопросы."
?:?"Нажмите <ENTER>"
10 a$=inkey$
if a$<>chr$(13) then 10
cls:?:?

?" Используете ли вы дезодорант?"
?"1 - Иногда"
?"2 - Да"
?"3 - Нет"
gosub 50
?" Вы можете поднять руку на женщину?"
?"1 - По обстоятельствам"
?"2 - Да"
?"3 - Нет"
gosub 50
?" С какими женщинами вы предпочитаете заводить романы?"
?"1 - С ровесницами"
?"2 - Со старшими"
?"3 - С младшими"
gosub 50
?" Какой у вас размер джинсов?"
?"1 - 34-36"
?"2 - до 34"
?"3 - Больше 36-го"
gosub 50
?" Есть ли у вас привычка смотреть понравившейся женщине в глаза?"
?"1 - Иногда"
?"2 - Нет"
?"3 - Да"
gosub 50
?" Имеет ли для вас значение, дырявые на вас носки или нет?"
?"1 - Если иду в гости"
?"2 - Да"
?"3 - Нет"
gosub 50
?" Вы занимаетесь спортом?"
?"1 - Нет"
?"2 - Да"
?"3 - Периодически"
gosub 50
?" Сколько времени вы проводите в ванной по утрам?"
?"1 - От 10 до 30 минут"
?"2 - Больше 30 минут"
?"3 - Меньше 10"
gosub 50
?" Способны ли вы поцеловать понравившуюся вам незнакомую женщину?"
?"1 - Да"
?"2 - Не знаю"
?"3 - Нет"
gosub 50
?" Отказывались ли вы когда-нибудь от вешающейся вам на шею красавицы?"
?"1 - Да"
?"2 - Нет"
?"3 - И не откажусь!"
gosub 50
?" Как часто вы меняете нижнее белье?"
?"1 - Раз в сутки"
?"2 - Чаще"
?"3 - Реже"
gosub 50
?" У вас есть машина?"
?"1 - Да"
?"2 - Хочу купить"
?"3 - Нет"
gosub 50
?" Куда следует вести женщину во время второго свидания?"
?"1 - В ресторан"
?"2 - В кино"
?"3 - К себе домой или погулять по городу"
gosub 50
?" Можно ли сказать женщине 'нет'?"
?"1 - Иногда"
?"2 - Нет"
?"3 - Да"
gosub 50
?" Как часто нужно дарить женщине цветы?"
?"1 - По настроению?"
?"2 - Каждый день"
?"3 - По праздникам"
gosub 50
?" Какую славу о себе вы предпочитаете иметь?"
?"1 - Дурную"
?"2 - Добрую"
?"3 - Никакую"
gosub 50
?" Вы пользуетесь услугами проституток?"
?"1 - Нет"
?"2 - Редко"
?"3 - Нет"
gosub 50
?" Как вы определите свою разговорную экспрессвность по возрастающей?"
?"1 - 1"
?"2 - 2"
?"3 - 3"
gosub 50
?" Кто кого чаще бросал?"
?"1 - Я женщин"
?"2 - В равной степени"
?"3 - Женщины меня (вообще не помню)"
gosub 50
?" Как часто вы можете себе позволить водить любимую женщину в ресторан?"
?"1 - Редко"
?"2 - Раз в месяц"
?"3 - Когда захочу или раз в неделю"
gosub 50
?" Насколько вы уверены в своих сексуальных способностях?"
?"1 - Лучше некуда"
?"2 - Все в порядке"
?"3 - Есть проблемы"
gosub 50
?" Кто из перечисленных персонажей вам более всего импонирует?"
?"1 - Пирс Броснан"
?"2 - Брэд Питт"
?"3 - Арнольд Шварценеггер\Леонардо Ди Каприо"
gosub 50
?" Как скоро следует переходить от непосредственного знакомства к сексу?"
?"1 - Через несколько дней"
?"2 - Как сложится"
?"3 - Чем быстрее, тем лучше"
gosub 50
?" Как вы отреагируете, если любимая сообщит вам о своей беременности?"
?"1 - Спокойно"
?"2 - Обрадуюсь"
?"3 - Разозлюсь или испугаюсь"
gosub 50
?" Как часто вы меняли партнерш за последний год?"
?"1 - Каждый месяц"
?"2 - Чаще"
?"3 - Реже"
gosub 50
?" Вы ругаетесь матом при женщинах?"
?"1 - Бывает"
?"2 - Нет"
?"3 - Да"
gosub 50
?" О чем следует говорить во время первого свидания?"
?"1 - О себе"
?"2 - О погоде"
?"3 - О сексе или о бизнесе"
gosub 50
?:?"         Р  Е  З  Ю  М  Е"
select case g
case 0 to 10:
?" Ваша незащищенность способна вызвать у женщин материнский инстинкт. Вы"
?"привлекаете сильных, увренных в себе дам, которые пытаются реализовать с"
?"вашей помощью мечты о собственном превосходстве."
case 11 to 20:
?" Можете собой гордиться. Слабый пол привлекает исходящая от вас"
?"внутренняя сила. Вы умеете выдерживать четкую грань между"
?"самоуверенностью и растерянностью. На вас можно рассчитывать."
case else:
?" Ваша уверенность перешла все возможные границы и превратилась"
?"в самоуверенность. Поэтому неудивительно, что женщины одаривают"
?"вас совсем не теми взглядами, которыми хотелось бы. Они вас"
?"побаиваются и не знают, чего от вас ждать."
end select

select case y
case 0 to 9:
?" Увы, в вашем случае приходится полагаться больше не на внешность,"
?"а на содержание. Остается надеяться, что вы обладаете незаурядным"
?"умом, хороши в постели или, по крайней мере, богаты."
case 10 to 19:
?" Вы обладаете вполне привлекательной наружностью. Но не"
?"стоит рассчитывать исключительно на нее. Женщины, безусловно,"
?"не пропустят вас незамеченным. Но для окончательной победы"
?"вам понадобится кое-что еще."
case else:
?" Надо полагать, вашей внешности можно позавидовать. Вам не "
?"требуется особого труда, чтобы расположить к себе практически "
?"любую женщину. Однако, ежели вы хотите ее удержать, то одной"
?"хорошей фигуры явно недостаточно."
end select

select case r
case 0 to 10:
?" Любой джентельмен должен снять перед вами шляпу. Ваши"
?"манеры практически безупречны. Вы знаете, как нужно вести"
?"себя с женщинами. И им это, безусловно, импонирует. Но для"
?"полного успеха вам не хватает определенной жесткости, чего-то"
?"животного и естественного."
case 11 to 20:
?" При всей своей светскости вы обладаете и всеми"
?"атрибутами настоящей мужественности, что делает вас неотразимым"
?"в женских глазах. Вас нельзя упрекнуть в неуважении к женщине,"
?"но при случае вы вполне способны поставить ее на место."
case else:
?" Вы слишком грубы и неотесанны. Хотя некоторых женщин вы вполне"
?"устраиваете. Но это лишь исключение из правил. С вашими манерами"
?"тяжело рассчитывать на успех у слабого пола."
end select
30 goto 30

50 a$=inkey$
select case a$
case "1":g=g+1:cls:sound 100,2:sound 200,3:?:?:return
case "2":y=y+1:cls:sound 300,2:sound 500,3:?:?:return
case "3":r=r+1:cls:sound 800,2:sound 700,3:?:?:return
case else:goto 50
end select
100 cls:?:?:?:?"Программа посвящается...":sound 1000,2:sound 1200,3:end

--------------------

There's nothing left but silent epitaphs.

pycha

Дата 2.11.2009, 02:12 (ссылка)

(нет голосов)

Загрузка ...

главный анастазиолог

Профиль
Группа: Участник
Сообщений: 239
Регистрация: 20.6.2008
Где: Украина

тут вообще респект smile

--------------------

ищу хакера со знанием компьютера длятехкт

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Флейм \| Следующая тема »