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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.02.2018, 09:49   #1
Ceroth
Новичок
Джуниор
 
Регистрация: 21.02.2018
Сообщений: 2
По умолчанию Смена окон по нажати - Turbo Pascal

Здравствуйте!

Есть программа выполняющая различные процедуры.
Необходимо добавить в неё функцию при нажатии Alt+Q менять местами окна с часами и мерцающим текстом.

Вот, что у меня получается:
Код:
{$M $1000, 0, 0}
program Lab6;
uses Crt, Dos;

const Thread11Count = 1;
      Thread12Count = 1;
      FNameC = '1.txt';
      X3C = 45; Y3C = 5; X4C = 5; Y4C = 4; X2C = 5; Y2C = 3;
	    xT: integer = 42;
	    xF: integer = 1;
	    AllTicks = 1;
      N = 10;
      Pic = '█';

type
  video = array[1..25, 1..80] of
   record
      symbol: char;
      attr: byte;
    end;

var
  memory: video absolute $B800:$0000;
  isShift: byte absolute $0000:$0417;
  kbFlags: Word absolute $40:$17;
  Scr: Array[1..25, 1..80] of Record
    symbol: Char;
    attr: Byte;
  end Absolute $B800:$0000;
  Save: record
    symbol: char;
    attr: byte;
  end;

  x3, y3, dx3, dy3: Integer;
  x4, y4, x2, y2: Integer;
  h, m, s, s100: Word;
  f: Text;

  Old8h, Old9h: Procedure;
  Thread11, Thread12, SumThread: Integer;
  Error, CurCount, CurLine, i, T, Process: Integer;
  On11, On12, On2, On3, On4, Start, isExit: Boolean;
  Stop11, Stop12, Stop2, Stop3, Stop4: Boolean;
  KeyCode, NewAttr, OldAttr: byte;
  CurStr, FName, hs, ms, ss: String;
  A: array [1..N] of String;

procedure SetCurSize(BegLine, EndLine: Byte);
var
  Regs: Registers;
begin
  with Regs do
  begin
    AH := $01;
    CH := BegLine;
    CL := EndLine;
  end;
  Intr($10, Regs);
end;

procedure DrawCurrentInfo;
begin
  Window(1, 21, 40, 25);
  GotoXY(1, 1); Write('ESC - Выход');
  GotoXY(1, 3); Write('Буфер - ', CurCount / N * 100:3:0, '%');
  GotoXY(1, 2); Write('Активен процесс № ');
  if On11 then Write('1-Производитель');
  if On12 then Write('1-Потребитель  ');
  if On2 then  Write('2              ');
  if On3 then  Write('3              ');
  if On4 then  Write('4              ');
end;

procedure Pr11;
begin
  if CurCount < N then
  begin
    if EOF(f) then
    begin
      Close(f);
      Reset(f);
    end;
    ReadLn(f, CurStr);
    Inc(CurCount);
    A[CurCount] := CurStr;
  end;
end;

procedure Pr12;
begin
  if CurCount > 0 then
  begin
    Window(1, 1, 40, 9);
    CurStr := A[1];
    for i := 2 to CurCount do A[i - 1] := A[i];
    Dec(CurCount);
    Inc(CurLine);
    if CurLine < 10 then GotoXY(1, CurLine)
    else
    begin
      GotoXY(1, 1); DelLine;
      GotoXY(1, 9 - 1);
    end;
    WriteLn(CurStr);
  end;
end;

procedure Pr2;
begin
  Window(xF, 11, 40, 19);
  OldAttr := TextAttr;
  NewAttr := 1 + Random(15); TextColor(NewAttr);
  GotoXY(x2, y2); Write('Мерцающий текст');
  GotoXY(x2, y2+2); Write('на две строки');
  TextAttr := OldAttr;
end;

procedure Pr3;
begin
  Memory[y3, x3].Symbol := Save.Symbol;
  Memory[y3, x3].Attr := Save.Attr;
  if (x3 + dx3 > 80) or (x3 + dx3 < 42) then dx3 := -dx3;
  if (y3 + dy3 > 9) or (y3 + dy3 < 1) then dy3 := -dy3;
  Inc(x3, dx3); Inc(y3, dy3);
  Save.Symbol := Memory[y3, x3].Symbol;
  Save.Attr := Memory[y3, x3].Attr;
  Memory[y3, x3].Symbol := Pic;
  Memory[y3, x3].Attr := 3;
end;

procedure Pr4;
begin
  Window(xT, 11, 80, 19);
  GetTime(h, m, s, s100);
  Str(h, hs); Str(m, ms); Str(s, ss);
  if h < 10 then hs := '0' + hs;
  if m < 10 then ms := '0' + ms;
  if s < 10 then ss := '0' + ss;
  GotoXY(x4, y4); Write(hs, ':', ms, ':', ss);
