Programalama > PASCAL

Etiketler: ezcane, program, tasarimi

Ort. 0
Puan ver:
ANA PROGRAM BU ANAPROG.PAS OLARAK KAYDET
Uses Crt,Secim,Yazi;
 Const
 M : Menutip = ( ' Bilgi Girisi   ',
                 ' Bilgi Listele  ',
                 ' Bilgi Arama    ',
                 ' Bilgi Dzeltme ',
                 ' Bilgi Silme    ',
                 '     €iKiS      ');
   Var
   X,i : Byte;
       Begin
       clrscr;
       bas1;
       renk(0,0);
       Clrscr;
       Renk(7,0);
       Cerceve('T',2,2,80,48,2);
       yazi1;yazi2;
       Cerceve('T',32,21,49,28,15);
           Sec('Y',M,22,33,6,1,x,true);
       case X of
       1 : ;
       2 : ;
       3 : ;
       4 : ;
       5 : ;
       6 :exit;
       end;


       end.


UNİTİ HAZİRLA SECİM.PAS OLARAK  KAYDET

Unit secim;
Interface
 Uses crt;
 Type
 MenuTip = Array[1..6] of string[30];
 procedure Sec(Sekil     :Char;
               Menu      :Menutip;
               Satir,Sutun,Elsay,Artis :Byte;
               var X           :Byte;
               EscEvet     :Boolean);
 procedure Cerceve(Sek:Char; X1,Y1,X2,Y2,R :byte);
 procedure Renk(Y,Z:byte);

 Implementation

 procedure Renk;
 begin
 Textcolor(Y);
 Textbackground(Z);
 end;

     Procedure Sec;
     var
     Sat , Sut , i :byte;
     Tus            :char;
    begin
 Sekil :=Upcase(Sekil);
 renk(4,7);Sat:=Satir;Sut:=Sutun;
 for i:=1 to elsay do
 begin
 gotoxy(Sut,Sat);write(menu[i]);
 if Sekil='Y' then
 Sat:=Sat+Artis Else Sut:=Sut+Artis;
 end;
 Sut:=Sutun;Sat:=Satir;gotoxy(Sut,Sat);
 renk(8,3);write(menu[1]);X:=1;
 repeat
 Tus:=readkey;if Tus=#0 then Tus:=readkey;
 Renk(4,7);
 case Sekil of

    'Y':
  if (Tus=#80) or  (Tus=#72) then
    begin
    gotoxy(Sut,Sat);write(menu[x]);
    if Tus=#80 then {Asagi Ok}
    if x>Elsay-1 then
    begin x:=1;Sat:=Satir;end
    else
    begin x:=x+1;Sat:=Sat+Artis;end;
    if Tus=#72 then {Yukari Ok}
    if x<2 then
    begin x:=Elsay;Sat:=Satir+(Elsay -1)*Artis;End
    else
    begin x:=x-1;Sat:=Sat-Artis;end;
    gotoxy(Sut,Sat);renk(8,3);write(menu[x]);
    end;
  end;
  Until Tus=#13;
  end;

    Procedure Cerceve;
    Var
    I:integer;
    Cizgi:string[80];
    Begin
    Renk(r,7);Sek:=Upcase(Sek);
      Case Sek  of
      'T':Begin
        fillchar(Cizgi,x2-x1,#196);
        Cizgi[0]:=chr(x2-x1-1);
        gotoxy(X1,Y1);write( chr(218),Cizgi,Chr(191));
          for I:=Y1+1 to Y2-1 do
          begin
          gotoxy(X1,I);write(Chr(179));
          gotoxy(X2,I);write(Chr(179));
          end;
        gotoxy(X1,Y2);write(Chr(192),Cizgi,Chr(217));
         end;
      'C':Begin
         fillchar(Cizgi,x2-x1,#205);
        Cizgi[0]:=chr(x2-x1-1);
        gotoxy(X1,Y1);write( chr(201),Cizgi,Chr(187));
          for I:=Y1+1 to Y2-1 do
          begin
          gotoxy(X1,I);write(Chr(186));
          gotoxy(X2,I);write(Chr(186));
          end;
        gotoxy(X1,Y2);write(Chr(200),Cizgi,Chr(188));
         end;
         end;
         end;
end.

UNİTEDE YAZİ.PAS OLARAK KAYDET 
unit yazi;

interface
Uses crt;
Procedure yazi1;
procedure yazi2;
Procedure bas1;
implementation
Procedure yazi1;
begin
textcolor(9);
gotoxy(8,3);
      delay(24000);Write(' E');
      delay(24000);Write(' z');
      delay(24000);Write(' c');
      delay(24000);Write(' a');
      delay(24000);Write(' n');
      delay(24000);Write(' E');
      delay(24000);Write('   ');
      delay(12000);Write(' I');
      delay(12000);Write(' s');
      delay(12000);Write(' l');
      delay(12000);Write(' e');
      delay(12000);Write(' M');
      delay(24000);Write('   ');
      delay(6000);Write(' O');
      delay(6000);Write(' t');
      delay(6000);Write(' a');
      delay(6000);Write(' m');
      delay(6000);Write(' a');
      delay(6000);Write(' s');
      delay(6000);Write(' y');
      delay(6000);Write(' o');
      delay(6000);Write(' N');
      delay(24000);Write('   ');
      delay(6000);Write(' P');
      delay(6000);Write(' r');
      delay(6000);Write(' o');
      delay(6000);Write(' g');
      delay(6000);Write(' r');
      delay(6000);Write(' a');
      delay(6000);Write(' m');
      delay(6000);Write(' I');
      end;
      procedure yazi2;
      begin
gotoxy(11,47);
textcolor(12);
      delay(12000);Write(' T');
      delay(12000);Write(' a');
      delay(12000);Write(' s');
      delay(12000);Write(' a');
      delay(12000);Write(' r');
      delay(12000);Write(' l');
      delay(12000);Write(' a');
      delay(12000);Write(' y');
      delay(12000);Write(' a');
      delay(12000);Write(' n');
      delay(25000);Write('..');
      delay(20000);Write('..');
      delay(15000);Write('..');
      delay(24000);Write('   ');
      delay(6000);Write('Stacer');
      delay(6000);Write('   ');
      delay(6000);Write('  b');
      delay(6000);Write('y');
      delay(8000);Write('   ');
      delay(6000);Write('  Sahin');
      delay(6000);Write(' ');
      delay(6000);Write(' Akin');
      end;
      procedure bas1;
      begin
      textcolor(4);textbackground(0);
      gotoxy(41,23);write('Program A‡iliyor.... ');
      gotoxy(23,20);write('LtfeN BekleyiniZ');
      delay(60000);
      gotoxy(15,44);
      textcolor(3);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
                    write('ÎÎ');delay(50000);
                    write('ÎÎÎÎ');delay(50000);
       end;


end.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.