Nostalji

       Ne günlermiş, yıl 1999-2000 öğrencilik yıllarım Turbo Pascal ile yaptığım bir stok takip programı. Dün akşam eski dosyalarımı karıştırırken buldum. Ne yalan söyliyeyim çok duygulandım bir acayip oldum anlatılmaz yaşanır derlerya öyle işte. Şöyle bir inceledim kodları yazdıklarımı. Ne kadar çok yazmışım öyle, herbir karekterini tek tek yazmışım, bir ekran görüntüsü ile button, pencere ve diğer araçların olduğu kendi yazdığım uniti aşşağıya ekliyeyimde tam olsun :)

unit sarac;
interface
uses crt,dos;

var ekrtip          :word;

procedure desen(x1,y1,x2,y2,zr,yr,dt :byte);
procedure konyaz(x1,y1 :byte ;yazi :string);
procedure rkonyaz(x1,y1,zr,yr :byte ;yazi :string);
procedure renk(zr,yr :byte);
procedure renklisil(renk :byte);
procedure cerceve(x1,y1,x2,y2,zr,cr : byte);
procedure ses(frekans,zaman :integer);
procedure golge(x1,y1,x2,y2,gr,zr : byte ;goltip : char);
procedure baslik(x1,y1,yr,zr,cz,cr,ct :byte; yazi :string);
procedure nocursor;
procedure buton(x1,y1 :byte ;yazi :string);
procedure ekrantipi;
procedure ekransakla(var ekr:pointer);
procedure ekrangetir(var ekr:pointer);

implementation

{*************** KONYAZ ALT PROGRAMI *****************}

procedure konyaz(x1,y1 :byte ;yazi :string);
begin
     gotoxy(x1,y1);
     write(yazi);
end;

{*************** RKONYAZ ALT PROGRAMI *****************}

procedure rkonyaz(x1,y1,zr,yr :byte ;yazi :string);
begin
     textcolor(yr);
     textbackground(zr);
     gotoxy(x1,y1);
     write(yazi);
end;

{*************** RENK ALT PROGRAMI *****************}

procedure renk(zr,yr :byte);
begin
     textbackground(zr);
     textcolor(yr);
end;

{*************** Renkli sil alt program� *****************}

procedure renklisil(renk :byte);
begin
     textbackground(renk);
     clrscr;
end;

{*************** SES sil alt program� *****************}
procedure ses(frekans,zaman :integer);
begin
     sound(frekans);
     delay(zaman);
     nosound;
end;


{*************** DESEN alt program� *****************}

procedure desen(x1,y1,x2,y2,zr,yr,dt :byte);
var
   k,l  :byte;
begin
   renk(zr,yr);
   for k:=y1 to y2 do
       begin
            for l:=x1 to x2 do
                begin
                     gotoxy(l,k);write(chr(dt));
                end;
       end;
end;

{*************** CERVECE alt program� *****************}
procedure cerceve(x1,y1,x2,y2,zr,cr : byte);
var
   i,j          :integer;
   cizgi        :string[80];
begin
renk(zr,cr);
fillchar(cizgi,x2-x1,#196);
cizgi[0]:=chr(x2-x1-1);
gotoxy(x1,y1);write(#218,cizgi,#191);
for i:=y1+1 to y2-1 do
begin
     gotoxy(x1,i);writeln(#179);
     gotoxy(x2,i);writeln(#179);
end;
gotoxy(x1,y2);write(#192,cizgi,#217);
end;

{*************** GOLGE alt program� *****************}
procedure golge(x1,y1,x2,y2,gr,zr :byte; goltip :char);

var
   i,j          :integer;
   golge        :string[80];
begin
renk(zr,gr);
fillchar(golge,x2-x1,goltip);
golge[0]:=chr(x2-x1-1);
for i:=y1+1 to y2-1 do
begin
     gotoxy(x2,i);writeln(goltip);
     gotoxy(x2+1,i);writeln(goltip);
end;
gotoxy(x1,y2);write(golge,'ÛÛÛ');
end;

{*************** BASLIK alt program� *****************}

procedure baslik(x1,y1,yr,zr,cz,cr,ct :byte; yazi :string);
var
   ct1,ct2 :byte;

begin
     if ct=1 then
        begin
             ct1:=180;
             ct2:=195;
        end;
     if ct=2 then
        begin
             ct1:=185;
             ct2:=204;
        end;
     renk(cz,cr);
     gotoxy(x1+1,y1);write(chr(ct1));
     gotoxy(x1+length(yazi)+4,y1);write(chr(ct2));
     renk(yr,zr);
     gotoxy(x1+2,y1);write(' ',yazi,' ');

end;

{*************** EKRAN SAKLAMA ALT PROGRAMLARI *****************}

procedure ekrantipi;
begin
     if mem[$0000:$049]=7 then ekrtip:=$B000
     else ekrtip:=$B800;
end;

procedure ekransakla(var ekr:pointer);
begin
     getmem(ekr,4000);
     move(ptr(ekrtip,0)^,ekr^,4000);
end;

procedure ekrangetir(var ekr:pointer);
begin
     move(ekr^,ptr(ekrtip,0)^,4000);
{     freemem(ekr,4000);}
end;

{**************  NOCURSOR ALT PROGRAMI ************}

procedure nocursor;
var
   r    :registers;
begin
  with r do
    begin
      ah:=$01;ch:=$20;cl:=$20;
    end;
  intr($10,r);
end;

{**************  BUTON ALT PROGRAMI ************}

procedure buton(x1,y1 :byte ;yazi :string);
var s     :string;
    k     :byte;
begin
     {textcolor(0);
     textbackground(4);
     gotoxy(x1,y1);write(' ',yazi,' ');
     renk(1,0);
     for k:=x1+1 to (length(yazi)+3) do
     begin
      konyaz(k,y1+3,'ß');
     end;}


     {x1:=5;
     y1:=5;
     yazi:='M�Ÿteri';}
     textcolor(0);
     textbackground(4);
     gotoxy(x1,y1);writeln(' ',yazi,' ');
     textcolor(0);
     textbackground(1);
     for k:=x1 to (x1+length(yazi)+1) do
     begin
          gotoxy(k+1,y1+1);writeln('ß');
     end;
     gotoxy(k+1,y1);writeln('Ü');
{     konyaz(x1+length(yazi)+2,y1,'Ü');

{     textbackground(4);
     fillchar(s,length(yazi)+2,#223);
     s[0]:=chr(80);
     gotoxy(x1+1,y1+1);
     write(s);}
end;

end.

        Birde bunun grafik modda olan halini yapmıştım ama onu bulamadım , pencereler buttonlar hepsi 3D'idi, windows gibi yani