end;

procedure SwapWnd;
var
  t: Integer;
  buf: array [0..39] of Word;
begin
  t:=xT; xT:=xF; xF:=t;
  for t:=11 to 17 do begin
    Move(Scr[t,42],buf,SizeOf(buf));
    Move(Scr[t,1],Scr[t,42],SizeOf(buf));
    Move(buf,Scr[t,1],SizeOF(buf));
  end;
end;

{$F+}
procedure Key; Interrupt;
begin
  KeyCode := port[$60];
  case KeyCode of
    1:  isExit := true;
    17: if kbFlags and 8 <>0 then SwapWnd;
    2:  begin
          if (isShift and $02) = $02 then Stop11 := true
          else if Thread11 > 1 then Dec(Thread11);
        end;
    3:  begin
          if (isShift and $02) = $02 then Stop11 := false
          else Inc(Thread11);
        end;
    4:  begin
          if (isShift and $02) = $02 then Stop12 := true
          else if Thread12 > 1 then Dec(Thread12);
        end;
    5:  begin
          if (isShift and $02) = $02 then Stop12 := false
          else Inc(Thread12);
        end;
    6:  if (isShift and $02) = $02 then Stop2 := true;
    7:  if (isShift and $02) = $02 then Stop2 := false;
    8:  if (isShift and $02) = $02 then Stop3 := true;
    9:  if (isShift and $02) = $02 then Stop3 := false;
    10: if (isShift and $02) = $02 then Stop4 := true;
    11: if (isShift and $02) = $02 then Stop4 := false;
    end;
	  Inline($9C);
  Old9h;
end;

procedure Timer; Interrupt;
begin
  if Start then
    if T < AllTicks then
    begin
      if On11 then Pr11 else
      if On12 then Pr12 else
      if On2  then Pr2  else
      if On3  then Pr3  else
      if On4  then Pr4;
      Inc(T);
      DrawCurrentInfo;
    end
    else
    begin
      Start := false;
      if On11 then On11 := false else
      if On12 then On12 := false else
      if On2  then On2 := false  else
      if On3  then On3 := false  else
      if On4  then On4 := false;
    end;
  Inline($9C);
  Old8h;
