Programlama yapalım ve Öğrenelim.

Ekran Koruyucu

//çok hoş bir ekran koruyucu...

//Form ayarlarını Tam ekran, Border filan yapın... arkaplan siyah

var

Form1: TForm1;

tamam: boolean;

x,y,b,sil:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

randomize;

Cursor:=crNone;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

x:=random(Width);

y:=random(height);

b:=random(650);

sil:=random(100);

Canvas.Font.Color:=rgb(random(255),random(255),random(255));

Canvas.Font.Size:=b;

Canvas.Brush.Style:=bsClear;

Canvas.TextOut(x,y,'*');

if sil=50 then refresh;

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

close;

end;

procedure TForm1.FormClick(Sender: TObject);

begin

end;

Delphi - .....................................

Microsoft Speech API?

basit yol ile yazıları ses e çevirme vede dinlemek.

http://mraga.h10.ru/faq.html

// ????? ?? NT, 2k, XP, Win9x ? SAPI SDK

uses Comobj;

procedure TForm1.Button1Click(Sender: TObject);

var

voice: OLEvariant;

begin

voice := CreateOLEObject('SAPI.SpVoice');

voice.Speak('Hello World!', 0); //???????? ? ???????? ????

end;

neoturk - N adet veziri satranç tahtasına yerleştirelim ( recursive örneği )

herkese merhaba,

artık kod uzmanı olmamız gerekiyor,

bu da .pas uzantılı bir dosyayı gözle incelerken,

forma neleri yerleştireceğimizi hemen farketmemiz gerek!

örnek:

TForm1 = class(TForm)

StringGrid1: TStringGrid;

Button1: TButton;

Memo1: TMemo;

StringGrid2: TStringGrid;

ListBox1: TListBox;

Label2: TLabel;

Label3: TLabel;

Timer1: TTimer;

Label1: TLabel;

CheckBox1: TCheckBox;

Edit1: TEdit;

Button2: TButton;

Label4: TLabel;

yukarda görüldüğü gibi,

forma,

2 adet stringgrid

-bir tanesi yerleştirme animasyonunu gösterecek

-bir tanesi yerleştirilmiş pozisyonu gösterecek

2 adet button

-yerleştir düğmesi

-dur düğmesi

1 adet memo

-ayrıntıları yazmak için

4 adet label

-bilgilendirme amaçlı labeller

1 adet timer

-süre sayacı

1 adet checkbox

-tarama animasyonunu gösterip göstermeyeceği

1 adet edit

-kaç adet veziri yerleştireceğimizi buraya girecez sayı olarak

1 adet listbox

-bulunan çözümlerin listesini tutacak

kodun tamamı aşağıdadır ( pas olarak )

gereken click ve yordamları elle düzeltin ve yerine yazın

programı çalıştırıp test edebilirsiniz,

amaç: recursive ( öz yineli ) function kullanımını kavramak

hikayesi:

bir arkadaşım bilgisayar mühendisliğinde okuyordu ve mezun oldu.

ama kodlama alt yapısı sıfırdı...

örnek çalışmalarını incelediğimde piyasa gezen 8 veziri yerleştiren

pascal kodu ile uygulama yaptıklarını gördüm.

hocaların bile bu konu üzerinde durmayıp

NxN lik bir tahta için çözüm üretmemeleri beni kızdırdı açıkçası...

oturup sıfırdan yazmak istedim ve 3 saatte mantığını oluşturup

kodladım. çok da zorlanmadım açıkçası. zorlanırsam namerdim !!!

**************************************************************

**** N adet veziri satranç tahtasına yeleştiren programım ****

**************************************************************

{ written by neoturk 02.2005 }

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, ExtCtrls;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

Button1: TButton;

Memo1: TMemo;

StringGrid2: TStringGrid;

ListBox1: TListBox;

Label2: TLabel;

Label3: TLabel;

Timer1: TTimer;

Label1: TLabel;

CheckBox1: TCheckBox;

Edit1: TEdit;

Button2: TButton;

Label4: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure goster(sender:Tobject);

procedure goster2(sender:Tobject);

end;

const

vezir='X';

