home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MCGA#03.ZIP / MCGA03.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-11  |  2.8 KB  |  156 lines
  1. Unit MCGA03;
  2.  
  3. interface
  4.  
  5. Procedure SetGraphMode (Num:Byte);
  6. Procedure SetPixel     (X,Y:Integer;Color:Byte);
  7.  
  8. Procedure LineEqu      (X1,Y1,X2,Y2:Integer;Color:Byte);
  9. Procedure LineIndiv    (X1,Y1,X2,Y2:Integer;Color:Byte);
  10. Procedure Line         (X1,Y1,X2,Y2:Integer;Color:Byte);
  11.  
  12. implementation
  13.  
  14. var
  15.   ScreenWide  :  Integer;
  16.   ScreenAddr  :  Word;
  17.  
  18. Procedure SetGraphMode (Num:Byte);
  19. begin
  20.   asm
  21.     mov al,Num
  22.     mov ah,0
  23.     int 10h
  24.     end;
  25.   Case Num of
  26.     $13 : ScreenWide := 320;
  27.     end;
  28.   ScreenAddr := $A000;
  29. end;
  30.  
  31. Procedure SetPixel (X,Y:Integer;Color:Byte);
  32. begin
  33.   asm
  34.     push ds
  35.     mov  ax,ScreenAddr
  36.     mov  ds,ax
  37.  
  38.     mov  ax,Y
  39.     mov  bx,320
  40.     mul  bx
  41.     mov  bx,X
  42.     add  bx,ax
  43.  
  44.     mov  al,Color
  45.     mov  byte ptr ds:[bx],al
  46.     pop  ds
  47.     end;
  48. end;
  49.  
  50. Procedure LineEqu (X1,Y1,X2,Y2:Integer;Color:Byte);
  51. var
  52.   Slope  :  Real;
  53.   D,X,Y  :  Integer;
  54. begin
  55.   If (X1 = X2) or (Y1 = Y2) then Exit;
  56.   If X1 > X2 then begin
  57.     D  := X1;
  58.     X1 := X2;
  59.     X2 := D;
  60.     D  := Y1;
  61.     Y1 := Y2;
  62.     Y2 := D;
  63.     end;
  64.   Slope := (Y2-Y1)/(X2-X1);
  65.   If Abs(Y2-Y1) > Abs(X2-X1) then begin
  66.     Slope := (X2-X1)/(Y2-Y1);
  67.     For Y := Y1 to X2 do
  68.       SetPixel (Trunc(Slope*(Y-Y1)+X1),Y,Color);
  69.     end
  70.   Else begin
  71.     Slope := (Y2-Y1)/(X2-X1);
  72.     For X := X1 to X2 do
  73.       SetPixel (X,Trunc(Slope*(X-X1)+Y1),Color);
  74.     end;
  75. end;
  76.  
  77. Procedure LineIndiv (X1,Y1,X2,Y2:Integer;Color:Byte);
  78. var
  79.   X,Y,
  80.   YIncr,
  81.   D,DX,DY,
  82.   AIncr,BIncr :  Integer;
  83.   Ofs         :  Word;
  84. begin
  85.   If X1 > X2 then begin
  86.     D  := X1;
  87.     X1 := X2;
  88.     X2 := D;
  89.     D  := Y1;
  90.     Y1 := Y2;
  91.     Y2 := D;
  92.     end;
  93.   If Y2 > Y1 then YIncr :=  1
  94.              else YIncr := -1;
  95.   DX := X2 - X1;
  96.   DY := Abs (Y2-Y1);
  97.   D := 2 * DY - DX;
  98.   AIncr := 2 * (DY - DX);
  99.   BIncr := 2 * DY;
  100.  
  101.   X := X1;
  102.   Y := Y1;
  103.   SetPixel (X,Y,Color);
  104.  
  105.   For X := X1 + 1 to X2 do begin
  106.     If D >= 0 then begin
  107.       Inc (Y,YIncr);
  108.       Inc (D,AIncr);
  109.       end
  110.     Else Inc (D,BIncr);
  111.     SetPixel (X,Y,Color);
  112.     end;
  113. end;
  114.  
  115. Procedure Line (X1,Y1,X2,Y2:Integer;Color:Byte);
  116. var
  117.   I,
  118.   YIncr,
  119.   D,DX,DY,
  120.   AIncr,BIncr :  Integer;
  121.   Ofs         :  Word;
  122. begin
  123.  If X1 > X2 then begin
  124.     D  := X1;
  125.     X1 := X2;
  126.     X2 := D;
  127.     D  := Y1;
  128.     Y1 := Y2;
  129.     Y2 := D;
  130.     end;
  131.   If Y2 > Y1 then YIncr :=  320
  132.              else YIncr := -320;
  133.   DX := X2 - X1;
  134.   DY := Abs (Y2-Y1);
  135.   D := 2 * DY - DX;
  136.   AIncr := 2 * (DY - DX);
  137.   BIncr := 2 * DY;
  138.  
  139.   Ofs := Word(Y1) * 320 + Word(X1);
  140.  
  141.   Mem [$A000:Ofs] := Color;
  142.  
  143.   For I := X1 + 1 to X2 do begin
  144.     If D >= 0 then begin
  145.       Inc (Ofs,YIncr);
  146.       Inc (D,AIncr);
  147.       end
  148.     Else Inc (D,BIncr);
  149.     Inc (Ofs);
  150.     Mem [$A000:Ofs] := Color;
  151.     end;
  152. end;
  153.  
  154. Begin
  155. End.
  156.