Примеры Лабораторных работы на Delphi

Тема в разделе "Pascal and Delphi", создана пользователем NATRIY, 8 фев 2010.

Наш партнер Genesis Hackspace
Статус темы:
Закрыта.
  1. NATRIY

    NATRIY Гость

    Выкладываю лабораторный работы.
    Может кому-нибудь они помогут, и будут началом для разработки своих программок.
    В самой программе указано, задание.
    Пользуйтесь на здоровице! Не забывайте о чел. благодарности!! ))))))))))))0
     

    Вложения:

    • Delfi.rar
      Размер файла:
      314,6 КБ
      Просмотров:
      121
    rum22 нравится это.
  2. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Задача №N
    Создать однонаправленый(тут двунаправленый) список который вмещает информацию о имени реки и ее длине. Сделать процедуру для добавления, вставки и удаления елементов списка.
    Код (Text):
    type TStringList=^TString;
    TString = record
    name_:string;
    length_:integer;
    prew : TStringList;
    next : TStringList;
    end;

    var list,top,bottom:TStringList;
    i:integer;
    name_:String;
    length_:integer;

    procedure add(var list,top,bottom:TStringList; name_:string; legnth_:integer);
    begin
    new(list);
    list^.name_:=name_;
    list^.length_:=length_;
    list^.prew:=top;
    if top=nil then bottom:=list;
    if list^.prew<>nil then List^.prew^.next:=list;
    list^.next:=nil;

    top:=list;
    end;

    procedure insert(var list,top,bottom:TStringList; after:integer; name_:string; length_:integer);
    var k,k2:TStringList;
    begin
    k2:=bottom;
    if after <>0 then
    for i:=1 to after do
    k2:=k2^.next;
    new(k);
    k^.name_:=name_;
    k^.length_:=length_;
    k^.prew:=k2;
    k^.next:=k2^.next^.next;
    k2^.next:=k;
    end;

    procedure Write(list,bottom:TStringList; from_first:boolean);
    begin
    if not from_first then
    while list<>nil do
    begin
    writeln('name : ',list^.name_);
    writeln('length : ',list^.length_);
    writeln;
    list:=list^.prew;
    end
    else
    while bottom<>nil do
    begin
    writeln('name : ',bottom^.name_);
    writeln('length : ',bottom^.length_);
    writeln;
    bottom:=bottom^.next;
    end
    end;


    procedure remove(var list,top,bottom:TStringList; after:integer);
    var k,k2:TStringList;
    begin
    k2:=bottom;
    if after <>0 then
    for i:=1 to after-1 do
    k2:=k2^.next;

    k2^.next:=k2^.next^.next;

    end;


    begin
    top:=nil;
    bottom:=nil;
    for i:=1 to 5 do
    begin
    writeln('enter river''s name');
    readln(name_);
    writeln('enter river''s length');
    readln(length_);
    add(list,top,bottom,name_,length_);
    end;
    write(list,bottom,true);
    readln;
    insert(list,top,bottom,2,'new river',102);//вставка после второго елемента
    write(list,bottom,true);
    readln;
    remove(list,top,bottom,1);// уничтожение второго елемента
    write(list,bottom,true);
    readln;
    end.
     
  3. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Тема: Умножение матриц
    Марица*матрицу
    матрица*столбик
    Код (Delphi):
    uses crt;
    const m=3;
    n=5;
    k=7;
    type mas1=array[1..m,1..n] of integer;
    type mas2=array[1..n,1..k] of integer;
    type mas3=array[1..m,1..k] of integer;
    type mas4=array[1..n] of integer;
    type mas5=array[1..m] of integer;

    var a:mas1;
    b:mas2;
    c:mas3;
    x:mas4;
    s:mas5;
    action,action2:integer;

    procedure matrix_write(a_:mas1;b_:mas2;c_:mas3;x:integer);
    var i,j:integer;
    begin
    case x of
    1:
    for i:=1 to m do
    begin
    write('| ');
    for j:=1 to n do
    write(a_[i,j]:4,' | ');
    writeln;
    end;
    2:
    for i:=1 to n do
    begin
    write('| ');
    for j:=1 to k do
    write(b_[i,j]:4,' | ');
    writeln;
    end;
    3:
    for i:=1 to m do
    begin
    write('| ');
    for j:=1 to k do
    write(c_[i,j]:4,' | ');
    writeln;
    end;
    end;
    end;

    procedure matrix_read(var a_:mas1;var b_:mas2;x_:integer);
    var i,j:integer;
    begin
    case x_ of
    1:
    for i:=1 to m do
    for j:=1 to n do
    begin
    write(' a[',i,',',j,'] = ');
    readln(a_[i,j]);
    end;
    2:
    for i:=1 to n do
    for j:=1 to k do
    begin
    write(' b[',i,',',j,'] = ');
    readln(b_[i,j]);
    end;
    end;
    end;

    procedure colum_write(x_:mas4; s_:mas5;n:integer);
    var i:integer;
    begin
    case n of
    1:
    begin
    write('| ');
    for i:=1 to n do
    write(x_[i]:4,' | ');
    writeln;
    end;
    2:
    begin
    write('| ');
    for i:=1 to m do
    write(s_[i]:4,' | ');
    writeln;
    end;
    end;
    end;

    procedure colum_read(var x_:mas4);
    var i:integer;
    begin
    for i:=1 to n do
    begin
    write(' x[',i,'] = ');
    readln(x[i]);
    end;
    end;

    procedure matrix_on_colum(a_:mas1;x_:mas4;var s_:mas5);
    var i,j:integer;
    begin
    for i:=1 to m do
    s_[i]:=0;

    for i:=1 to m do
    for j:=1 to n do
    s_[i]:=s_[i]+a_[i,j]*x_[j];
    end;


    procedure matrix_on_matrix(a_:mas1;b_:mas2;var c_:mas3);
    var i,j,p:integer;
    begin
    for i:=1 to m do
    for j:=1 to k do
    c_[i,j]:=0;
    for i:=1 to m do
    for j:=1 to k do
    for p:=1 to n do
    c_[i,j]:=c_[i,j]+a_[i,p]*b_[p,j];
    end;


    begin
    while action<>4 do
    begin
    clrscr;
    writeln('1. Enter arrays');
    writeln('2. Show arrays');
    writeln('3. Multiply arrays');
    writeln('4. Exit');
    readln(action);
    case action of
    1:
    begin
    clrscr;
    writeln('1. Enter matrix ''a''');
    writeln('2. Enter matrix ''b''');
    writeln('3. Enter colum ''x''');
    readln(action2);
    case action2 of
    1: matrix_read(a,b,1);
    2: matrix_read(a,b,2);
    3: colum_read(x);
    end;
    end;

    2:
    begin
    clrscr;
    writeln('1. Show matrix ''a''');
    writeln('2. Show matrix ''b''');
    writeln('3. Show matrix ''c''');
    writeln('4. Show colum ''x''');
    writeln('5. Show colum ''s''');
    readln(action2);
    case action2 of
    1: matrix_write(a,b,c,1);
    2: matrix_write(a,b,c,2);
    3: matrix_write(a,b,c,3);
    4: colum_write(x,s,1);
    5: colum_write(x,s,2);
    end;
    end;
    3:
    begin
    clrscr;
    writeln('1. c=a*b');
    writeln('2. s=a*x');
    readln(action2);
    case action2 of
    1:
    begin
    matrix_on_matrix(a,b,c);
    matrix_write(a,b,c,3);
    end;
    2:
    begin
    matrix_on_colum(a,x,s);
    colum_write(x,s,2);
    end;
    end;
    end;


    end;
    readln;
    end;
    end.
     
  4. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Тесты, работают с тхт файлами, тхт файл может содержать в себе несколько тестов (каждый из которых имеет по неколько вопросов).
     

    Вложения:

    • 1234.zip
      Размер файла:
      80,7 КБ
      Просмотров:
      29
Загрузка...
Похожие Темы - Примеры Лабораторных работы
  1. Генералл
    Ответов:
    10
    Просмотров:
    288
  2. Vunderkind
    Ответов:
    4
    Просмотров:
    3.323
  3. morpheus
    Ответов:
    0
    Просмотров:
    12.450
  4. European
    Ответов:
    535
    Просмотров:
    163.945
Статус темы:
Закрыта.

Поделиться этой страницей