http://opeople.ru/index.php Sun, 01 Aug 2010 14:49:00 +0400 5 55 Программируем на Паскале и Delphi "Нарисовать прямоугольный треугольник по катету и прилягающему углу который задает пользователь, вычислить площадь треугольника"
Зделал форму: edit1 - ввод катета, edit2 - ввод угла, кнопка - нарисовать, еще едит на площадь
второй катет определяется умножением первого на тангенс угла, имеем 2 точки для гипотенузы , площадь ab/2.
Но вот реализовать как програму для меня сложно, помогите пожалуйста ]]> K1NG K1NG K1NG Wed, 28 Jul 2010 10:55:14 +0400 199996 6 Программирование на Паскале, Си, Бейсике, Ассемблере
I. Найти все слова, которые встречаются в каждом из двух заданных предложений .

II. Выяснить сколько раз встречается каждая буква алфавита в строке.

Может хотя бы одну подскажите, а до второй уже сам додумаюсь? Заранее спасибо]]> zarathusta zarathusta zarathusta Sat, 03 Jul 2010 13:43:37 +0400 199958 55 Программируем на Паскале и Delphi Написать рекурсивную программу поиска индекса минимального элемента массива.

Заранее, огромное спасибо!
]]> gia1509 Luisa Luisa Fri, 02 Jul 2010 09:52:17 +0400 199956 55 Программируем на Паскале и Delphi Помогите, пожалуйста, написать программу.
Задание:

На координатной плоскости своими действительными координатами (x1, y1), (x2, y2), (x3, y3), (x4, y4) задан выпуклый четырехугольник. Если он является параллелограммом, найти площадь той его части, которая расположена во второй координатной четверти.

Пример работы правильной программы
Введите координаты вершин четырехугольника
–2 3 2 3 2 –3 –3 –4
Четырехугольник не является параллелограммом
Введите координаты вершин четырехугольника
–5 –2 1 4 5 4 –1 –2
Четырехугольник является параллелограммом
Искомая площадь 4.5

Заранее спасибо]]> student2009 student2009 student2009 Wed, 30 Jun 2010 16:37:24 +0400 199954 55 Программируем на Паскале и Delphi 2. дан массив целых чисел из n элементов заполненный случайным образом числами промежутка [-100;200] . Найти количество тех элементов значение которых положительны и не превосходят заданного числа А
3. дан массив целых чисел из n элементов заполненный случайным образом числами промежутка [-100;200]. Найти номер последней пары соседних элементов с разными знаками
4. заменить минимальный элемент массива на средний
5. заменить нулями элементы массива между минимальным и максимальным по модулю кроме их самих
6. из элементов массива D составить массив А той же размерности по правилу
7. дан массив целых чисел из n элементов заполненный случайным образом числами из промежутка [-140;140] удалить из него элементы у которых первая и вторая цифры одинаковы
8. дан массив целых чисел из n элементов заполненный случайным образом числами из промежутка [-140;140] вставить значение минимальных элементов массива после всех четных элементов
9. дан массив целых чисел из n элементов заполненный случайным образом числами из промежутка [-140;140] поменять местами 2 половины массива, сохраняя их порядок


помогите пожалуйста. у меня зачет, и за сутки надо сделать все задачи. а я тут дуб дубом. плиз="((( хелп
и если сделайте, то скинте мне на мыло Wolverine_080@mail.ru заранее благодарю. даже за попытку.

да... это надо на делфи]]> shket shket shket Fri, 18 Jun 2010 20:35:45 +0400 199853 56 Программирование на Си, и в C++ Builder Реализовать и использовать функцию, которая вставляет одну строку в другую:
int insertString (char destinString[81], const char sourceString[81], int Index);
Входные данные:
destinString – строка, в которую вставляется другая строка
sourceString – вставляемая строка
Index – индекс символа, начиная с которого вставляется строка
Выходные данные:
destinString – строка после вставки в нее другой строки
возвращаемое значение - признак успешной вставки строки: 0 – не успешно, 1 — успешно

Реализовать и использовать функцию поиска вхождения символа в текст:
int findCharInText (const char text[20][81], char character, int * line, int *
column);
Входные данные:
text – текст, в котором ищется символ
character – символ, который необходимо найти
line – строка, с которой необходимо начать поиск
column — столбец, с которого необходимо начать поиск
Выходные данные:
line – строка найденного символа
column — столбец найденного символа
возвращаемое значение - признак успешности поиска: 0 – не успешно, 1 - успешно.

[/b]ВОТ ЧТО Я СДЕЛАЛ:
надо переделать так чтобы весь поиск вхождения символа был в самой функции findCharInText , а не тупо сравнение как у меня в функции...
переделать не получается, может кто чем поможет?

##### Код { #####

