Hовогодняя елочка... (RU.COMPUTER.HUMOR)
--------Это пересланное сообщениеОт: Valerij Kozhevnikoff <Valerij.Kozhevniko***@f*****.org>
Тема: Hовогодняя елочка...
===8<==============Оригинальный текстЗдравствуй, Alexander!
Чтв, 06 Окт 05 в 17:16, Alexander "rf" Kolomoyets -> All:
Hе работает =)))
Зато вот это реально компилится и запускается.
(***********************************************************
Program : OH TOPMO3
Version : 1.1
Released: 25 May 1993
Author : Kirill Shirokov
The Future Hackers Co.
CoAuthor: Dmitry Moskovich
This program illustrates visual effect, when english
combinations of characters looks like russian text.
Original idea was researched by Viacheslav Slavinsky
(Some years ago he wrote genius line: KACEKOB - TOPMO3).
Copyright by The Future Hackers Co., 1993
All rights reserved.
************************************************************)
program OH_TOPMO3;
uses
CRT;
const
MHOrO_TEKCTOB = 15;
nPOPEXA = nil;
type
A_KTO_EBO_3HAET = (HO_KTO_TO_BEgb_3HAET, BCE_ETO_BECbMA_CTPAHHO);
HyMEP = Byte;
CTPOKA = String[15];
TEKCTuK = record
OHA: CTPOKA;
TOPMO3: HyMEP;
end;
TAM_ABTOMAT = ^ABTOMAT;
ABTOMAT = object
MOE_X, MOE_Y: HyMEP;
TEKCTOB_BCEBO: HyMEP;
TEKCTbl: array[1..MHOrO_TEKCTOB] of TEKCTuK;
KAKOE: HyMEP;
TOPMO3uM: HyMEP;
XPEH_EMy: TAM_ABTOMAT;
constructor BOT_EBOHOE_MECTO(X, Y: HyMEP);
procedure BOH_ETOT_XPEH(KOMy_XPEH: TAM_ABTOMAT);
procedure ETO_CTPOKA(OHA_CAMA: CTPOKA;
EE_TOPMO3: HyMEP);
procedure BblBOg;
end;
XMblPb = object
HE_KACEKOB: A_KTO_EBO_3HAET;
KTO_TAM_CAMOE_TAKOE: TAM_ABTOMAT;
constructor Hy_HuKAK_MHE_EBO_HE_HA3BATb;
procedure B_nyTb;
procedure u_EBO_TO3E
(uMEHHO_ETO_MOXHATOE_OHO_CAMOE:
TAM_ABTOMAT);
end;
procedure BAM_TEMHO;
begin
ClrScr;
end;
procedure TOPMO3HyTb(CKOKO: HyMEP);
begin
Delay(CKOKO);
end;
procedure rge_EMy_KBACuTb(EBO_X, EBO_Y: HyMEP);
begin
GoToXY(EBO_X, EBO_Y);
end;
function WyXEP: Boolean;
begin
WyXEP := KeyPressed;
end;
constructor ABTOMAT.BOT_EBOHOE_MECTO(X, Y: HyMEP);
begin
MOE_X := X;
MOE_Y := Y;
TEKCTOB_BCEBO := 0;
KAKOE := 0;
TOPMO3uM := 0;
end;
procedure ABTOMAT.BOH_ETOT_XPEH(KOMy_XPEH: TAM_ABTOMAT);
begin
XPEH_EMy := KOMy_XPEH;
end;
procedure ABTOMAT.ETO_CTPOKA(OHA_CAMA: CTPOKA; EE_TOPMO3: HyMEP);
begin
if TEKCTOB_BCEBO < MHOrO_TEKCTOB then begin
Inc(TEKCTOB_BCEBO);
with TEKCTbl[TEKCTOB_BCEBO] do begin
OHA := OHA_CAMA;
TOPMO3 := EE_TOPMO3;
end;
end;
end;
procedure ABTOMAT.BblBOg;
begin
if TEKCTOB_BCEBO > 0 then begin
if TOPMO3uM = 0 then begin
Inc(KAKOE);
if KAKOE > TEKCTOB_BCEBO then KAKOE := 1;
rge_EMy_KBACuTb(MOE_X, MOE_Y);
with TEKCTbl[KAKOE] do begin
Write(OHA);
TOPMO3uM := TOPMO3;
end;
end;
Dec(TOPMO3uM);
end;
end;
constructor XMblPb.Hy_HuKAK_MHE_EBO_HE_HA3BATb;
begin
KTO_TAM_CAMOE_TAKOE := nPOPEXA;
HE_KACEKOB := BCE_ETO_BECbMA_CTPAHHO;
end;
procedure XMblPb.u_EBO_TO3E(uMEHHO_ETO_MOXHATOE_OHO_CAMOE: TAM_ABTOMAT);
begin
if KTO_TAM_CAMOE_TAKOE = nPOPEXA then begin
KTO_TAM_CAMOE_TAKOE := uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
uMEHHO_ETO_MOXHATOE_OHO_CAMOE^.XPEH_EMy :=
uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
end
else begin
uMEHHO_ETO_MOXHATOE_OHO_CAMOE^.XPEH_EMy :=
KTO_TAM_CAMOE_TAKOE^.XPEH_EMy;
KTO_TAM_CAMOE_TAKOE^.XPEH_EMy := uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
end;
end;
procedure XMblPb.B_nyTb;
var
ETOT_PAXuT: TAM_ABTOMAT;
begin
ETOT_PAXuT := KTO_TAM_CAMOE_TAKOE;
while not WyXEP do
with ETOT_PAXuT^ do begin
BblBOg;
ETOT_PAXuT := XPEH_EMy;
rge_EMy_KBACuTb(1, 10);
TOPMO3HyTb(10);
end;
end;
procedure BAM_XOPOWO;
begin
BAM_TEMHO;
WriteLN('OH TOPMO3 v1.0 Copyright The Future Hackers, 1993');
WriteLN(' . Written by Kirill Shirokov and Dmitry Moskovich, May 93');
WriteLN;
end;
var
EBO_3EHKu,
EBO_HOC,
EBO_POT,
EBO_XBOCT : ABTOMAT;
KACEKOB : XMblPb;
begin
with KACEKOB do begin
Hy_HuKAK_MHE_EBO_HE_HA3BATb;
with EBO_3EHKu do begin
BOT_EBOHOE_MECTO(1, 1);
ETO_CTPOKA('- -', 20);
ETO_CTPOKA('o o', 3);
ETO_CTPOKA('O O', 16);
ETO_CTPOKA('0 0', 23);
ETO_CTPOKA('O O', 14);
ETO_CTPOKA('o o', 5);
end;
u_EBO_TO3E(@EBO_3EHKu);
with EBO_HOC do begin
BOT_EBOHOE_MECTO(1, 2);
ETO_CTPOKA(' .. ', 21);
ETO_CTPOKA(' oo ', 16);
end;
u_EBO_TO3E(@EBO_HOC);
with EBO_POT do begin
BOT_EBOHOE_MECTO(1, 3);
ETO_CTPOKA(' -- ', 22);
ETO_CTPOKA(' == ', 4);
ETO_CTPOKA('-==-', 6);
ETO_CTPOKA('/--\', 19);
ETO_CTPOKA('----', 16);
ETO_CTPOKA('\==/', 21);
ETO_CTPOKA('----', 3);
end;
u_EBO_TO3E(@EBO_POT);
BAM_TEMHO;
B_nyTb;
BAM_XOPOWO;
end;
end.
(***********************************************************)
WBR, Jason.
_/(ZX)/_ /*e-mail: jason2000(не кошка)yandex.ru ICQ: 62235830*/
/np:/ *silence*
program Елочка;
Begin
Лес.елочка.create();
While not Лес.елочка.dead do
Begin
лес.елочка.age := лес.елочка.age 1;
if зима or лето then
begin
лес.елочка.plain := true;
лес.елочка.color := cl_green;
end;
метель.filename:="'D:"Music"NSYNC - Bye Bye Bye.mp3"';
метель.open;
sleep(1000);
метель.play;
моpоз.укутать(лес.елочка);
GetMessage(H, лес.елочка.handle, 0, 0);
if h.uint = wm_замеpзла then
dead := true;
end;
лес.заяц.create;
лес.заяц.тpусливый := true;
лес.заяц.color := cl_gray;
x := лес.елочка.left;
y := лес.елочка.top;
While x
Begin
лес.заяц.left := x;
inc(x);
лес.заяц.top := y round( abs(sin(x*pi/180)*10) );
end;
Winexec("'wolf3d.exe /evil"',0);
лес.елочка.cuttoclipboard;
Пpаздник.pastefromclipboard;
Пpаздник.елочка.skin.loadfromfile("'наpядная.jpg"');
For i:=1 to SizeOf(Пpаздник.елочка.pадость) do
Пpаздник.Дети.астpоение Пpаздник.елочка.pадость;
End.
Капиpайт утеpян... 8(
Папа, а на каких растениях пиво растет? Пиво не растет, сынок, его ДОБЫВАЮТ!
Я и мои соседи слушаем: 26 T.I. - 24's
Александр Томилов E-mail: asteroid (at) perm (dot) raid (dot) ru
Форум не обо всем, но многом: http://sforum.hut1.ru/forum/
Номер выпуска : 4967
Возраст листа : 747 (дней)
Количество подписчиков : 531
Адрес в архиве : http://subscribe.ru/archive/comp.soft.prog.prog/msg/451196
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru
-*Информационный канал Subscribe.Ru
Подписан адрес:
Код этой рассылки: comp.soft.prog.prog
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru?subject=comp.soft.prog.prog
http://subscribe.ru/ http://subscribe.ru/feedback
