Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Вниз

Прикольный исходник на паскале нашол :)   Найти похожие ветки 

 
syte_ser78 ©   (2005-05-25 10:32) [0]

Взято на http://deep.webest.net

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 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.


 
Игорь Шевченко ©   (2005-05-25 10:37) [1]

LMD


 
Alexander Panov ©   (2005-05-25 10:38) [2]

Игорь Шевченко ©   (25.05.05 10:37) [1]
LMD


Снисходительнее надо быть к школьникам-)


 
Игорь Шевченко ©   (2005-05-25 10:43) [3]

Alexander Panov ©   (25.05.05 10:38) [2]

К ламерам снисхождения не будет. Это те школьники, которым самый кайф в лифте соответствующее слово нацарапать или наскальной живописью стены разукрасить. Отстой.


 
syte_ser78 ©   (2005-05-25 10:48) [4]

Не знаю, заметили ли уважаемые мастера, но это код который компелируется. Процедуры и переменные написаны латинскими буквами. Меня прикольнуло именно это.


 
DVM ©   (2005-05-25 10:52) [5]

это каким же надо терпением обладать, чтобы сидеть и подыскивать замены русским буквам среди латинских в течение всей работы.


 
syte_ser78 ©   (2005-05-25 10:53) [6]

Терпения не надо. Просто написать утилитку меняющую русские символы на латинские.


 
raidan ©   (2005-05-25 10:53) [7]

>DVM ©   (25.05.05 10:52) [5]
>это каким же надо терпением обладать, чтобы сидеть и подыскивать замены русским буквам среди латинских в течение всей работы.

Категорически не хотели либо работать, либо учиться :)


 
КаПиБаРа ©   (2005-05-25 11:01) [8]

Очень занимательный код


 
TUser ©   (2005-05-25 11:22) [9]

> Не знаю, заметили ли уважаемые мастера, но это код который  компелируется. Процедуры и переменные написаны латинскими буквами. Меня прикольнуло именно это.

Увы, для компилируемости его пришлось немного поправить. Вот интересно, что имел в виду автор, когда писАл такое
writeln (""чего-то там"");
И еще там что-то по мелочи редактировать пришлось. А так - действительно забавно.



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2005.06.14;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.038 c
3-1115553366
SergeyPVC
2005-05-08 15:56
2005.06.14
После удаление размер БД не уменьшился... :(


3-1115549163
_e_u_
2005-05-08 14:46
2005.06.14
Добавление строки в таблицу ;)


10-1093539136
Лана Розанова
2004-08-26 20:52
2005.06.14
Проблемы с COM


14-1115861977
ArMellon
2005-05-12 05:39
2005.06.14
Хочу саб вуфер


4-1114412117
UserCP
2005-04-25 10:55
2005.06.14
Privileged Instructor что это такое?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский