Перейти к содержанию

FunlOvEe

Пользователи
  • Постов

    21
  • Зарегистрирован

  • Посещение

Сообщения, опубликованные FunlOvEe

  1. 1234.jpg



    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ExtCtrls, StdCtrls, Grids;

    type
    TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
    const Value: String);
    procedure StringGrid2SetEditText(Sender: TObject; ACol, ARow: Integer;
    const Value: String);
    private
    { Private declarations }
    public
    { Public declarations }
    end;
    type
    Matrix= array[0..5,0..4] of integer;
    var
    Form1: TForm1;
    TotalTime : integer;
    Matrix1 : Matrix;
    Matrix2 : Matrix;

    implementation

    {$R *.dfm}

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    dec(TotalTime);
    Label1.Caption := inttostr(TotalTime);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    TotalTime := 30;
    Timer1.Interval := 1000;
    Timer1.Enabled := true;
    Label1.Caption := '30';
    Beep();
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    var i,j:integer;
    begin
    Timer1.Enabled := false;
    StringGrid1.Cells[0,0] := 'N;';
    StringGrid1.Cells[1,0] := '1';
    StringGrid1.Cells[2,0] := '2';
    StringGrid1.Cells[3,0] := '3';
    StringGrid1.Cells[4,0] := 'Сумма трех';
    StringGrid1.Cells[5,0] := 'Счет;';
    StringGrid1.Cells[0,1] := '1';
    StringGrid1.Cells[0,2] := '2';
    StringGrid1.Cells[0,3] := '3';
    StringGrid1.Cells[0,4] := '4';

    StringGrid2.Cells[0,0] := 'N;';
    StringGrid2.Cells[1,0] := '1';
    StringGrid2.Cells[2,0] := '2';
    StringGrid2.Cells[3,0] := '3';
    StringGrid2.Cells[4,0] := 'Сумма трех';
    StringGrid2.Cells[5,0] := 'Счет';
    StringGrid2.Cells[0,1] := '1';
    StringGrid2.Cells[0,2] := '2';
    StringGrid2.Cells[0,3] := '3';
    StringGrid2.Cells[0,4] := '4';
    for i:= 1 to 5 do
    for j:=1 to 4 do
    begin
    Matrix1[i,j] := 0;
    Matrix2[i,j] := 0;
    end;
    end;

    Procedure Summa(var StringGrid_S: TStringGrid; Matrix_S:Matrix);
    var ACol,ARow:integer;
    i:integer;
    begin
    Matrix_S[4,1] := Matrix_S[3,1] + Matrix_S[2,1] + Matrix_S[1,1];
    Matrix_S[4,2] := Matrix_S[3,2] + Matrix_S[2,2] + Matrix_S[1,2];
    Matrix_S[4,3] := Matrix_S[3,3] + Matrix_S[2,3] + Matrix_S[1,3];
    Matrix_S[4,4] := Matrix_S[3,4] + Matrix_S[2,4] + Matrix_S[1,4];

    Matrix_S[5,1] := Matrix_S[4,1] + Matrix_S[4,2] + Matrix_S[4,3] + Matrix_S[4,4];
    for i:= 2 to 4 do
    Matrix_S[5,i] := Matrix_S[5,1];

    for ACol:=4 to 5 do
    for ARow:= 1 to 4 do
    if ( Matrix_S[ACol,ARow] > 0 ) then
    StringGrid_S.Cells[ACol,ARow] := inttostr(Matrix_S[ACol,ARow]);
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    begin
    Timer1.Enabled := false;
    end;

    procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
    ARow: Integer; const Value: String);
    begin
    if ( Value <> '' ) then
    Matrix1[ACol,ARow] := strtoint(Value)
    else
    Matrix1[ACol,ARow] := 0;
    Summa(Form1.StringGrid1,Matrix1);
    end;

    procedure TForm1.StringGrid2SetEditText(Sender: TObject; ACol,
    ARow: Integer; const Value: String);
    begin
    if ( Value <> '' ) then
    Matrix2[ACol,ARow] := strtoint(Value)
    else
    Matrix2[ACol,ARow] := 0;
    Summa(Form1.StringGrid2,Matrix2);
    end;

    end.
    unit Unit1;

  2. Как я встретил вашу маму | How I Met Your Mother

    UtwUxsFqku.gif

    Год выпуска: 2008

    Страна: США

    Жанр: комедия

    Продолжительность: ~20 мин.

    Перевод: Slivas, vers

    Озвучание: (одноголосый по версии Кураж-Бамбей)

    Режиссер: Памела Фриман

    В ролях: Джош Рэднор, Джейсон Сегел, Коби Смалдерс, Нил Патрик Хэррис, Эллисон Хэнниган

    Описание: How I met your mother - комедия про Теда (Джош Рэднор) и про то, как он влюбился. Все неприятности начинаются с того, что лучший друг Теда, Маршалл (Джейсон Сегел) вдруг неожиданно сообщил, что он хочет сделать предложение своей давней подруге, Лили (Эллисон Хэнниган), воспитательнице детского сада. К тому времени Тед понимает, что ему нужно прилагать больше усилий, если он действительно надеется найти свою настоящую любовь. Помогает ему в этих поисках его друг Барни (Нил Патрик Хэррис), убежденный холостяк, вечно со своим, иногда чересчур, мнением на все происходящее, со склонностью к костюмам и верным способом познакомиться с девушками. Когда Тед встречает Робин (Коби Смалдерс), он решает, что это любовь с первого взгляда, но у судьбы в запасе есть кое-что еще. Сериал представлен в форме повествования в будущем.

    Доп. информация:

    релиз: kuraj-bambey.ru

    Качество: HDTVRip

    Формат: AVI

    Видео: XVID 640x352 23.98fps 975Kbps

    Аудио: MPEG Audio Layer 3 48000Hz stereo 160Kbps

    2vgayS5vD0.jpg

    FHxtwmhh9q.jpg

    fUDAmSb1Wo.jpg

    MVWSigdpR8.jpg

    How I Met Your Mother 1-4 season

  3. Bufalo


    uses crt;
    var i,s:integer;
    begin
    clrscr;
    for i:= 10 to 99 do
    s := s+i;
    writeln(s);
    readkey;
    end.


    var i,s,n,c,d:integer;
    begin
    clrscr;
    write('Vvedite n: ');
    read(n);
    write('Vvedite d: ');
    read(d);
    for i := 1 to ( n div 2 ) do
    if ( n mod i = 0 ) then
    begin
    if ( i div 2 <> 0 ) then
    s := s + i;
    inc(c);
    end;
    Write('Summa = ',s,', kolvo delit = ',c);
    c:=0;
    for i := d+1 to ( n div 2 ) do
    if ( n mod i = 0 ) then
    inc(c);
    write(', kolvo delitelei > d = ', c);
    readkey;
    end.
    uses crt;

  4. 1.задан вещественный массив X из 10 элементов.Найти минимальный элемент и его порядковый номер.


    var X: array[1..10] of integer;
    i,mini,min: integer;
    begin
    clrscr;
    for i := 0 to 10 do
    begin
    write('vvedite ',i,'ii element :');
    read(x[i]);
    end;
    min := x[1];
    for i := 2 to 10 do
    if ( x[i] < min ) then
    begin
    min := x[i];
    mini := i;
    end;
    write('Min element = ', min,' nomer = ', mini);
    readkey;
    end.
    uses crt;

    1.Написать программу ,которая бы запрашивала возвраст человека и сообщала,сколько лет ему осталось до пенсии,либо он уже пенсионер.Учитывать наступление пенсионного возвраста для мужчин и жещин.


    var age,sex:byte;
    begin
    clrscr;
    Write('Vvedite vozrast: ');
    readln(age);
    Write('Vvedite pol(0 zhen, 1 muzh): ')
    readln(sex);
    if ( sex = 0 ) then
    write('Do pensii ostalos ', 55-age,' let');
    else
    write('Do pensii ostalos ', 60-age,' let');
    readkey;
    end.
    uses crt;

    1.Вычислить произведение массива С[7] целых чисел,и если это произведение отрицательное,то вывести его абсолютное значение.


    const n = 7;
    var c: array[1..n] of integer;
    s,i: integer;
    begin
    clrscr;
    for i := 1 to n do
    begin
    write( 'c[',i,'] = ' );
    read( c[i] );
    end;
    s := 1;
    for i := 1 to n do
    s := s * c[i];
    if ( s < 0 ) then
    writeln( abs(s) )
    else
    writeln(s);
    readkey;
    end.
    uses crt;

    2.Дана последовательность n различных целых чисел. найти сумму её членов,расположенным между максимальным и минимальным значениями (в сумму включить и оба этих числа)


    const n = 7;
    var c: array[1..n] of integer;
    s,i,max,min,maxi,mini: integer;
    begin
    clrscr;
    for i := 1 to n do
    begin
    write( 'c[',i,'] = ' );
    read( c[i] );
    end;
    max:= c[1];
    min:= c[1];
    for i := 1 to n do
    if ( max < c[i] ) then
    begin
    max := c[i];
    maxi := i;
    end;
    for i := 1 to n do
    if ( min > c[i] ) then
    begin
    min := c[i];
    mini := i;
    end;
    if ( mini > maxi ) then
    begin
    s := mini;
    mini := maxi;
    maxi := s;
    end;
    s := 0;
    for i:= mini to maxi do
    s := s+c[i];
    writeln(s);
    readkey;
    end.
    uses crt;

    2. Составьте программу,проверяющую,верно ли утверждение,что сумма цифр введенного вами целого числа является четным.


    var n,s:integer;
    begin
    clrscr;
    write('Vvedite chislo: ');
    readln(n);
    s := 0;
    while ( n <> 0 ) do
    begin
    s := s + n mod 10;
    n := n div 10;
    end;
    if ( s mod 2 = 0) then
    Writeln('Summa chisla chetnaya - ', s)
    else
    Writeln('Summa chisla nechetnaya - ',s);
    readkey;
    end.
    uses crt;

    2. Масса 8 литров бензина 5,68 кг. Цистерна имеет объем 500 куб.метров Хватит ли её,чтобы вместить А тонн бензина?


    var ton,lkg:real;
    begin
    clrscr;
    Write('Vvdedite skolko tonn benzina: ');
    read(ton);
    lkg := 5.68 / 8; {0.71}
    lkg := lkg * 500; { 355ton }
    if ( ton > lkg ) then
    write('ne vmestitso')
    else
    write('vmestitso');
    readkey;
    end.
    uses crt;

    1.Ракета запускается с точки на экваторе и развивает скорость v км/с.Каков результат запуска? Замечание: если v<=7/8 км/с,то ракета упадет на Землю,если 7/816.4,то ракета покинет Солнечную систему.


    var km:real;
    begin
    clrscr;
    Write('Vvdedite kakyu skorost razvila raketa: ');
    readln(km);
    if ( km < 7.8 ) then
    writeln('raketa upadet')
    else
    if ( ( km > 7.8 ) and ( km < 11.2 ) ) then
    writeln('stanet sputnikom zemli')
    else
    if ( ( km > 11.2 ) and ( km < 16.4) ) then
    writeln('stanet sputnikom solnca')
    else
    if ( km > 16.4 ) then
    writeln('pokinet solnc sistemy');
    readkey;
    end.
    uses crt;

  5. ght


    const n = 7;
    var c: array[1..n] of integer;
    s,i: integer;
    begin
    clrscr;
    for i := 1 to n do
    begin
    write( 'c[',i,'] = ' );
    read( c[i] );
    end;
    s := 1;
    for i := 1 to n do
    s := s * c[i];
    if ( s < 0 ) then
    writeln( abs(s) )
    else
    writeln(s);
    readkey;
    end.
    uses crt;


    const n = 7;
    var c: array[1..n] of integer;
    s,i,max,min,maxi,mini: integer;
    begin
    clrscr;
    for i := 1 to n do
    begin
    write( 'c[',i,'] = ' );
    read( c[i] );
    end;
    max:= c[1];
    min:= c[1];
    for i := 1 to n do
    if ( max < c[i] ) then
    begin
    max := c[i];
    maxi := i;
    end;
    for i := 1 to n do
    if ( min > c[i] ) then
    begin
    min := c[i];
    mini := i;
    end;
    s := 0;
    for i:= mini to maxi do
    s := s+c[i];
    writeln(s);
    readkey;
    end.
    uses crt;

  6. Digma


    var i,n,sum:integer;
    begin
    clrscr;
    write(' N = ' );
    readln(n);
    for i:=1 to n div 2 do
    if n mod i = 0 then
    sum:= sum + i;
    if ( sum = n) then
    writeln(' Число ',n, ' совершенное')
    else
    writeln(' Число ',n, ' несовершенное');
    readkey;
    end.
    uses crt;


    var n,i:integer;
    x,y:real;
    function f(n:integer):integer;
    begin
    if n = 0 then f := 1
    else
    f := n*f(n-1);
    end;
    function s(x,n:real):real;
    var t:real;
    begin
    t := Abs(x);
    if x < 0 then
    s:= (-1)*exp(n*Ln(t))
    else
    s:= exp(n*Ln(t));
    end;
    begin
    clrscr;
    x := 0;
    y := f(5)/( s(4,5)+f(4) /
    ( s(4,4)+f(3) /
    ( s(4,3)+f(2) /
    (s(4,2)+1/(4+x))
    )
    )
    );
    write(y:1:8);
    readkey;
    end.
    uses crt;

    SxLvn


    const y = 4;
    type stud = record
    fam,fio:string[30];
    nomer:longint;
    end;
    var tmp_stud:stud;
    a:array[1..y] of stud;
    i,j,k,n:integer;
    x:longint;

    procedure swap(var e1, e2: stud);
    var
    e: stud;
    begin
    e := e1; e1 := e2; e2 := e;
    end;

    procedure qsort(l, r: integer);
    var
    i, j, x: integer;
    begin
    i := l;
    j := r;
    x := a[l+random(r-l+1)].nomer;
    repeat
    while ( x > a[i].nomer ) do inc(i);
    while ( x < a[j].nomer ) do dec(j);
    if (i <= j) and ((a[i].fam[1] = 'o') or ( a[j].fam[1] = 'o')) then
    begin
    swap(a[i], a[j]);
    inc(i);
    dec(j);
    end
    else
    begin
    inc(i);
    dec(j);
    end;
    until i > j;
    if l < j then qsort(l, j);
    if i < r then qsort(i, r);
    end;

    begin
    clrscr;
    for i:=1 to y do
    begin
    write('vvedite familiyu: ');
    readln(a[i].fam);
    write('vvedite iniczial: ');
    readln(a[i].fio);
    write('vvedite nomer: ');
    readln(a[i].nomer);
    end;
    for i:=1 to y do
    if ( a[i].fam[1] = 'o' ) then
    qsort(1,y);
    for i:=1 to y do
    writeln (a[i].fam, a[i].fio:4, a[i].nomer:12);
    readkey;
    end.
    uses crt;

  7. ght


    var i:integer;
    begin
    clrscr;
    for i:= 10 to 99 do
    if ( ( sqr( i div 10 ) + sqr( i mod 10 ) ) mod 13 = 0 ) then
    write( i:3 );
    readkey;
    end.
    uses crt;


    var n,i:integer;
    a,p:real;
    function sum(n:integer):integer;
    begin
    if n = 0 then sum := 0
    else
    sum := n+sum(n-1);
    end;
    begin
    clrscr;
    write('a = ');
    readln(a);
    write('n = ');
    readln(n);
    p := a;
    for i:=2 to n do
    begin
    p := p * sum(i);
    end;
    write('Ответ: ',p:5:2);
    readkey;
    end.
    uses crt;

  8. X-tender

    Задание не так понял.

    Тогда надо sum повыше занулить до цикла или ваще убрать, иначе будет 0 или 1.


    const m=4;
    n=6;
    var i,j,t,sum:integer;
    a:array[1..m,1..n] of integer;
    begin
    clrscr;
    for i:=1 to m do
    for j:=1 to n do
    begin
    write('a[',i,',',j,'] = ');
    read(a[i,j]);
    end;
    for i:=1 to m do
    begin
    t:=1;
    for j:=1 to n div 2 do
    if (a[i,j*2] mod 2 = 0) then
    t:=0;
    sum:=sum+t;
    end;
    writeln(sum);
    readkey;
    end.
    uses crt;

  9. Помогите написать прогу или напишите идею решения данной задачи.

    Совмещение ломаных. Две ломаные построены по ребрам сеточной области с целочисленными координатами. Требуется составить алгоритм—программу проверки совпадения двух ломаных, составленных из отрезков, с точностью до параллельного переноса и поворота на 90°, 180°, 270°. Исходные данные — число отрезков ломаных и значения координат их концов — определяются в текстовом файле. Выходной файл результатов должен содержать признак 1, если ломаные совпадают, и 0 — в противном случае.

    Пример файла исходных данных:

    4 — количество отрезков первой ломаной

    0 0 1 0 3 0 2 0 1 0 2 0 3 0 3 1

    2 — количество отрезков второй ломаной

    1 1 1 4 0 4 1 4

    Пример файла результатов:

    1 — ломаные совпадают.

    мб кому-нибудь пригодится


    #include
    #include
    #include
    #include
    #include
    using namespace std;

    struct decart
    {
    int x;
    int y;
    };

    int cos4[] = {1, 0, -1, 0};
    int sin4[] = {0, 1, 0, -1};
    int n1, n2;
    struct decart *line1, *line2, *nline1, *nline2;

    // true, если три точки образуют прямую линию
    bool isline(struct decart *p)
    {
    return (p[0].x * p[1].y + p[1].x * p[2].y + p[2].x * p[0].y) -
    (p[0].y * p[1].x + p[1].y * p[2].x + p[2].y * p[0].x) == 0;
    }

    // return: true - присоединение найденного отрезка слева
    // false - присоединение найденного отрезка справа
    bool isleft(struct decart *src, int x0, int y0, int x1, int y1, struct decart *result, int cnt)
    {
    bool left;
    struct decart *begin;

    left = true;
    begin = src;

    for(;;)
    {
    if(src[0].x == x0 && src[0].y == y0)
    {
    result[0] = src[1];
    break;
    }
    if(src[0].x == x1 && src[0].y == y1)
    {
    result[0] = src[1];
    left = false;
    break;
    }
    if(src[1].x == x0 && src[1].y == y0)
    {
    result[0] = src[0];
    break;
    }
    if(src[1].x == x1 && src[1].y == y1)
    {
    result[0] = src[0];
    left = false;
    break;
    }
    src += 2;
    }
    memmove(src, src + 2, (cnt * 2 - 2 - (src - begin)) * sizeof(struct decart));
    return(left);
    }

    // Склеивание отдельных отрезков в сплошную ломаную
    int sort_line(struct decart *src, struct decart *dest, int cnt)
    {
    struct decart *begin, tmp;

    begin = dest;
    dest[0] = src[0];
    dest[1] = src[1];
    dest += 2;
    src += 2;

    while(--cnt)
    {
    if(isleft(src, begin[0].x, begin[0].y, dest[-1].x, dest[-1].y, &tmp, cnt))
    {
    memmove(begin + 1, begin, (dest - begin) * sizeof(struct decart));
    begin[0] = tmp;
    }
    else
    {
    dest[0] = tmp;
    }
    ++dest;
    }

    return(dest - begin);
    }

    // Выбросить среднюю точку из трех точек, если эти
    // три точки располагаются на одной линии
    int del_punkt(struct decart *p, int cnt)
    {
    int i;
    struct decart *tmp;
    bool yes_delete;

    do
    {
    yes_delete = false;
    for(tmp = p,i = cnt - 2; i; --i,++tmp)
    {
    if(isline(tmp))
    {
    memmove(tmp + 1, tmp + 2, (cnt - 2 - (tmp - p)) * sizeof(struct decart));
    --cnt;
    yes_delete = true;
    break;
    }
    }
    } while(yes_delete);
    return(cnt);
    }

    bool eq_line(struct decart *line1, struct decart *line2, int cnt, int step)
    {
    int i, j, k, x, y;

    for(i = 0; i < 4; ++i)
    {
    for(j = k = 0; j < cnt; ++j,k += step)
    {
    x = line1[k].x * cos4[i] + line1[k].y * sin4[i];
    y = -line1[k].x * sin4[i] + line1[k].y * cos4[i];
    if(line2[k].x != x || line2[k].y != y)
    break;
    }
    if(j == cnt)
    return(true);
    }
    return(false);
    }

    void input(void)
    {
    int i;
    ifstream fin("input.txt");

    if(!fin)
    {
    cout << "Cant open the file\n";
    cout << "Press any key...";
    getch();
    exit(0);
    }

    fin >> n1;
    line1 = new struct decart[n1 * 2];
    nline1 = new struct decart[n1 + 1];

    for(i = 0; i < n1 * 2; ++i)
    {
    fin >> line1[i].x >> line1[i].y;
    }

    fin >> n2;
    line2 = new struct decart[n2 * 2];
    nline2 = new struct decart[n2 + 1];

    for(i = 0; i < n2 * 2; ++i)
    {
    fin >> line2[i].x >> line2[i].y;
    }
    }

    void output(char c)
    {
    delete[] line1;
    delete[] line2;
    delete[] nline1;
    delete[] nline2;
    ofstream fout("output.txt");
    fout << c;
    }

    int main(int argc, char* argv[])
    {
    int i, x1, x2, y1, y2;

    input();
    n1 = sort_line(line1, nline1, n1);
    n2 = sort_line(line2, nline2, n2);

    n1 = del_punkt(nline1, n1);
    n2 = del_punkt(nline2, n2);

    if(n1 != n2)
    {
    output('0');
    cout<<"0 Press any key...";
    //getch();
    return(0);
    }

    // Сдвиг по левому краю
    x1 = nline1[0].x;
    y1 = nline1[0].y;
    x2 = nline2[0].x;
    y2 = nline2[0].y;
    for(i = 0; i < n1; ++i)
    {
    nline1[i].x -= x1;
    nline1[i].y -= y1;
    nline2[i].x -= x2;
    nline2[i].y -= y2;
    }

    if(eq_line(nline1 + 1, nline2 + 1, n1 - 1, +1))
    {
    output('1');
    cout<<"1 Press any key...";
    //getch();
    return(0);
    }

    // Сдвиг по правому краю
    x1 = nline1[n1 - 1].x;
    y1 = nline1[n1 - 1].y;
    for(i = 0; i < n1; ++i)
    {
    nline1[i].x -= x1;
    nline1[i].y -= y1;
    }

    if(eq_line(nline1 + n1 - 2, nline2 + n1 - 2, n1 - 1, -1))
    {
    output('1');
    cout<<"1 Press any key...";
    //getch();
    return(0);
    }

    output('0');
    cout<<"0 Press any key...";
    //getch();
    return 0;
    }
    #include 

  10. Помогите написать прогу или напишите идею решения данной задачи.

    Совмещение ломаных. Две ломаные построены по ребрам сеточной области с целочисленными координатами. Требуется составить алгоритм—программу проверки совпадения двух ломаных, составленных из отрезков, с точностью до параллельного переноса и поворота на 90°, 180°, 270°. Исходные данные — число отрезков ломаных и значения координат их концов — определяются в текстовом файле. Выходной файл результатов должен содержать признак 1, если ломаные совпадают, и 0 — в противном случае.

    Пример файла исходных данных:

    4 — количество отрезков первой ломаной

    0 0 1 0 3 0 2 0 1 0 2 0 3 0 3 1

    2 — количество отрезков второй ломаной

    1 1 1 4 0 4 1 4

    Пример файла результатов:

    1 — ломаные совпадают.

×
×
  • Создать...