Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.05.2009, 21:22   #1
aiktz
Форумчанин
 
Регистрация: 10.03.2009
Сообщений: 104
По умолчанию Программа должна вычерчивать схему сложной электрической цепи.

1. Программа вычерчивает схему сложной электрической цепи.
Код:
{ При вычерчивании схемы цепи используется рекурсия.}
Uses Graph;
const
{ шаг сетки }
dx=7;
dy=7;
river:integer; grMode:integer; grPath:string; ErrCode:integer; x,y: integer;
k: integer;
порядок цепи }
{ выводит схему цепи k-ro порядка } Procedure Cep(k: integer; x,y: integer); begin
SetColor(Green);
Line (x, y, x+2*dx, y) ;
Rectangle (x+2*dx,y-dy,x+6*dx,y+dy);
Line(x+6*dx,y,x+8*dx,y);
OuttextXY(x+3*dx,y-3*dy,'Rl');
SetColor(Yellow);
Line(x+8*dx,y,x+8*dx,y+2*dy);
Rectangle(x+7*dx,y+2*dy,x+9*dx,y+6*dy);
Line(x+8*dx,y+6*dy,x+8*dx", y+8*dy) ;
OuttextXY(x+10Mx,y+2*dy, 'R2') ;
SetColor(LightGray) ;
Line(x,y+8*dy,x+2*dx,y+8*dy);
Rectangle(x+2*dx,y+7*dy,x+6*dx, y+9*dy) ;
Line(x+6*dx,y+8*dy,x+8*dx, y+8*dy); 1 OuttextXY(x+3*dx,y+5*dy,'R3');
if k>l then Cep(k-l,x+8*dx,y);
end;
begin
grDriver:=VGA; grMode:=VGAHi; grPath:='e:\tp\bgi'; InitGraph (grDriver,grMode,grPath); ErrCode:=GraphResult; if ErrCode <> grOK then begin
writeln ('Ошибка инициализации графического режима.1);
writeln ('Для завершения работы нажмите <Enter>');
readln; Halt (I
end;
OutTextXY(10,10,'Введите порядок цепи и нажмите <Enter>'); readln(k); сер (k, 10,50) ; 
readln; 
CloseGraph; 
end.

2. нарисовать паровоз

Код:
 uses Graph;
grDriver: Integer; grMode: Integer; ErrCode: Integer; res: integer;
x,y: integer; { координаты базовой точки паровоза }
dx,dy: integer; { шаг координатной сетки } t
r: array[1..15] of PointType; { координаты точек контура паровоза }
begin
grDriver := detect;
InitGraph(grDriver, grMode,'e:\tp\bgi');
ErrCode : = GraphResult;
if ErrCode = grOk then
begin
x0:=100; y0:=100;
dx:=5; dy:=5;
{ корпус }
tr[l].y:=yO+7*dy;
tr[2].y:=yO+6*dy; 
tr[3].y:=yO+6*dy; 
tr[4].y:=yO+3*dy; 
tr[5].y:=yO+3*dy; 
tr[6].y:=yO+O*dy; 
tr[7]".y:=y0+0*dy; 
tr[8].y:=yO+3*dy; 
tr[9].y:=yO+3*dy; 
tr[10].y:=yO+l*dy; 
tr[1].x:=xO+O*dx;
tr[2].x:=xO+O*dx;
tr[3].x:=xO+l*dx;
tr[4J .x:=xO+l*dx;
tr[5].x:=xO+2*dx;
tr[6].x:=xO+2*dx;
tr[7].x:=xO+3*dx;
tr[8].x:=xO+3*dx;
tr[9].x:=xO+7*dx;
tr[10].x:=xO+7*dx;
tr[ll].x:=xO+13*dx;
tr[12].x:=xO+13*dx; tr[12].y:=yO+2*dy;
tr[13].x:=xO+12*dx; tr[13].y:=yO+2*dy;
tr[14].x:=xO+12*dx; tr[14].y:=yO+7*dy;
tr[15].x:=xO+O*dx; tr[15].y:=yO+7*dy;
DrawPoly(15,tr);
{ окно )
Rectangle(xO+8*dx,yO+2*dy,x0+10*dx,yO+4*dy),
{ колеса )
SetFillStyle(SolidFill,Red);
SetColor(Red);
PieSlice(xO+3*dx,yO+7*dy, 0,360,l*dx);
PieSlice(xO+6*dx, yO+7*dy,0,360,l*dx);
PieSlice(xO+9*dx,yO+7*dy,0,360,l*dx);
{ окантовка колес }
SetColor(White);
Circle(xO+3*dx,yO+7*dy,l*dx), Circle(xO+6*dx,yO+7*dy,l*dx), Circle(xO+9*dx,yO+7*dy,l*dx),
readln; 
end;
CloseGraph; 
end.
помогите исправить программы....очень нужно!
aiktz вне форума Ответить с цитированием
Старый 20.05.2009, 07:40   #2
OCTAGRAM
Oldschool geek
Форумчанин
 
Аватар для OCTAGRAM
 
Регистрация: 09.03.2009
Сообщений: 611
По умолчанию

1.



Сложность схемы просто зашкаливает

Код:
{ При вычерчивании схемы цепи используется рекурсия.}
Uses Graph, SVGA;
const
{ шаг сетки }
  dx = 7;
  dy = 7;
var
  grDriver : Integer;
  grMode   : Integer;
  grPath   : String;
  ErrCode  : Integer;
  x, y     : Integer;
  k        : Integer;
{порядок цепи }
{ выводит схему цепи k-ro порядка }
Procedure Cep(k: Integer; x, y: Integer);
begin
  SetColor(Green);
  Line(x, y, x + 2 * dx, y) ;
  Rectangle(x + 2 * dx, y - dy, x + 6 * dx, y + dy);
  Line(x + 6 * dx, y, x + 8 * dx, y);
  OuttextXY(x + 3 * dx, y - 3 * dy, 'R1');
  SetColor(Yellow);
  Line(x + 8 * dx, y, x + 8 * dx, y + 2 * dy);
  Rectangle(x + 7 * dx, y + 2 * dy, x + 9 * dx, y + 6 * dy);
  Line(x + 8 * dx, y + 6 * dy, x + 8 * dx, y + 8 * dy);
  OuttextXY(x + 10 * dx, y + 2 * dy, 'R2');
  SetColor(LightGray);
  Line(x, y + 8 * dy, x + 2 * dx, y + 8 * dy);
  Rectangle(x + 2 * dx, y + 7 * dy, x + 6 * dx, y + 9 * dy);
  Line(x + 6 * dx, y + 8 * dy, x + 8 * dx, y + 8 * dy);
  OuttextXY(x + 3 * dx, y + 5 * dy, 'R3');
  if k > 1 then
    Cep(k - 1, x + 8 * dx, y);
end;

begin
  {grDriver := VGA;
  grMode := VGAHi;}
  grDriver := Detect;
  grPath := 'x:\bp';
  InitGraph(grDriver, grMode, grPath);
  ErrCode := GraphResult;
  if ErrCode <> grOK then
  begin
    WriteLn('Ошибка инициализации графического режима.');
    WriteLn('Для завершения работы нажмите <Enter>');
    ReadLn;
    Halt(1);
  end;
  SetColor(LightGray);
  SetTextStyle(SmallFont, HorizDir, 5);
  Write('                                       ');
  OutTextXY(0, 0, 'Введите порядок цепи и нажмите <Enter>: ');
  ReadLn(k);
  Cep(k, 10, 50);
  ReadLn;
  CloseGraph;
end.
Вообще, такое впечатление, что через FineReader прогу распознавали.

2.



Код:
uses Graph, SVGA;
var
  grDriver : Integer;
  grMode   : Integer;
  ErrCode  : Integer;
  res      : Integer;
  x0, y0   : Integer; { координаты базовой точки паровоза }
  dx, dy   : Integer; { шаг координатной сетки }
type
  PointType = record
    x, y : Integer;
  end;
var
  { координаты точек контура паровоза }
  tr : array[1 .. 15] of PointType;

begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, 'x:\bp');
  ErrCode := GraphResult;
  if ErrCode = grOk then
  begin

    {
    x0 := 100; y0 := 100;
    dx := 5; dy := 5;
    }
    {
     ImgMinX = x0, ImgMaxX = x0 + 13 * dx
     ImgMinY = y0, ImgMaxY = y0 + 7 * dy

     dx = dy
    }
    dx := ((GetMaxX + 1) * 5 div 6) div 13;
    dy := ((GetMaxY + 1) * 5 div 6) div 7;
    if dx < dy then dy := dx else dx := dy;
    x0 := (GetMaxX - 13 * dx) div 2;
    y0 := (GetMaxY - 7 * dx) div 2;

    SetColor(White);

    { корпус }
    tr[1].y := y0 + 7 * dy;
    tr[2].y := y0 + 6 * dy;
    tr[3].y := y0 + 6 * dy;
    tr[4].y := y0 + 3 * dy;
    tr[5].y := y0 + 3 * dy;
    tr[6].y := y0 + 0 * dy;
    tr[7].y := y0 + 0 * dy;
    tr[8].y := y0 + 3 * dy;
    tr[9].y := y0 + 3 * dy;
    tr[10].y := y0 + 1 * dy;
    tr[11].y := y0 + 1 * dy;
    tr[1].x := x0 + 0 * dx;
    tr[2].x := x0 + 0 * dx;
    tr[3].x := x0 + 1 * dx;
    tr[4].x := x0 + 1 * dx;
    tr[5].x := x0 + 2 * dx;
    tr[6].x := x0 + 2 * dx;
    tr[7].x := x0 + 3 * dx;
    tr[8].x := x0 + 3 * dx;
    tr[9].x := x0 + 7 * dx;
    tr[10].x := x0 + 7 * dx;
    tr[11].x := x0 + 13 * dx;
    tr[12].x := x0 + 13 * dx; tr[12].y := y0 + 2 * dy;
    tr[13].x := x0 + 12 * dx; tr[13].y := y0 + 2 * dy;
    tr[14].x := x0 + 12 * dx; tr[14].y := y0 + 7 * dy;
    tr[15].x := x0 + 0 * dx; tr[15].y := y0 + 7 * dy;
    DrawPoly(15,tr);
    { окно }
    Rectangle(x0 + 8 * dx, y0 + 2 * dy, x0 + 10 * dx, y0 + 4 * dy);
    { колеса }
    SetFillStyle(SolidFill, Red);
    SetColor(Red);
    PieSlice(x0 + 3 * dx, y0 + 7 * dy, 0, 360, 1 * dx);
    PieSlice(x0 + 6 * dx, y0 + 7 * dy, 0, 360, 1 * dx);
    PieSlice(x0 + 9 * dx, y0 + 7 * dy, 0, 360, 1 * dx);
    { окантовка колес }
    SetColor(White);
    Circle(x0 + 3 * dx, y0 + 7 * dy, 1 * dx);
    Circle(x0 + 6 * dx, y0 + 7 * dy, 1 * dx);
    Circle(x0 + 9 * dx, y0 + 7 * dy, 1 * dx);
    ReadLn;
  end;
  CloseGraph;
end.
If you want to get to the top, you have to start at the bottom

http://pascal.net.ru/

Последний раз редактировалось OCTAGRAM; 20.05.2009 в 08:05.
OCTAGRAM вне форума Ответить с цитированием
Старый 20.05.2009, 09:15   #3
aiktz
Форумчанин
 
Регистрация: 10.03.2009
Сообщений: 104
По умолчанию

ооооооооогромное вам спасибо!!!
aiktz вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
программа, которая как будто должна бы генерировать коды на пополнения мобильных счетов gajdamak Свободное общение 23 27.02.2009 18:13
программа, работающая под вистой, должна разделить hdd еще на 2 диска KORT Софт 1 25.08.2008 13:57
Как работать с TCanvas - на PaintBox1 программа должна рисовать полигон Михаил Юрьевич Общие вопросы Delphi 16 04.01.2008 15:31
Delphi 6 - Программа должна узнать уровень загруженности процессора Никки Общие вопросы Delphi 3 20.11.2007 19:40
WinApi, программа должна выдавать основной номер версии ОС MARGO Win Api 2 16.11.2007 21:14