#include "stdafx.h"
#include <stdio.h>
#include <string.h>
#include "testing.h"
#include <tchar.h>
#include <ctype.h>
#include <conio.h>

int insertString (char destinString[81], const char sourceString[81], int Index) //функция, которая вставляет одну строку в другую
{
    int length;//Переменная, хранящая количество элементов в строке
    int all_len;//Переменная определяющая сумму вставляемых символов и символов находящихся в строке
    int insert_test=0;
    int z,k=0;//Переменные циклов


    char temp [81];

    all_len=strlen(destinString)+strlen(sourceString);//Определение суммы вставляемых символов и символов в строке
                    if(all_len<=81)//Сравнение суммы символов с размером строки
                    {
                        insert_test=1;
                        length=strlen(destinString);//находим количество символов в строке
                        for(z=Index;z<length;z++)//копирование символов идущих после заданного
                        {
                            temp[k]=destinString[z];
                            k++;
                        }
                        temp[k]='\0';//ограничение строки
                        k=0;
                        for (z=Index;z<all_len;z++)
                        {
                            destinString[z]=sourceString[k];
                            k++;
                        }
                        strcat(destinString,temp);
                    }
                    
                    return (insert_test);
}

int findCharInText (const char text[20][81], char character, int * line, int *column)
{
    int symbol_test=0;
    
    if (text[*line][*column]==character)//Сравнение i-го символа с символом перед которым будет вставляться последовательность
    {
        symbol_test=1;
    }
    
                
    return (symbol_test);
}
int _tmain(int argc, _TCHAR* argv[])
{
    char sourceString [81];//Массив из вставляемых символов
    char character;//Удаляемый символ
    char text [20][81];
    int M;//Количество строк
    char b[100];//Массив забирающий "ненужные" символы
    int flag, flag2, chek_string=0;
    
    //Ввод вставляемых символов
    input_printf("Enter insert text:");
    gets(sourceString);

    //Ввод символа перед которым будет вставляться последовательность
    input_printf("Enter a symbol:");
    scanf("%c",&character);

    input_printf("Print M:");//Ввод количества строк текстового массива
    scanf("%d",&M);
    if (M<1 || M>20)//Проверка вхождения в диапазон переменной М
        error_printf("invalid input data");
    else
    {
        input_printf("Starting text:\n");
        gets(b);
        for (int i=0; i<M; i++)//Ввод текстового массива
        {
            gets(text[i]);
        }
        for(int i=0;i<M;i++)
        {
            for(int j=0;j<81; j++)
            {
                flag=findCharInText(text, character, &i, &j);
                if(flag)
                {
                    flag2=insertString(text[i], sourceString, j);
                    if (flag2)
                    {
                        j=j+strlen(sourceString)+1;
                    }
                }
            }
        }

        input_printf("Edited text:\n");
        for (int i=0; i<M; i++)//Выводим изменённый текстовый массив
        {
            if (strlen(text[i])==0)//Если количество символов в строке текстового массиве равно 0
                chek_string++;//То увеличиваем значение переменной chek_string
            else
                printf("%s\n",text[i]);//Иначе выводим изменённую строку
        }
        if (chek_string==M)//Если количество пустых строк совпадает с количеством строк в текстовом массиве
            puts("no solution");//Выводим сообщение
        
    }
    WAIT_ANY_KEY
    return 0;
}
##### Код } #####]]> Artak Artak Artak Thu, 17 Jun 2010 18:56:55 +0400 199848 6 Программирование на Паскале, Си, Бейсике, Ассемблере

С borlpas скинул его..а как работать не знаю..и что с ним можно сделать?]]> АртёмычСм АртёмычСм АртёмычСм Sat, 12 Jun 2010 07:53:52 +0400 199838 55 Программируем на Паскале и Delphi ]]> falks armen armen Fri, 11 Jun 2010 09:46:05 +0400 199835 55 Программируем на Паскале и Delphi А решите пожалуйста еще и 20 задачку про студента. Только очень срочно тоже зачет нужен. Заранее спасибо ev4onka91 Гена Гена Thu, 10 Jun 2010 18:37:33 +0400 199833 57 Программирование на Бейсике и Visual Basic помогите плз fatal1ty fatal1ty fatal1ty Tue, 08 Jun 2010 10:38:26 +0400 199827 55 Программируем на Паскале и Delphi Где в данной программе находятся входные и выходные данные?
Заранее спасибо!

##### Код { #####

program SeaWar;
uses Graph,crt;
var
GraphDriver:integer;
GraphMode:integer;
ErrorCode:integer; {Переменные для инитилизации графики}
s_score:string;

