pascal сегментные часы

[world12_tk]

Здраствуйте уважаемые программисты аки форумчанины. Возникла проблема.... Мне нужно было написать программу, которая выводит на экран сегментные электронные часы. Проблема в том, что первые два сегмента мерцают.... Помогите мне исправить.. И еще я буду презнателен,если кто нибудь мне поможет укоротить программу, т.к я всего лишь начинающий прогаммист, а программа большая. Заранее спасибо.
Вот исходный текст программы:

program kurs4;

uses Crt, Dos, Graph;

var

gd,gm,k:integer;


hi,ml,sl,h2,m2,s2,hs2:word;

procedure cifra(x,y,n:integer); type

a4=array [0..4] of integer;

a6=array [1..7] of byte; const

a=4; b=20; c=a+a+b;

dl:a4=(a,b,a,-a,-b);

d2:a4=(-a,0,a,a,0);

dx:a6=(0,0,0,0,c,0,c);

dy:a6=(0,c,2*c,0,0,c,c);

q:array[0..9]of byte=

($5F,$5,$76,$75,$2D,$79,$7B,$45,$7F,$7D); var

xy:array [0..5] of PointType;

j,k,d:byte; begin

setfillstyle(0,0);

bar(x-a,y-a,x+(c+a+a),y+2*(c+2*a));

d:=q[n];

for j:=1 to 7 do begin

if ((d) and ($80 shr j))=0 then continue;

xy[0]. x:=x+dx[j];

xy[0].y:=y+dy[j];

for k:=1 to 5 do if j<4 then begin

xy[k].x:=xy[k-1].x+dl[k-1];

xy[k].y:=xy[k-1].y+d2[k-1];

end

else

begin

xy[k].x:=xy[k-1].x-d2[k-1];

xy[k].y:=xy[k-1].y+dl[k-1];

end;

setfillstyle(1,14);

fillpoly(6,xy);

end;

end;

begin gd:=0;

initgraph(gd,gm,'');

settextstyle(0,0,4);

setcolor(14);

outtextxy(136,44,':');

outtextxy(256,44,':');

setcolor(4);

hi:=100; 
hi:=100; 

ml:=100;

sl:=100;

repeat

gettime(h2,m2,s2,hs2);


k:=h2 div 10;

cifra(50,30,k);



k:=h2 mod 10;

cifra(100,30,k); 
hi:=h2;

if ml<>m2 then begin 

k:=m2 div 10; cifra(170,30,k);

k:=m2 mod 10; cifra(220,30,k);

ml:=m2;

end;

if sl<>s2 then begin 

k:=s2 div 10;

cifra(290,30,k);

k:=s2 mod 10; cifra(340,30,k);

sl:=s2; end;

until KeyPressed;

closegraph;

end.

[Скандербег]

program kurs4;

uses Crt, Dos, Graph;

var
  gd, gm, k : integer;
  hi, ml, sl, h2, m2, s2, hs2 : word;

procedure cifra(x, y, n : integer);
type
  a4 = array [0..4] of integer;
  a6 = array [1..7] of byte; const
  a = 4; b = 20; c = a + a + b;
  dl : a4 = (a, b, a, -a, -b);
  d2 : a4 = (-a, 0, a, a, 0);
  dx : a6 = (0, 0, 0, 0, c, 0, c);
  dy : a6 = (0, c, 2*c, 0, 0, c, c);
  q : array[0..9] of byte=
    ($5F, $5, $76, $75, $2D, $79, $7B, $45, $7F, $7D);

var
  xy : array [0..5] of PointType;
  j, k, d : byte;

begin
  setfillstyle(0, 0);
  bar(x-a, y-a, x+(c+a+a), y+2*(c+2*a));
  d := q[n];
  for j := 1 to 7 do begin
    if d and ($80 shr j) = 0 then continue;
    xy[0].x := x + dx[j];
    xy[0].y := y + dy[j];
    for k := 1 to 5 do
      if j < 4 then begin
        xy[k].x := xy[k-1].x + dl[k-1];
        xy[k].y := xy[k-1].y + d2[k-1];
      end else begin
        xy[k].x := xy[k-1].x - d2[k-1];
        xy[k].y := xy[k-1].y + dl[k-1];
      end;
    setfillstyle(1, 14);
    fillpoly(6, xy);
  end;