crlf=#13#10;

var

Form1: TForm1;

timex,bulunan,positioncount:integer;

tempx,vezirlist:tstringlist;

tahta:array[1..100,1..100] of string;

maxvezir:byte;

kapat:boolean;

implementation

{$R *.dfm}

//************* copy + pos combination *******************

function left12(sender:Tobject;x:string;subkey:string;leftrayt:byte):string;

var x1,x2:string;posx:integer;lenx:integer;

begin

lenx:=length(subkey);

posx:=pos(subkey,x);

x1:=copy(x,1,posx-lenx);

x2:=copy(x,posx+lenx,999);

if leftrayt=1 then left12:=x1 else left12:=x2;

end;

{*********************** getlines ************************}

function getlines(x:string;apostrof:string):string;

var m,n,acount:integer;x2:string;tg:Tstringlist;

begin

//apostrof miktarını öğren

acount:=0;

n:=length(x);

for m:=1 to n do if x[m]=apostrof then inc(acount);

//apostrofları ayır

tg:=tstringlist.Create;

n:=acount;

for m:=1 to n do

begin

x2:=copy(x,1,pos(apostrof,x)-1);

//form1.memo1.lines.add(inttostr(pos(apostrof,x))+apostrof);

tg.add(trim(x2));

//form1.memo1.lines.add(x2);

x2:=copy(x,pos(apostrof,x)+1,9999);

//showmessage('ok');

x:=x2;

end;

if trim(x)<>'' then tg.add(trim(x));

result:=tg.text;

tg.free;

//final

end;

//*** form create (başlangıç)

procedure TForm1.FormCreate(Sender: TObject);

begin

tempx:=tstringlist.Create;

vezirlist:=Tstringlist.Create;

maxvezir:=8;

//final

end;

//*** goster

procedure Tform1.goster(sender:Tobject);

var m,n:integer;

begin

if checkbox1.Checked=false then exit;

for m:=1 to maxvezir do

for n:=1 to maxvezir do

stringgrid1.Cells[n-1,m-1]:=tahta[m,n];

//final

end;

//*** goster2

procedure Tform1.goster2(sender:Tobject);

var m,n:integer;

begin

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]=vezir then form1.stringgrid2.Cells[n-1,m-1]:=tahta[m,n] else form1.StringGrid2.Cells[n-1,m-1]:=' ';

//final

end;

//*** goster

procedure goster3(sender:Tobject);

var m,n:integer;

begin

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]=vezir then form1.stringgrid1.Cells[n-1,m-1]:=tahta[m,n] else form1.StringGrid1.Cells[n-1,m-1]:=' ';

//final

end;

//*** vezir say

function vezirsay(sender:Tobject):integer;

var m,n,vezirsayisi:integer;

begin

vezirsayisi:=0;

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]=vezir then inc(vezirsayisi);

result:=vezirsayisi;

//final

end;

//*** path capture

function pathcapture(sender:Tobject):string;

var m,n:integer;x:string;bul:integer;

begin

x:='';bul:=0;

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]=vezir then

begin

inc(bul);

if bul=maxvezir then

x:=x+inttostr(m)+ '-'+inttostr(n)

else

x:=x+inttostr(m)+ '-'+inttostr(n)+',';

end;

result:=x;

//final

end;

//*** yerlestir

procedure yerlestir(sender:Tobject;sat,sut:integer);

var xsat,xsut,m:integer;

begin

for m:=sut+1 to maxvezir do tahta[sat,m]:='1';//yatay

for m:=sut-1 downto 1 do tahta[sat,m]:='1';//yatay

for m:=sat+1 to maxvezir do tahta[m,sut]:='1';//dikey

for m:=sat-1 downto 1 do tahta[m,sut]:='1';//dikey

xsat:=sat;xsut:=sut;

repeat

xsat:=xsat-1;xsut:=xsut-1;

if (xsat>=1) and (xsut>=1) then tahta[xsat,xsut]:='1';

until (xsat<=1) or (xsut<=1);

xsat:=sat;xsut:=sut;

repeat

xsat:=xsat-1;xsut:=xsut+1;

