منتديات الجلفة لكل الجزائريين و العرب - عرض مشاركة واحدة - برنامج باسكال على طريقة PowerPoint (من برمجتي)
عرض مشاركة واحدة
قديم 2012-06-22, 16:28   رقم المشاركة : 12
معلومات العضو
King Soft
عضو مشارك
 
الصورة الرمزية King Soft
 

 

 
إحصائية العضو










افتراضي

السلام عليكم اخي


لقد انهيت بفضل الله من برمجته

تفضل البرنامج

كود PHP:
Program Cry;
uses crt;
type matx= array[1..8,1..8of Char ;
 var 
A,b,c,p:integer;
    
M:matx;
    
Tb:array[1..2,1..8of string;
    
Td:array[1..2,1..8of integer;
function 
Rand(const AValues: array of Char): Char;
begin
  Result 
:= AValues[Random(High(AValues) + 1)];
end;
Procedure Remp(var T:matx);  //0 or 1
var i,j:integer;
begin
for i:= 1 to 8 do
    for 
j:=1 to 8 do
        
T[i,j]:=Rand(['0','1']) ;
end;
procedure mark(var T:matx);
var 
i,r:integer;
begin
For i:=1 to 8 do
begin
R
:=Random(8);
if 
R=0 then R:=2;
T[i,r]:='#';
end;
end;
function 
position(T:matx;l:byte):integer;
var 
i:integer;
begin
Result 
:=0;
for 
i:=1 to 8 do
if 
T[l,i]='#' then  Result :=i;
end;
Function 
Bin2Dex(S:String) :integer;
var  
i,R,p:integer;
function 
puis(y:integer):integer;
var 
k:integer;
begin
puis
:=1;
for 
k:=1 to y do
puis:=puis*2
end
;
begin
r
:=0;
i:=0;
While 
i<= length(s)do
begin
p
:=length(s)-i;
if 
S[p]='1' then R:=R+puis(i);
i:=i+1;
end;
Result:=R;
end;
begin   Remp(M);mark(M);

for 
A:=1 to 8 do
begin
p
:=position(M,A);
   for 
b:=1 to p-do
       
Tb[1,A]:=Tb[1,A]+M[A,b];
   for 
c:=p+1 to 8 do
       
Tb[2,A]:=Tb[2,A]+M[A,c];
end;
for 
a:=1 to 8 do
Td[1,a]:= Bin2Dex(Tb[1,a]);
for 
a:=1 to 8 do
Td[2,a]:= Bin2Dex(Tb[2,a]);
For 
A:=1 to 8 do
   For 
b:=1 to 8 do
   
begin
       Gotoxy
(b*5,a*3);
        
Write(M[a,b]);
   
end;
Writeln;
Writeln('le Conv en Binair ----------');

For 
A:=1 to 8 do
begin Writeln;
   
Write('Line',a);
    For 
b:=1 to 2 do
        
Write(Td[b,a]:5);

end;
readln;readln;
end
بالتوفيق