برنامه های نوشته شده به زبان پاسکال

بازی بسیار جالب و فکری کارت که به زبان پاسکال نوشته ام


لینک دریافت: http://w17.easy-share.com/1701659400.html

پسورد : www.forum.daneshjuha.org

salam mishe barname bazi dozo ham bezarin

نقل قول:

---

نوشته اصلی توسط M.E

salam mishe barname bazi dozo ham bezarin

---

برنامه بازی دوز به زبان پاسکال

کد:

---

program dooz;
type
home=array[1..3,1..3] of real ;
var
i,count6,j,i1,j1,i2,num,numgh,j2,l,k,m,count,count1,error,error1:integer;
counter,a,b:integer;
sum,sum1:real;
pos:string;
cell:home;
begin
  for l:=1 to 30 do
    writeln;
  for l:=1 to 35 do
    write(' ');
  writeln('-----------');
  for l:=1 to 34 do
    write('-');
  write('| DooZ Game |');
  for l:=1 to 33 do
    write('-');
  for l:=1 to 35 do
    write(' ');
  writeln('-----------');
  writeln;
  writeln;
  count:=0;
  error:=1;
  for i:=1 to 3 do
    for j:=1 to 3 do
      cell [i,j]:=0.1;
  for i:=1 to 3 do
    begin
    write ('                      ');
    for l:=1 to 3 do
      write('|',' ','|          ');
    for j:=1 to 5 do
    writeln;


    end;
  repeat
    counter:=0;
    count6:=0;
    numgh:=0;
    pos:='';
    repeat
    repeat
        writeln('Please Enter Number of row and column:');
        readln(a,b);
        if (a>3) or (a<1) or (b>3) or (b<1) then
          begin
            error:=0;
            writeln('The number that you entered is invalid !!!');
          end
        else
          error:=1;
    until error=1;
        count1:=0;
        pos:='else';
      if (cell[a,b]=0) or (cell[a,b]=1) then
        begin
          writeln('The cell that you choose, had became full');
          error1:=0;
        end
      else
        error1:=1;
    until error1=1;
          count:=count+1;
          cell[a,b]:=1;
        if cell[2,2]=0.1 then
            begin
              cell[2,2]:=0;
              count1:=1;
            end;
        num:=0;
{------------------------------------Ghotr---------------------------------}
            {-----------Ghot1----------}
            sum:=0;
              for j:=1 to 3 do
                  sum:=sum+cell[j,j];
              if (sum>2) and (sum<3) then
                  begin
                    numgh:=1;
                    pos:='ghotr1';
                  end
              else if sum=3 then
                  begin
                    num:=5;
                  end
              else if sum=0 then
                  begin
                    num:=10;
                  end;
        {------------Ghotr2--------------}
              sum1:=0;
                sum1:=cell[1,3]+cell[2,2]+cell[3,1];
              if (sum1>2) and (sum1<3) then
                  begin
                    numgh:=2;
                    pos:='ghotr2';
                  end
              else if sum1=3 then
                  begin
                    num:=5;
                  end
              else if sum1=0 then
                  begin
                    num:=10;
                  end;
              writeln;