if (xsat>=1) and (xsut<=maxvezir) then tahta[xsat,xsut]:='1';

until (xsat<=1) or (xsut>=maxvezir);

xsat:=sat;xsut:=sut;

repeat

xsat:=xsat+1;xsut:=xsut-1;

if (xsat<=maxvezir) and (xsut>=1) then tahta[xsat,xsut]:='1';

until (xsat>=maxvezir) or (xsut<=1);

xsat:=sat;xsut:=sut;

repeat

xsat:=xsat+1;xsut:=xsut+1;

if (xsat<=maxvezir) and (xsut<=maxvezir) then tahta[xsat,xsut]:='1';

until (xsat>=maxvezir) or (xsut>=maxvezir);

tahta[sat,sut]:=vezir;//veziri yerleştir

//final

end;

//*** rebuild tahta ( remove vezir )

procedure rebuildtahta(sender:Tobject);

var m,n:integer;x:string;sat,sut:integer;

begin

//vezir listesini oluştur

vezirlist.Clear;

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]=vezir then vezirlist.Add(inttostr(m)+'-'+inttostr(n));

//clear tahta

for m:=1 to maxvezir do

for n:=1 to maxvezir do tahta[m,n]:='0';

//set tahta

n:=vezirlist.Count-1;

for m:=0 to n do

begin

x:=vezirlist.Strings[m];

sat:=strtoint(left12(sender,x,'-',1));

sut:=strtoint(left12(sender,x,'-',2));

tahta[sat,sut]:=vezir;

yerlestir(sender,sat,sut);

end;

form1.goster(sender);

end;

//************** recursive ****************

procedure r(sender:Tobject;satir,sutun,level:integer);

var xsat,xsut,m,n:integer;blsat,blsut:Tstringlist;x:string;

procedure getfreenodes;

var m,n:integer;

begin

//boş nokta listesini oluştur

tempx.Clear;

for m:=1 to maxvezir do

for n:=1 to maxvezir do

if tahta[m,n]='0' then

begin

blsat.Add(inttostr(m));

blsut.Add(inttostr(n));

tempx.Add(inttostr(m)+'-'+inttostr(n));

end;

//form1.Memo2.text:=tempx.Text;form1.Memo2.Refresh;

end;

//begin

begin

if kapat then exit;

blsat:=Tstringlist.Create;

blsut:=Tstringlist.Create;

yerlestir(sender,satir,sutun);

inc(positioncount);

form1.label1.caption:=inttostr(positioncount)+'/ L:'+inttostr(level);

inc(level);

if vezirsay(sender)=maxvezir then

begin

x:=pathcapture(sender);

//form1.Memo1.lines.add(x);

if form1.ListBox1.Items.IndexOf(x)=-1 then

begin

inc(bulunan);

form1.Label2.caption:=inttostr(bulunan)+' found';

form1.listbox1.Items.add(x);

goster3(sender);

end;

end

else

begin

if vezirsay(sender)<satir then exit;//bu satır gereksiz taramaları engeller

getfreenodes;//boş noktaları hesapla ve al

//analize başla

for m:=0 to blsat.Count-1 do

begin

xsat:=strtoint(blsat.strings[m]);

xsut:=strtoint(blsut.strings[m]);

//showmessage(inttostr(m)+' > '+inttostr(xsat)+'-'+inttostr(xsut)+crlf+'/position:'+inttostr(positioncount)+'/ L:'+inttostr(level));

r(sender,xsat,xsut,level);

tahta[xsat,xsut]:='0';rebuildtahta(sender);

application.ProcessMessages;

end;

blsat.Free;

blsut.Free;

//final

end;

procedure clearboard;

var m,n:integer;

begin

for m:=1 to maxvezir do

for n:=1 to maxvezir do

tahta[m,n]:='0';

end;

procedure TForm1.Button1Click(Sender: TObject);

var m,n:integer;

begin

maxvezir:=strtointdef(edit1.Text,8);

kapat:=false;

stringgrid1.RowCount:=maxvezir;

stringgrid1.colCount:=maxvezir;

stringgrid2.RowCount:=maxvezir;

stringgrid2.colCount:=maxvezir;

