ورود به حساب ثبت نام جدید فراموشی کلمه عبور
برای ورود به حساب کاربری خود، نام کاربری و کلمه عبورتان را در زیر وارد کرده و روی “ ورود به حساب” کلیک کنید.





اگر فرم ثبت نام برای شما نمایش داده نمیشود، اینجا را کلیک کنید.









اگر فرم بازیابی کلمه عبور برای شما نمایش داده نمیشود، اینجا را کلیک کنید.





صفحه 2 از 5 نخست 12345 آخرین
نمایش نتایج: از 11 به 20 از 43
  1. #11
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    تعویض قطر اصلی و فرعی ماتریس 5 در 5

    تعویض قطر اصلی و فرعی ماتریس 5 در 5

    کد PHP:
    uses wincrt;

    var
       
    : array[1..5,1..5of integer;
       
    i,j,temp integer;

    begin
         
    for i:= 1 to 5 do
             for 
    j:= 1 to 5 do
                 
    begin
                      writeln
    ('Enter a[',i,j,']');
                      
    readln(a[i,j]);
                 
    end;

         
    temp:=a[1,1];
         
    a[1,1]:=a[1,5];
         
    a[1,5]:=temp;

         
    temp:=a[2,2];
         
    a[2,2]:=a[2,4];
         
    a[2,4]:=temp;

         
    temp:=a[4,4];
         
    a[4,4]:=a[4,2];
         
    a[4,2]:=temp;

         
    temp:=a[5,5];
         
    a[5,5]:=a[5,1];
         
    a[5,1]:=temp;


         for 
    i:= 1 to 5 do
             
    begin
                   
    for j:= 1 to 5 do
                       
    writea[i,j]:3);
                   
    writeln;
             
    end;

    end
  2. #12
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    سیستم بانکداری با استفاده از رکورد ها

    سیستم بانکداری با استفاده از رکورد ها

    دانلود سورس : [برای نمایش لینک باید عضو شوید. ]

    دانلود فایل جرایی : [برای نمایش لینک باید عضو شوید. ]

    کد PHP:
    {B A N K I N G  S Y S T E M (Records)
    PROGRAMMING BY :
                
    HUSSEIN TAJARENEZHAD}
    uses wincrt;

    type
        Information 
    record
                    firstname
    ,lastname,accounttype string[20];
                    
    customercode,supply            longint;
                    
    profit                         real;
        
    end;
        
    Customers = array[1..100of information;
    var
       
    info information;
       
    i,j,sc,integer;
       
    custom customers;
       
    integer;

    procedure starting;
              
    begin
                   writeln
    ('                * W E L C O M E  T O  B A N K I N G  S Y S T E M *');
                   
    writeln;
                   
    Writeln('What You Want To Do?');
                   
    writeln;
                   
    writeln('  * Add Customer                      : 01');
                   
    writeln('  * Find Customer By Last name        : 02');
                   
    writeln('  * Find Customer By Customer Code    : 03');
                   
    writeln('  * View All Customer                 : 04');
                   
    writeln('  * Profit                            : 05');
                   
    writeln('  * Delete Customer                   : 06');
                   
    writeln('  * For Sorting Data By Last Name     : 07');
                   
    writeln('  * For Sorting Data By Customer Code : 08');
                   
    writeln('  * Edit Customer Infomation          : 09');
                   
    writeln('  * View Profit Rate                  : 10');
                   
    writeln;
                   
    writeln('Enter Service Code :');
                   
    readln(sc);
                   
    clrscr;
                  

              
    end;

    procedure scan;
              var
                 
    n,i,integer;
               
              
    begin
                  
                   writeln
    ('                    * A D D  C U S T O M E R  S Y S T E M *');
                   
    writeln;

                   while 
    100 do
                         
    begin
                              writeln
    ('Enter Number of Customer you want to add');
                              
    readln(n);
                              
    m:=m+n;
                             

                              if 
    100 then
                                 begin
                                      writeln
    ('You can only Enter 100 customer!');
                                      
    m:=m-n;
                         
    end;
                   for 
    i:= 1 to n do
                       
    begin
                            
    for j:= 1 to 5 do
                                
    begin
                                     
    case j of
                                          1
    :
                                            
    begin
                                                 writeln
    ('Select Accunt Type For Below Chart :');
                                                 
    writeln('***********************************');
                                                 
    writeln('*     Account Name     *   Code   *');
                                                 
    writeln('***********************************');
                                                 
    writeln('* Long Period 1 Year   :    1     *');
                                                 
    writeln('* Long Period 2 Year   :    2     *');
                                                 
    writeln('* Long Period 3 Year   :    3     *');
                                                 
    writeln('* Long Period 4 Year   :    4     *');
                                                 
    writeln('* Long Period 5 Year   :    5     *');
                                                 
    writeln('* Short Period         :    6     *');
                                                 
    writeln('***********************************');
                                                 
    writeln;
                                                 
    writeln('Enter Type Code :');
                                                 
    readln(custom[i].accounttype);

                                                 if 
    custom[i].accounttype='1' then
                                                    custom
    [i].accounttype:='Long Period 1 Year'

                                                 
    else if custom[i].accounttype='2' then
                                                      custom
    [i].accounttype:='Long Period 2 Year'

                                                 
    else if custom[i].accounttype='3' then
                                                      custom
    [i].accounttype:='Long Period 3 Year'

                                                 
    else if custom[i].accounttype='4' then
                                                      custom
    [i].accounttype:='Long Period 4 Year'

                                                 
    else if custom[i].accounttype='5' then
                                                      custom
    [i].accounttype:='Long Period 5 Year'

                                                 
    else if custom[i].accounttype='6' then
                                                      custom
    [i].accounttype:='Short Period'
                                                 
    else
                                                     
    begin
                                                          Writeln
    ('For Your Acount Profit Not Calculate');
                                                          
    custom[i].accounttype:='None';
                                                     
    end;

                                                
                                            
    end;
                                          
    3:
                                            
    begin
                                                 writeln
    ('Enter Last name of Customer :');
                                                 
    readln(custom[i].lastname);
                                            
    end;
                                          
    2:
                                            
    begin
                                                 writeln
    ('Enter First name of Customer :');
                                                 
    readln(custom[i].firstname);
                                            
    end;
                                          
    4:
                                            
    begin
                                                 writeln
    ('Enter Customer Code :');
                                                 
    readln(custom[i].customercode);
                                            
    end;
                                          
    5:
                                            
    begin
                                                 writeln
    ('Enter Customer ',custom[i].customercode,' Supply :');
                                                 
    readln(custom[i].supply);
                                            
    end;
                                     
    end;
                                
    end;
                            
    writeln;
                            
    writeln('Entering Data Completed');
                            
    writeln;
                            
    write('* ',custom[i].firstname,' ',custom[i].lastname,' ',custom[i].accounttype);
                            
    writeln(' Accunt Sucssecfuly Created');
                            
    writeln;
                            if 
    i<>n then
                               writeln
    ('Now Enter Data of Customer ',i+1);
                       
    end;
                       
    Writeln('Entering Data for ',n,' Customer Completed');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
              
    end;{End of procedure scan}
    end;

    procedure searchname;
              var
                 
    string[30];
                 
    flag,sni integer;
                
              
    begin
                   writeln
    ('           * S E A R C H I N G  S Y S T E M : B Y  L A S T  N A M E *');
                   
    writeln;
                   
    writeln('Enter last name which you want to search');
                   
    readln(l);
                   
    flag:= 0;
                   
    sni:=1;
                   while (
    sni<100) and (flag=0) do
                         
    begin
                              
    if l=custom[sni].lastname then
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln;
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',custom[sni].firstname,' ',custom[sni].lastname);
                                      
    writeln('* Customer Code : ',custom[sni].customercode);
                                      
    writeln('* Supply        : ',custom[sni].supply);
                                      
    writeln('* Account Type  : ',custom[sni].accounttype);
                                      
    writeln('* Profit        : ',custom[sni].profit:8:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag:= 1;
                                 
    end;
                              
    inc(sni);
                         
    end;
                   if 
    flag=0 then
                      Writeln
    ('Customer Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search name}

    procedure searchcode;
              var
                 
    cc longint;
                 
    flag1,sci integer;
              
    begin
                   writeln
    ('        * S E A R C H I N G  S Y S T E M : B Y  C U S T O M E R  C O D E *');
                   
    writeln;
                   
    writeln('Enter Customer Code which you want to search');
                   
    readln(cc);
                   
    flag1:= 0;
                   
    sci:=1;
                   while (
    sci<100) and (flag1=0) do
                         
    begin
                              
    if (cc=custom[sci].customercodethen
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',custom[sci].firstname,' ',custom[sci].lastname);
                                      
    writeln('* Customer Code : ',custom[sci].customercode);
                                      
    writeln('* Supply        : ',custom[sci].supply);
                                      
    writeln('* Account Type  : ',custom[sci].accounttype);
                                      
    writeln('* Profit        : ',custom[sci].profit:8:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag1:= 1;
                                 
    end;
                              
    inc(sci);
                         
    end;
                   if 
    flag1=0 then
                      Writeln
    ('Customer Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search code}

    procedure sortname;
              var
                 
    index integer;
                 
    min   string;
                 
    temp  information;
              
    begin
              writeln
    ('        * S O R T I N G  D A T A  S Y S T E M  B Y  L A S T  N A M E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := custom[i].lastname;
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    custom[j].lastnamemin then
                                  begin
                                       min
    := custom[j].lastname;
                                       
    index:=j;
                                  
    end;
                               
    temp:=custom[index];
                               
    custom[index]:=custom[i];
                               
    custom[i]:=temp;
                      
    end;
                      
    writeln('Data sorted By Last Name');
                      
    writeln('For view sorted data in first page enter show service code');
                      
    writeln;
                      
    writeln('For Continue Press Enter');
                      
    readln;
                      
    clrscr;
                      
    starting;
                      
              
    end;{End Of procedure Sorting Data By Customer Last Name}

    procedure sortcode;
              var
                 
    index integer;
                 
    min   longint;
                 
    temp  information;
              
    begin
              writeln
    ('     * S O R T I N G  D A T A  S Y S T E M  B Y  C U S T O M E R  C O D E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := custom[i].customercode;
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    custom[j].customercodemin then
                                  begin
                                       min
    := custom[j].customercode;
                                       
    index:=j;
                                  
    end;
                               
    temp:=custom[index];
                               
    custom[index]:=custom[i];
                               
    custom[i]:=temp;
                      
    end;
                     
                      
    writeln('Data sorted By Customer Code');
                      
    writeln('For view sorted data in first page enter show service code');
                      
    writeln;
                      
    writeln('For Continue Press Enter');
                      
    readln;
                      
    clrscr;
                      
    starting;
              
    end;{End Of procedure Sorting Data By Customer Code}

     

    برای مشاهده ادامه سورس برنامه به ادامه مطلب بروید......

    procedure show;

              
    begin
                   writeln
    ('        * V I E W  A L L  C U S T O M E R  A C C U N T  S Y S T E M *');
                   
    writeln;
                   
    writeln('*******************************************************************************');
                   
    writeln('*   Full Name   *  Customer Code  *  Supply    *  Accunt Type    *Profit Pyear*');
                   
    writeln('*******************************************************************************');
                   for 
    i:= 1 to m do
                       
    begin
                            write
    ('  ',custom[i].firstname,' ',custom[i].lastname);
                            
    write(' ':5,custom[i].customercode);
                            
    write(' ':5,custom[i].supply);
                            
    write(' ':5,custom[i].accounttype);
                            
    writeln(' ':5,custom[i].profit:8:2);
                       
    end;
                   
    writeln('*******************************************************************************');
                  
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;{End of procedure show all Customers}

    procedure profit;
              
    begin
                   writeln
    ('            * P R O F I T  C A L C U L A T O R  S Y S T E M *');
                   for 
    i:= 1 to m+do
                      
                            if 
    custom[i].accounttype='Short Period' then
                               custom
    [i].profit:=custom[i].supply*9/100

                            
    else if custom[i].accounttype='Long Period 1 Year' then
                                 custom
    [i].profit:=custom[i].supply*15/100

                            
    else if custom[i].accounttype='Long Period 2 Year' then
                                 custom
    [i].profit:=custom[i].supply*16/100

                            
    else if custom[i].accounttype='Long Period 3 Year' then
                                 custom
    [i].profit:=custom[i].supply*17/100

                            
    else if custom[i].accounttype='Long Period 4 Year' then
                                 custom
    [i].profit:=custom[i].supply*18/100

                            
    else if custom[i].accounttype='Long Period 5 Year' then
                                 custom
    [i].profit:=custom[i].supply*19/100;
                           
                               
                  
                   
    writeln('With Below Rate Profit Calculated!');
                   
    writeln;
                   
    writeln('                           Profit Percent Chart');
                   
    writeln('                      ***********************************');
                   
    writeln('                      *     Account Name     *   Code   *');
                   
    writeln('                      ***********************************');
                   
    writeln('                      * Long Period 1 Year   :   15 %   *');
                   
    writeln('                      * Long Period 2 Year   :   16 %   *');
                   
    writeln('                      * Long Period 3 Year   :   17 %   *');
                   
    writeln('                      * Long Period 4 Year   :   18 %   *');
                   
    writeln('                      * Long Period 5 Year   :   19 %   *');
                   
    writeln('                      * Short Period         :   9 %    *');
                   
    writeln('                      ***********************************');
                   
    writeln;
                   
    show;
              
    end;{End of Perocedure Calculating Profit}

    procedure delete;
              var
                 
    id longint;
                 
    flag integer;
                 
    ans integer;
                
              
    begin
                   writeln
    ('             * D E L E T I N G  C U S T O M E R  S Y S T E M *');
                   
    writeln;
                   
    writeln('Enter Customer Code of Customer which you want to remove :');
                   
    readln(id);
                   
    flag:= 0;
                   
    i:=1;
                   while (
    i<100) and (flag=0) do
                         
    begin
                              
    if id=custom[i].customercode then
                                 begin
                                      writeln
    ('You Select Customer with below information!');
                                      
    writeln;
                                      
    writeln('*************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',custom[i].firstname,' ',custom[i].lastname);
                                      
    writeln('* Customer Code : ',custom[i].customercode);
                                      
    writeln('* Supply        : ',custom[i].supply);
                                      
    writeln('* Account Type  : ',custom[i].accounttype);
                                      
    writeln('* Profit        : ',custom[i].profit:8:2);
                                      
    writeln('*');
                                      
    writeln('*************************************************');
                                      
    flag:=1;
                                      
    writeln;
                                      
    writeln;
                                      
    writeln('Are You sure to remove ',custom[i].firstname,' ',custom[i].lastname,' Account?');
                                      
    writeln('If you are agree press 0 key');
                                      
    readln(ans);
                                      if 
    ans=0 then
                                         begin
                                              
    for j:= i to m do
                                                  
    begin
                                                       custom
    [j]:=custom[j+1];
                                                      
                                                  
    end;
                                              
    m:=m-1;
                                              
    writeln;
                                              
    writeln('Account sucssecfully removed!');
                                              
    writeln;
                                              
    writeln('For Continue Press Enter');
                                              
    readln;
                                              
    clrscr;
                                              
    starting;
                                         
    end
                                      
    else
                                          
    begin
                                               writeln
    ;
                                               
    writeln('Removing Canceled!');
                                               
    writeln;
                                               
    writeln('For Continue Press Enter');
                                               
    readln;
                                               
    clrscr;
                                               
    starting;
                                          
    end;
                                 
    end;
                              
    inc(i);
                         
    end;
                   if 
    flag=0 then
                      begin
                           Writeln
    ('Customer Not Found');
                           
    writeln;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                      
    end;
              
    end;{End Of Procedure Delete}

     

    procedure edit;
              var
                 
    id longint;
                 
    flag integer;
                 
    ans integer;
                

              
    begin
                   writeln
    ('       * E D I T I N G  C U S T O M E R  I N F O R M A T I O N  S Y S T E M *');
                   
    writeln;
                   
    writeln('Enter Customer Code of Customer which you want to change information''s :');
                   
    readln(id);
                   
    flag:= 0;
                   
    i:=1;
                   while (
    i<100) and (flag=0) do
                         
    begin
                              
    if id=custom[i].customercode then
                                 begin
                                      writeln
    ('You Select Customer with below information!');
                                      
    writeln;
                                      
    writeln('*************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',custom[i].firstname,' ',custom[i].lastname);
                                      
    writeln('* Customer Code : ',custom[i].customercode);
                                      
    writeln('* Supply        : ',custom[i].supply);
                                      
    writeln('* Account Type  : ',custom[i].accounttype);
                                      
    writeln('* Profit        : ',custom[i].profit:8:2);
                                      
    writeln('*');
                                      
    writeln('*************************************************');
                                      
    flag:= 1;
                                      
    writeln;
                                      
    writeln;
                                     
                                      
    writeln('************************');
                                      
    writeln('*                      *');
                                      
    writeln('* First Name     :  1  *');
                                      
    writeln('* Last Name      :  2  *');
                                      
    writeln('* Customer Code  :  3  *');
                                      
    writeln('* Supply         :  4  *');
                                      
    writeln('* Account Type   :  5  *');
                                      
    writeln('*                      *');
                                      
    writeln('************************');
                                      
    writeln;
                                      
    writeln('Enter Code of Each Information :');
                                      
    readln(ans);
                                      case 
    ans of
                                           1
    :
                                             
    begin
                                                  writeln
    ('Enter New First name of customer :');
                                                  
    readln(custom[i].firstname);
                                                  
    writeln('First name Changed!');


                                             
    end;
                                           
    2:
                                             
    begin
                                                  writeln
    ('Enter New Last name of customer :');
                                                  
    readln(custom[i].lastname);
                                                  
    writeln('Last name Changed!');

                                                  
                                             
    end;
                                           
    3:
                                             
    begin
                                                  writeln
    ('Enter New Customer code customer :');
                                                  
    readln(custom[i].customercode);
                                                  
    writeln('Customer Code Changed!');


                                             
    end;
                                           
    4:
                                             
    begin
                                                  writeln
    ('Enter New Supply of customer :');
                                                  
    readln(custom[i].supply);
                                                  
    writeln('Supply Changed!');


                                             
    end;
                                           
    5:
                                             
    begin
                                                  writeln
    ('Enter New Account Type customer :');
                                                  
    readln(custom[i].accounttype);
                                                  
    writeln('Account Type Changed!');
                                                  
                                                  
                                             
    end
                                           
    else
                                               
    begin
                                                    writeln
    ('With Upper Code We dont Have information');
                                                    
    writeln;
                                                    
    writeln('For Continue Press Enter');
                                                    
    readln;
                                                    
    clrscr;
                                                    
    starting;
                                               
    end;         
                                      
    end;
                                
                                 
    end;
                              
    inc(i);
                         
    end;
                   if 
    flag=0 then
                      begin
                           Writeln
    ('Customer Not Found');
                           
    writeln;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                      
    end
                   
    else
                       
    begin
                           writeln
    ;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                       
    end;
              
    end;{End OF Perucedure Edit}

    procedure help;
              
    begin
                   writeln
    ('                            * P R O F I T  P E R C E N T *');
                   
    writeln;
                   
    writeln('     Profit Percent Chart');
                   
    writeln('***********************************');
                   
    writeln('*     Account Name     *   Code   *');
                   
    writeln('***********************************');
                   
    writeln('* Long Period 1 Year   :   15 %   *');
                   
    writeln('* Long Period 2 Year   :   16 %   *');
                   
    writeln('* Long Period 3 Year   :   17 %   *');
                   
    writeln('* Long Period 4 Year   :   18 %   *');
                   
    writeln('* Long Period 5 Year   :   19 %   *');
                   
    writeln('* Short Period         :   9 %    *');
                   
    writeln('***********************************');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;
                     

     

    procedure afterstarting;
              
    begin
                   
    case sc of
                        01
    :
                           
    scan;
                        
    02:
                           
    searchname;
                        
    03:
                           
    searchcode;    
                        
    04:
                           
    show;
                        
    05:
                           
    profit;
                        
    06:
                           
    delete;
                        
    07:
                           
    sortname;
                        
    08:
                           
    sortcode;
                        
    09:
                           
    edit;
                        
    10:
                           
    help;
                   else
                       
    begin
                            writeln
    ('* With Code: ',sc,' We Dont Have Service!!!');
                            
    starting;
                       
    end;
                       

                   
    end;
              
    end;
    begin
         starting
    ;
         
    s:=1;
         while 
    s=do
               
    afterstarting;
    end.{End Of Main}

    {
    B A N K I N G  S Y S T E M (Records)
    PROGRAMMING BY :
                
    HUSSEIN TAJARENEZHAD
  3. #13
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    سیستم بانکداری با استفاده از آرایه ها

    سیستم بانکداری با استفاده از آرایه ها

    کد PHP:
    {B A N K I N G  S Y S T E M
    PROGRAMMING BY 
    :
                
    HUSSEIN TAJARENEZHAD}
    uses wincrt;

    type
        information
    =array[1..50,1..2of string[30];{First name,Account Type}
        
    accunt = array[1..50,1..2of longint;{Customer Code,Supply}
        
    pro = array[1..50of real;{Profit}
        
    lname = array[1..50of string[30];{Last Name}
    var
       
    info information;
       
    no accunt;
       
    fa lname;
       
    prof pro;
       
    i,j,sc,integer;
    procedure starting;
              
    begin
                   writeln
    ('                * W E L C O M E  T O  B A N K I N G  S Y S T E M *');
                   
    writeln;
                   
    Writeln(' What You Want To Do?');
                   
    writeln;
                   
    writeln('* Add Customer                      : 01');
                   
    writeln('* Find Customer By Last name        : 02');
                   
    writeln('* Find Customer By Customer Code    : 03');
                   
    writeln('* View All Customer                 : 04');
                   
    writeln('* Profit                            : 05');
                   
    writeln('* Delete Customer                   : 06');
                   
    writeln('* For Sorting Data By Last Name     : 07');
                   
    writeln('* For Sorting Data By Customer Code : 08');
                   
    writeln('* Help                              : 09');
                   
    writeln;
                   
    writeln('Enter Service Code :');
                   
    readln(sc);
                   
    clrscr;
                  

              
    end;
    procedure scan;
              var
                 
    n,i,integer;
                 
    char;
              
    begin
                  
                   writeln
    ('                    * A D D  C U S T O M E R  S Y S T E M *');
                   
    writeln;

                   while 
    100 do
                         
    begin
                              writeln
    ('Enter Number of Customer you want to add');
                              
    readln(n);
                              
    m:=m+n;
                             

                              if 
    100 then
                                 begin
                                      writeln
    ('You can only Enter 100 customer!');
                                      
    m:=m-n;
                         
    end;
                   for 
    i:= 1 to n do
                       
    begin
                            
    for j:= 1 to 5 do
                                
    begin
                                     
    case j of
                                          1
    :
                                            
    begin
                                                 writeln
    ('Select Accunt Type For Below Chart :');
                                                 
    writeln('***********************************');
                                                 
    writeln('*     Account Name     *   Code   *');
                                                 
    writeln('***********************************');
                                                 
    writeln('* Long Period 1 Year   :    1     *');
                                                 
    writeln('* Long Period 2 Year   :    2     *');
                                                 
    writeln('* Long Period 3 Year   :    3     *');
                                                 
    writeln('* Long Period 4 Year   :    4     *');
                                                 
    writeln('* Long Period 5 Year   :    5     *');
                                                 
    writeln('* Short Period         :    6     *');
                                                 
    writeln('***********************************');
                                                 
    writeln;
                                                 
    writeln('Enter Type Code :');
                                                 
    readln(info[i,2]);

                                                 if 
    info[i,2]='1' then
                                                    info
    [i,2]:='Long Period 1 Year'
                                                 
    else if info[i,2]='2' then
                                                      info
    [i,2]:='Long Period 2 Year'
                                                 
    else if info[i,2]='3' then
                                                      info
    [i,2]:='Long Period 3 Year'
                                                 
    else if info[i,2]='4' then
                                                      info
    [i,2]:='Long Period 4 Year'
                                                 
    else if info[i,2]='5' then
                                                      info
    [i,2]:='Long Period 5 Year'
                                                 
    else if info[i,2]='6' then
                                                      info
    [i,2]:='Short Period'
                                                 
    else
                                                     
    begin
                                                          Writeln
    ('For Your Acount Profit Not Calculate');
                                                          
    info[i,2]:='None';
                                                     
    end;

                                                
                                            
    end;
                                          
    3:
                                            
    begin
                                                 writeln
    ('Enter Last name of Customer :');
                                                 
    readln(fa[i]);
                                            
    end;
                                          
    2:
                                            
    begin
                                                 writeln
    ('Enter First name of Customer :');
                                                 
    readln(info[i,1]);
                                            
    end;
                                          
    4:
                                            
    begin
                                                 writeln
    ('Enter Customer Code :');
                                                 
    readln(no[i,1]);
                                            
    end;
                                          
    5:
                                            
    begin
                                                 writeln
    ('Enter Customer ',no[i,1],' Supply :');
                                                 
    readln(no[i,2]);
                                            
    end;
                                     
    end;
                                
    end;
                            
    writeln;
                            
    writeln('Entering Data Compelited');
                            
    writeln;
                            
    writeln('* ',info[i,1],' ',fa[i],' ',info[i,2],' Accunt Sucssecfuly Created');
                            
    writeln;
                            if 
    i<>n then
                               writeln
    ('Now Enter Data of Customer ',i+1);
                       
    end;
                       
    Writeln('Entering Data for ',n,' Customer Compelited');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
              
    end;{End of procedure scan}
    end;

    برای در یافت ادامه سورس کد به ادامه متن بروید.                                                                                              

    procedure searchname;
              var
                 
    string[30];
                 
    flag,sni integer;
                
              
    begin
                   writeln
    ('           * S E A R C H I N G  S Y S T E M : B Y  L A S T  N A M E *');
                   
    writeln;
                   
    writeln('Enter last name which you want to search');
                   
    readln(l);
                   
    flag:= 0;
                   
    sni:=1;
                   while (
    sni<100) and (flag=0) do
                         
    begin
                              
    if l=fa[snithen
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln;
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',info[sni,1],' ',fa[sni]);
                                      
    writeln('* Customer Code : ',no[sni,1]);
                                      
    writeln('* Supply        : ',no[sni,2]);
                                      
    writeln('* Accunt Type   : ',info[sni,2]);
                                      
    writeln('* Profit        : ',prof[sni]:8:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag:= 1;
                                 
    end;
                              
    inc(sni);
                         
    end;
                   if 
    flag=0 then
                      Writeln
    ('Customer Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search name}

    procedure searchcode;
              var
                 
    cc longint;
                 
    flag1,sci integer;
              
    begin
                   writeln
    ('        * S E A R C H I N G  S Y S T E M : B Y  C U S T O M E R  C O D E *');
                   
    writeln;
                   
    writeln('Enter Customer Code which you want to search');
                   
    readln(cc);
                   
    flag1:= 0;
                   
    sci:=1;
                   while (
    sci<100) and (flag1=0) do
                         
    begin
                              
    if (cc=no[sci,1]) then
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name       : ',info[sci,1],' ',fa[sci]);
                                      
    writeln('* Customer Code   : ',no[sci,1]);
                                      
    writeln('* Supply          : ',no[sci,2]);
                                      
    writeln('* Accunt Type     : ',info[sci,2]);
                                      
    writeln('* Profit Per Year : ',prof[sci]:8:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag1:= 1;
                                 
    end;
                              
    inc(sci);
                         
    end;
                   if 
    flag1=0 then
                      Writeln
    ('Customer Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search code}

                  
    procedure sortname;
              var
                 
    index,integer;
                 
    longint;
                 
    t1 real;
                 
    temp,min string;
              
    begin
              writeln
    ('        * S O R T I N G  D A T A  S Y S T E M  B Y  L A S T  N A M E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := fa[i];
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    fa[j]< min then
                                  begin
                                       min
    := fa[j];
                                       
    index:=j;
                                  
    end;
                               
    fa[index]:=fa[i];
                               
    fa[i]:=min;
                               for 
    j:= 1 to 2 do
                                   
    begin
                                        temp
    :=info[i,j];
                                        
    info[i,j]:=info[index,j];
                                        
    info[index,j]:=temp;
                                   
    end;
                               for 
    j:= 1 to 2 do
                                   
    begin
                                        t
    :=no[i,j];
                                        
    no[i,j]:=no[index,j];
                                        
    no[index,j]:=t;
                                   
    end;
                               
    t1:=prof[i];
                               
    prof[i]:=prof[index];
                               
    prof[index]:=t1;
                      
    end;
                      
    writeln('Data sorted By Last Name');
                      
    writeln('For view sorted data in first page enter show service code');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
              
    end;
    procedure sortcode;
              var
                 
    index,k,min integer;
                 
    longint;
                 
    t1 real;
                 
    temp string;
              
    begin
              writeln
    ('     * S O R T I N G  D A T A  S Y S T E M  B Y  C U S T O M E R  C O D E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := no[i,1];
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    no[j,1]< min then
                                  begin
                                       min
    := no[j,1];
                                       
    index:=j;
                                  
    end;
                               
    no[index,1]:=no[i,1];
                               
    no[i,1]:=min;
                               for 
    j:= 1 to 2 do
                                   
    begin
                                        temp
    :=info[i,j];
                                        
    info[i,j]:=info[index,j];
                                        
    info[index,j]:=temp;
                                   
    end;

                               
    t:=no[i,2];
                               
    no[i,2]:=no[index,2];
                               
    no[index,2]:=t;

                               
    t1:=prof[i];
                               
    prof[i]:=prof[index];
                               
    prof[index]:=t1;
                      
    end;
                      
    writeln('Data sorted By Customer Code');
                      
    writeln('For view sorted data in first page enter show service code');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;
    procedure show;

              
    begin
                   writeln
    ('        * V I E W  A L L  C U S T O M E R  A C C U N T  S Y S T E M *');
                   
    writeln;
                   
    writeln('*******************************************************************************');
                   
    writeln('*   Full Name   *  Customer Code  *  Supply    *  Accunt Type    *Profit Pyear*');
                   
    writeln('*******************************************************************************');
                   for 
    i:= 1 to m do
                       
    begin
                            write
    ('  ',info[i,1],' ',fa[i]);
                            
    write(' ':5,no[i,1]);
                            
    write(' ':5,no[i,2]);
                            
    write(' ':5,info[i,2]);
                            
    writeln(' ':5,prof[i]:8:2);
                       
    end;
                   
    writeln('*******************************************************************************');
                  
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;{End of procedure show}
    procedure profit;
              
    begin
                   writeln
    ('            * P R O F I T  C A L C U L A T O R  S Y S T E M *');
                   for 
    i:= 1 to m+do
                      
                            if 
    info[i,2]='Short Period' then
                               prof
    [i]:=no[i,2]*9/100
                            
    else if info[i,2]='Long Period 1 Year' then
                                 prof
    [i]:=no[i,2]*15/100
                            
    else if info[i,2]='Long Period 2 Year' then
                                 prof
    [i]:=no[i,2]*16/100
                            
    else if info[i,2]='Long Period 3 Year' then
                                 prof
    [i]:=no[i,2]*17/100
                            
    else if info[i,2]='Long Period 4 Year' then
                                 prof
    [i]:=no[i,2]*18/100
                            
    else if info[i,2]='Long Period 5 Year' then
                                 prof
    [i]:=no[i,2]*19/100;
                           
                               
                  
                   
    writeln('With Belw Rate Profit Calculated!');
                   
    writeln;
                   
    writeln('                           Profit Percent Chart');
                   
    writeln('                      ***********************************');
                   
    writeln('                      *     Account Name     *   Code   *');
                   
    writeln('                      ***********************************');
                   
    writeln('                      * Long Period 1 Year   :   15 %   *');
                   
    writeln('                      * Long Period 2 Year   :   16 %   *');
                   
    writeln('                      * Long Period 3 Year   :   17 %   *');
                   
    writeln('                      * Long Period 4 Year   :   18 %   *');
                   
    writeln('                      * Long Period 5 Year   :   19 %   *');
                   
    writeln('                      * Short Period         :   9 %    *');
                   
    writeln('                      ***********************************');
                   
    writeln;
                   
    show;
              
    end;
    procedure delete;
              var
                 
    id longint;
                 
    flag integer;
                 
    ans integer;
                 
    javab char;
              
    begin
                   writeln
    ('             * D E L E T I N G  C U S T O M E R  S Y S T E M *');
                   
    writeln;
                   
    writeln('Enter Customer Code of Customer which you want to remove :');
                   
    read(id);
                   
    flag:= 0;
                   
    i:=1;
                   while (
    i<100) and (flag=0) do
                         
    begin
                              
    if id=no[i,1then
                                 begin
                                      writeln
    ('You Select Customer with below information!');
                                      
    writeln;
                                      
    writeln('*************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name       : ',info[i,1],' ',fa[i]);
                                      
    writeln('* Customer Code   : ',no[i,1]);
                                      
    writeln('* Supply          : ',no[i,2]);
                                      
    writeln('* Accunt Type     : ',info[i,2]);
                                      
    writeln('* Profit Per Year : ',prof[i]:8:2);
                                      
    writeln('*');
                                      
    writeln('*************************************************');
                                      
    flag:= 1;
                                      
    writeln;
                                      
    writeln;
                                      
    writeln('Are You sure to remove ',info[i,1],' ',fa[i],' Account?');
                                      
    writeln('If you are agree press 0 key');
                                      
    readln(ans);
                                      if 
    ans=0 then
                                         begin
                                              
    for j:= i to m do
                                                  
    begin
                                                       info
    [j,1] := info[j+1,1];
                                                       
    info[j,2] := info[j+1,2];
                                                       
    fa[j] :=fa[j+1];
                                                       
    prof[j] := prof[j+1];
                                                       
    no[j,1] := no[j+1,1];
                                                       
    no[j,2] := no[j+1,2];
                                                  
    end;
                                              
    m:=m-1;
                                              
    writeln;
                                              
    writeln('Account sucssecfully removed!');
                                              
    writeln;
                                              
    writeln('For Continue Press Enter');
                                              
    readln;
                                              
    clrscr;
                                              
    starting;
                                         
    end
                                      
    else
                                          
    begin
                                               writeln
    ;
                                               
    writeln('Removing Canceled!');
                                               
    writeln;
                                               
    writeln('For Continue Press Enter');
                                               
    readln;
                                               
    clrscr;
                                               
    starting;
                                          
    end;
                                 
    end;
                              
    inc(i);
                         
    end;
                   if 
    flag=0 then
                      begin
                           Writeln
    ('Customer Not Found');
                           
    clrscr;
                           
    delete;
                      
    end;
              
    end;

    procedure help;
              
    begin
                   writeln
    ('                            * P R O F I T  P E R C E N T *');
                   
    writeln;
                   
    writeln('     Profit Percent Chart');
                   
    writeln('***********************************');
                   
    writeln('*     Account Name     *   Code   *');
                   
    writeln('***********************************');
                   
    writeln('* Long Period 1 Year   :   15 %   *');
                   
    writeln('* Long Period 2 Year   :   16 %   *');
                   
    writeln('* Long Period 3 Year   :   17 %   *');
                   
    writeln('* Long Period 4 Year   :   18 %   *');
                   
    writeln('* Long Period 5 Year   :   19 %   *');
                   
    writeln('* Short Period         :   9 %    *');
                   
    writeln('***********************************');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;

    procedure afterstarting;
              
    begin
                   
    case sc of
                        01
    :
                           
    scan;
                        
    02:
                           
    searchname;
                        
    03:
                           
    searchcode;    
                        
    04:
                           
    show;
                        
    05:
                           
    profit;
                        
    06:
                           
    delete;
                        
    07:
                           
    sortname;
                        
    08:
                           
    sortcode;
                        
    09:
                           
    help;
                   else
                       
    begin
                            writeln
    ('* With Code: ',sc,' We Dont Have Service!!!');
                            
    starting;
                       
    end;
                       

                   
    end;
              
    end;


    begin
         starting
    ;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
    end.

    {
    B A N K I N G  S Y S T E M
    PROGRAMMING BY 
    :
                
    HUSSEIN TAJARENEZHAD
  4. #14
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    در یافت یک تاریخ و مشخص نمودن نام آن روز

    در یافت یک تاریخ و مشخص نمودن نام آن روز

    کد PHP:
    uses wincrt;

    var
       
    td : array[1..10of char;
       
    ld : array[1..12of char;
       
    ntda : array[1..17of string[10];
       
    ndt string[10];
       
    td1,td2,tm1,tm2,ty1,ty2,ty3,ty4,ntd,tm,ty integer;
       
    ld1,ld2,lm1,lm2,ly1,ly2,ly3,ly4,nld,lm,ly integer;
       
    i,index,D,integer;
       
    ndtd,ndtm,ndty longint;
       
    ndld,ndlm,ndly longint;
    begin
         ntda
    [1]:='shanbe';
         
    ntda[2]:='1shanbe';
         
    ntda[3]:='2shanbe';
         
    ntda[4]:='3shanbe';
         
    ntda[5]:='4shanbe';
         
    ntda[6]:='5shanbe';
         
    ntda[7]:='jome';
         
    ntda[8]:='shanbe';
         
    ntda[9]:='1shanbe';
         
    ntda[10]:='2shanbe';
         
    ntda[11]:='3shanbe';
         
    ntda[12]:='4shanbe';
         
    ntda[13]:='5shanbe';
         
    ntda[14]:='jome';
         
    writeln('Like below :');
         for 
    i:= 1 to 7 do
             
    write(ntda[i]:10);
         
    writeln;
         
    writeln('Enter Name Of Today');
         
    readln(ndt);

        
         
    writeln('Enter Date of Today');
         for 
    i:= 1 to 10 do
             
    read(td[i]);

         
    writeln('Enter date of day which you want to know name :');
         
    i:=1;
         for 
    i:= 1 to 12 do
             
    read(ld[i]);

         for 
    i:=7 to 14 do
             if 
    ntda[i]=ndt then
                index
    :=i;
         
    writeln;
        
         
    td1:=ord(td[10])-48;
         
    td2:=ord(td[9])-48;
         
    tm1:=ord(td[7])-48;
         
    tm2:=ord(td[6])-48;
         
    ty1:=ord(td[4])-48;
         
    ty2:=ord(td[3])-48;
         
    ty3:=ord(td[2])-48;
         
    ty4:=ord(td[1])-48;

         
    ntd:=td1+(10*td2);
         
    tm:=tm1+(10*tm2);
         
    ty:=ty1+(10*ty2)+(100*ty3)+(1000*ty4);
        

         
    ld1:=ord(ld[12])-48;
         
    ld2:=ord(ld[11])-48;
         
    lm1:=ord(ld[9])-48;
         
    lm2:=ord(ld[8])-48;
         
    ly1:=ord(ld[6])-48;
         
    ly2:=ord(ld[5])-48;
         
    ly3:=ord(ld[4])-48;
         
    ly4:=ord(ld[3])-48;

         
    nld:=ld1+(10*ld2);
         
    lm:=lm1+(10*lm2);
         
    ly:=ly1+(10*ly2)+(100*ly3)+(1000*ly4);

         
    writeln;
        

         if 
    tm<=6 then
            ndtm
    :=tm*31
         
    else
            
    ndtm:=(6*31)+((tm-6)*30);

         
    ndty:=ty*365+(ty div 4);

         
    ndtd:=ntd+ndtm+ndty;{today date bu day}


        
         if 
    lm<=6 then
            ndlm
    :=lm*31
         
    else
            
    ndlm:=(6*31)+((lm-6)*30);

         
    ndly:=ly*365+(ly div 4);

         
    ndld:=nld+ndlm+ndly;{last date bu day}


         
    d:=ndtd-ndld;

         
    R:=D mod 7;

         
    writeln;
         case 
    R of
              0
    write(ntda[index]);
              
    1write(ntda[index-1]);
              
    2write(ntda[index-2]);
              
    3write(ntda[index-3]);
              
    4write(ntda[index-4]);
              
    5write(ntda[index-5]);
              
    6write(ntda[index-6]);
        
         
    end;
             

    end
  5. #15
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    سیستم ثبت اطلاعات دانشجویان:ثبت:حذف:مرتب سازی

    سیستم ثبت اطلاعات دانشجویان:ثبت:حذف:مرتب سازی


    کد PHP:
    {Student Information
    Programming By Hussein Tajarenezhad
    Tajarenezhad
    @gmail.com}

    uses wincrt;
    type
        StudentInformation 
    record
                           firstname
    ,lastname string[20];
                           
    studentno longint;
                           
    average real;
        
    end;
        
    students = array[1..100of StudentInformation;
    var
       
    stud students;
       
    sc,m,s,i,integer;

    procedure starting;
              
    begin
                   writeln
    ('* W E L C O M E  T O  S T U D E N T  I N F O R M A T I O N *');
                   
    writeln;
                   
    Writeln('What You Want To Do?');
                   
    writeln;
                   
    writeln('  * Add Student                          : 01');
                   
    writeln('  * Find Student By Last name            : 02');
                   
    writeln('  * Find Student By Student.No           : 03');
                   
    writeln('  * View All Student                     : 04');
                   
    writeln('  * Delete Student                       : 05');
                   
    writeln('  * For Sorting Student By Last Name     : 06');
                   
    writeln('  * For Sorting Student Student.No       : 07');
                   
    writeln('  * Edit Student Infomation              : 08');
                   
    writeln;
                   
    writeln('Enter Service Code :');
                   
    readln(sc);
                   
    clrscr;
              
    end;

    procedure scan;
              var
                 
    n,i,integer;
               
              
    begin
                  
                   writeln
    ('                    * A D D  S T U D E N T  S Y S T E M *');
                   
    writeln;

                   while 
    100 do
                         
    begin
                              writeln
    ('Enter Number of Student you want to add');
                              
    readln(n);
                              
    m:=m+n;
                             

                              if 
    100 then
                                 begin
                                      writeln
    ('You can only Enter 100 Student!');
                                      
    m:=m-n;
                         
    end;
                   for 
    i:= 1 to n do
                       
    begin
                            
    for j:= 1 to 4 do
                                
    begin
                                     
    case j of
                                          4
    :
                                            
    begin
                                                 writeln
    ('Enter Student Average :');
                                                 
    readln(stud[i].average);
                                                
                                            
    end;
                                          
    2:
                                            
    begin
                                                 writeln
    ('Enter Last name of Student :');
                                                 
    readln(stud[i].lastname);
                                            
    end;
                                          
    1:
                                            
    begin
                                                 writeln
    ('Enter First name of Student :');
                                                 
    readln(stud[i].firstname);
                                            
    end;
                                          
    3:
                                            
    begin
                                                 writeln
    ('Enter Student.No :');
                                                 
    readln(stud[i].Studentno);
                                            
    end;
                                         
                                     
    end;
                                
    end;
                            
    writeln;
                            
    writeln('Entering Data Compelited');
                            
    writeln;
                            
    write('* ',stud[i].firstname,' ',stud[i].lastname,' ',stud[i].studentno);
                            
    writeln(' Student Sucssecfuly Added');
                            
    writeln;
                            if 
    i<>n then
                               writeln
    ('Now Enter Data of Student ',i+1);
                       
    end;
                       
    Writeln('Entering Data for ',n,' Student Compelited');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
                   
    end;
              
    end;{End of procedure scan}

    procedure searchname;
              var
                 
    string[30];
                 
    flag,sni integer;
                
              
    begin
                   writeln
    ('           * S E A R C H I N G  S Y S T E M : B Y  L A S T  N A M E *');
                   
    writeln;
                   
    writeln('Enter last name which you want to search');
                   
    readln(l);
                   
    flag:= 0;
                   
    sni:=1;
                   while (
    sni<100) and (flag=0) do
                         
    begin
                              
    if l=stud[sni].lastname then
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln;
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',stud[sni].firstname,' ',stud[sni].lastname);
                                      
    writeln('* Student.No    : ',stud[sni].studentno);
                                      
    writeln('* Average       : ',stud[sni].average:5:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag:= 1;
                                 
    end;
                              
    inc(sni);
                         
    end;
                   if 
    flag=0 then
                      Writeln
    ('Student Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search name}

    برای دریافت ادامه سورس کد ادامه مطلب را ببینید

    procedure searchcode
    ;
              var
                 
    cc longint;
                 
    flag1,sci integer;
              
    begin
                   writeln
    ('        * S E A R C H I N G  S Y S T E M : B Y  C U S T O M E R  C O D E *');
                   
    writeln;
                   
    writeln('Enter Student.No which you want to search');
                   
    readln(cc);
                   
    flag1:= 0;
                   
    sci:=1;
                   while (
    sci<100) and (flag1=0) do
                         
    begin
                              
    if (cc=stud[sci].studentnothen
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name     : ',stud[sci].firstname,' ',stud[sci].lastname);
                                      
    writeln('* Student.No    : ',stud[sci].studentno);
                                      
    writeln('* Average       : ',stud[sci].average:5:2);
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag1:= 1;
                                 
    end;
                              
    inc(sci);
                         
    end;
                   if 
    flag1=0 then
                      Writeln
    ('Student Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search code}

     

    procedure sortname;
              var
                 
    index integer;
                 
    min   string;
                 
    temp  StudentInformation;
              
    begin
              writeln
    ('        * S O R T I N G  S T U D E N T   S Y S T E M  B Y  L A S T  N A M E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := stud[i].lastname;
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    stud[j].lastnamemin then
                                  begin
                                       min
    := stud[j].lastname;
                                       
    index:=j;
                                  
    end;
                               
    temp:=stud[index];
                               
    stud[index]:=stud[i];
                               
    stud[i]:=temp;
                      
    end;
                      
    writeln('Students sorted By Last Name');
                      
    writeln('For view sorted data in first page enter show service code');
                      
    writeln;
                      
    writeln('For Continue Press Enter');
                      
    readln;
                      
    clrscr;
                      
    starting;
                      
              
    end;{End Of procedure Sorting Data By Student Last Name}

    procedure sortcode;
              var
                 
    index integer;
                 
    min   longint;
                 
    temp  StudentInformation;
              
    begin
              writeln
    ('     * S O R T I N G  S T U D E N T  S Y S T E M  B Y  C U S T O M E R  C O D E *');
              
    writeln;
              for 
    i:= 1 to m do
                      
    begin
                           min
    := stud[i].Studentno;
                           
    index:=i;
                           for 
    j:= i+1 to m do

                               if 
    stud[j].Studentnomin then
                                  begin
                                       min
    := stud[j].Studentno;
                                       
    index:=j;
                                  
    end;
                               
    temp:=stud[index];
                               
    stud[index]:=stud[i];
                               
    stud[i]:=temp;
                      
    end;
                     
                      
    writeln('Students sorted By Student.No');
                      
    writeln('For view sorted data in first page enter show service code');
                      
    writeln;
                      
    writeln('For Continue Press Enter');
                      
    readln;
                      
    clrscr;
                      
    starting;
              
    end;{End Of procedure Sorting Data By Student Code}

    procedure show;

              
    begin
                   writeln
    ('        * V I E W  A L L   S T U D E N T   S Y S T E M *');
                   
    writeln;
                   
    writeln('*******************************************************************************');
                   
    writeln('*   Full Name   *  Student.No  *  Average                                     *');
                   
    writeln('*******************************************************************************');
                   for 
    i:= 1 to m do
                       
    begin
                            write
    ('  ',stud[i].firstname,' ',stud[i].lastname);
                            
    write(' ':5,stud[i].Studentno);
                            
    writeln(' ':5,stud[i].average);
                       
    end;
                   
    writeln('*******************************************************************************');
                  
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;{End of procedure show all Students}


    procedure delete;
              var
                 
    id longint;
                 
    flag integer;
                 
    ans integer;
                
              
    begin
                   writeln
    ('             * D E L E T I N G  S T U D E N T  S Y S T E M *');
                   
    writeln;
                   
    writeln('Enter Student.No of Student which you want to remove :');
                   
    readln(id);
                   
    flag:= 0;
                   
    i:=1;
                   while (
    i<100) and (flag=0) do
                         
    begin
                              
    if id=stud[i].Studentno then
                                 begin
                                      writeln
    ('You Select Student with below information!');
                                      
    writeln;
                                      
    writeln('*************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name      : ',stud[i].firstname,' ',stud[i].lastname);
                                      
    writeln('* Student.No     : ',stud[i].Studentno);
                                      
    writeln('* Average        : ',stud[i].average);
                                      
    writeln('*');
                                      
    writeln('*************************************************');
                                      
    flag:=1;
                                      
    writeln;
                                      
    writeln;
                                      
    writeln('Are You sure to remove ',stud[i].firstname,' ',stud[i].lastname,' ?');
                                      
    writeln('If you are agree press 0 key');
                                      
    readln(ans);
                                      if 
    ans=0 then
                                         begin
                                              
    for j:= i to m do
                                                  
    begin
                                                       stud
    [j]:=stud[j+1];
                                                      
                                                  
    end;
                                              
    m:=m-1;
                                              
    writeln;
                                              
    writeln('Student sucssecfully removed!');
                                              
    writeln;
                                              
    writeln('For Continue Press Enter');
                                              
    readln;
                                              
    clrscr;
                                              
    starting;
                                         
    end
                                      
    else
                                          
    begin
                                               writeln
    ;
                                               
    writeln('Removing Canceled!');
                                               
    writeln;
                                               
    writeln('For Continue Press Enter');
                                               
    readln;
                                               
    clrscr;
                                               
    starting;
                                          
    end;
                                 
    end;
                              
    inc(i);
                         
    end;
                   if 
    flag=0 then
                      begin
                           Writeln
    ('Student Not Found');
                           
    writeln;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                      
    end;
              
    end;{End Of Procedure Delete}


    procedure edit;
              var
                 
    id longint;
                 
    flag integer;
                 
    ans integer;
                

              
    begin
                   writeln
    ('       * E D I T I N G  S T U D E N T  I N F O R M A T I O N  S Y S T E M *');
                   
    writeln;
                   
    writeln('Enter Student.No of Student which you want to change information''s :');
                   
    read(id);
                   
    flag:= 0;
                   
    i:=1;
                   while (
    i<100) and (flag=0) do
                         
    begin
                              
    if id=stud[i].Studentno then
                                 begin
                                      writeln
    ('You Select Student with below information!');
                                      
    writeln;
                                      
    writeln('*************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name      : ',stud[i].firstname,' ',stud[i].lastname);
                                      
    writeln('* Student.No     : ',stud[i].Studentno);
                                      
    writeln('* Average        : ',stud[i].average);
                                      
    writeln('*');
                                      
    writeln('*************************************************');
                                      
    flag:= 1;
                                      
    writeln;
                                      
    writeln;
                                     
                                      
    writeln('************************');
                                      
    writeln('*                      *');
                                      
    writeln('* First Name     :  1  *');
                                      
    writeln('* Last Name      :  2  *');
                                      
    writeln('* Student.No     :  3  *');
                                      
    writeln('* Average        :  4  *');
                                      
    writeln('*                      *');
                                      
    writeln('************************');
                                      
    writeln;
                                      
    writeln('Enter Code of Each Information :');
                                      
    readln(ans);
                                      case 
    ans of
                                           1
    :
                                             
    begin
                                                  writeln
    ('Enter New First name of Student :');
                                                  
    readln(stud[i].firstname);
                                                  
    writeln('First name Changed!');


                                             
    end;
                                           
    2:
                                             
    begin
                                                  writeln
    ('Enter New Last name of Student :');
                                                  
    readln(stud[i].lastname);
                                                  
    writeln('Last name Changed!');

                                                  
                                             
    end;
                                           
    3:
                                             
    begin
                                                  writeln
    ('Enter New Student.No Student :');
                                                  
    readln(stud[i].Studentno);
                                                  
    writeln('Student.No Changed!');


                                             
    end;
                                           
    4:
                                             
    begin
                                                  writeln
    ('Enter New Average of Student :');
                                                  
    readln(stud[i].average);
                                                  
    writeln('Average Changed!');


                                             
    end
                                          
                                           
    else
                                               
    begin
                                                    writeln
    ('With Upper Code We dont Have information');
                                                    
    writeln;
                                                    
    writeln('For Continue Press Enter');
                                                    
    readln;
                                                    
    clrscr;
                                                    
    starting;
                                               
    end;         
                                      
    end;
                                
                                 
    end;
                              
    inc(i);
                         
    end;
                   if 
    flag=0 then
                      begin
                           Writeln
    ('Student Not Found');
                           
    writeln;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                      
    end
                   
    else
                       
    begin
                           writeln
    ;
                           
    writeln('For Continue Press Enter');
                           
    readln;
                           
    clrscr;
                           
    starting;
                       
    end;
              
    end;{End OF Perucedure Edit}

    procedure afterstarting;
              
    begin
                   
    case sc of
                        01
    :
                           
    scan;
                        
    02:
                           
    searchname;
                        
    03:
                           
    searchcode;    
                        
    04:
                           
    show;
                        
    05:
                           
    delete;
                        
    06:
                           
    sortname;
                        
    07:
                           
    sortcode;
                        
    08:
                           
    edit;
                       
                   else
                       
    begin
                            writeln
    ('* With Code: ',sc,' We Dont Have Service!!!');
                            
    starting;
                       
    end;
                       

                   
    end;
              
    end;
    begin
         starting
    ;
         
    s:=1;
         while 
    s=do
               
    afterstarting;
    end.{End Of Main}

    {
    Student Information
    Programming By Hussein Tajarenezhad 
  6. #16
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    سورس پروژه مديريت كتابخانه به زبان اسكال

    سیستم کتابخانه

    کد PHP:
    uses wincrt;{Programming By Hussein Tajarenezhad(Tajarenezhad@Gmail.com)}

    type
        MemberInfo 
    = array[1..100,1..3of string[30];{First name,Last Name ,Books}
        
    Bookinfo = array[1..500,1..3of string[20];{Book name ,Author name ,Book code,}
        
    MemberCode = array[1..100of integer;{Member Code}

    var
       
    mi memberinfo;
       
    bi bookinfo;
       
    mc membercode;
       
    sc,i,j,mm,mb integer;
    procedure starting;
              
    begin
                   writeln
    ('                * L I B R A R Y  S Y S T E M *');
                   
    writeln;
                   
    Writeln(' What You Want To Do?');
                   
    writeln;
                   
    writeln('* Add Member            : 01');
                   
    writeln('* Add Book              : 02');
                   
    writeln('* Find Member           : 03');
                   
    writeln('* View All Member       : 04');
                   
    writeln('* View All Book         : 05');
                   
    writeln('* Find Book             : 06');
                  
                   
    writeln;
                   
    writeln('Enter Service Code :');
                   
    readln(sc);
                   
    clrscr;
                  

              
    end;
    procedure scanmember;
            
              var
                 
    n,i,integer;
                 
    char;
              
    begin
                  
                   writeln
    ('                    * A D D  M E M B E R  S Y S T E M *');
                   
    writeln;

                   while 
    100 do
                         
    begin
                              writeln
    ('Enter Number of Member you want to add');
                              
    readln(n);
                              
    mm:=mm+n;
                             

                              if 
    100 then
                                 begin
                                      writeln
    ('You can only Enter 100 Member!');
                                      
    mm:=mm-n;
                         
    end;
                   for 
    i:= 1 to n do
                       
    begin
                            
    for j:= 1 to 3 do
                                
    begin
                                     
    case j of
                                         
                                           
                                          2
    :
                                            
    begin
                                                 writeln
    ('Enter Last name of Member :');
                                                 
    readln(mi[i,2]);
                                            
    end;
                                          
    1:
                                            
    begin
                                                 writeln
    ('Enter First name of Member :');
                                                 
    readln(mi[i,1]);
                                            
    end;
                                          
    3:
                                            
    begin
                                                 writeln
    ('Enter Member Code :');
                                                 
    readln(mc[i]);
                                            
    end;
                                         
                                     
    end;
                                
    end;
                            
    writeln;
                            
    writeln('Entering Data Compelited');
                            
    writeln;
                            
    writeln('* ',mi[i,1],' ',mi[i,2],' ',' Accunt Sucssecfuly Created');
                            
    writeln;
                            if 
    i<>n then
                               writeln
    ('Now Enter Data of Member ',i+1);
                       
    end;
                       
    Writeln('Entering Data for ',n,' Member Completed');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
              
    end;{End of procedure scanmember}
    end;

    procedure scanbook;
              var
                 
    n,i,integer;
                 
    char;
              
    begin
                  
                   writeln
    ('                    * A D D  B O O K  S Y S T E M *');
                   
    writeln;

                  
                       
                              
    writeln('Enter Number of Book you want to add');
                              
    readln(n);
                              
    mb:=mb+n;
                             

                              if 
    1000 then
                                 begin
                                      writeln
    ('You can only Enter 1000 Book!');
                                     
                       
                   for 
    i:= 1 to n do
                       
    begin
                            
    for j:= 1 to 3 do
                                
    begin
                                     
    case j of
                                         
                                           
                                          1
    :
                                            
    begin
                                                 writeln
    ('Enter Name of Book :');
                                                 
    readln(bi[i,1]);
                                            
    end;
                                          
    2:
                                            
    begin
                                                 writeln
    ('Enter Name of Book Author :');
                                                 
    readln(bi[i,2]);
                                            
    end;
                                          
    3:
                                            
    begin
                                                 writeln
    ('Enter Book Code :');
                                                 
    readln(bi[i,3]);
                                            
    end;
                                         
                                     
    end;
                                
    end;
                            
    writeln;
                            
    writeln('Entering Data Compelited');
                            
    writeln;
                            
    writeln('* ',bi[i,1],' ',bi[i,2],' Book Sucssecfuly Added');
                            
    writeln;
                            if 
    i<>n then
                               writeln
    ('Now Enter Data of Book ',i+1);
                       
    end;
                       
    Writeln('Entering Data for ',n,' Book Completed');
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
                      
              
    end;{End of procedure scanbook}
    end;

    procedure findmember;
              var
                 
    cc longint;
                 
    flag1,sci integer;
              
    begin
                   writeln
    ('        * S E A R C H I N G  S Y S T E M : B Y  M E M B E R  C O D E *');
                   
    writeln;
                   
    writeln('Enter Member Code which you want to search');
                   
    readln(cc);
                   
    flag1:= 0;
                   
    sci:=1;
                   while (
    sci<100) and (flag1=0) do
                         
    begin
                              
    if (cc=mc[sci]) then
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Full name       : ',mi[sci,1],' ',mi[sci,2]);
                                      
    writeln('* Member  Code    : ',mc[sci]);
                                      
    writeln('* ');
                                      
    writeln('* Book''s         : ',mi[sci,3]);
                                      
    writeln('* ');
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag1:= 1;
                                 
    end;
                              
    inc(sci);
                         
    end;
                   if 
    flag1=0 then
                      Writeln
    ('Member Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search code}

    procedure findbook;
              var
                 
    string[30];
                 
    flag,sni integer;
                
              
    begin
                   writeln
    ('           * S E A R C H I N G  S Y S T E M : B Y  B O O K  N A M E *');
                   
    writeln;
                   
    writeln('Enter book name which you want to search');
                   
    readln(l);
                   
    flag:= 0;
                   
    sni:=1;
                   while (
    sni<100) and (flag=0) do
                         
    begin
                              
    if l=bi[sni,1then
                                 begin
                                      writeln
    ('Data Found!');
                                      
    writeln;
                                      
    writeln('*******************************************************************************');
                                      
    writeln('*');
                                      
    writeln('* Book name     : ',bi[sni,1]);
                                      
    writeln('* Book Code     : ',bi[sni,3]);
                                      
    writeln('* Author        : ',bi[sni,2]);
                                      
    writeln('* ');
                                      
    writeln('* ');
                                      
    writeln('*');
                                      
    writeln('*******************************************************************************');
                                      
    flag:= 1;
                                 
    end;
                              
    inc(sni);
                         
    end;
                   if 
    flag=0 then
                      Writeln
    ('Book Not Found');
                   
    writeln;
                   
    writeln('For Continue Press Enter');
                   
    readln;
                   
    clrscr;
                   
    starting;
              
    end;{End of procedure search book name}

    procedure showallmember;
              
    begin
                   writeln
    ('        * V I E W  A L L  M E M B E R  A C C U N T  S Y S T E M *');
                   
    writeln;
                   
    writeln('*******************************************************************************');
                   
    writeln('*   Full Name     *   Member Code    *    Books    *                          *');
                   
    writeln('*******************************************************************************');
                   for 
    i:= 1 to mm do
                       
    begin
                            write
    ('  ',mi[i,1],' ',mi[i,2]);
                            
    write(' ':5,mc[i]);
                            
    write(' ':5,mi[i,3]);
                           
                           
                       
    end;
                   
    writeln('*******************************************************************************');
                  
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;{End of procedure show member}

    procedure showallbook;
              
    begin
                   writeln
    ('        * V I E W  A L L  B O O K  S Y S T E M *');
                   
    writeln;
                   
    writeln('*******************************************************************************');
                   
    writeln('*   Book Name     *   Author Name    *    Book Code    *                      *');
                   
    writeln('*******************************************************************************');
                   for 
    i:= 1 to mb do
                       
    begin
                            write
    ('  ',bi[i,1]);
                            
    write(' ':5,bi[i,2]);
                            
    write(' ':5,bi[i,3]);
                           
                           
                       
    end;
                   
    writeln('*******************************************************************************');
                  
                       
    writeln;
                       
    writeln('For Continue Press Enter');
                       
    readln;
                       
    clrscr;
                       
    starting;
              
    end;{End of procedure show book}

    procedure afterstarting;
              
    begin
                   
    case sc of
                        01
    :
                           
    scanmember;
                        
    02:
                           
    scanbook;
                        
    03:
                           
    findmember;    
                        
    04:
                           
    showallmember;
                        
    05:
                           
    showallbook;
                        
    06:
                           
    findbook;
                       
                   else
                       
    begin
                            writeln
    ('* With Code: ',sc,' We Dont Have Service!!!');
                            
    starting;
                       
    end;
                       

                   
    end;
              
    end;


    begin
         starting
    ;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
         
    afterstarting;
    end
  7. #17
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    ضرب و جمع دو عدد 20 رقمی

    ضرب و جمع دو عدد 20 رقمی

    کد PHP:
    uses wincrt;

    var
       
    s1,s2,sum string[21];
       
    sum1,string[20];
       
    jj,p,i,n1,j,n2,kk,c,k,er integer;
    begin
         writeln
    ('Enter S1 :');
         
    readln(s1);
         
    writeln('Enter S2 :');
         
    readln(s2);
         
    c:=0;
         for 
    i:=20 downto 1 do
             
    begin
                  val
    (s1[i],n1,er);
                  
    val(s2[i],n2,er);
                  
    k:=n1+n2;
                  
    sum[i+1]:=chr(k mod 10 ord('0'));
                  
    c:=k div 10;
             
    end;
         
    sum[1]:=chr(ord('0'));
         
    sum[0]:=chr(21);
         
    writeln;
         
    writeln('',s1,' + ',s2,' = ',sum);
         for 
    i:= 1 to 50 do
             
    sum1[i]:='0';
         
    sum1[0]:=chr(50);
         
    p:=50;
         for 
    i:=20 downto 1 do
             
    begin
                  val
    (s1[i],n1,er);
                  for 
    kk:=1 to 50 do
                      
    s[kk]:='0';
                  
    s[0]:=chr(50);
                  
    c:=0;
                  
    jj:=p;
                  for 
    j:= 20 downto 1 do
                      
    begin
                           val
    (s1[j],n2,er);
                           
    k:=n1*n2;
                           
    s[jj]:=chr((k mod 10)+ord('0'));
                           
    c:= k div 10;
                           
    dec(jj);
                      
    end;
                  
    s[jj]:=chr(c+ord('0'));
                  
    c:=0;
                  
    dec(p);
                  for 
    kk:=50 downto jj+do
                      
    begin
                           val
    (s[kk],n1,er);
                           
    k:=n1*n2;
                           
    sum1[kk]:=chr(k mod 10+ord('0'));
                           
    c:=k div 10;
                      
    end;
                  
    sum[jj]:=chr(c+ord('0'));
             
    end;
         
    writeln;
         
    writeln(' ',s1,' + ',s2,' = ',sum1);

    end.{TEST NOT COMPLETE
  8. #18
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    تعیین بشترین تکرار 0 تا 9 در یک آرایه 20 عضوی

    تعیین بشترین تکرار 0 تا 9 در یک آرایه 20 عضوی

    کد PHP:
    uses wincrt;

    var
       
    a: array[1..20of integer;
       
    b: array[0..9of integer;
       
    i,maxinteger;
    begin
         writeln
    ('Enter Numbers');
         for 
    i:= 1 to 20 do
             
    begin
                  writeln
    ('Enter Number ',i);
                  
    readln(a[i]);
             
    end;
         
    writeln;
         for 
    i:=1 to 20 do
             
    begin
                  
    case a[iof
                       0
    :   b[0]:=b[0]+1;
                       
    1:   b[1]:=b[1]+1;
                       
    2:   b[2]:=b[2]+1;
                       
    3:   b[3]:=b[3]+1;
                       
    4:   b[4]:=b[4]+1;
                       
    5:   b[5]:=b[5]+1;
                       
    6:   b[6]:=b[6]+1;
                       
    7:   b[7]:=b[7]+1;
                       
    8:   b[8]:=b[8]+1;
                       
    9:   b[9]:=b[9]+1;
                  
    end;
             
    end;
         
    max:=b[0];
         for 
    i:= 1 to 9 do
             if 
    b[i] > max then
                max
    :=b[i];
        
         if 
    maxb[0then
            Writeln
    ('Number with Maximum repeat is ',0)
             else if 
    maxb[1then
             Writeln
    ('Number with Maximum repeat is ',1)
              else if 
    maxb[2]then
              Writeln
    ('Number with Maximum repeat is ',2)
              else if 
    maxb[3]then
              Writeln
    ('Number with Maximum repeat is ',3)
              else if 
    maxb[4]then
              Writeln
    ('Number with Maximum repeat is ',4)
              else if 
    maxb[5]then
              Writeln
    ('Number with Maximum repeat is ',5)
              else if 
    maxb[6]then
              Writeln
    ('Number with Maximum repeat is ',6)
              else if 
    maxb[7]then
              Writeln
    ('Number with Maximum repeat is ',7)
              else if 
    maxb[8]then
              Writeln
    ('Number with Maximum repeat is ',8)
              else if 
    maxb[9]then
              Writeln
    ('Number with Maximum repeat is ',9);
    end
  9. #19
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    دریافت اطلاعات 100 دانشجو ، چاپ لیست مشروطین ، منظم نمودن اطلاعات قبول شدگان بر اساس

    دریافت اطلاعات 100 دانشجو ، چاپ لیست مشروطین ، منظم نمودن اطلاعات قبول شدگان بر اساس فامیلی

    کد PHP:
    uses wincrt;

    var
       
    info : array[1..100,1..2of string[25];
       
    fa: array[1..100]of string[30];
       
    no : array[1..100,1..6of integer;
       
    ave: array[1..10of real;
       
    n,i,j,index,integer;
       
    an,min,tempstring[30];
       
    t1 real;
    begin
         writeln
    ('Enter Number Of Student Which you want to add,Maximum is 100');
         
    readln(n);
         if 
    n>100 then
            writeln
    ('Number Is Greater than 100,program will work But in continue you have problem');
         
    writeln('Now Enter Information');
         for 
    i:=1 to n do
             for 
    j:=1 to 9 do
                 
    begin
                      
    case j of
                           1
    :
                             
    begin
                                  writeln
    ('Enter First name of student ',i);
                                  
    readln(info[i,1]);
                             
    end;
                           
    2:
                             
    begin
                                  writeln
    ('Enter Last name of student ',i);
                                  
    readln(fa[i]);
                             
    end;
                           
    3:
                             
    begin
                                  writeln
    ('Enter Student No of student ',i);
                                  
    readln(info[i,2]);
                             
    end;
                           
    4:
                             
    begin
                                  writeln
    ('Enter grade 1 of student ',i);
                                  
    readln(no[i,1]);
                             
    end;
                           
    5:
                             
    begin
                                  writeln
    ('Enter unit of grad 1 of student ',i);
                                  
    readln(no[i,2]);
                             
    end;
                           
    6:
                             
    begin
                                  writeln
    ('Enter grade 2 of student ',i);
                                  
    readln(no[i,3]);
                             
    end;
                           
    7:
                             
    begin
                                  writeln
    ('Enter unit of grad 2 of student ',i);
                                  
    readln(no[i,4]);
                             
    end;
                           
    8:
                             
    begin
                                  writeln
    ('Enter grade 3 of student ',i);
                                  
    readln(no[i,5]);
                             
    end;
                           
    9:
                             
    begin
                                  writeln
    ('Enter unit of grad 3 of student ',i);
                                  
    readln(no[i,6]);
                             
    end;
                      
    end;
                 
    end;
         for 
    i:= 1 to n do
             for 
    j:= 1 to 6 do
                 
    ave[i]:=(((no[i,1]*no[i,2])+(no[i,3]*no[i,4])+(no[i,5]*no[i,6]))/(no[i,2]+no[i,4]+no[i,6]));
         
    writeln('If You Want Liste Mashrootin Write mashroot');
         
    writeln('If You Want Liste Ghaboolin write ghabool');
         
    readln(an);
         if 
    an='mashroot' then
            begin
                 writeln
    ('*********** Liste Mashrootin ************');
                 for 
    i:= 1 to n do
                     if (
    ave[i]<10then
                        begin
                             writeln
    ('*');
                             
    writeln('*   Full name : ',info[i,1],' ',fa[i]);
                             
    writeln('*   Student No : ',info[i,2]);
                             
    writeln('*   Average is : ',ave[i]:5:2);
                             
    writeln('*');
                             
                        
    end;
                
                 
    writeln('*****************************************');
            
    end
         
    else if (an='ghabool'then
             begin
                  
    for i:= 1 to n do
                      
    begin
                           min
    := fa[i];
                           
    index:=i;
                           for 
    j:= i+1 to n do

                               if 
    fa[j]< min then
                                  begin
                                       min
    := fa[j];
                                       
    index:=j;
                                  
    end;
                               
    fa[index]:=fa[i];
                               
    fa[i]:=min;
                               for 
    j:= 1 to 2 do
                                   
    begin
                                        temp
    :=info[i,j];
                                        
    info[i,j]:=info[index,j];
                                        
    info[index,j]:=temp;
                                   
    end;
                               for 
    j:=1 to 6 do
                                   
    begin
                                        t
    :=no[i,j];
                                        
    no[i,j]:=no[index,j];
                                        
    no[index,j]:=t;
                                   
    end;
                               
    t1:=ave[i];
                               
    ave[i]:=ave[index];
                               
    ave[index]:=t1;
                      
    end;
                    
    writeln('********************************** Liste Ghaboolin ***********************');
                    
    writeln('*                                                                        *');
                    
    writeln('*Last name * First name * Student No * grade1 * grade2 * grad3 * average *');
                    
    i:=1;
                    for 
    i:= i to n do
                        
    begin
                             
    if (ave[i]<10then
                                i
    :=i+1;
                
    writeln('*',fa[i],' * ',info[i,1],' * ',info[i,2],' * ',no[i,1],'  * ',no[i,3],' * ',no[i,5],' * ',ave[i]:5:2,'*');
                        
    end;
                    
    writeln('**************************************************************************');
             
    end;              
    end
  10. #20
    Propascal
    كاربر عادي
    http://up.vbiran.ir/images/rgk38wbh3cfxod62rhr2.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gifhttp://up.vbiran.ir/images/qndtfn66fcrrq7cw6yh.gif
    تاریخ عضویت
    2011 Dec
    نوشته ها
    49
    3
    0

    حل دو معادله دو مجهول به روش کرامر به درخواست توحید

    حل دو معادله دو مجهول به روش کرامر به درخواست توحید

    کد PHP:
    Uses wincrt;

    var
       
    a,b,c,d,e,f,x,real;
    begin
         writeln
    ('In Style Below :');
         
    writeln('ax + by = e');
         
    writeln('cx + dy = f');
         
    writeln;
         
    writeln('Enter a :');
         
    read(a);
         
    writeln('Enter b :');
         
    read(b);
         
    writeln('Enter e :');
         
    read(e);
         
    writeln('Enter c :');
         
    read(c);
         
    writeln('Enter d :');
         
    read(d);
         
    writeln('Enter f :');
         
    read(f);

         
    x:=((e*d-b*f)/(a*d-b*c));
         
    y:=((a*f-e*c)/(a*d-b*c));

         
    writeln;
         
    writeln('X = ',x:5:2);
         
    writeln('Y = ',y:5:2);

    end
صفحه 2 از 5 نخست 12345 آخرین
نمایش نتایج: از 11 به 20 از 43

اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. پاسخ: 0
    آخرين نوشته: 2012-10-07, 03:33 PM
  2. سورس پروژه تبديل حروف بزرگ و كوچك در پاسكال
    توسط MspSoft در انجمن پروژه‌های Open Source
    پاسخ: 0
    آخرين نوشته: 2012-02-17, 01:10 PM
  3. مجموعه سورس هاي دلفي
    توسط MspSoft در انجمن برنامه نویسی در Delphi
    پاسخ: 5
    آخرين نوشته: 2012-01-17, 02:59 PM
  4. دانلود مجموعه سورس پروژه هاي كريستال در ويژوال بيسيك
    توسط MspSoft در انجمن گزارش سازی با Crystal Report
    پاسخ: 0
    آخرين نوشته: 2011-12-30, 08:12 PM
  5. سورس پروژه مغلوب عدد در پاسكال
    توسط Propascal در انجمن مباحث عمومی دلفی و پاسکال
    پاسخ: 0
    آخرين نوشته: 2011-12-16, 01:02 PM

کلمات کلیدی این موضوع

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  

Content Relevant URLs by vBSEO 3.6.0 RC 2