Форум программистов
 
О проблемах с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

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

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


Ответ
 
Опции темы
Внимание! Есть замечания модератора по теме: Название темы должно адекватно отражать суть решаемой задачи/проблемы.
Старый 18.07.2012, 19:06   #1
Blatota
Новичок
Джуниор
 
Регистрация: 16.07.2012
Сообщений: 1
Лампочка Объединить две графические программы в одну. Модуль GraphABC. PascalABC

Посоветуйте как соединить две программки в одну


едет паровоз ЖЭ ДЭ ВЭ

Код:
uses GraphABC;
VAR i: integer;
BEGIN
LockDrawing;
For i:=1 to WindowWidth do begin
SetWindowSize(1280,600);
ClearWindow;
Line(0,300,1600,300);
FloodFill(0,200,clMoneyGreen);
FloodFill(400,500,clSilver);

Line(i+380,200,i+410,200);
Line(i+380,200,i+390,210);
Line(i+400,210,i+410,200);

Line(i+100,270,i+120,270);
Line(i+300,270,i+320,270);
Line(i+200,270,i+220,270);

SetBrushColor(clRed);
setfontcolor(clblue);
setfontsize(28);
Rectangle(i+20,230,i+100,280);
TextOut (48+i,231,'ЖЭ');
Rectangle(i+120,230,i+200,280);
TextOut (144+i,231,'ДЭ');
Rectangle(i+220,230,i+300,280);
TextOut (246+i,231,'ВЭ');

SetBrushColor(clYellow);
RoundRect(i+320,200,i+365,280,30,20);
SetBrushColor(clSkyBlue);
RoundRect(i+320,230,i+420,280,30,20);
Rectangle(i+390,230,i+400,210);
SetBrushColor(clyellow);

Circle(i+30,290,10);
Circle(i+90,290,10);

Circle(i+130,290,10);
Circle(i+190,290,10);

Circle(i+230,290,10);
Circle(i+290,290,10);

Circle(i+345,278,22);
Circle(i+377,288,12);
Circle(i+400,288,12);
Redraw;

SetFontColor (clBlack);
end;
END.

дойдя до середины сменить фон на такой( с елкой с гирляндами со снежинками)

Код:
program Elka;
uses
  ABCObjects, GraphABC;

const
  MaxX = 800;
  MaxY = 600;
  SnowN = 100;
  SKol=7;  
type
  Snow = record
    x0: real;   
    Amp: real;  
    Speed: real;
    y: real; 
    x: real;   
  end;

TYPE
  GirT= record
    xScr: integer;
    yScr: integer;
    Col: color;
  end;  

var
  GirArr: array [1..1000] of GirT;
  Gir1: GirT;
  GirCount: integer;
  GirColInd: integer;
  Snows: array[1..SnowN] of Snow;
  Snow1: Snow;
  i: integer;
  xScr, yScr: integer;
  Pic: Picture;
  GirInd: integer;
  GirKol: integer;
  //maxx,maxy: integer;

procedure PrepareGir();
var
  z, xScr, yScr: integer;
  a, R, x0, y0, x, y: real;
  col: color;
begin
  x0:=0;
  y0:=80;

  GirInd:=1;
  col:=RGB(0,255,0);
  GirKol:=14; 
  R:=40;
  for z:=1 to SKol do
  begin
    a:=Pi/2+1+0.225;
    while(a<(Pi+Pi/2-1-0.225)) do   
    begin
      x:=x0+R*sin(a);
      y:=y0+R*cos(a);
      xScr:=trunc(x+MaxX/2);
      yScr:=trunc(MaxY/2-y);
      col:=RGB(Random(255),Random(255),Random(255));
      Gir1.xScr:=xScr;
      Gir1.yScr:=yScr;
      Gir1.Col:=col;
      GirArr[GirInd]:=Gir1;
      inc(GirInd);
      a:=a+Pi/GirKol;
    end;
    R:=R+30;        
    GirKol:=GirKol+3; 
  end;
End;

procedure DrawGir();
var
  i: integer;
  
Begin
  for i:=1 to GirInd-1 do
    begin
      SetBrushColor( GirArr[1+(i+GirColInd) mod GirInd].Col );
      circle(GirArr[i].xScr, GirArr[i].yScr, 3);
    end;
    GirCount:=GirCount+1;
    if GirCount mod 15=0 then
      GirColInd:=(GirColInd+1) mod GirInd;