end;

begin
  gd := 0;
  initgraph(gd, gm, '');
  settextstyle(0, 0, 4);
  setcolor(14);
  outtextxy(136, 44, ':');
  outtextxy(256, 44, ':');
  setcolor(4);
  hi:=100;
  ml:=100;
  sl:=100;
  repeat
    gettime(h2, m2, s2, hs2);
    if hi <> h2 then begin
      k := h2 div 10; cifra(50, 30, k);
      k := h2 mod 10; cifra(100, 30, k);
      hi := h2;
    end;
    if ml <> m2 then begin
      k := m2 div 10; cifra(170, 30, k);
      k := m2 mod 10; cifra(220, 30, k);
      ml := m2;
    end;
    if sl <> s2 then begin
      k := s2 div 10; cifra(290, 30, k);
      k := s2 mod 10; cifra(340, 30, k);
      sl := s2;
    end;
  until KeyPressed;
  closegraph;
end.

[world12_tk]

Спасибо вам Скандербег за исправление. А вот у меня теперь такой вопрос. Как реализовать процедуру, которая рисует одну восьмерку, т.е. первую цифру, а потом вызывать ее для рисования других цифр.... А то препод замучил меня....))?

[world12_tk]

И еще вопросик..... нам преподаватель дал так называемые критерии по написанию процедуры. Говорит, что в каждой процедуре должно быть не более 15 строчек кода. Имеется ввиду все что идет после begin. Не поможете ее разбить? заранее спасибо

[Скандербег]

А черт его знает что здесь можно еще сделать - все, вроде, вылизано.
У препода, наверное, одна сверхзадача: учить самостоятельно мыслить, поэтому и дает установки, которым на практике никто не будет следовать (15 строчек на процедуру - это сильно. Можно же все операторы процедуры в одну строку засандалить. Имел ввиду он, видимо, операторы, а не строчки).
Не знаю, может подсунуть такой вариант. На большее фантазии не хватает. Проблема в том, что процедура gettime возвращает куски времени в разных переменных и тут хоть тресни, а надо по-порядку их использовать (без циклов и пр. оптимизации).

{выше как и было}
...
begin
  bar(x-a, y-a, x+(c+a+a), y+2*(c+2*a));
  d := q[n];
  for j := 1 to 7 do begin
    if d and ($80 shr j) = 0 then continue;
    xy[0].x := x + dx[j];
    xy[0].y := y + dy[j];
    for k := 1 to 5 do
      if j < 4 then begin
        xy[k].x := xy[k-1].x + dl[k-1];
        xy[k].y := xy[k-1].y + d2[k-1];
      end else begin
        xy[k].x := xy[k-1].x - d2[k-1];
        xy[k].y := xy[k-1].y + dl[k-1];
      end;
    setfillstyle(1, 14);
    fillpoly(6, xy);
  end;
end;

procedure Do(tm, pl : Integer)
begin
  setfillstyle(0, 0);
  k := tm div 10; 
  cifra(pl, 30, k);
  k := tm mod 10; 
  cifra(pl+50, 30, k);
end;

begin
  gd := 0;
  initgraph(gd, gm, '');
  settextstyle(0, 0, 4);
  setcolor(14);
  outtextxy(136, 44, ':');
  outtextxy(256, 44, ':');
  setcolor(4);
  hi:=100;
  ml:=100;
  sl:=100;
  repeat
    gettime(h2, m2, s2, hs2);
    if hi <> h2 then begin
      Do(h2, 50);
      hi := h2;
    end;
    if ml <> m2 then begin
      Do(m2, 170);
      ml := m2;
    end;
    if sl <> s2 then begin
      Do(s2, 290);
      sl := s2;
    end;
  until KeyPressed;
  closegraph;
end.

[world12_tk]

А что за процедура DO, что она делает?

[Скандербег]

То что делалось внутри тела самой программы - вызывает прорисовку цифр. Код тела программы на несколько строк сократился, и все дела.
Еще setfillstyle(0, 0); перенесено из процедуры cifra в процедуру Do.
От лукавого все это. Говорю, что программа сделана профессионально и оптимизирована достаточно хорошо, чтобы можно с ней еще что-то сделать (кто поверит, что начинающий ее делал ).

