home *** CD-ROM | disk | FTP | other *** search
/ HOT Scene Stuff / hotscenestuffzyklop1996.iso / diskmags / deutsch / blckmail / bm06 / vgrafik.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-30  |  10KB  |  373 lines
  1.  
  2. Unit VGrafik;
  3.  
  4. Interface
  5.  
  6. Uses Crt, Dos, Graph;
  7.  
  8. Type
  9.   Typ1_2   = 1..2;
  10.   Vektor   = Array[1..3] of Integer; {stinknormaler Vektor}
  11.   BVektor  = Array[1..2] of Integer; {Bildschirmvektor}
  12.  
  13. Procedure Let(Var vec: Vektor; x1, x2, x3: Integer);
  14. {Weist einem Vektor drei Koordinaten zu}
  15.  
  16. Procedure AddVec(vec1, vec2: Vektor; Var Ergebnis: Vektor);
  17. {Die Vektoraddition}
  18.  
  19. Procedure SM(vec: Vektor; k: Integer; Var Ergebnis: Vektor);
  20. {Multiplikation eines Vektors mit einer Zahl}
  21.  
  22. Procedure V2B(vec: Vektor; Var bvec: BVektor);
  23. {Umrechnung eines Vektors in Bildschirmkoordinaten}
  24.  
  25. Procedure Plot_Hi(vec: Vektor; Farbe: Word);
  26. {** Durch einen Vektor festgelegten Punkt **}
  27. {** im Modus 640*480/16 Farben setzen     **}
  28.  
  29. Procedure Plot_256(vec: Vektor; Farbe: Byte);
  30. {** Durch einen Vektor festgelegten Punkt **}
  31. {** im Modus 320*200/256 Farben setzen    **}
  32.  
  33. Procedure Line_Hi(vec1, vec2: Vektor; Farbe: Word);
  34. {** Zeichnet eine Linie zwischen zwei Vektorpunkten **}
  35. {** im Modus 640*480/16 Farben **}
  36.  
  37. Procedure Line_256(vec1, vec2: Vektor; Farbe: Word);
  38. {****** Linie im Modus 320*200/256 Farben ******}
  39.  
  40. Procedure SetGFX(Modus: Typ1_2);
  41. {****** Initialisiert den Grafikbildschirm ******}
  42.  
  43. Procedure VecBall_Hi(Mittelpunkt: Vektor; Radius: Integer; Farbe: Byte);
  44. {*** Vektorball im Modus 640*480/16 Farben ***}
  45.  
  46. Procedure VecBall_256(Mittelpunkt: Vektor; Radius: Integer; Farbe: Byte);
  47. {*** Vektorball im Modus 320*200/256 Farben ***}
  48.  
  49.  
  50.  
  51.  
  52. Implementation
  53.  
  54.  
  55. Const
  56.   x_256=320;
  57.   y_256=200;
  58.   Video=$A000;
  59.  
  60.  
  61. Procedure Let(Var vec: Vektor; x1, x2, x3: Integer);
  62. Begin
  63.   vec[1]:=x1;
  64.   vec[2]:=x2;
  65.   vec[3]:=x3;
  66. End;
  67.  
  68.  
  69. Procedure AddVec(vec1, vec2: Vektor; Var Ergebnis: Vektor);
  70. Begin
  71.   Ergebnis[1]:=vec1[1]+vec2[1];
  72.   Ergebnis[2]:=vec1[2]+vec2[2];
  73.   Ergebnis[3]:=vec1[3]+vec2[3];
  74. End;
  75.  
  76.  
  77. Procedure SM(vec: Vektor; k: Integer; Var Ergebnis: Vektor);
  78. Begin
  79.   Ergebnis[1]:=k*vec[1];
  80.   Ergebnis[2]:=k*vec[2];
  81.   Ergebnis[3]:=k*vec[3];
  82. End;
  83.  
  84.  
  85. Procedure V2B(vec: Vektor; Var bvec: BVektor);
  86. {Umrechnung eines Vektors in Bildschirmkoordinaten}
  87. Var
  88.   x, y, z: Integer;
  89. Begin
  90.   x:=vec[1];
  91.   y:=vec[2];
  92.   z:=vec[3];
  93.   bvec[1]:=x-(z div 2);
  94.   bvec[2]:=y-(z div 2);
  95. End;
  96.  
  97.  
  98. Procedure Plot_Hi(vec: Vektor; Farbe: Word);
  99. {** Durch einen Vektor festgelegten Punkt **}
  100. {** im Modus 640*480/16 Farben setzen     **}
  101. Var
  102.   xb, yb: Integer;
  103.   b: BVektor;
  104. Begin
  105.   V2B(vec, b);
  106.   xb:=b[1]+319;
  107.   yb:=240-b[2];
  108.   PutPixel(xb, yb, Farbe);
  109. End;
  110.  
  111.  
  112. Procedure Plot_256(vec: Vektor; Farbe: Byte);
  113. {** Durch einen Vektor festgelegten Punkt **}
  114. {** im Modus 320*200/256 Farben setzen    **}
  115. Var
  116.   xb, yb: Integer;
  117.   b: BVektor;
  118.   Adr: Word;
  119. Begin
  120.   V2B(vec, b);
  121.   xb:=b[1]+159;
  122.   yb:=100-b[2];
  123.   ASM
  124.     MOV AX,Video
  125.     MOV ES,AX
  126.     MOV AX,x_256
  127.     MUL  yb
  128.     MOV  DI,AX
  129.     ADD  DI,xb
  130.     MOV  AH,Farbe
  131.     XCHG ES:[DI],AH
  132.   End;
  133. End;
  134.  
  135.  
  136. Procedure Line_256(vec1, vec2: Vektor; Farbe: Word);
  137. {** Zeichnet eine Linie zwischen zwei Vektorpunkten **}
  138. {** im Modus 320*256/256 Farben **}
  139.  
  140.   Procedure Line_low(x1,y1,x2,y2,col:Integer);
  141.   { ** Linie in 320x200/256 in Pascal }
  142.   var x,y,kriterium,dx,dy,stepx,stepy:integer;
  143.   begin
  144.     dx:=(x2-x1);
  145.     dy:=(y2-y1);
  146.     if dx<0 then dx:=-dx;
  147.     if dy<0 then dy:=-dy;
  148.     if dx=0 then kriterium:=0 else kriterium:=round(-dx/2);
  149.     if x2>x1 then stepx:=1 else stepx:=-1;
  150.     if y2>y1 then stepy:=1 else stepy:=-1;
  151.     x:=x1;y:=y1;mem[$a000:x+y*320]:=col;
  152.     while not ((x=x2)and(y=y2)) do begin
  153.       if kriterium<0 then begin
  154.         x:=x+stepx;kriterium:=kriterium+dy;
  155.       end;
  156.       if (kriterium>=0)and(y<>y2) then begin
  157.         y:=y+stepy;kriterium:=kriterium-dx;
  158.       end;
  159.       mem[$a000:x+y*320]:=col;
  160.     end;
  161.   end;
  162.  
  163. Var
  164.   b1, b2: BVektor;
  165.   xb1, yb1, xb2, yb2: Integer;
  166. Begin
  167.   V2B(vec1, b1);
  168.   V2B(vec2, b2);
  169.   xb1:=b1[1]+319;
  170.   yb1:=240-b1[2];
  171.   xb2:=b2[1]+319;
  172.   yb2:=240-b2[2];
  173.   Line_low(xb1, yb1, xb2, yb2, Farbe);
  174. End;
  175.  
  176. Procedure Line_Hi(vec1, vec2: Vektor; Farbe: Word);
  177. {** Zeichnet eine Linie zwischen zwei Vektorpunkten **}
  178. {** im Modus 640*480/16 Farben **}
  179. Var
  180.   b1, b2: BVektor;
  181.   xb1, yb1, xb2, yb2: Integer;
  182. Begin
  183.   V2B(vec1, b1);
  184.   V2B(vec2, b2);
  185.   xb1:=b1[1]+319;
  186.   yb1:=240-b1[2];
  187.   xb2:=b2[1]+319;
  188.   yb2:=240-b2[2];
  189.   SetColor(Farbe);
  190.   Line(xb1, yb1, xb2, yb2);
  191. End;
  192.  
  193.  
  194. Procedure SetGFX(Modus: Typ1_2);
  195. {****** Initialisiert den Grafikbildschirm ******}
  196. Var
  197.   Driver, Mode: Integer;
  198. Begin
  199.   DetectGraph(Driver, Mode);
  200.   If Driver = VGA then
  201.   Begin
  202.     If Modus = 1 then InitGraph(Driver, Mode, ''); {** 640*480, 16 Farben  **}
  203.     If Modus = 2 then                              {** 320*200, 256 Farben **}
  204.     ASM
  205.       mov ax, $13
  206.       int $10
  207.     End;
  208.   End
  209.   Else
  210.   Begin
  211.     writeln('Sorry, dieses Programm benötigt eine VGA-Karte');
  212.     Halt;
  213.   End;
  214. End;
  215.  
  216.  
  217. Procedure VecBall_Hi(Mittelpunkt: Vektor; Radius: Integer; Farbe: Byte);
  218. {*** Vektorball im Modus 640*480/16 Farben ***}
  219. Var
  220.   xp, yp, zp , xp1, yp1, zp1: Integer;
  221.   Vec1, Vec2 : Vektor;
  222.   s1, s2, step, step1, fak: Real;
  223. Begin
  224.   s1:=0;
  225.   step:=pi/40;
  226.   step1:=pi/20;
  227.   {********************* Gitter 1 ****************************************}
  228.   repeat
  229.     yp:=round(radius*sin(s1))+mittelpunkt[2];
  230.     yp1:=-round(radius*sin(s1))+mittelpunkt[2];
  231.     s2:=0;
  232.     fak:=radius*cos(s1);
  233.     repeat
  234.       xp:=round(sin(s2)*fak)+Mittelpunkt[1];
  235.       zp:=round(cos(s2)*fak)+Mittelpunkt[3];
  236.       Let(Vec1, xp, yp, zp);
  237.       xp1:=round(sin(s2+step1)*fak)+Mittelpunkt[1];
  238.       zp1:=round(cos(s2+step1)*fak)+Mittelpunkt[3];
  239.       Let(Vec2, xp1, yp, zp1);
  240.       Line_hi(vec1, vec2, farbe);
  241.       Let(Vec1, xp, yp1, zp);
  242.       Let(Vec2, xp1, yp1, zp1);
  243.       Line_hi(vec1, vec2, farbe);
  244.       s2:=s2+step1;
  245.     until s2>=pi*2;
  246.     s1:=s1+step;
  247.   until s1>=pi/2;
  248.   {********************* Gitter 2 **************************************}
  249.   s1:=0;
  250.   repeat
  251.     xp:=round(radius*sin(s1))+mittelpunkt[1];
  252.     xp1:=-round(radius*sin(s1))+mittelpunkt[1];
  253.     s2:=0;
  254.     fak:=radius*cos(s1);
  255.     repeat
  256.       yp:=round(sin(s2)*fak)+Mittelpunkt[2];
  257.       zp:=round(cos(s2)*fak)+Mittelpunkt[3];
  258.       Let(Vec1, xp, yp, zp);
  259.       yp1:=round(sin(s2+step1)*fak)+Mittelpunkt[2];
  260.       zp1:=round(cos(s2+step1)*fak)+Mittelpunkt[3];
  261.       Let(Vec2, xp, yp1, zp1);
  262.       Line_hi(vec1, vec2, farbe);
  263.       Let(Vec1, xp1, yp, zp);
  264.       Let(Vec2, xp1, yp1, zp1);
  265.       Line_hi(vec1, vec2, farbe);
  266.       s2:=s2+step1;
  267.     until s2>pi*2;
  268.     s1:=s1+step;
  269.   until s1>=pi/2;
  270.   {************************* Gitter 3 **********************************}
  271.   s1:=0;
  272.   repeat
  273.     zp:=round(radius*sin(s1))+mittelpunkt[3];
  274.     zp1:=-round(radius*sin(s1))+mittelpunkt[3];
  275.     s2:=0;
  276.     fak:=radius*cos(s1);
  277.     repeat
  278.       xp:=round(cos(s2)*fak)+Mittelpunkt[1];
  279.       yp:=round(sin(s2)*fak)+Mittelpunkt[2];
  280.       Let(Vec1, xp, yp, zp);
  281.       xp1:=round(cos(s2+step1)*fak)+Mittelpunkt[1];
  282.       yp1:=round(sin(s2+step1)*fak)+Mittelpunkt[2];
  283.       Let(Vec2, xp1, yp1, zp);
  284.       Line_hi(vec1, vec2, farbe);
  285.       Let(Vec1, xp, yp, zp1);
  286.       Let(Vec2, xp1, yp1, zp1);
  287.       Line_hi(vec1, vec2, farbe);
  288.       s2:=s2+step1;
  289.     until s2>pi*2;
  290.     s1:=s1+step;
  291.   until s1>=pi/2;
  292. End;
  293.  
  294.  
  295. Procedure VecBall_256(Mittelpunkt: Vektor; Radius: Integer; Farbe: Byte);
  296. {*** Vektorball im Modus 320*200/256 Farben ***}
  297. Var
  298.   xp, yp, zp , xp1, yp1, zp1: Integer;
  299.   Vec1, Vec2 : Vektor;
  300.   s1, s2, step, step1, fak: Real;
  301. Begin
  302.   s1:=0;
  303.   step:=pi/40;
  304.   step1:=pi/20;
  305.   {********************* Gitter 1 ****************************************}
  306.   repeat
  307.     yp:=round(radius*sin(s1))+mittelpunkt[2];
  308.     yp1:=-round(radius*sin(s1))+mittelpunkt[2];
  309.     s2:=0;
  310.     fak:=radius*cos(s1);
  311.     repeat
  312.       xp:=round(sin(s2)*fak)+Mittelpunkt[1];
  313.       zp:=round(cos(s2)*fak)+Mittelpunkt[3];
  314.       Let(Vec1, xp, yp, zp);
  315.       xp1:=round(sin(s2+step1)*fak)+Mittelpunkt[1];
  316.       zp1:=round(cos(s2+step1)*fak)+Mittelpunkt[3];
  317.       Let(Vec2, xp1, yp, zp1);
  318.       line_256(vec1, vec2, farbe);
  319.       Let(Vec1, xp, yp1, zp);
  320.       Let(Vec2, xp1, yp1, zp1);
  321.       line_256(vec1, vec2, farbe);
  322.       s2:=s2+step1;
  323.     until s2>=pi*2;
  324.     s1:=s1+step;
  325.   until s1>=pi/2;
  326.   {********************* Gitter 2 **************************************}
  327.   s1:=0;
  328.   repeat
  329.     xp:=round(radius*sin(s1))+mittelpunkt[1];
  330.     xp1:=-round(radius*sin(s1))+mittelpunkt[1];
  331.     s2:=0;
  332.     fak:=radius*cos(s1);
  333.     repeat
  334.       yp:=round(sin(s2)*fak)+Mittelpunkt[2];
  335.       zp:=round(cos(s2)*fak)+Mittelpunkt[3];
  336.       Let(Vec1, xp, yp, zp);
  337.       yp1:=round(sin(s2+step1)*fak)+Mittelpunkt[2];
  338.       zp1:=round(cos(s2+step1)*fak)+Mittelpunkt[3];
  339.       Let(Vec2, xp, yp1, zp1);
  340.       line_256(vec1, vec2, farbe);
  341.       Let(Vec1, xp1, yp, zp);
  342.       Let(Vec2, xp1, yp1, zp1);
  343.       line_256(vec1, vec2, farbe);
  344.       s2:=s2+step1;
  345.     until s2>pi*2;
  346.     s1:=s1+step;
  347.   until s1>=pi/2;
  348.   {************************* Gitter 3 **********************************}
  349.   s1:=0;
  350.   repeat
  351.     zp:=round(radius*sin(s1))+mittelpunkt[3];
  352.     zp1:=-round(radius*sin(s1))+mittelpunkt[3];
  353.     s2:=0;
  354.     fak:=radius*cos(s1);
  355.     repeat
  356.       xp:=round(cos(s2)*fak)+Mittelpunkt[1];
  357.       yp:=round(sin(s2)*fak)+Mittelpunkt[2];
  358.       Let(Vec1, xp, yp, zp);
  359.       xp1:=round(cos(s2+step1)*fak)+Mittelpunkt[1];
  360.       yp1:=round(sin(s2+step1)*fak)+Mittelpunkt[2];
  361.       Let(Vec2, xp1, yp1, zp);
  362.       line_256(vec1, vec2, farbe);
  363.       Let(Vec1, xp, yp, zp1);
  364.       Let(Vec2, xp1, yp1, zp1);
  365.       line_256(vec1, vec2, farbe);
  366.       s2:=s2+step1;
  367.     until s2>pi*2;
  368.     s1:=s1+step;
  369.   until s1>=pi/2;
  370. End;
  371.  
  372.  
  373. End.