المساعد الشخصي الرقمي

مشاهدة النسخة كاملة : تحويل كود إلى برنامج



EMEM
15-05-2005, 12:53 AM
السادة الكرام السلام عليكم ورحمة الله وبركاته أرجو منكم جميعا مساعدتي بكل ما تستطيعون ، لأني بحاجة ماسة للبرنامج الرجاء المساعدة أرجوكم
أما الكود فهو كالتالي وطبعا يمكنكم عمله بلغة البيسك أو الفيجوال بيسك أو لغة السي إذا أمكن المهم أن يتحول إلى برنامج حتى ولو كان به بعض القصور المهم أريد برنامج يعمل أفيدوني أفادكم الله

program transformobject(input,output);
type
matrix3x3=array[1..3,1..3] of real;
cpts2=array[1..3] of real;
wcpt2=array[1..3] of real;
var
thematrix:matrix3x3;
pts:cpts2;
refpt:wcpt2;
x,y:integer;

procedure matrix3x3setidentity(var m:matrix3x3(;
var
r,c:integer;
begin
for r:=1 to 3 do
for c:=1 to 3 do
if r=c then m[r,c]:=1 else m[r,c]:=0
end;

procedure matrix3x3premultiply(t,m:matrix3x3);
var
r,c:integer;
tmp:matrix3x3;
begin
for r:=1 to 3 do
for c:= 1 to 3 do
tmp[r,c]:=m[r,1]*t[1,c]+m[r,2]*t[2,c]+m[r,3]*t[3,c];
for r:=1 to 3 do
for c:=1 to 3 do
t[r,c]:=tmp[r,c]
end;

procedure scale(sx,sy:real;refpt:wcpt2);
var
m:matrix3x3;
begin
matrix3x3setidentity(m);
m[1,1]:=sx;
m[1,3]:=(1-sx)*refpt[x];
m[2,2]:=sy;
m[2,3]:=(1-sy)*refpt[y];
matrix3x3premultiply(m,thematrix);
end;

procedure rotate(a:real;refpt:wcpt2);
var
m:matrix3x3;
function toradians(a:real):real;
begin
toradians:=a*3.14159/180
end;
begin
matrix3x3setidentity(m);
a:=toradians(a);
m[1,1]:=cos(a);
m[1,2]:=-sin(a);
m[1,3]:=refpt[x]*(1-cos(a))+refpt[y]*sin(a);
m[2,1]:=sin(a);
m[2,2]:=cos(a);
m[2,3]:=refpt[y]*(1-cos(a))-refpt[x]*sin(a);
matrix3x3premultiply(m,thematrix)
end;

procedure translate(tx,ty:integer);



m:matrix3x3;
begin
matrix3x3 setidentity(m);
m[1,3]:=tx;
m[2,3]:=ty;
matrex3x3premultiply(m,thematrix)
end;

procedure transformpoints(npts:integer;var pts:wcpts2);
var
k:integer;
tmp:real;
begin
for k:= 1 to npts do
with pts[k] do
begin
tmp:=thematrix[1,1]*x+thematrix[1,2]*y+thematrix[1,3];
y:=thematrix[2,1]*x+thematrix[2,2]*y+thematrix[2,3];
x:=tmp;
end
end;
begin
pts[1].x:=50.5;pts[1].y:=50.0;
pts[2].x:=150.5;pts[2].y:=50.0;
pts[3].x:=100.0;pts[1].y:=150.0;
matrix3x3 setidentity (thematrix);
pfillarea(3,pts);
scale(0.5,0.5,refpt);
rotate(90,refpt);
translate(0,75);
transformpoints(3,pts);
pfillarea(3,pts);
end.

أما الكود الآخر فهو على النحو التالي


program linechartprogram(input,output,infile);
const
monthcount=12;
margin=24;
labellength=24;
dataoffset=18;
type
months=(jan,fep,mar,apr,may,jun,jul,aug,sep,oct,nov,dec);
indata=array[months]of real;
var
infile:text;
month:months;
data:indata;
monthplace:array[months] of real;
interval,y,x,chartbottom:real;

procedure getdata(var data:indata);
begin
reset(infile);{,chartdata) }
for month:=jan to dec do
readln(infile,data[month]);
close(infile);
end;

procedure drawlabels;
{var
textposition:wcpts;}
function getlabel(month:months):string;
begin
case month of
jan:getlabel:='jan';
fep:getlabel:='fep';
mar:getlabel:='mar';
apr:getlabel:='apr';
may:getlabel:='may';
jun:getlabel:='jun';
jul:getlabel:='jul';
aug:getlabel:='aug';
sep:getlabel:='sep';
oct:getlabel:='oct';
nov:getlabel:='nov';
dec:getlabel:='dec';
end;
end;
begin
y:=chartbottom;
for month:=jan to dec do
begin
x:=monthplace[month]-0.5*labellength;
ptext(textposition,grtlabel(month));
end;
end;
end.