{Все переменные, используемые в программе}
x           :integer;
y           :integer;  {Переменные для хранения координат}
xx          :integer;  {и переменные цикла}
typ         :integer;  {Тип текущего корабля}
xxx         :integer;  {Координаты}
tarx        :integer;  {Координаты прицела и пушки}
fx          :integer;  {Координаты}
fy          :integer;
score       :integer;  {Кол-во очков}
old_score   :integer;  {Прошлое значение кол-ва очков}
mimo        :integer;  {Кол-во промахов}
oldx        :integer;  {Координаты}
oldy        :integer;
crx         :integer;
cr_type     :integer;  {Тип корабля}
flang       :integer;  {С какой стороны плывёт корабль}
croldx      :integer;
cr_ind2     :integer;
cr_ind:longint;      {Рабочая переменная}
c:char;              {Хранение нажатых клавишь}
            {Флаги}
b           :boolean;  {Флаг нажатия клавиш "стрелок"}
fire        :boolean;  {Стрельба}
swim        :boolean;  {Перемещение}
promah      :boolean;  {Промах}
vzriv       :boolean;  {Взрыв}
const
{Два константных массива точек для хранения координат скал}
trin1:array[1..4] of PointType=
((x:-70;y:380),(x:60;y:20),(x:150;y:350),(x:-70;y:380));
trin2:array[1..4] of PointType=
((x:670;y:380),(x:560;y:5),(x:500;y:350),(x:670;y:400));

{Процедура вывода прицела и пушки на экран}
procedure target(ix:integer;bb:boolean);
const iy=200;
begin
if bb then begin   {Отображение}
SetColor(green);
SetFillStyle(SolidFill,green);
FillEllipse(ix,430,26,100);
SetColor(lightgreen);
Line(ix-10,iy,ix+10,iy);
Line(ix,iy-10,ix,iy+10);
end else begin     {Стирание}
SetFillStyle(SolidFill,blue);
SetColor(blue);
FillEllipse(ix,430,26,100);
SetColor(blue);
Line(ix-10,iy,ix+10,iy);
Line(ix,iy-10,ix,iy+10);
end;
end;

{Процедура вывода на экран различных кораблей}
procedure sheep(ix:integer;tip:integer;bb:boolean);
const
iy=200;
var
col,col2:integer;
sp1,sp2,sp3:array[1..5] of PointType;
begin
col:=brown;
col2:=yellow;
if not bb then begin    {Если bb=true, то отображение корабля}
col:=blue;              {Иначе стирание корабля}
col2:=blue;
end;
{Координаты кораблей, относительно центральной точки ix}
sp1[1].x:=ix-40;
sp1[1].y:=190;
sp1[2].x:=ix+40;
sp1[2].y:=190;
sp1[3].x:=ix+20;
sp1[3].y:=215;
sp1[4].x:=ix-20;
sp1[4].y:=215;
sp1[5].x:=sp1[1].x;
sp1[5].y:=sp1[1].y;
sp2[1].x:=ix-30;
sp2[1].y:=190;
sp2[2].x:=ix+30;
sp2[2].y:=190;
sp2[3].x:=ix+15;
sp2[3].y:=210;
sp2[4].x:=ix-15;
sp2[4].y:=210;
sp2[5].x:=sp2[1].x;
sp2[5].y:=sp2[1].y;
sp3[1].x:=ix-20;
sp3[1].y:=195;
sp3[2].x:=ix+20;
sp3[2].y:=195;
sp3[3].x:=ix+10;
sp3[3].y:=205;
sp3[4].x:=ix-10;
sp3[4].y:=205;
sp3[5].x:=sp3[1].x;
sp3[5].y:=sp3[1].y;
{Отображение одного из трёх типов кораблей}
case tip of
3: begin
SetColor(col);
SetFillStyle(SolidFill,col);
FillPoly(5,sp1);
Rectangle(ix-18,iy-30,ix+18,iy-2);
SetColor(col2);
SetFillStyle(SolidFill,col2);
Rectangle(ix-10,iy-25,ix+10,iy-15);
FillEllipse(ix-18,iy,5,5);
FillEllipse(ix+18,iy,5,5);
FillEllipse(ix,iy,5,5);
end;
2: begin
SetColor(col);
SetFillStyle(SolidFill,col);
FillPoly(5,sp2);
line(ix,200,ix,170);
line(ix-5,175,ix+5,175);
line(ix-10,180,ix+10,180);
end;
1: begin
SetColor(col);
SetFillStyle(SolidFill,col);
FillPoly(5,sp3);
line(ix,200,ix,185);
line(ix-5,185,ix+5,185);
line(ix-10,190,ix+10,190);
end;
end;
end;

