Program Madelung;
{$G+,N+,E-,D-}
Uses Graph, CRT;
{$L C:\PROGRA~2\BP70\BIN\EGAVGA.OBJ}
type
  TCoo = record
    x, y, z : Integer;
  end;
const
  Nlay : Byte = 5;
  Color : Integer = 10;
  Sx : Integer = 600 div 7;
  Sy : Integer = 440 div 7;
  Szx : Integer = 13;
  Szy : Integer = 11;
  Xb : Integer = 100;
  Yb : Integer = 60;
var
  P : Pointer;
  D, R, e : Integer;
  Coo : array[1..7*7*7] of TCoo;
  i, j, k : Integer;
  Xmb, Ymb : Integer;
Procedure EGAVGA; External;
Procedure WaitRetrace;Assembler;
asm
             mov  dx, 03DAh
@VRTL1:
             in   al, dx
             test al, 8
             jnz  @VRTL1
@VRTL2:
             in al, dx
             test   al, 8
	     jnz     @VRTL2
             ret
end;
Procedure InitMouse; Assembler;
asm
    mov ax, 0
    int 33h
end;
Procedure ShowMouse; Assembler;
asm
    mov ax, 1
    int 33h
end;
Procedure HideMouse; Assembler;
asm
    mov ax, 2
    int 33h
end;
Function MouseButt : Word; Assembler;
asm
    mov ax, 3
    int 33h
    mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
    mov ax, 3
    int 33h
    mov ax, cx
end;
Function MouseY : Word; Assembler;
asm
    mov ax, 3
    int 33h
    mov ax, dx
end;
Procedure MouseGotoXY(X, Y : Integer); Assembler;
asm
  mov   ax, 4
  mov   cx, word ptr X
  mov   dx, word ptr Y
  int   33h
end;
Function MouseIn(X1,Y1,X2,Y2: Integer): Boolean;
begin
  MouseIn := (MouseX>X1) and (MouseXY1) and (MouseY grOk then
  begin
    WriteLn('Произошла ошибка графики!!!');
    WriteLn(GraphErrorMsg(e));
  end;
  InitMouse;
  Color := Green;
  MoveTo(Xb, Yb);
  SetColor(DarkGray);
  for k := 1 to NLay do
    for j := 1 to NLay do
      begin
        if (k = Nlay div 2 + 1) then SetColor(LightGray);
        MoveTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
        for i := 1 to NLay do
          LineTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
      end;
  SetColor(DarkGray);
  for k := 1 to NLay do
    for i := 1 to NLay do
      begin
        if (k = Nlay div 2 + 1) then SetColor(LightGray);
        MoveTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
        for j := 1 to NLay do
          LineTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
      end;
  SetColor(DarkGray);
  for i := 1 to NLay do
    for j := 1 to NLay do
      begin
        MoveTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
        for k := 1 to NLay do
        begin
         if (k = Nlay div 2 + 1) then SetColor(LightGray);
          LineTo(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy);
        end;
      end;
  for k := 1 to NLay do
    for j := 1 to NLay do
      for i := 1 to NLay do
        begin
          if (k = Nlay div 2 + 1) then Color := LightGreen;
          SetColor(Color+(i+j+k) and 1);
          Circle(Xb+(i-1)*Sx+(k-1)*Szx, Yb+(j-1)*Sy+(k-1)*Szy, 2);
        end;
  Xmb := Xb+(Nlay div 2)*Sx+(Nlay div 2)*Szx;
  Ymb := Yb+(Nlay div 2)*Sy+(Nlay div 2)*Szy;
  ShowMouse;
  SetColor(White);
  While not KeyPressed do
  begin
    if MouseButt = 1 then
    begin
      HideMouse;
      Line(Xmb, Ymb, MouseX, MouseY);
      ShowMouse;
    end;
  end;
  ReadKey;
  CloseGraph;
end.

Назад