end;
{$F-}
Часы перемещаются нормально, а мерцающий текст на долю секунды прыгает в нужное окно(4), после чего падает вниз(5)(

скриншот прилагаю
Изображения
Тип файла: jpg SS.jpg (67.8 Кб, 73 просмотров)
Ceroth вне форума Ответить с цитированием
Старый 21.02.2018, 09:51   #2
Ceroth
Новичок
Джуниор
 
Регистрация: 21.02.2018
Сообщений: 2
По умолчанию

К сожалению весь код в одно сообщение не помещается.

Вот окончаение:
Код:
procedure GetParam;
begin
  if ParamCount = 0 then
  begin
    FName := FNameC;
    x2 := X2C; y2 := Y2C;
    x4 := X4C; y4 := Y4C;
  end
  else
  if ParamCount = 1 then
  begin
    FName := ParamStr(1);
    Assign(f, FName);
    {I-}
    Reset(f);
    {I+}
    if IOResult <> 0 then FName := FNameC;
    x2 := X2C; y2 := Y2C;
    x4 := X4C; y4 := Y4C;
  end
  else
  if ParamCount = 2 then
  begin
    FName := ParamStr(1);
    Assign(f, FName);
    {I-}
    Reset(f);
    {I+}
    if IOResult <> 0 then FName := FNameC;
    Val(ParamStr(2), x2, Error);
    if (Error <> 0) or (x2 > 25) or (x2 < 1) then x2 := X2C;
    y2 := Y2C;
    x4 := X4C; y4 := Y4C;
  end
  else
  if ParamCount = 3 then
  begin
    FName := ParamStr(1);
    Assign(f, FName);
    {I-}
    Reset(f);
    {I+}
    if IOResult <> 0 then FName := FNameC;
    Val(ParamStr(2), x2, Error);
    if (Error <> 0) or (x2 > 25) or (x2 < 1) then x2 := X2C;
    Val(ParamStr(3), y2, Error);
    if (Error <> 0) or (y2 > 7) or (y2 < 1) then y2 := Y2C;
    x4 := X4C; y4 := Y4C;
  end
  else
  if ParamCount = 4 then
  begin
    FName := ParamStr(1);
    Assign(f, FName);
    {I-}
    Reset(f);
    {I+}
    if IOResult <> 0 then FName := FNameC;
    Val(ParamStr(2), x2, Error);
    if (Error <> 0) or (x2 > 25) or (x2 < 1) then x2 := X2C;
    Val(ParamStr(3), y2, Error);
    if (Error <> 0) or (y2 > 7) or (y2 < 1) then y2 := Y2C;
    Val(ParamStr(4), x4, Error);
    if (Error <> 0) or (x4 > 20) or (x4 < 1) then x4 := X4C;
    y4 := Y4C;
  end
  else
  if ParamCount >= 5 then
  begin
    FName := ParamStr(1);
    Val(ParamStr(2), x2, Error);
    if (Error <> 0) or (x2 > 25) or (x2 < 1) then x2 := X2C;
    Val(ParamStr(3), y2, Error);
    if (Error <> 0) or (y2 > 7) or (y2 < 1) then y2 := Y2C;
    Val(ParamStr(4), x4, Error);
    if (Error <> 0) or (x4 > 20) or (x4 < 1) then x4 := X4C;
    Val(ParamStr(5), y4, Error);
    if (Error <> 0) or (y4 > 9) or (y4 < 1) then y4 := Y4C;
  end;
end;

procedure DrawInfo;
var i : Integer;
begin
  Window(1, 1, 80, 25);
  for i := 1 to 80 do
  begin
    GotoXY(i, 10); Write('─');
    GotoXY(i, 20); Write('─');
  end;
  for i := 1 to 25 do
  begin
    GotoXY(41, i); Write('│');
  end;
  GotoXY(41, 10); Write('┼');
  GotoXY(41, 20); Write('┼');
  Window(42, 21, 80, 25);
  GotoXY(1, 1); Write('1. Shift+1/2 - Stop/Start. 1/2 = -/+');
  GotoXY(1, 2); Write('2. Shift+3/4 - Stop/Start. 3/4 = -/+');
  GotoXY(1, 3); Write('3.  Shift+5/6 - Stop/Start');
  GotoXY(1, 4); Write('4.  Shift+7/8 - Stop/Start');
  GotoXY(1, 5); Write('5.  Shift+9/0 - Stop/Start');
end;

begin
  GetParam;
  ClrScr;
  DrawInfo;
  isExit := false;
  SetCurSize($20, $00);
  Randomize;
  Stop11 := false; Stop12 := false; Stop2 := false; Stop3 := false; Stop4 := false;

  Thread11 := Thread11Count; Thread12 := Thread12Count;
  CurCount := 0; CurLine := 0;
  Assign(f, FName); Reset(f);

  x3 := X3C; y3 := Y3C; dx3 := 1; dy3 := 1;
  Save.Symbol := Memory[y3, x3].Symbol;
  Save.Attr := Memory[y3, x3].Attr;
  Memory[y3, x3].Symbol := Pic;
  Memory[y3, x3].Attr := 3;

  GetIntVec($8, @Old8h);
  SetIntVec($8, Addr(Timer));
  GetIntVec($9, @Old9h);
  SetIntVec($9, Addr(Key));
  while not isExit do
  begin
    SumThread := Thread11 + Thread12;
    if (Random < Thread11 / SumThread) then
    begin
      if not Stop11 then
      begin
        T := 0; On11 := true; Start := true; While Start do;
      end;
    end
    else
    if not Stop12 then
    begin
      T := 0; On12 := true; Start := true; While Start do;
    end;
    if not Stop2 then
    begin
      T := 0; On2 :=  true; Start := true; While Start do;
    end;
    if not Stop3 then
    begin
      T := 0; On3 :=  true; Start := true; While Start do;
    end;
    if not Stop4 then
    begin
      T := 0; On4 :=  true; Start := true; While Start do;
    end;
  end;
  While CurCount > 0 do Pr12;
  Close(f);
  Window(1, 1, 80, 25);
  ClrScr;
  ReadKey;
  SetCurSize($06, $07);
  SetIntVec($8, Addr(Old8h));
  SetIntVec($9, Addr(Old9h));
end.
Ceroth вне форума Ответить с цитированием
Старый 21.02.2018, 14:32   #3
Black Fregat
Программист
Участник клуба
 
Аватар для Black Fregat
 
Регистрация: 23.06.2009
Сообщений: 1,772
По умолчанию

Левую границу Вы меняете, а правую нет. Как ведет себя окно с левой границей 42, а правой - 40 - вот как-то странно ведёт..
Black Fregat вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[DLL] отслеживание и смена названий окон vermond Общие вопросы C/C++ 2 25.01.2014 13:03
Turbo Pascal состояние программы и методы использования окон отладчика. djquins Помощь студентам 0 15.12.2013 01:26
pascal abc, pascal turbo. выборка данных из одного .txt в другой ТипичныйСтудент Помощь студентам 6 27.04.2013 15:29
Как сделать, чтобы было только нажати 3 цифры XxXGhosTXxX Общие вопросы C/C++ 6 20.03.2011 15:31
Ввод данных при нажати на кнопку в активную ячейку. sergiksergik Microsoft Office Excel 2 21.03.2009 21:30