[world12_tk]

да.... есть грешок за этим... просто когда я написал свой вариант, он был не рациональным... И его сказали переделать, а как я незнаю.... Графический режим мы изучаем сами. Кстати вот выложил исходничек своей программы. Мож кому нибудь интересен будет. Еще раз спасибо.

[world12_tk]

Уважаемые форумчанины. препод уже достал с этой задачей. Помогите ее исправить. Моя программа написана по такому принципу.... проверяет условие нужно ли рисовать цифры, а потом их рисует. Он посоветовал каждый раз рисовать цифры.... Как это исправить? вот исходный код:

program kurs4;

uses Crt, Dos, Graph;


procedure FigureDrawing(x, y, n : integer);
type
  a4 = array [0..4] of integer;
  a6 = array [1..7] of byte; const
  a = 4; b = 20; c = a + a + b;
  dl : a4 = (a, b, a, -a, -b);
  d2 : a4 = (-a, 0, a, a, 0);
  dx : a6 = (0, 0, 0, 0, c, 0, c);
  dy : a6 = (0, c, 2*c, 0, 0, c, c);
  q : array[0..9] of byte=
    ($5F, $5, $76, $75, $2D, $79, $7B, $45, $7F, $7D);

var
  xy : array [0..5] of PointType;
  j, k, d : byte;

begin
  setfillstyle(0, 0);
  bar(x-a, y-a, x+(c+a+a), y+2*(c+2*a));
  d := q[n];
  for j := 1 to 7 do begin
    if d and ($80 shr j) = 0 then continue;
    xy[0].x := x + dx[j];
    xy[0].y := y + dy[j];
    for k := 1 to 5 do
      if j < 4 then begin
        xy[k].x := xy[k-1].x + dl[k-1];
        xy[k].y := xy[k-1].y + d2[k-1];
      end else begin
        xy[k].x := xy[k-1].x - d2[k-1];
        xy[k].y := xy[k-1].y + dl[k-1];
      end;
    setfillstyle(1, 14);
    fillpoly(6, xy);
  end;
end;

procedure Initialization(var hi, ml, sl : word);
var
  gd, gm: integer;

begin
  gd := 0;
  initgraph(gd, gm, '');
  hi:=100;
  ml:=100;
  sl:=100;
end;

procedure DrawingOfDividers;
begin
  settextstyle(0, 0, 4);
  setcolor(14);
  outtextxy(136, 44, ':');
  outtextxy(256, 44, ':');
  setcolor(4);
end;

procedure CheckOfHours(h2:word;var hi:word);
var
  k : integer;

begin
  if hi <> h2 then
  begin
    k := h2 div 10; FigureDrawing(50, 30, k);
    k := h2 mod 10; FigureDrawing(100, 30, k);
    hi := h2;
  end;
end;

procedure CheckOfMinutes(m2:word;var ml:word);
var
  k : integer;

begin
  if ml <> m2 then
  begin
    k := m2 div 10; FigureDrawing(170, 30, k);
    k := m2 mod 10; FigureDrawing(220, 30, k);
    ml := m2;
  end;
end;

procedure CheckOfSeconds(s2:word;var sl:word);
var
  k : integer;

begin
  if sl <> s2 then
  begin
    k := s2 div 10; FigureDrawing(290, 30, k);
    k := s2 mod 10; FigureDrawing(340, 30, k);
    sl := s2;
  end;
end;

var
  hi,ml,sl,hs2,h2,m2,s2 : word;

begin
  Initialization(hi,ml,sl);
  DrawingOfDividers;
  repeat
    gettime(h2, m2, s2, hs2);
    CheckOfHours(h2,hi);
    CheckOfMinutes(m2,ml);
    CheckOfSeconds(s2,sl);
  until KeyPressed;
  closegraph;
end.

Заранее благодарен

[CrossPurpose]

Есть вопрос, что означают строчки
q : array[0..9] of byte=
($5F, $5, $76, $75, $2D, $79, $7B, $45, $7F, $7D);

и

if d and ($80 shr j) = 0 then continue;

Объясните пожалуйста на русском языке) как можно проще