{Начало главной процедуры программы}
begin
x:=100;
xx:=0;
xxx:=0;
oldx:=0;
b:=false;
tarx:=320;
fire:=false;      {инитилизация пременных}
crx:=0;
croldx:=800;
score:=0;
old_score:=0;
mimo:=0;
promah:=false;
vzriv:=false;

{Переключение в графический режим}
GraphDriver:=Detect;
InitGraph(GraphDriver,GraphMode,'');
if ErrorCode=grok then begin
SetColor(green);
SetBKColor(black);
end else begin
Writeln('ERROR!');
exit;
end;

SetColor(white);
OutText('Vipolnil:Ivanov Ivan');
OutTextXY(0,10,'Group:  1');
SetTextJustify(CenterText,CenterText);
OutTextXY(640 div 2,480 div 2,'Najmi <Enter> i nachni igrat!');
c:=ReadKey;

{Подготовка экрана к игре}
ClearDevice;
SetBkColor(blue);
SetColor(lightgray);
SetFillStyle(SolidFill,lightgray);
FillPoly(4,trin1);
FillPoly(4,trin2);
SetColor(black);
Target(320,true);

{Главный цикл обработки различных сообщений}
repeat
repeat

{Обработка сообщения "Взрыв корабля"}
if vzriv then begin
   if xx=0 then begin
      typ:=cr_type;
      xxx:=crx;
   end;
   if xx<150 then begin
      {Рисование взрыва}
      Sound(Random(100));
      swim:=false;
      SetColor(red);
      SetColor(red);
      SetFillStyle(SolidFill,red);
      FillEllipse(xxx,200,21*typ,17*typ);
      inc(xx);
   end else begin
       NoSound;
       swim:=false;
      SetColor(blue);
      SetFillStyle(SolidFill,blue);
      FillEllipse(xxx,200,21*typ,17*typ);
      xx:=0;
      vzriv:=false;
   end;
end;

{Обработка сообщения "Перемещение"}
if swim then begin
      if cr_ind<400 then begin
         Sheep(crx,cr_type,false);
         if promah then promah:=false;
      end else begin
      if cr_ind mod cr_type*5=0 then begin
                if promah then begin
                   if flang=0 then flang:=1
                   else flang:=0;
                   promah:=false;
                end;
         if flang=0 then begin
            if crx=485 then begin
               inc(cr_ind2);
               if cr_ind2<3 then Sheep(crx,cr_type,true)
               else begin
               Sheep(crx,cr_type,false);
               swim:=false;
               end;
            end else begin
                crx:=crx+1;
                Sheep(croldx,cr_type,false);
                Sheep(crx,cr_type,true);
                croldx:=crx;
            end;
         end else begin
             if crx=150 then begin
               inc(cr_ind2);
               if cr_ind2<3 then Sheep(crx,cr_type,true)
               else begin
               Sheep(crx,cr_type,false);
               swim:=false;
               end;
            end else begin
                crx:=crx-1;
                Sheep(croldx,cr_type,false);
                Sheep(crx,cr_type,true);
                croldx:=crx;
            end;
         end;
      end;
      end;
      inc(cr_ind);
end else begin
    {Если корабля нет на экране, то случайным методом
    выбирается новый корабль}
    Randomize;
    croldx:=800;
    cr_ind2:=0;
    if random(2)=0 then begin
    crx:=150;
    flang:=0;
    end else begin
    crx:=485;
    flang:=1;
    end;
    swim:=true;
    cr_ind:=0;
    Randomize;
    cr_type:=random(3)+1;
end;

{Обработка сообщения "Выстрел"}
{и рисование полёта снаряда}
if fire then begin
x:=x-10;
Sound(x);
SetColor(blue);
line(fx+1,fy-2,fx+1,fy+2);
line(fx-1,fy-2,fx-1,fy+2);
line(fx,fy-2,fx,fy+2);
fy:=fy-2;
SetColor(lightred);
line(fx+1,fy-2,fx+1,fy+2);
line(fx-1,fy-2,fx-1,fy+2);
line(fx,fy-2,fx,fy+2);
if fy<200 then begin
if (getpixel(fx-1,fy-3)=brown)or(getpixel(fx+1,fy-3)=brown) then begin
old_score:=score;
inc(score);
vzriv:=true;
end else begin
{Обработка сообщения "Промах"}
promah:=true;
inc(mimo);
          if mimo>5 then begin
          {Выход из игры в случае проигрыша}
          ClearDevice;
          SetColor(white);
          SetBkColor(black);
          SetTextJustify(CenterText,CenterText);
          OutTextXY(640 div 2,480 div 2,'GAME OVER!');
          Sound(200);
          Delay(10000);
          NoSound;
          c:=ReadKey;
          exit;
          end;