End;

procedure DrawTree();
var
  p, x, y, r: integer;
  a1, a2: integer;
begin
  x := maxx div 2;
  y :=maxy div 2 - 130;
  r := 70 + 10;
  a1 := -110 - 5;
  a2 := -70 + 5;
  //FloodFill(maxx,maxy,);
  SetBrushColor(cllightblue);
  fillrect(maxx, maxy - (maxy div 3), 0,0);

  SetBrushColor(clSaddleBrown);
  fillrect(x - 12, y + 250, x + 12, y + 340);
  SetBrushColor(clgreen);

  for p := 1 to 10 do
  begin
    fillpie(x, y, r, a1, a2);
    y := y + 25;
    a1 := a1 - 5;
    a2 := a2 + 5;
  end;
end;

procedure GenNewSnow(var s: Snow; FirstUse: Boolean);
begin
  S.x0 := Random(MaxX);
  S.Amp := 5 + Random(20);
  S.Speed := 0.1 + Random(5) / 5;
  if FirstUse then
    S.y := Random(MaxY)
  else
    S.y := 0;
end;

BEGIN
  PrepareGir();

  SetWindowSize(MaxX, MaxY);
  Pic := Picture.Create('snow21.gif');

  for i := 1 to SnowN do
  begin
    GenNewSnow(Snows[i], True);
  end;

  while(true ) do
  begin

    LockDrawing;
    Window.Clear(clwhite);
    DrawTree();     
    DrawGir();      
    
    // Рисуем снег
    for i := 1 to SnowN do
    begin
      Snow1 := Snows[i];
      Snow1.x := Snow1.x0 + Snow1.Amp * sin(Snow1.y / 10);
      xScr := trunc(Snow1.x);
      yScr := trunc(Snow1.y);
      Pic.Draw(xScr, yScr, 15, 15);
      Snow1.y := Snow1.y + Snow1.Speed;
      if Snow1.y > MaxY then
      begin
        GenNewSnow(Snow1, False);
      end;
      Snows[i] := Snow1;
    end;
      Redraw;
    sleep(1);
  end;

end.


___________
1. Название темы должно адекватно отражать суть решаемой задачи/проблемы.
На первый раз я исправил.
В дальнейшем темы с подобным названием будут закрываться/удаляться,
а автор такой темы получать штрафы.


2. Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)

Не забывайте об этом!

Модератор.
Изображения
Тип файла: gif snow21.gif (369 байт, 36 просмотров)

Последний раз редактировалось Serge_Bliznykov; 19.07.2012 в 08:27.
Blatota вне форума Ответить с цитированием
Старый 18.07.2012, 23:50   #2
Jaiden
Meitantei
Пользователь
 
Аватар для Jaiden
 
Регистрация: 10.04.2011
Сообщений: 15
По умолчанию

Как вариант, перенести все процедуры и переменные второй программы в первую(предварительно избавившись от "клона" i). Затем после цикла (после которого первая программа должна была закончиться), вставить весь код второй программы.
Так как вы указали, что вторая программа должна выполниться, когда поезд окажется на полпути (если я правильно понял), то отредактируйте в первой программе эту строчку (всеобщий цикл):
Код:
BEGIN
LockDrawing;
For i:=1 to (round(WindowWidth/2)) do begin
Я проверил - вроде работает как есть.

Ах да, и ставьте, наконец коды программ в теги.
With Silence comes Peace.
With Peace comes Freedom.
With Freedom comes Silence.
Jaiden вне форума Ответить с цитированием
Ответ
Купить рекламу на форуме от 7000 рублей в месяц



Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно объединить 3 программы в модуль ALSe61 Помощь студентам 0 28.05.2012 14:27
Сравнить две программы. Одну из самых первых и одну из последний coNsept Свободное общение 8 23.03.2012 22:21
Две программы в PascalABC Mnsh Помощь студентам 5 27.12.2011 07:30
Объединить две процедуры в одну AndreiFQ Помощь студентам 5 24.06.2010 08:26
как объединить две программы? kuzmich Общие вопросы Delphi 3 28.10.2009 19:45


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS
Скидки на курсы GeekBrains 40%, выбирайте программу для себя