old/PAS/CELLS.PAS

Uses Graph,CRT;

Const
  XCen = 320;
  YCen = 240;
Var
  size,Maincolor : byte;
  j,h,gd,gm : integer;

Procedure WriteCell(x,y,color:integer);
Var
 a2,x2,y2 : real;
 i : integer;
Begin
  setcolor(color);
  a2:=0;x2:=x-size/2;y2:=y-sqrt(3*sqr(size)/4);Moveto(round(x2),round(y2));
  for i := 1 to 6 do
    begin
      x2 := x2+cos(a2)*size;
      y2 := y2+sin(a2)*size;
      Lineto(round(x2),round(y2));
      a2 := a2+60*3.14/180;
    end;
End;

Procedure ShowOne(k,color:integer);
Var
  x0,y0,a,dx,dy : real;
  v : array [1..6] of pointtype;
  h,i,num : integer;
  snum : string;
Begin
  a := 30*3.14/180;
  x0 := XCen+(k-1)*(size+round(size*cos(60*3.14/180)));
  y0 := 2*sqrt(3*size*size/4)+YCen+(k-1)*sqrt(3*sqr(size)/4);
  v[1].x := 0;
  v[1].y := round(k*2*sqrt(3*size*size/4)-4*k*sqrt(3*sqr(size)/4));
  num := ((12+(k-2)*6) div 2*(k-1))+2;
  for h := 2 to 6 do
    begin
      v[h].x := round(v[h-1].x+((2*sqrt(3*size*size/4))*k)*cos(a));
      v[h].y := round(v[h-1].y+((2*sqrt(3*size*size/4))*k)*sin(a));
      a:=a+60*3.14/180;
    end;
  v[2].x := -v[2].x;v[3].x := -v[3].x;v[5].x := -v[5].x;v[6].x := -v[6].x;
  for h := 1 to 6 do
   begin
    str(num+(h-1)*k+k-1,snum);
    if (MainColor<>0) then WriteCell(v[h].x+XCen,-v[h].y+Ycen,color)
    else WriteCell(v[h].x+XCen,-v[h].y+Ycen,Random(14)+1);
    IF TextWidth(snum) < 2*sqrt(3*size*size/4) then
    OutTextXY(v[h].x+XCen,-v[h].y+Ycen,snum);
   end;
  if (k<>1) then
  begin
   for h := 1 to 6 do
    begin
     if h = 1 then
      begin
       dx := v[6].x-v[1].x;
       dy := -(v[6].y-v[1].y);
      end
     else
      begin
       dx := v[h-1].x-v[h].x;
       dy := -(v[h-1].y-v[h].y);
      end;
     for i := k-1 downto 1 do
      begin
       Str(num,snum);
       if (MainColor<>0) then
         WriteCell(round(v[h].x+(dx/k*i)+XCen),round(-v[h].y+(dy/k*i))+Ycen,color)
       else WriteCell(round(v[h].x+(dx/k*i)+XCen),round(-v[h].y+(dy/k*i))+Ycen,Random(14)+1);
       IF TextWidth(snum) < 2*sqrt(3*size*size/4) then
       OutTextXY(round(v[h].x+(dx/k*i)+XCen),round(-v[h].y+(dy/k*i))+Ycen,snum);
       inc(num);
      end;
      INc(num);
    end;
  end;
End;{ShowOne}
{----------------------------}
Procedure Start;
Begin
  Gd := Detect;
  InitGraph(Gd, Gm, ' ');
  if GraphResult <> grOk then
  Halt(1);
  SetTextJustify(1,1);
  OutTextXY(XCen,Ycen,'1');
End;

Begin
  Write('Введите размер ячейки: ');
  ReadLn(size);
{  Write('Цвет? (0-нету) ');
  ReadLn(MainColor);}
  MainColor :=0;
  Start;
  for j := 1 to round(GetMaxY/(4*sqrt(3*size*size/4)))-1 do ShowOne(j,j mod 15 + 1);
  ReadKey;
  CloseGraph;
End.