end;
fire:=false;
NoSound;
SetColor(blue);
line(fx+1,fy-2,fx+1,fy+2);
line(fx-1,fy-2,fx-1,fy+2);
line(fx,fy-2,fx,fy+2);
end;
end;
if b then begin
{Перерисовка прицела и пушки в случае нажатия клавиш "влево-вправо"}
target(oldx,false);
target(tarx,true);
b:=false;
end else target(tarx,true);
{В случае попадания, производится начисление очков и вывод их на экран}
if old_score<>score then begin
   SetColor(blue);
   SetTextJustify(LeftText,BottomText);
   Str(old_score,s_score);
   OutTextXY(70,460,s_score);
   old_score:=score;
end;
    SetColor(white);
    SetTextJustify(LeftText,BottomText);
    OutTextXY(20,460,'Score');
    Str(score,s_score);
    OutTextXY(70,460,s_score);
delay(150);  {Временная задержка главного цикла}
until keypressed;
{Обработка нажатия клавиш}
c:=readkey;
case c of
#75: begin  {влево}
if tarx>220 then begin
oldx:=tarx;
tarx:=tarx-5;
b:=true;
end;
end;
#77: begin  {вправо}
if tarx<420 then begin
oldx:=tarx;
tarx:=tarx+5;
b:=true;
end;
end;
#32: begin  {пробел "Выстрел"}
if not fire then begin
x:=800;
fire:=true;
fx:=tarx;
fy:=380;
end;
end;
#27: begin   {esc "Выход"}
NoSound;
exit;
end;
end;
until false; {Зацикливание главного цикла обработки сообщений}
end.

##### Код } #####]]> muscul muscul muscul Sun, 06 Jun 2010 18:24:21 +0400 199825 57 Программирование на Бейсике и Visual Basic Помогите пожалуйста написать]]> fatal1ty fatal1ty fatal1ty Wed, 02 Jun 2010 07:23:55 +0400 199823 57 Программирование на Бейсике и Visual Basic
]]> Спартанка Спартанка Спартанка Tue, 01 Jun 2010 17:08:42 +0400 199820 55 Программируем на Паскале и Delphi Есть программа-ищет наименьшее покрытие графа!
То есть есть граф строиться матрица инцидентности а по ней уже программа ищет наименьше покрытие графа!

Она все правильно считает но я некоторые процедуры никак не могу разобрать!!!
Спасибо!!!!
Может просто кто сталкивался !!!

//Процедура поиска наименьшего покрытия
procedure TMainForm.N6Click(Sender: TObject);
var outp:tchildform;
i,j,k,jj,SumElem,MaxSum,r,mm:integer;
E:array of byte;
o,kp:byte;
zz,z:real;
label l1,l2;
begin
//Определение наличия покрытий
SumElem:=0;
for j:=0 to n-1 do begin
for i:=0 to m-1 do SumElem:=SumElem+DataTab[i,j];
if SumElem=0 then begin ShowMessage('Для '+ActiveMDichild.caption+' покрытий не существует.');
exit; end;;
SumElem:=0;
end;
//Определение размеров массивов P и C
SumElem:=0; MaxSum:=0;
for i:=0 to m-1 do begin
for j:=0 to n-1 do SumElem:=SumElem+DataTab[i,j];
if MaxSum<SumElem then MaxSum:=SumElem;
SumElem:=0;
end;
setlength(C,n,MaxSum);
setlength(P,n,MaxSum,n);
//Формирование блоков таблицы
i:=0;j:=0;
repeat
k:=0;
repeat
if datatab[i,j]=1 then
begin
jj:=0;
setlength(C[j],k+1);
c[j][k]:=ves[i];
setlength(P[j],k+1,n);
repeat
p[j][k,jj]:=datatab[i,jj];
jj:=jj+1;
until jj>n-1;
k:=k+1;
end;
i:=i+1;
until i>m-1;
j:=j+1;
i:=0;
until j>n-1;

KDataTab:=DataTab;
KVes:=Ves;


//Поиск
setlength(E,n);kp:=1;
for i:=0 to n-1 do E[i]:=0;
k:=0;z:=0;zz:=1.7*power(10,38);B:=nil;
i:=0;
while i<=n-1 do
begin
if E[i]=0 then
begin
j:=-1;
l2:repeat
j:=j+1;
if j>high(P[i]) then goto l1;
until z+c[i,j]<=zz;
K:=k+1;setlength(B,k);
z:=z+c[i,j];B[k-1,0]:=i;
B[k-1,1]:=j;
for r:=i to n-1 do
if p[i][j,r]=1 then E[r]:=1;
end;
i:=i+1;
end;
//Удалить в листинге
if zz=z then kp:=kp+1;
zz:=z;BB:=B;
l1: if B=nil then begin