{------------------------------------Soton-----------------------------------}
          repeat
            sum:=0;
              count6:=count6+1;
              for j:=1 to 3 do
                  sum:=sum+cell[j,count6];
              if (sum>2) and (sum<3) then
                  begin
                    num:=count6;
                    pos:='soton';
                  end
              else if sum=3 then
                  begin
                    count6:=3;
                    num:=5;
                  end
              else if sum=0 then
                  begin
                    num:=10;
                    count6:=3;
                  end;
              writeln;
            until count6=3;
{-------------------------------Satr-----------------------------------------}
          repeat
            sum:=0;
            counter:=counter+1;
              for j:=1 to 3 do
                  sum:=sum+cell[counter,j];
              if (sum>2) and (sum<3) then
                  begin
                    num:=counter;
                    pos:='satr';
                  end
              else if sum=3 then
                  begin
                    counter:=3;
                    num:=5;
                  end
              else if sum=0 then
                  begin
                    num:=10;
                    counter:=3;
                  end;
              writeln;
            until counter=3;
{---------------------Checking-----------------------------------------------}


            If num=10 then
              begin
                writeln('------Sory You Lose-------');
                count:=5;
              end
            else if num=5 then
              begin
                write('    ');
                for l:=1 to 70 do
                  write('_');
                  writeln;
                for l:=1 to 3 do
                  begin
                    write('    |');
                    for k:=1 to 69  do
                        write(' ');
                    writeln('|');
                    end;
                    write('    |','                We greet to you for this victory');
                    for l:=1 to 20 do
                      write(' ');
                    writeln('|');
                    write('    |');
                    for k:=1 to 69  do
                        write(' ');
                    writeln('|');
                    write('    |','                            You Won');
                    for l:=1 to 33 do
                      write(' ');
                      writeln('|');
                    count:=5;
                for l:=1 to 3 do
                  begin
                    write('    |');
                    for k:=1 to 69 do
                        write(' ');
                    writeln('|');
                  end;
                  write('    ');
                for l:=1 to 70 do
                  write('-');
                  writeln;
              end


            else if (num=1) or (num=2) or (num=3) then
              begin


              if pos='satr' then
                begin
                  for j2:=1 to 3 do
                    if cell[num,j2]=0.1 then
                      if count1=0 then
                        begin
                          cell[num,j2]:=0;
                          count1:=1;
                        end;
                  end
              else if pos='soton' then
                begin
                  for j2:=1 to 3 do
                    if cell[j2,num]=0.1 then
                      if count1=0 then
                        begin
                          cell[j2,num]:=0;
                          count1:=1;
                        end;
                end;
                end;
              if pos='ghotr1' then
                begin
                    for j2:=1 to 3 do
                      if cell[j2,j2]=0.1 then
                        if count1=0 then
                          begin
                            cell[j2,j2]:=0;
                            count1:=1;
                          end;
                end
              else if pos='ghotr2' then
              begin
                if count1=0 then
                    if cell[1,3]=0.1 then
                      begin
                        cell[1,3]:=0;
                        count1:=1;
                      end
                    else if cell[2,2]=0.1 then
                      begin
                        cell[2,2]:=0;
                        count1:=1;
                      end
                    else if cell[3,1]=0.1 then
                      begin
                        cell[3,1]:=0;
                        count1:=1;
                      end;
              end
              else if pos='else' then
                begin
                for i:=1 to 3 do
                  for j:=1 to 3 do
                    if count1=0 then
                      if cell[i,j]=0.1 then
                        begin
                          cell[i,j]:=0;
                          count1:=1;
                        end;
                end;
      writeln;
      writeln;
      write('--< Game Ground >');
        for l:=1 to 63 do
        write('-');
        writeln;
      for l:=1 to 5 do
        writeln;
      For l:=1 to 3 do
        begin
          write('                      ');
          for k:=1 to 3 do
            if cell[l,k]=0.1 then
              write('|',' ','|            ')
            else
              write ('|',cell[l,k]:1:0,'|            ');
            for m:=1 to 8 do
            writeln;
        end;
 until count=5;
  if (num<>5) and (num<>10) then
  begin
    writeln('    ------------------------< Nobody don`t won >---------------------------');
    writeln('    ------------------------<  Try again later >---------------------------');
  end;
  writeln('  /\');
  writeln('  /  \ ');
  writeln(' / || \  Press Enter For Exit');
  writeln('--------');
  readln;


  end.

---

سلام.
نیاز مبرم به 4 تا(یا بیشتر ) مسئله ساده یا حرفه ای مالی به زبان پاسکال دارم .

مثل یه همچین چیزی :

نقل قول:

---

برنامه ای بنویسید که حقوق یک کارمند را دریافت کرده و اگر کمتر از 4500000 ریال باشد بدون کسر مالیات ان را پرداخت کند.در غیر این صورت تا کمتر از 6000000 ریال 7 % مالیات کمتر از 7500000 , 10% مالیات , کمتر از 9000000 , 15 % و بیشتر از 9000000 , 20% مالیات کسر نماید (این برنامه حقوق خالص را مشخص میکند )


برنامه به زبان پاسکال :


Program
var a count
begin
read a)
if a<4500000 then
write :=(a)
end
else
if (a>4500000)and (a<6000000) then
begin
b=(a-4500000)*7/100
a=a-b
write (a)
end
if (a>6000000)and (a<7500000)then
begin
.
.
.

---

نقل قول:

---

نوشته اصلی توسط Amin4All

سلام.
نیاز مبرم به 4 تا(یا بیشتر ) مسئله ساده یا حرفه ای مالی به زبان پاسکال دارم .

مثل یه همچین چیزی :

---

اسم برنامه ها و بگین شاید تونستیم کمکی کنیم:36:

نقل قول:

---

نوشته اصلی توسط sunyboy

اسم برنامه ها و بگین شاید تونستیم کمکی کنیم:36:

---

هر برنامه ای باشه فقط با پاسکال نوشته شده باشه و مثل همون مثال مربوط به حقوق و دستمزد ومالی باشه .(الته مال خودم نیست )

سلام خسته نباشید
میشه برنامه ای بنویسید که عددی دریافت وبه مبنای 16 ببره..