timer1.Enabled:=true;

timex:=0;

bulunan:=0;

positioncount:=0;

memo1.Clear;listbox1.Clear;

clearboard;

//r(sender,1,1,0);

for m:=1 to maxvezir do

begin

clearboard;

r(sender,1,m,0);

end;

memo1.Lines.Add('ok. [ '+inttostr(positioncount)+' position searched... ]');

timer1.Enabled:=false;

//final

end;

procedure TForm1.ListBox1Click(Sender: TObject);

var m,n:integer;x:string;xsat,xsut:integer;

begin

m:=listbox1.ItemIndex;

if m<>-1 then

begin

x:=listbox1.items[m];

tempx.Text:=getlines(x,',');

for m:=1 to maxvezir do

for n:=1 to maxvezir do

begin

tahta[m,n]:='0';

stringgrid2.Cells[m-1,n-1]:='0';

end;

for m:=0 to tempx.Count-1 do

begin

x:=tempx.Strings[m];

xsat:=strtoint(left12(sender,x,'-',1));

xsut:=strtoint(left12(sender,x,'-',2));

tahta[xsat,xsut]:=vezir;

yerlestir(sender,xsat,xsut);

goster2(sender);

end;

//final

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

inc(timex);

label3.Caption:=inttostr(timex)+' second';

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

kapat:=true;

end;

end.

**********************************************************************

işte piyasada gezen pascal kodu:

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils;

type

durum=array[1..8]of 1..8;

var

x,y,sayac,grd,grm,k,j:integer;

sakla:array[1..92]of durum;

durumlar:durum;

ihtimal:byte;

colon:array[1..8]of 1..8;

colfree:array[1..8]of boolean;

upfree:array[2..16]of boolean;

downfree:array[-7..7]of boolean;

sira:0..8;

procedure Bul; {8 Vezirin bir birini yemeden nerelere konulacag }

var s:1..8; { ihtimallerini bulan procedure}

i:byte;

begin

sira:=sira+1;

for s:=1 to 8 do

if colfree[s] and upfree[sira+s] and downfree[sira-s] then

begin

colon[sira]:=s; colfree[s]:=false;

upfree[sira+s]:=false; downfree[sira-s]:=false;

if sira=8 then

begin

sayac:=sayac+1; ;

Write(sayac:2,'. Durum : ');

for i:=1 to 8 do

begin

write(i,'-',colon[i],' ');

durumlar[i]:=colon[i];

end;

sakla[sayac]:=durumlar;

writeln;

if (sayac mod 23)=0 then

begin

writeln(' Di§er Durunlar G”rmek ˜‡in Bir TuŸa Basn');

readln;

end;

end {if}

else bul; {!!! PROCEDUR'UN KEND˜N˜ €AGIRDIGI YER !!!!!!}

colfree[s]:=true;

upfree[sira+s]:=true;

downfree[sira-s]:=true;

end;{if}

sira:=sira-1;

end; {procedure}

begin

{ TODO -oUser -cConsole Main : Insert code here }

writeln;

sira:=0;

sayac:=0;

for x:=1 to 8 do

colfree[x]:=true;

for x:=2 to 16 do

upfree[x]:=true;

for x:=-7 to 7 do

downfree[x]:=true;

bul;

repeat

writeln('92 durum söz konusu bir ihtimal numarası girin');

readln(ihtimal);

if (ihtimal>0) and (ihtimal<93) then

begin

durumlar:=sakla[ihtimal];

end;

until ihtimal=0;

end.

******************

gördüğünüz gibi alıntı bir kod olup, üzerinde türkçeleştirme yapılmış hali!

orjinali de bende mevcut.

ve benim yazdığım program ile hiç bir alakası ve benzerliği de yok.

yukardaki kodu NxN e çeviremezsiniz, çünkü,

for x:=1 to 8 do

colfree[x]:=true;

for x:=2 to 16 do

upfree[x]:=true;

for x:=-7 to 7 do

downfree[x]:=true;

görüldüğü gibi buradaki mantık ne için kullanılmış yazana sormak lazım!

fazla da kasmak istemiyorum zaten....