//Вывод результата]]> puzen puzen puzen Tue, 01 Jun 2010 00:47:18 +0400 199818 57 Программирование на Бейсике и Visual Basic
1.В ЭВМ вводятся по очереди данные о росте N учащихся класса.Определить средний рост учащихся класса.
2.Вычислить сумму четных элементов одномерного массива до первого встреченного нулевого элемента.
3.Имеется двумерный массив целых чисел размерности 6*5.Найти номер строки, для которой средне арифметическое значение элементов максимально.
4.Напишите программу, подсчитывающую количество различных букв в заданном слове.

ЛюДИ если кто-то хорошо понимает в q-basic напишите мне в скайп или агент.
скайп:mishania2103
агент:mihei_stalker@mail.ru]]> LABUS LABUS LABUS Sat, 29 May 2010 22:18:42 +0400 199811 6 Программирование на Паскале, Си, Бейсике, Ассемблере вот программа:

uses crt;
Type mas=array[1..19,1..19] of real;
Type mas1=array[1..10] of real;
var F:mas;
X1,X2,minY,Z:mas1;
t1,z2,z1,t,dt,tk,tp,xp1,xp2,xk1,xk2 ,dx1,dx2,minF,minF1,mx,my,minX1,min X2:real;
i,n,j,u,grDriver,grMode,y,yy,x,xx,p x,py,px1,py1:integer;
grPath,l,s:string;

{подпрограмма формирования одномерных массивов}
procedure form(xn:mas1;xp,xk:real);
var dx,x:real;
k:integer;
begin
k:=10;
x:=xp;
dx:=(xk-xp)/(k-1);
for i:=1 to 10 do
begin
xn[i]:=x;
x:=x+dx;
end;
end;
{-----------------------------------------------------}
{подпрограмма-функция сопративления}
function te(h:real):real;
begin
te:=0.273*(sin(3*h+3)/h)/(cos(3*h+3)/h);
end;
{передаточная ф-я}
function r(a,b,te:real):real;
begin
r:=sqr(sqr(a))-0.9*b+sqr(te)+2*a+ sqr(a)*sqr(a)*sqr(a)*b/3;
end;
{Подпрограмма формирования двумерного массива}
procedure miF(x:mas;k1,k2:mas1;var miF:real;var miX1,miX2:real);
begin
miF:=F[1,1];
miX1:=k1[1];
miX2:=k2[1];
for u:=1 to n do
begin
for j:=1 to n do
begin
{Модуль1:поиск минимального элемента F(n,n)}
if F[u,j]<miF then
begin
miF:=F[u,j];
miX1:=k1[u];miX2:=k2[j];
end;
end;
end;
end;

{ПРОГРАММА}
begin
clrscr;
xp1:=1.2;
xp2:=-1.8;
xk1:=2.3;
xk2:=0.1;
tp:=-5;
tk:=4;
dt:=0.5;
t:=tp;
{---------формирование массивов х1 и х2-----------}
form(x1,xp1,xk1);
form(x2,xp2,xk2);
{-------------------------------------------------}
writeln;
writeln(' Начало таблицы');
Writeln(' |-----|---------|--------|--------|------------|----------|');
Writeln(' | i | T | Z | minF | X1min | X2min |');
Write(' |-----|---------|--------|--------|------------|----------|') ;
{цикл по времени }
for i:=1 to 19 do begin
{обращение к подпрограмме-функции а(t)}
Z[i]:=te(t);writeln;
for u:=1 to 10 do
begin
for j:=1 to 10 do
begin
F[u,j]:=r(x1[u],z[i],x2[j]);
end;
end;
{определение минимума двумерного массива F(10,10) и соответствующих значений x1 и x2}
miF(F,X1,X2,minF,minX1,minX2);
minY[i]:=minF;
if i=10 then begin
readln;
writeln(' Конец таблицы');
end;
if ((i>=1)and(i<9)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |' ,minX1:2:0,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=9 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=10 then
begin
writeln(' |-----|---------|--------|--------|------------|----------|');
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:4,' | ',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if ((i>=11)and(i<20)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|-------|----------|----------|-------|--------|');
end;
if i=19 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|--------|-----------|----------|-----|--------------|');
end;
t:=t+dt;
end;
Writeln;Writeln;Writeln;Writeln;Wri teln;
readln;end.]]> AndrewPl AndrewPl AndrewPl Sat, 29 May 2010 11:19:50 +0400 199808 6 Программирование на Паскале, Си, Бейсике, Ассемблере ====>> Цитата (AndrewPl @ 28.5.2010, 4:04) :

uses crt;
Type mas=array[1..19,1..19] of real;
Type mas1=array[1..10] of real;
var F:mas;
X1,X2,minY,Z:mas1;
t1,z2,z1,t,dt,tk,tp,xp1,xp2,xk1,xk2,dx1,dx2,minF,minF1,mx,my,minX1,minX2:real;
i,n,j,u,grDriver,grMode,y,yy,x,xx,px,py,px1,py1:integer;
grPath,l,s:string;

{подпрограмма формирования одномерных массивов}
procedure form(xn:mas1;xp,xk:real);
var dx,x:real;
k:integer;
begin
k:=10;
x:=xp;
dx:=(xk-xp)/(k-1);
for i:=1 to 10 do
begin
xn[i]:=x;
x:=x+dx;
end;
end;
{-----------------------------------------------------}
{подпрограмма-функция сопративления}
function a(h:real):real;
begin
a:=0.273*(sin(3*h+3)/h)/(cos(3*h+3)/h);
end;
{передаточная ф-я}
function b(a,b,te:real):real;
begin
b:=exp(4*ln(a))-0.9*b+sqr(a)+2*a+ exp(6*ln(a))*b/3; { - вот тут " Ошибка: вещественное деление на 0 (Program4.pas, строка 34)"}[b]
end;
{Подпрограмма формирования двумерного массива}
procedure miF(x:mas;k1,k2:mas1;var miF:real;var miX1,miX2:real);
begin
miF:=F[1,1];
miX1:=k1[1];
miX2:=k2[1];
for u:=1 to n do
begin
for j:=1 to n do
begin
{Модуль1:поиск минимального элемента F(n,n)}
if F[u,j]<miF then
begin
miF:=F[u,j];
miX1:=k1[u];miX2:=k2[j];
end;
end;
end;
end;

{ПРОГРАММА}
begin
clrscr;
xp1:=1.2;
xp2:=-1.8;
xk1:=2.3;
xk2:=0.1;
tp:=-5;
tk:=4;
dt:=0.5;
t:=tp;
{---------формирование массивов х1 и х2-----------}
form(x1,xp1,xk1);
form(x2,xp2,xk2);
{-------------------------------------------------}
writeln;
writeln(' Начало таблицы');
Writeln(' |-----|---------|--------|--------|------------|----------|');
Writeln(' | i | T | Z | minF | X1min | X2min |');
Write(' |-----|---------|--------|--------|------------|----------|') ;
{цикл по времени }
for i:=1 to 19 do begin
{обращение к подпрограмме-функции а(t)}
Z[i]:=a(t);writeln;
for u:=1 to 10 do
begin
for j:=1 to 10 do
begin
F[u,j]:=b(x1[u],z[i],x2[j]);
end;
end;
{определение минимума двумерного массива F(10,10) и соответствующих значений x1 и x2}
miF(F,X1,X2,minF,minX1,minX2);
minY[i]:=minF;
if i=10 then begin
readln;
writeln(' Конец таблицы');
end;
if ((i>=1)and(i<9)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |' ,minX1:2:0,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=9 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=10 then
begin
writeln(' |-----|---------|--------|--------|------------|----------|');
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:4,' | ',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if ((i>=11)and(i<20)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|-------|----------|----------|-------|--------|');
end;
if i=19 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|--------|-----------|----------|-----|--------------|');
end;
t:=t+dt;
end;
Writeln;Writeln;Writeln;Writeln;Writeln;
readln;end.

<<====
помогите пожалуйста]]> AndrewPl AndrewPl AndrewPl Fri, 28 May 2010 09:22:56 +0400 199807 6 Программирование на Паскале, Си, Бейсике, Ассемблере Type mas=array[1..19,1..19] of real;
Type mas1=array[1..10] of real;
var F:mas;
X1,X2,minY,Z:mas1;
t1,z2,z1,t,dt,tk,tp,xp1,xp2,xk1,xk2,dx1,dx2,minF,minF1,mx,my,minX1,minX2:real;
i,n,j,u,grDriver,grMode,y,yy,x,xx,px,py,px1,py1:integer;
grPath,l,s:string;

{подпрограмма формирования одномерных массивов}
procedure form(xn:mas1;xp,xk:real);
var dx,x:real;
k:integer;
begin
k:=10;
x:=xp;
dx:=(xk-xp)/(k-1);
for i:=1 to 10 do
begin
xn[i]:=x;
x:=x+dx;
end;
end;
{-----------------------------------------------------}
{подпрограмма-функция сопративления}
function a(h:real):real;
begin
a:=0.273*(sin(3*h+3)/h)/(cos(3*h+3)/h);
end;
{передаточная ф-я}
function b(a,b,te:real):real;
begin
b:=exp(4*ln(a))-0.9*b+sqr(a)+2*a+ exp(6*ln(a))*b/3; { - вот тут " Ошибка: вещественное деление на 0 (Program4.pas, строка 34)"}[b]
end;
{Подпрограмма формирования двумерного массива}
procedure miF(x:mas;k1,k2:mas1;var miF:real;var miX1,miX2:real);
begin
miF:=F[1,1];
miX1:=k1[1];
miX2:=k2[1];
for u:=1 to n do
begin
for j:=1 to n do
begin
{Модуль1:поиск минимального элемента F(n,n)}
if F[u,j]<miF then
begin
miF:=F[u,j];
miX1:=k1[u];miX2:=k2[j];
end;
end;
end;
end;

{ПРОГРАММА}
begin
clrscr;
xp1:=1.2;
xp2:=-1.8;
xk1:=2.3;
xk2:=0.1;
tp:=-5;
tk:=4;
dt:=0.5;
t:=tp;
{---------формирование массивов х1 и х2-----------}
form(x1,xp1,xk1);
form(x2,xp2,xk2);
{-------------------------------------------------}
writeln;
writeln(' Начало таблицы');
Writeln(' |-----|---------|--------|--------|------------|----------|');
Writeln(' | i | T | Z | minF | X1min | X2min |');
Write(' |-----|---------|--------|--------|------------|----------|') ;
{цикл по времени }
for i:=1 to 19 do begin
{обращение к подпрограмме-функции а(t)}
Z[i]:=a(t);writeln;
for u:=1 to 10 do
begin
for j:=1 to 10 do
begin
F[u,j]:=b(x1[u],z[i],x2[j]);
end;
end;
{определение минимума двумерного массива F(10,10) и соответствующих значений x1 и x2}
miF(F,X1,X2,minF,minX1,minX2);
minY[i]:=minF;
if i=10 then begin
readln;
writeln(' Конец таблицы');
end;
if ((i>=1)and(i<9)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |' ,minX1:2:0,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=9 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:3,' |',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if i=10 then
begin
writeln(' |-----|---------|--------|--------|------------|----------|');
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:4,' | ',minF:1:1,' |',minX1:2:2,' | ',minX2:4:2,' |');
write(' |-----|---------|--------|--------|------------|----------|');
end;
if ((i>=11)and(i<20)) then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|-------|----------|----------|-------|--------|');
end;
if i=19 then
begin
writeln(' | ',i:2,' | ',T:2:2,' |',z[i]:6:2,' | ',minF:8:3,' |',minX1:4:2,' | ',minX2:4:2,' |');
write(' |----|--------|-----------|----------|-----|--------------|');
end;
t:=t+dt;
end;
Writeln;Writeln;Writeln;Writeln;Writeln;
readln;end.]]> AndrewPl AndrewPl AndrewPl Fri, 28 May 2010 08:04:51 +0400 199806 6 Программирование на Паскале, Си, Бейсике, Ассемблере



Данная квадратная матрица. Составить программу вычисления среднего арифметического элементов главной и побочной диагоналей. - через функцию...
]]> AndrewPl AndrewPl AndrewPl Wed, 26 May 2010 09:47:24 +0400 199794 6 Программирование на Паскале, Си, Бейсике, Ассемблере

вот что я сделал:


Program Maxl;
uses crt;
const n=18;
type mas=array[1..n] of integer;
var d,e,g:mas;j,m,p:integer;

procedure pm(x:mas;var
p:integer);
var k,i:integer;
begin


readln(k);

for i:=1 to k do begin
write('x[',i,']='); readln(x[i]); end;
p:=1;
for i:=1 to k do
if x[i]mod 2=0 then
begin
p:=p*x[i];end;

end;

begin
clrscr;
writeln;
readln(m);
for j:=1 to m do
begin
pm(d,p); pm(e,p); pm(g,p);
writeln( p);
writeln( p);
writeln( p);
end;
end.



вот ещё одна...тоже не получается(((
Для заданных квадратных матриц X(5*5) и F(4,4) найти суммы и произведения элементов, расположенных ниже побочной диагонали.

program z1;
uses crt;
const n=5;m=2;
type mas=array[1..n,1..n] of integer;
var a,f:mas;
t,p1,p2,s1,s2:integer;
procedure z(x:mas;var s,p:integer);
var i,j,k:integer;
begin
for i:=1 to n do begin
for j:=1 to n do
read(x[i,j]); end;
for i:=1 to n do begin
for j:=1 to n do
write(x[i,j],' ');writeln(' ');
end;

for i:=1 to n do begin
for j:=n+1-i to n do s:=0;p:=1;
s:=s+x[i,j];p:=p+x[i,j];end;end;
begin
clrscr;
for t:=1 to m do
begin
z(a,s1,p1); z(f,s2,p2); end;
writeln('s1=',s1,' s2=',s2,' p1=',p1, ' p2=',p2);
end.
]]> AndrewPl AndrewPl AndrewPl Wed, 26 May 2010 07:34:08 +0400 199793