home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ANIVGA11.ZIP / GRAB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-14  |  45.7 KB  |  1,614 lines
  1. {$UNDEF Test}
  2.  
  3. {$B-,F-,I+,R-,S+,X+}
  4.  
  5. {$IFDEF Test}
  6.  {$M 2048,0,15000}
  7. {$ELSE}
  8.  {$M 2048,0,0}
  9. {$ENDIF}
  10.  
  11. PROGRAM GrabSprite;
  12.  
  13. {$IFDEF Test}
  14. USES Graph,Dos,Crt;
  15. {$ELSE}
  16. USES Crt,Dos,TSR6;
  17. {$ENDIF}
  18. CONST maxwidth=38*4;      {Workarea; gerade so gross gewaehlt, dass die Daten}
  19.       maxheight=maxwidth; {noch von MAKES weiterverarbeitet werden koennen}
  20.  
  21.       Datenbytes=maxheight*succ(pred(maxwidth) div 4)*4;
  22.       Kopf=50; {Größe des folgenden Spriteheaders in Bytes (ohne Data-Feld):}
  23.  
  24.       BackGndMode : BOOLEAN = FALSE;  {Sprites oder Hintergrund einfangen?}
  25.  
  26. TYPE sprite_typ= record case Integer of
  27.       0:(
  28.          Zeiger_auf_Plane:Array[0..3] OF Word;   {Diese...}
  29.          Breite_in_4er_Gruppen:WORD;             {...Daten}
  30.          Hoehe_in_Zeilen:WORD;                   {...brauchen}
  31.          Translate:Array[1..4] OF Byte;          {...alles}
  32.          SpriteLength:WORD;
  33.          Dummy:Array[1..10] OF Word;             {...zusammen}
  34.          Kennung:ARRAY[1..2] OF CHAR;
  35.          Version:BYTE;
  36.          Modus:BYTE;
  37.          ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;   {"Kopf" Bytes!}
  38.          Data:Array[1..Datenbytes] OF Byte;
  39.         );
  40.       1:(
  41.          readin:Array[0..(Datenbytes-1)  {max. Größe der Planedaten}
  42.                       +(maxwidth*2)*2    {dto., Y-Grenzen (2 Wort-Tabellen)}
  43.                       +(maxheight*2)*2   {dto., X-Gr. (auch Worteinträge)}
  44.                       +Kopf] OF Byte;    {Zeiger am Anfang, immer!}
  45.         )
  46.      END;
  47.     PlotXYProc  =PROCEDURE (x,y:INTEGER);
  48.     GetDotXYFunc=FUNCTION (x,y:INTEGER):BYTE;
  49.     GraphicMode=RECORD
  50.                  x,y:INTEGER;
  51.                  m  :BYTE;
  52.                  put:PlotXYProc;
  53.                  get:GetDotXYFunc
  54.                 END;
  55.  
  56.  
  57. VAR PlotXY   : PlotXYProc;
  58.     GetDotXY : GetDotXYFunc;
  59.     sprite   : Sprite_Typ;
  60.     mask: BYTE;
  61.     temp,Zugriff:BYTE;
  62.     maxx,maxy,
  63.     deltax,deltay,
  64.     breite,hoehe,
  65.     x1,y1,x2,y2,
  66.     x1old,y1old,x2old,y2old:INTEGER;
  67.     MB:WORD;  {zum auslesen der Mausbuttons}
  68.  
  69.     mode   : BYTE ABSOLUTE $40:$49;  {aktueller Grafikmodus}
  70.     page   : BYTE ABSOLUTE $40:$62;  {aktuelle Grafikseite}
  71.     pageadr: WORD; {Startadresse davon, wird aus VGA direkt ausgelesen}
  72.  
  73.     CRTAddress, {Adresse des CRT-Ports, $3B4/$3D4 fuer monochrom/Farbe}
  74.     StatusReg:WORD;  {dto., fuer Statusregister, $3BA/$3DA}
  75.  
  76. {-----Maus: -----------------------------}
  77. CONST NoButton=0;    {Ergebniswerte von MouseButtons fuer: kein...,}
  78.       LeftButton=1;  {...nur der linke,}
  79.       RightButton=2; {...nur der rechte,}
  80.       BothButtons=3; {...beide Mausbuttons gedrueckt}
  81.       SaveArea=1000; {benoetigter Speicher (ca.) , um Mausstatus zu retten}
  82. VAR SaveMouseArea:ARRAY[1..SaveArea] OF BYTE;
  83.  
  84. FUNCTION InitMouse(VAR buttons:WORD):BOOLEAN; ASSEMBLER;
  85. { in: - }
  86. {out: buttons = Anzahl Buttons,}
  87. {     TRUE/FALSE fuer Maus da/nich da}
  88. {rem: Routine muss zu Beginn aufgerufen werden!}
  89. ASM
  90.   XOR AX,AX
  91.   INT $33
  92.   LES DI,buttons
  93.   MOV ES:[DI],BX
  94.   NEG AX
  95. END;
  96.  
  97. PROCEDURE ResetMouse; ASSEMBLER;
  98. { in: - }
  99. {out: - }
  100. {rem: versetzt die Maus in ihren Initialisierungszustand}
  101. ASM
  102.   XOR AX,AX
  103.   INT $33
  104. END;
  105.  
  106. FUNCTION MouseButtons:WORD; ASSEMBLER;
  107. { in: - }
  108. {out: Zustand der Buttons, in Bit 0&1 codiert}
  109. ASM
  110.   MOV AX,3
  111.   INT $33
  112.   MOV AX,BX
  113.   AND AX,3
  114. END;
  115.  
  116. PROCEDURE GetMouseMovement(VAR deltax,deltay:INTEGER); ASSEMBLER;
  117. { in: - }
  118. {out: deltax,deltay = relative Bewegung der Maus seit dem letzten Aufruf}
  119. ASM
  120.   MOV AX,$B
  121.   INT $33
  122.   LES DI,deltax
  123.   MOV ES:[DI],CX
  124.   LES DI,deltay
  125.   MOV ES:[DI],DX
  126. END;
  127.  
  128. FUNCTION MemToStoreMouseState:WORD; ASSEMBLER;
  129. ASM
  130.   MOV AX,$15
  131.   INT $33
  132.   MOV AX,BX
  133. END;
  134.  
  135. PROCEDURE SaveMouse; ASSEMBLER;
  136. { in: - }
  137. {out: - }
  138. {rem: Mausstatus wurde in "SaveMouseArea" gerettet}
  139. {     Dieses Feld muss gross genug sein, um diese Infos aufnehmen zu koennen}
  140. ASM
  141.   MOV AX,$16
  142.   MOV DX,OFFSET SaveMouseArea
  143.   PUSH DS
  144.   POP ES
  145.   INT $33
  146. END;
  147.  
  148. PROCEDURE RestoreMouse; ASSEMBLER;
  149. { in: SaveMouseArea enthaelt alten Mauszustand}
  150. {out: - }
  151. {rem: alter Mauszustand wurde wiederhergestellt}
  152. ASM
  153.   MOV AX,$17
  154.   MOV DX,OFFSET SaveMouseArea
  155.   PUSH DS
  156.   POP ES
  157.   INT $33
  158. END;
  159.  
  160. {-----Palette: --------------------------}
  161. TYPE PaletteEntry=RECORD red,green,blue:BYTE END;
  162.      BigPalette=ARRAY[0..255] OF PaletteEntry;
  163.      PalettePtr=^BigPalette;
  164.      SmallPalette=ARRAY[0..15] OF BYTE;
  165. CONST DefaultColors:BigPalette=    {Defaultfarben-Palette des 256-Farbmodus}
  166.  (                                 {ausgelesen mithilfe des BIOS-Aufrufs:  }
  167.   (red:  0; green:  0; blue:  0),  { MOV AX,1017h ;lese Palettenregister}
  168.   (red:  0; green:  0; blue: 42),  { XOR BX,BX    ;von Farbe 0 an }
  169.   (red:  0; green: 42; blue:  0),  { MOV CX,100h  ;alle 256 Farben}
  170.   (red:  0; green: 42; blue: 42),  { LES DX,Ziel  ;nach ES:DX }
  171.   (red: 42; green:  0; blue:  0),  { INT 10h }
  172.   (red: 42; green:  0; blue: 42),  {Achtung! Die Werte koenn(t)en nur dann }
  173.   (red: 42; green: 21; blue:  0),  {ausgelesen werden, wenn der Grafikmodus}
  174.   (red: 42; green: 42; blue: 42),  {bereits aktiv ist, deshalb wurden sie  }
  175.   (red: 21; green: 21; blue: 21),  {hier "statisch" aufgenommen!}
  176.   (red: 21; green: 21; blue: 63),
  177.   (red: 21; green: 63; blue: 21),
  178.   (red: 21; green: 63; blue: 63),
  179.   (red: 63; green: 21; blue: 21),
  180.   (red: 63; green: 21; blue: 63),
  181.   (red: 63; green: 63; blue: 21),
  182.   (red: 63; green: 63; blue: 63),
  183.   (red:  0; green:  0; blue:  0),
  184.   (red:  5; green:  5; blue:  5),
  185.   (red:  8; green:  8; blue:  8),
  186.   (red: 11; green: 11; blue: 11),
  187.   (red: 14; green: 14; blue: 14),
  188.   (red: 17; green: 17; blue: 17),
  189.   (red: 20; green: 20; blue: 20),
  190.   (red: 24; green: 24; blue: 24),
  191.   (red: 28; green: 28; blue: 28),
  192.   (red: 32; green: 32; blue: 32),
  193.   (red: 36; green: 36; blue: 36),
  194.   (red: 40; green: 40; blue: 40),
  195.   (red: 45; green: 45; blue: 45),
  196.   (red: 50; green: 50; blue: 50),
  197.   (red: 56; green: 56; blue: 56),
  198.   (red: 63; green: 63; blue: 63),
  199.   (red:  0; green:  0; blue: 63),
  200.   (red: 16; green:  0; blue: 63),
  201.   (red: 31; green:  0; blue: 63),
  202.   (red: 47; green:  0; blue: 63),
  203.   (red: 63; green:  0; blue: 63),
  204.   (red: 63; green:  0; blue: 47),
  205.   (red: 63; green:  0; blue: 31),
  206.   (red: 63; green:  0; blue: 16),
  207.   (red: 63; green:  0; blue:  0),
  208.   (red: 63; green: 16; blue:  0),
  209.   (red: 63; green: 31; blue:  0),
  210.   (red: 63; green: 47; blue:  0),
  211.   (red: 63; green: 63; blue:  0),
  212.   (red: 47; green: 63; blue:  0),
  213.   (red: 31; green: 63; blue:  0),
  214.   (red: 16; green: 63; blue:  0),
  215.   (red:  0; green: 63; blue:  0),
  216.   (red:  0; green: 63; blue: 16),
  217.   (red:  0; green: 63; blue: 31),
  218.   (red:  0; green: 63; blue: 47),
  219.   (red:  0; green: 63; blue: 63),
  220.   (red:  0; green: 47; blue: 63),
  221.   (red:  0; green: 31; blue: 63),
  222.   (red:  0; green: 16; blue: 63),
  223.   (red: 31; green: 31; blue: 63),
  224.   (red: 39; green: 31; blue: 63),
  225.   (red: 47; green: 31; blue: 63),
  226.   (red: 55; green: 31; blue: 63),
  227.   (red: 63; green: 31; blue: 63),
  228.   (red: 63; green: 31; blue: 55),
  229.   (red: 63; green: 31; blue: 47),
  230.   (red: 63; green: 31; blue: 39),
  231.   (red: 63; green: 31; blue: 31),
  232.   (red: 63; green: 39; blue: 31),
  233.   (red: 63; green: 47; blue: 31),
  234.   (red: 63; green: 55; blue: 31),
  235.   (red: 63; green: 63; blue: 31),
  236.   (red: 55; green: 63; blue: 31),
  237.   (red: 47; green: 63; blue: 31),
  238.   (red: 39; green: 63; blue: 31),
  239.   (red: 31; green: 63; blue: 31),
  240.   (red: 31; green: 63; blue: 39),
  241.   (red: 31; green: 63; blue: 47),
  242.   (red: 31; green: 63; blue: 55),
  243.   (red: 31; green: 63; blue: 63),
  244.   (red: 31; green: 55; blue: 63),
  245.   (red: 31; green: 47; blue: 63),
  246.   (red: 31; green: 39; blue: 63),
  247.   (red: 45; green: 45; blue: 63),
  248.   (red: 49; green: 45; blue: 63),
  249.   (red: 54; green: 45; blue: 63),
  250.   (red: 58; green: 45; blue: 63),
  251.   (red: 63; green: 45; blue: 63),
  252.   (red: 63; green: 45; blue: 58),
  253.   (red: 63; green: 45; blue: 54),
  254.   (red: 63; green: 45; blue: 49),
  255.   (red: 63; green: 45; blue: 45),
  256.   (red: 63; green: 49; blue: 45),
  257.   (red: 63; green: 54; blue: 45),
  258.   (red: 63; green: 58; blue: 45),
  259.   (red: 63; green: 63; blue: 45),
  260.   (red: 58; green: 63; blue: 45),
  261.   (red: 54; green: 63; blue: 45),
  262.   (red: 49; green: 63; blue: 45),
  263.   (red: 45; green: 63; blue: 45),
  264.   (red: 45; green: 63; blue: 49),
  265.   (red: 45; green: 63; blue: 54),
  266.   (red: 45; green: 63; blue: 58),
  267.   (red: 45; green: 63; blue: 63),
  268.   (red: 45; green: 58; blue: 63),
  269.   (red: 45; green: 54; blue: 63),
  270.   (red: 45; green: 49; blue: 63),
  271.   (red:  0; green:  0; blue: 28),
  272.   (red:  7; green:  0; blue: 28),
  273.   (red: 14; green:  0; blue: 28),
  274.   (red: 21; green:  0; blue: 28),
  275.   (red: 28; green:  0; blue: 28),
  276.   (red: 28; green:  0; blue: 21),
  277.   (red: 28; green:  0; blue: 14),
  278.   (red: 28; green:  0; blue:  7),
  279.   (red: 28; green:  0; blue:  0),
  280.   (red: 28; green:  7; blue:  0),
  281.   (red: 28; green: 14; blue:  0),
  282.   (red: 28; green: 21; blue:  0),
  283.   (red: 28; green: 28; blue:  0),
  284.   (red: 21; green: 28; blue:  0),
  285.   (red: 14; green: 28; blue:  0),
  286.   (red:  7; green: 28; blue:  0),
  287.   (red:  0; green: 28; blue:  0),
  288.   (red:  0; green: 28; blue:  7),
  289.   (red:  0; green: 28; blue: 14),
  290.   (red:  0; green: 28; blue: 21),
  291.   (red:  0; green: 28; blue: 28),
  292.   (red:  0; green: 21; blue: 28),
  293.   (red:  0; green: 14; blue: 28),
  294.   (red:  0; green:  7; blue: 28),
  295.   (red: 14; green: 14; blue: 28),
  296.   (red: 17; green: 14; blue: 28),
  297.   (red: 21; green: 14; blue: 28),
  298.   (red: 24; green: 14; blue: 28),
  299.   (red: 28; green: 14; blue: 28),
  300.   (red: 28; green: 14; blue: 24),
  301.   (red: 28; green: 14; blue: 21),
  302.   (red: 28; green: 14; blue: 17),
  303.   (red: 28; green: 14; blue: 14),
  304.   (red: 28; green: 17; blue: 14),
  305.   (red: 28; green: 21; blue: 14),
  306.   (red: 28; green: 24; blue: 14),
  307.   (red: 28; green: 28; blue: 14),
  308.   (red: 24; green: 28; blue: 14),
  309.   (red: 21; green: 28; blue: 14),
  310.   (red: 17; green: 28; blue: 14),
  311.   (red: 14; green: 28; blue: 14),
  312.   (red: 14; green: 28; blue: 17),
  313.   (red: 14; green: 28; blue: 21),
  314.   (red: 14; green: 28; blue: 24),
  315.   (red: 14; green: 28; blue: 28),
  316.   (red: 14; green: 24; blue: 28),
  317.   (red: 14; green: 21; blue: 28),
  318.   (red: 14; green: 17; blue: 28),
  319.   (red: 20; green: 20; blue: 28),
  320.   (red: 22; green: 20; blue: 28),
  321.   (red: 24; green: 20; blue: 28),
  322.   (red: 26; green: 20; blue: 28),
  323.   (red: 28; green: 20; blue: 28),
  324.   (red: 28; green: 20; blue: 26),
  325.   (red: 28; green: 20; blue: 24),
  326.   (red: 28; green: 20; blue: 22),
  327.   (red: 28; green: 20; blue: 20),
  328.   (red: 28; green: 22; blue: 20),
  329.   (red: 28; green: 24; blue: 20),
  330.   (red: 28; green: 26; blue: 20),
  331.   (red: 28; green: 28; blue: 20),
  332.   (red: 26; green: 28; blue: 20),
  333.   (red: 24; green: 28; blue: 20),
  334.   (red: 22; green: 28; blue: 20),
  335.   (red: 20; green: 28; blue: 20),
  336.   (red: 20; green: 28; blue: 22),
  337.   (red: 20; green: 28; blue: 24),
  338.   (red: 20; green: 28; blue: 26),
  339.   (red: 20; green: 28; blue: 28),
  340.   (red: 20; green: 26; blue: 28),
  341.   (red: 20; green: 24; blue: 28),
  342.   (red: 20; green: 22; blue: 28),
  343.   (red:  0; green:  0; blue: 16),
  344.   (red:  4; green:  0; blue: 16),
  345.   (red:  8; green:  0; blue: 16),
  346.   (red: 12; green:  0; blue: 16),
  347.   (red: 16; green:  0; blue: 16),
  348.   (red: 16; green:  0; blue: 12),
  349.   (red: 16; green:  0; blue:  8),
  350.   (red: 16; green:  0; blue:  4),
  351.   (red: 16; green:  0; blue:  0),
  352.   (red: 16; green:  4; blue:  0),
  353.   (red: 16; green:  8; blue:  0),
  354.   (red: 16; green: 12; blue:  0),
  355.   (red: 16; green: 16; blue:  0),
  356.   (red: 12; green: 16; blue:  0),
  357.   (red:  8; green: 16; blue:  0),
  358.   (red:  4; green: 16; blue:  0),
  359.   (red:  0; green: 16; blue:  0),
  360.   (red:  0; green: 16; blue:  4),
  361.   (red:  0; green: 16; blue:  8),
  362.   (red:  0; green: 16; blue: 12),
  363.   (red:  0; green: 16; blue: 16),
  364.   (red:  0; green: 12; blue: 16),
  365.   (red:  0; green:  8; blue: 16),
  366.   (red:  0; green:  4; blue: 16),
  367.   (red:  8; green:  8; blue: 16),
  368.   (red: 10; green:  8; blue: 16),
  369.   (red: 12; green:  8; blue: 16),
  370.   (red: 14; green:  8; blue: 16),
  371.   (red: 16; green:  8; blue: 16),
  372.   (red: 16; green:  8; blue: 14),
  373.   (red: 16; green:  8; blue: 12),
  374.   (red: 16; green:  8; blue: 10),
  375.   (red: 16; green:  8; blue:  8),
  376.   (red: 16; green: 10; blue:  8),
  377.   (red: 16; green: 12; blue:  8),
  378.   (red: 16; green: 14; blue:  8),
  379.   (red: 16; green: 16; blue:  8),
  380.   (red: 14; green: 16; blue:  8),
  381.   (red: 12; green: 16; blue:  8),
  382.   (red: 10; green: 16; blue:  8),
  383.   (red:  8; green: 16; blue:  8),
  384.   (red:  8; green: 16; blue: 10),
  385.   (red:  8; green: 16; blue: 12),
  386.   (red:  8; green: 16; blue: 14),
  387.   (red:  8; green: 16; blue: 16),
  388.   (red:  8; green: 14; blue: 16),
  389.   (red:  8; green: 12; blue: 16),
  390.   (red:  8; green: 10; blue: 16),
  391.   (red: 11; green: 11; blue: 16),
  392.   (red: 12; green: 11; blue: 16),
  393.   (red: 13; green: 11; blue: 16),
  394.   (red: 15; green: 11; blue: 16),
  395.   (red: 16; green: 11; blue: 16),
  396.   (red: 16; green: 11; blue: 15),
  397.   (red: 16; green: 11; blue: 13),
  398.   (red: 16; green: 11; blue: 12),
  399.   (red: 16; green: 11; blue: 11),
  400.   (red: 16; green: 12; blue: 11),
  401.   (red: 16; green: 13; blue: 11),
  402.   (red: 16; green: 15; blue: 11),
  403.   (red: 16; green: 16; blue: 11),
  404.   (red: 15; green: 16; blue: 11),
  405.   (red: 13; green: 16; blue: 11),
  406.   (red: 12; green: 16; blue: 11),
  407.   (red: 11; green: 16; blue: 11),
  408.   (red: 11; green: 16; blue: 12),
  409.   (red: 11; green: 16; blue: 13),
  410.   (red: 11; green: 16; blue: 15),
  411.   (red: 11; green: 16; blue: 16),
  412.   (red: 11; green: 15; blue: 16),
  413.   (red: 11; green: 13; blue: 16),
  414.   (red: 11; green: 12; blue: 16),
  415.   (red:  0; green:  0; blue:  0),
  416.   (red:  0; green:  0; blue:  0),
  417.   (red:  0; green:  0; blue:  0),
  418.   (red:  0; green:  0; blue:  0),
  419.   (red:  0; green:  0; blue:  0),
  420.   (red:  0; green:  0; blue:  0),
  421.   (red:  0; green:  0; blue:  0),
  422.   (red:  0; green:  0; blue:  0)
  423.  );
  424.  
  425. VAR ActualColors:BigPalette;
  426.     oldColor,newColor:PaletteEntry;
  427.     i,b,dummy:BYTE;
  428.     palette:SmallPalette;
  429.  
  430. PROCEDURE GetBigPalette(VAR pal:BigPalette); ASSEMBLER;
  431. { in: pal = Zeiger auf Palette-Speicher}
  432. {out: pal = momentan aktueller Inhalt der 256-Farben CLUT}
  433. ASM
  434.    CLI
  435.    XOR AL,AL
  436.    MOV DX,3C7h
  437.    OUT DX,AL
  438.    LES DI,pal
  439.    MOV CX,768
  440.    MOV DX,3C9h
  441.   @L1:
  442.    IN AL,DX
  443.    STOSB
  444.    LOOP @L1
  445.    STI
  446. END;
  447.  
  448. PROCEDURE GetSmallPalette(VAR pal:SmallPalette); ASSEMBLER;
  449. { in: pal = Zeiger auf Palette-Speicher}
  450. {out: pal = momentan aktueller Inhalt der 16-Farben Palette}
  451. ASM
  452.   cli
  453.   mov bx,15
  454.   les di,pal
  455.  @L1:
  456.   mov dx,StatusReg
  457.   in al,dx
  458.   mov dx,3c0h
  459.   mov al,bl
  460.   out dx,al
  461.   inc dx
  462.   in al,dx
  463.   dec dx
  464.   mov es:[di+bx],al
  465.   mov dx,StatusReg
  466.   in al,dx
  467.   mov dx,3c0h
  468.   mov al,20h
  469.   out dx,al
  470.   dec bx
  471.   jns @L1
  472.   sti
  473. END;
  474.  
  475. PROCEDURE ConvertToDACValues(pal:SmallPalette; n:BYTE; VAR Colors:BigPalette);
  476. { in: pal   = Farbpalette}
  477. {     n     = groesster benutzter Farbindex in "pal"}
  478. {     Colors= aktueller Inhalt der 256 CLUT-Register als RGB-Tripel}
  479. {out: Colors[0..n]=wirklich benutzte RGB-Tripel}
  480. VAR i:BYTE;
  481.     temp:BigPalette;
  482. BEGIN
  483.  FOR i:=0 TO n DO temp[i]:=Colors[pal[i]];
  484.  FOR i:=0 TO n DO Colors[i]:=temp[i]
  485. END;
  486.  
  487. {----------------------------------------}
  488.  
  489. PROCEDURE swap(VAR x,y:INTEGER);
  490. VAR t:INTEGER;
  491. BEGIN
  492.  t:=x; x:=y; y:=t
  493. END;
  494.  
  495. FUNCTION NormalMode13hGetDot(x,y:INTEGER):BYTE; FAR; ASSEMBLER;
  496. { in: (x,y)  = Punktkoordinaten des auszulesenden Punktes }
  497. {out: Farbwert des Punkte über eine schnelle Routine      }
  498. ASM
  499.   cli
  500.   mov ax,320
  501.   mul y
  502.   mov bx,x
  503.   add bx,ax
  504.   mov ax,$A000
  505.   mov es,ax
  506.   mov al,es:[bx]
  507.   xor ah,ah
  508.   sti
  509. END;
  510.  
  511. FUNCTION CGAGetDot(x,y:INTEGER):BYTE; FAR; ASSEMBLER;
  512. { in: (x,y)  = Punktkoordinaten des auszulesenden Punktes }
  513. {     mask   = Farben, die der aktive Grafikmodus unter-  }
  514. {              stützt minus 1 (als Maske für AND-Befehl)  }
  515. {     maxx   = max. X-Koordinate (319 oder 639)           }
  516. {out: Farbwert des Punkte über eine schnelle Routine      }
  517. ASM
  518.   cli
  519.   mov ax,0B800h {CGA-Adresse beginnt immer bei $B8000}
  520.   mov es,ax
  521.   mov cx,y
  522.   mov dx,x
  523.  
  524.   xor bx,bx     {0 = Offset für ungerade Zeilen}
  525.   test cl,1     {gerade Zeile?}
  526.   jz @evenRow   {nein}
  527.   mov bx,2000h  {ja, Offset dafür laden}
  528. @evenRow:
  529.   shr cx,1
  530.   mov al,80
  531.   mul cl        {AX = (y div 2) * 80 }
  532.  
  533.   mov cx,dx
  534.   not cl
  535.   and cl,mask
  536.   shl cl,1      {CL = Bitposition}
  537.  
  538.   shr dx,1
  539.   shr dx,1
  540.   cmp maxx,319  {eine der mittleren Auflösungen (320x200)?}
  541.   jbe @L1       {ja, nur durch 4 teilen}
  542.   shr dx,1      {nein, 640x200, deshalb durch 8 teilen}
  543. @L1:
  544.  
  545.   add ax,dx
  546.   add bx,ax     {ES:BX = Zeiger auf Punktadresse}
  547.  
  548.   mov al,es:[bx]
  549.   ror al,cl     {relevante Bits isolieren}
  550.   and al,mask   {Rest löschen}
  551.  
  552.   xor ah,ah     {sicher ist sicher!}
  553.   sti
  554. END;
  555.  
  556.  
  557. FUNCTION EGAVGAGetDot(x,y:INTEGER):BYTE; FAR; ASSEMBLER;
  558. { in: (x,y)  = Punktkoordinaten des auszulesenden Punktes }
  559. {     pageadr= Offsetadresse der aktuellen Grafikseite    }
  560. {     mask   = Farben, die der aktive Grafikmodus unter-  }
  561. {              stützt minus 1 (als Maske für AND-Befehl)  }
  562. {              (ist für diese Modi immer = $F)            }
  563. {out: Farbwert des Punkte über eine schnelle Routine      }
  564. ASM
  565.   cli
  566.   mov dx,3ceh
  567.   mov al,5      {Modusregister...}
  568.   out dx,al
  569.   inc dx
  570.   in al,dx      {...retten}
  571.   push ax
  572.   mov al,0
  573.   out dx,al     {readmode 0 setzen}
  574.  
  575.   dec dx
  576.   mov al,4      {map select Register...}
  577.   out dx,al
  578.   inc dx
  579.   in al,dx
  580.   push ax       {...retten}
  581.  
  582.   mov bx,x
  583.   mov cx,bx
  584.   and cl,7
  585.   xor cl,7      {CL=7-(x mod 8)}
  586.   mov ch,1
  587.   shl ch,cl     {CH=Bitmaske}
  588.  
  589.   mov ax,80
  590.   mul y
  591.   shr bx,1
  592.   shr bx,1
  593.   shr bx,1
  594.   add bx,ax
  595.   add bx,pageadr
  596.   mov ax,$A000
  597.   mov es,ax     {ES:BX = Punktadresse}
  598.  
  599.   mov ah,3      {Startplane}
  600.   mov dx,3cfh
  601. @L1:
  602.   mov al,ah
  603.   out dx,al
  604.   mov al,es:[bx]
  605.   shl cl,1
  606.   and al,ch     {Punkt gesetzt?}
  607.   jz @L2        {nein}
  608.   or cl,1       {ja, merken}
  609. @L2:
  610.   dec ah        {nächste Plane}
  611.   jge @L1
  612.   and cl,mask   {cl=Ergebnisfarbe}
  613.  
  614.   pop ax
  615.   out dx,al     {map select Register wiederherstellen}
  616.   dec dx
  617.   mov al,5      {Modusregister auch}
  618.   out dx,al
  619.   inc dx
  620.   pop ax
  621.   out dx,al
  622.  
  623.   mov al,cl     {Ergebnis muß in AX stehen}
  624.   xor ah,ah     {sicher ist sicher!}
  625.   sti
  626. END;
  627.  
  628. FUNCTION BiosGetDot(x,y:INTEGER):BYTE; FAR; ASSEMBLER;
  629. { in: (x,y) = Punktkoordinaten des auszulesenden Punktes  }
  630. {     page  = Grafikseite, auf der sich der Punkt befindet}
  631. {     mask  = Farben, die der aktive Grafikmodus unter-   }
  632. {             stützt minus 1 (als Maske für AND-Befehl)   }
  633. {out: Farbwert des Punkte über einen BIOS-Aufruf}
  634. ASM
  635.   mov ah,$0D
  636.   mov bh,page
  637.   mov cx,x
  638.   mov dx,y
  639.   push ds
  640.   push bp
  641.   int $10
  642.   pop bp
  643.   pop ds
  644.   and al,mask
  645. END;
  646.  
  647. FUNCTION SpecialMode13hGetDot(x,y:INTEGER):BYTE; FAR;
  648. { in: (x,y) = Punktkoordinaten}
  649. {out: Farbwert dieses Punktes }
  650. {rem: Diese Routine ist ausschließlich für den eigenen,   }
  651. {     320x200x256x4 - Grafikmodus entwickelt, den das BIOS}
  652. {     nicht kennt!}
  653. VAR Offset,Adresse:Word;
  654.     Plane,temp :Byte;
  655. BEGIN
  656.  ASM
  657.     CLI
  658.     MOV DX,CRTAddress {Bildschirmstartadresse auslesen}
  659.     MOV AL,0Ch
  660.     OUT DX,AL
  661.     INC DX
  662.     IN AL,DX
  663.     MOV AH,AL
  664.     DEC DX
  665.     MOV AL,0Dh
  666.     OUT DX,AL
  667.     INC DX
  668.     IN AL,DX
  669.     MOV Adresse,AX
  670.     STI
  671.  END;
  672.  
  673.  Offset:=y*80+(x shr 2);
  674.  Plane :=(x and 3);
  675.  portw[$3CE]:=4 +(plane shl 8);
  676.  SpecialMode13hGetDot:=mem[$A000:Adresse+Offset];
  677. END;
  678.  
  679. PROCEDURE NormalMode13hXORDot(x,y:INTEGER); FAR; ASSEMBLER;
  680. { in: (x,y)  = Koordinaten des zu invertierenden Punktes}
  681. {out: der Punkt wurde mittels einer schnellen Routine }
  682. {     in seiner Farbe invertiert}
  683. ASM
  684.   cli
  685.   mov ax,320
  686.   mul y
  687.   mov bx,x
  688.   add bx,ax
  689.   mov ax,$A000
  690.   mov es,ax
  691.   mov al,es:[bx]
  692.   not al
  693.   mov es:[bx],al
  694.   sti
  695. END;
  696.  
  697. PROCEDURE CGAXORDot(x,y:INTEGER); FAR; ASSEMBLER;
  698. { in: (x,y)  = Koordinaten des zu invertierenden Punktes}
  699. {     mask   = Farben-1 des aktiven Grafikmodus}
  700. {     maxx   = max. X-Koordinate (319 oder 639)}
  701. {out: der Punkt wurde mittels einer schnellen Routine }
  702. {     in seiner Farbe invertiert}
  703. ASM
  704.   cli
  705.   mov ax,0B800h {CGA-Adresse beginnt immer bei $B8000}
  706.   mov es,ax
  707.   mov cx,y
  708.   mov dx,x
  709.  
  710.   xor bx,bx     {0 = Offset für ungerade Zeilen}
  711.   test cl,1     {gerade Zeile?}
  712.   jz @evenRow   {nein}
  713.   mov bx,2000h  {ja, Offset dafür laden}
  714. @evenRow:
  715.   shr cx,1
  716.   mov al,80
  717.   mul cl        {AX = (y div 2) * 80 }
  718.  
  719.   mov cx,dx
  720.   not cl
  721.   cmp maxx,319  {640x200 Modus?}
  722.   jbe @L0       {nein, Bitposition = (not(X) AND mask)*2 }
  723.   and cl,7      {ja, Bitposition berechnet sich zu not(X MOD 7)}
  724.   jmp @L2
  725. @L0:
  726.   and cl,mask
  727.   shl cl,1
  728. @L2:            {CL = Bitposition}
  729.  
  730.   shr dx,1
  731.   shr dx,1
  732.   cmp maxx,319  {eine der mittleren Auflösungen (320x200)?}
  733.   jbe @L1       {ja, nur durch 4 teilen}
  734.   shr dx,1      {nein, 640x200, deshalb durch 8 teilen}
  735. @L1:
  736.  
  737.   add ax,dx
  738.   add bx,ax     {ES:BX = Zeiger auf Punktadresse}
  739.  
  740.   mov al,es:[bx]
  741.   ror al,cl
  742.   mov ah,al
  743.   mov dl,mask
  744.   and al,dl     {AL = gelesene Farbe}
  745.   not al
  746.   and al,dl     {AL = zu setzende Farbe}
  747.  
  748.   not dl
  749.   and ah,dl
  750.   or al,ah
  751.   rol al,cl
  752.  
  753.   mov es:[bx],al
  754.  
  755.   sti
  756. END;
  757.  
  758. PROCEDURE EGAVGAXORDot(x,y:INTEGER); FAR;
  759. { in: (x,y)  = Koordinaten des zu invertierenden Punktes}
  760. {     pageadr= Offsetadresse der Grafikseite des Punktes}
  761. {     mask   = Farben-1 des aktiven Grafikmodus}
  762. {              (ist immer $F für diese Modi)   }
  763. {out: der Punkt wurde mittels einer schnellen Routine }
  764. {     in seiner Farbe invertiert}
  765. VAR farbe:BYTE;
  766. BEGIN
  767.  farbe:=NOT EGAVGAGetDot(x,y);
  768.  ASM
  769.   cli
  770.   mov dx,3ceh
  771.   mov al,5      {Modusregister...}
  772.   out dx,al
  773.   inc dx
  774.   in al,dx      {...retten}
  775.   push ax
  776.   mov al,2
  777.   out dx,al     {writemode 2 setzen}
  778.  
  779.   dec dx
  780.   mov al,8      {bitmask Register...}
  781.   out dx,al
  782.   inc dx
  783.   in al,dx
  784.   push ax       {...retten}
  785.  
  786.   mov bx,x
  787.   mov cx,bx
  788.   and cl,7
  789.   xor cl,7      {CL=7-(x mod 8)}
  790.   mov al,1
  791.   shl al,cl     {AL=Bitmaske}
  792.  
  793.   out dx,al     {setzen}
  794.  
  795.   mov ax,80
  796.   mul y
  797.   shr bx,1
  798.   shr bx,1
  799.   shr bx,1
  800.   add bx,ax
  801.   add bx,pageadr
  802.   mov ax,$A000
  803.   mov es,ax     {ES:BX = Punktadresse}
  804.  
  805.   mov al,farbe
  806.   mov es:[bx],al
  807.  
  808.   pop ax
  809.   mov dx,3cfh
  810.   out dx,al     {bitmask Register wiederherstellen}
  811.   dec dx
  812.   mov al,5      {Modusregister auch}
  813.   out dx,al
  814.   inc dx
  815.   pop ax
  816.   out dx,al
  817.  
  818.   sti
  819.  END;
  820. END;
  821.  
  822. PROCEDURE BiosXORDot(x,y:INTEGER); FAR; ASSEMBLER;
  823. { in: (x,y) = Koordinaten des zu invertierenden Punktes}
  824. {     page  = Grafikseite, auf der sich der Punkt befindet}
  825. {     mask  = Farben-1 des aktiven Grafikmodus}
  826. {out: der Punkt wurde mittels BIOS-Aufrufen in seiner Farbe invertiert}
  827. ASM
  828.   mov ah,$0D
  829.   mov bh,page
  830.   mov cx,x
  831.   mov dx,y
  832.   push ds
  833.   push bp
  834.   int $10
  835.   pop bp
  836.   pop ds
  837.   not al
  838.   and al,mask
  839.  
  840.   mov ah,$0C
  841.   mov bh,page
  842.   mov cx,x
  843.   mov dx,y
  844.   int $10
  845. END;
  846.  
  847. PROCEDURE SpecialMode13hXORDot(x,y:INTEGER); FAR;
  848. { in: (x,y) = Koordinaten des zu invertierenden Punktes}
  849. {out: der Punkt wurde in seiner Farbe invertiert}
  850. {rem: Diese Routine ist ausschließlich für den eigenen,   }
  851. {     320x200x256x4 - Grafikmodus entwickelt, den das BIOS}
  852. {     nicht kennt!}
  853. VAR Offset,Adresse:Word;
  854.     Plane,temp :Byte;
  855. BEGIN
  856.  ASM
  857.     CLI
  858.     MOV AX,4005h      {Writemode 0 setzen}
  859.     MOV DX,3CEh
  860.     OUT DX,AX
  861.  
  862.     MOV DX,CRTAddress {Bildschirmstartadresse auslesen}
  863.     MOV AL,0Ch
  864.     OUT DX,AL
  865.     INC DX
  866.     IN AL,DX
  867.     MOV AH,AL
  868.     DEC DX
  869.     MOV AL,0Dh
  870.     OUT DX,AL
  871.     INC DX
  872.     IN AL,DX
  873.     MOV Adresse,AX
  874.     STI
  875.  END;
  876.  
  877.  Offset:=y*80+(x shr 2);
  878.  Plane :=(x and 3);
  879.  portw[$3CE]:=4 +(plane shl 8);
  880.  temp:=mem[$A000:Adresse+Offset];
  881.  portw[$3C4]:=2+(1 shl (plane+8));
  882.  mem[$A000:Adresse+Offset]:=not temp;
  883. END;
  884.  
  885. FUNCTION SaveMode:BYTE;
  886. { in: - }
  887. {out: aktueller Schreib-/Lesemodus der Grafikkarte}
  888. BEGIN
  889.  ASM
  890.     MOV DX,3CEh
  891.     MOV AL,5
  892.     OUT DX,AL
  893.     INC DX
  894.     IN AL,DX
  895.     MOV @Result,AL
  896.  END
  897. END;
  898.  
  899. PROCEDURE RestoreMode(m:BYTE);
  900. { in: m = zu setzender Schreib-/Lesemodus}
  901. {out: der entsprechende Modus wurde gesetzt}
  902. BEGIN
  903.  ASM
  904.     MOV DX,3CEh
  905.     MOV AL,5
  906.     MOV AH,m
  907.     OUT DX,AX
  908.  END;
  909. END;
  910.  
  911. PROCEDURE xor_line(x1,y1,x2,y2:INTEGER);
  912. { in: (x1,y1) = linke, obere Startecke }
  913. {     (x2,y2) = rechte, untere Endecke }
  914. {   ( page    = aktuelle Grafikseite ) }
  915. {   ( mask    = Farben-1 des Grafikmodus)   }
  916. {out: Die durch die beiden Punkte definierte}
  917. {     Linie wurde in ihrer Farbe invertiert }
  918. {rem: page und mask müssen für den speziellen 320x200x256x4-Modus}
  919. {     nicht gesetzt sein}
  920. {     Die Linie muß horizontal oder vertikal verlaufen}
  921. {     Es muß gelten: x1<=x2, y1<=y2}
  922. VAR i:INTEGER;
  923. BEGIN
  924.  if y1=y2
  925.   THEN FOR i:=x1 TO x2 DO PlotXY(i,y1)
  926.   ELSE FOR i:=y1 TO y2 DO PlotXY(x1,i);
  927. END;
  928.  
  929. PROCEDURE xor_box(x1,y1,x2,y2:INTEGER);
  930. { in: (x1,y1) = linke, obere Startecke }
  931. {     (x2,y2) = rechte, untere Endecke }
  932. {   ( page    = aktuelle Grafikseite ) }
  933. {   ( mask    = Farben-1 des Grafikmodus)   }
  934. {out: Das durch die beiden Punkte definierte}
  935. {     Rechteck wurde farblich invertiert    }
  936. {rem: page und mask müssen für den speziellen 320x200x256x4-Modus}
  937. {     nicht gesetzt sein}
  938. {     Es muß gelten: x1<=x2, y1<=y2}
  939. BEGIN
  940.  xor_line(succ(x1),y1,x2,y1);
  941.  xor_line(x2,succ(y1),x2,y2);
  942.  xor_line(x1,y2,pred(x2),y2);
  943.  xor_line(x1,y1,x1,pred(y2));
  944. END;
  945.  
  946. FUNCTION Update(VAR ch:CHAR):BOOLEAN;
  947. { in: ch = Ziffer als Zeichen   : '0'..'9'}
  948. {out: ch = um 1 erhöhtes Zeichen: '1'..'0'}
  949. {     TRUE/FALSE, falls Übertrag in nächsthöhere Stelle}
  950. BEGIN
  951.  IF ch='9'
  952.   THEN ch:='0'
  953.   ELSE ch:=chr(succ(ord(ch)));
  954.  Update:=ch='0'
  955. END;
  956.  
  957. PROCEDURE ComputeSprite;
  958. { in: x1,y1,x2,y2 = als Sprite zu sicherndes Bildschirmrechteck}
  959. {     BestColor = Farbumsetztabelle    }
  960. {   ( page    = aktuelle Grafikseite ) }
  961. {   ( mask    = Farben-1 des Grafikmodus)   }
  962. {out: Sprite  = berechnete Spritedaten }
  963. {rem: Der Inhalt dieses Rechtecks wird in die Datei           }
  964. {     "GRAB_xxx.COD" geschrieben; }
  965. {     Der Grafikmodus muß korrekt eingeschaltet sein, da die  }
  966. {     Spriteinformationen direkt vom Schirm gelesen werden.   }
  967. {     page und mask müssen für den speziellen 320x200x256x4-  }
  968. {     Modus nicht gesetzt sein}
  969. VAR i,j,offset,Plane_Groesse:Word;
  970.     temp,p:Byte;
  971.     links,rechts,oben,unten:Integer;
  972.     fertig_li,fertig_re,fertig_ob,fertig_un:Boolean;
  973. BEGIN
  974.  
  975.  WITH Sprite DO
  976.   BEGIN
  977.  
  978.    {letzte nicht ganz schwarze Zeile suchen (Workarea kann auch leer sein!)}
  979.    MaxY:=Succ(y2);
  980.    REPEAT
  981.     dec(MaxY);
  982.     temp:=0;
  983.     FOR i:=x1 TO x2 DO temp:=temp or GetDotXY(i,MaxY);
  984.    UNTIL (temp<>0) or (maxy<y1);
  985.    IF maxy<y1
  986.     THEN BEGIN
  987.           sound(500); delay(100); nosound;
  988.           exit
  989.          END;
  990.  
  991.    {dto., für Spalte}
  992.    MaxX:=Succ(x2);
  993.    REPEAT
  994.     dec(MaxX);
  995.     temp:=0;
  996.     FOR i:=y1 TO MaxY DO temp:=temp or GetDotXY(MaxX,i);
  997.    UNTIL temp<>0;
  998.  
  999.    dec(MaxX,x1); dec(MaxY,y1); {relative Positionen}
  1000.  
  1001.    Translate[1]:=1; Translate[2]:=2; Translate[3]:=4; Translate[4]:=8;
  1002.    Kennung[1]:='K'; Kennung[2]:='R';
  1003.    Version:=1;
  1004.    Modus:=0;
  1005.    FOR i:=1 TO 10 DO dummy[i]:=0; {Dummywerte auf 0 setzen}
  1006.    Hoehe_in_Zeilen:=Succ(MaxY);   {Y-Werte reichen von 0..MaxY}
  1007.    Breite_in_4er_Gruppen:=Succ(MaxX shr 2); {0..3->1, 4..7->2, ...}
  1008.    {Anzahl Bytes pro Plane:}
  1009.    Plane_Groesse:=Hoehe_in_Zeilen*Breite_in_4er_Gruppen;
  1010.  
  1011.    {Indizes für Grenz- & Planedaten:}
  1012.    ZeigerL:=Kopf; {Fängt beim 1.Datenbyte an}
  1013.    ZeigerR:=ZeigerL+ (Hoehe_in_Zeilen*2);
  1014.    ZeigerO:=ZeigerR+ (Hoehe_in_Zeilen*2);
  1015.    ZeigerU:=ZeigerO+ (Breite_in_4er_Gruppen*4 *2);
  1016.    Zeiger_auf_Plane[0] :=ZeigerU+ (Breite_in_4er_Gruppen*4 *2);
  1017.    Zeiger_auf_Plane[1] :=Zeiger_auf_Plane[0]+ Plane_Groesse;
  1018.    Zeiger_auf_Plane[2] :=Zeiger_auf_Plane[1]+ Plane_Groesse;
  1019.    Zeiger_auf_Plane[3] :=Zeiger_auf_Plane[2]+ Plane_Groesse;
  1020.  
  1021.    {Das Sprite besteht aus: "Kopf" Bytes an Zeigern & speziellen Infos,}
  1022.    {4 Tabellen mit Planedaten, 2 Tabellen mit X-Grenzen (Wörter!),     }
  1023.    {2 Tabellen mit Y-Grenzen (Wörter, für jeden X-Wert einen!)         }
  1024.    SpriteLength:=Kopf+(Plane_Groesse*4)+
  1025.                   (Hoehe_in_Zeilen*2)*2+
  1026.                   (Breite_in_4er_Gruppen*4 *2)*2;
  1027.  
  1028.    {Jetzt die eigentlichen Spritedaten berechnen:}
  1029.    offset:=0;
  1030.    FOR j:=y1+0 TO y1+MaxY DO
  1031.     BEGIN
  1032.      FOR i:=0 TO Pred(Breite_in_4er_Gruppen) DO
  1033.       BEGIN
  1034.        FOR p:=0 TO 3 DO
  1035.          Readin[Zeiger_auf_Plane[p]+offset]:= GetDotXY(x1+(i shl 2)+p,j);
  1036.        inc(offset);
  1037.  
  1038.       END;
  1039.     END;
  1040.  
  1041.    {Nun die X-Grenzdaten für jede Zeile:}
  1042.    offset:=0;
  1043.    FOR j:=y1+0 TO y1+MaxY DO
  1044.     BEGIN
  1045.      links:=x1+0;
  1046.      rechts:=x1+Pred(Breite_in_4er_Gruppen shl 2);
  1047.      fertig_li:=false; fertig_re:=false;
  1048.      REPEAT
  1049.       if (not fertig_li and (GetDotXY(links,j)=0))
  1050.        THEN inc(links) ELSE fertig_li:=true;
  1051.       if (not fertig_re and (GetDotXY(rechts,j)=0))
  1052.        THEN dec(rechts) ELSE fertig_re:=true;
  1053.       if links>rechts THEN BEGIN fertig_li:=true; fertig_re:=true END;
  1054.      UNTIL fertig_li and fertig_re;
  1055.      if links>rechts
  1056.       THEN BEGIN {Leerzeile, Sentinelwerte eintragen}
  1057.             readin[ZeigerL+offset]:=lo(+16000);
  1058.             readin[Succ(ZeigerL+offset)]:=hi(+16000);
  1059.             readin[ZeigerR+offset]:=lo(-16000);
  1060.             readin[Succ(ZeigerR+offset)]:=hi(-16000)
  1061.            END
  1062.       ELSE BEGIN {normale Zeile, Grenzen eintragen}
  1063.             dec(links, x1); {relative Position bestimmen}
  1064.             dec(rechts,x1);
  1065.             readin[ZeigerL+offset]:=lo(links);
  1066.             readin[Succ(ZeigerL+offset)]:=hi(links);
  1067.             readin[ZeigerR+offset]:=lo(rechts);
  1068.             readin[Succ(ZeigerR+offset)]:=hi(rechts)
  1069.            END;
  1070.      inc(offset,2)  {Grenzeinträge sind Wörter!}
  1071.     END;
  1072.  
  1073.    {Dasselbe für die Grenzdaten jeder Spalte:}
  1074.    offset:=0;
  1075.    FOR i:=x1+0 TO x1+Pred(Breite_in_4er_Gruppen shl 2) DO
  1076.     BEGIN
  1077.      oben :=y1+0;
  1078.      unten:=y1+MaxY;
  1079.      fertig_ob:=false; fertig_un:=false;
  1080.      REPEAT
  1081.       if (not fertig_ob and (GetDotXY(i,oben)=0))
  1082.        THEN inc(oben) ELSE fertig_ob:=true;
  1083.       if (not fertig_un and (GetDotXY(i,unten)=0))
  1084.        THEN dec(unten) ELSE fertig_un:=true;
  1085.       if oben>unten THEN BEGIN fertig_ob:=true; fertig_un:=true END;
  1086.      UNTIL fertig_ob and fertig_un;
  1087.      if oben>unten
  1088.       THEN BEGIN {Leerspalte, Sentinelwerte eintragen}
  1089.             readin[ZeigerO+offset]:=lo(+16000);
  1090.             readin[Succ(ZeigerO+offset)]:=hi(+16000);
  1091.             readin[ZeigerU+offset]:=lo(-16000);
  1092.             readin[Succ(ZeigerU+offset)]:=hi(-16000)
  1093.            END
  1094.       ELSE BEGIN {normale Spalte, Grenzen eintragen}
  1095.             dec(oben, y1);
  1096.             dec(unten,y1);
  1097.             readin[ZeigerO+offset]:=lo(oben);
  1098.             readin[Succ(ZeigerO+offset)]:=hi(oben);
  1099.             readin[ZeigerU+offset]:=lo(unten);
  1100.             readin[Succ(ZeigerU+offset)]:=hi(unten)
  1101.            END;
  1102.      inc(offset,2)  {Grenzeinträge sind Wörter!}
  1103.     END;
  1104.  
  1105.   END; {of with}
  1106. END;
  1107.  
  1108. PROCEDURE WriteSpriteToDisk;
  1109. { in: Sprite = auf Disk zu schreibendes Sprite}
  1110. {     ActualColors[0..mask] = benutzte RGB-Farben}
  1111. {out: - }
  1112. {rem: Diese Routine darf nur aufgerufen werden, wenn Dos reentrantfaehig ist!}
  1113. {     Die Filenamen werden in den Nummern "fortgeschaltet"}
  1114. CONST Filename_lang:STRING[12]='GRAB_000.COD';
  1115.       Palname_lang :STRING[12]='GRABS000.PAL';
  1116. VAR f:FILE;
  1117.     fehler:BOOLEAN;
  1118. BEGIN
  1119.  {Nun die Daten auf Disk schreiben:}
  1120.  {$I-}
  1121.  fehler:=false;
  1122.  assign(f,Filename_lang); {Spritedaten schreiben}
  1123.  fehler:=fehler or (ioresult<>0);
  1124.  IF NOT fehler THEN rewrite(f,1);
  1125.  fehler:=fehler or (ioresult<>0);
  1126.  IF NOT fehler THEN blockwrite(f,sprite.readin,sprite.SpriteLength);
  1127.  close(f);
  1128.  fehler:=fehler or (ioresult<>0);
  1129.  
  1130.  assign(f,Palname_lang);  {Palette schreiben}
  1131.  fehler:=fehler or (ioresult<>0);
  1132.  IF NOT fehler THEN rewrite(f,1);
  1133.  fehler:=fehler or (ioresult<>0);
  1134.  IF NOT fehler THEN blockwrite(f,ActualColors[0],Succ(WORD(mask))*3);
  1135.  close(f);
  1136.  fehler:=fehler or (ioresult<>0);
  1137.  {$I+}
  1138.  IF fehler
  1139.   THEN sound(500)
  1140.   ELSE sound(1000);
  1141.  delay(100); nosound;
  1142.  
  1143.  IF Update(Filename_lang[8])  {Filenamen für nächsten Aufruf generieren}
  1144.   THEN IF Update(Filename_lang[7])
  1145.         THEN Update(Filename_lang[6]);
  1146.  IF Update(Palname_lang[8])   {Palettennamen für nächsten Aufruf generieren}
  1147.   THEN IF Update(Palname_lang[7])
  1148.         THEN Update(Palname_lang[6]);
  1149. END;
  1150.  
  1151. PROCEDURE WriteBackgroundToDisk;
  1152. { in: x1,y1,x2,y2 = als Background zu sicherndes Bildschirmrechteck}
  1153. {     ActualColors[0..mask] = benutzte RGB-Farben}
  1154. {   ( page    = aktuelle Grafikseite ) }
  1155. {out: - }
  1156. {rem: Der Inhalt dieses Rechtecks wird in die Datei            }
  1157. {     "GRAB_xxx.PIC" geschrieben, die Palette in "GRABPxxx.PAL"}
  1158. {     Der Grafikmodus muß korrekt eingeschaltet sein, da die   }
  1159. {     Spriteinformationen direkt vom Schirm gelesen werden.    }
  1160. {     page und mask müssen für den speziellen 320x200x256x4-   }
  1161. {     Modus nicht gesetzt sein}
  1162. CONST Filename_lang:STRING[12]='GRAB_000.PIC';
  1163.       Palname_lang :STRING[12]='GRABP000.PAL';
  1164.       PICHeader:STRING[3]='PIC'; {wird den Daten als Kennung vorausgestellt}
  1165. VAR f:file of BYTE;
  1166.     f2:FILE;
  1167.     b,plane:BYTE;
  1168.     i,j:INTEGER;
  1169.     fehler:BOOLEAN;
  1170. BEGIN
  1171.  {Nun die Daten auf Disk schreiben:}
  1172.  {$I-}
  1173.  fehler:=false;
  1174.  assign(f,Filename_lang);
  1175.  fehler:=fehler or (ioresult<>0);
  1176.  IF NOT fehler THEN rewrite(f);
  1177.  fehler:=fehler or (ioresult<>0);
  1178.  IF NOT fehler
  1179.   THEN BEGIN
  1180.         FOR i:=1 TO Length(PICHeader) DO
  1181.          WRITE(f,BYTE(PICHeader[i]));
  1182.        END;
  1183.  fehler:=fehler or (ioresult<>0);
  1184.  IF NOT fehler
  1185.   THEN FOR plane:=0 TO 3 DO
  1186.         FOR j:=y1 TO y2 DO
  1187.          FOR i:=0 TO (x2-x1) SHR 2 DO
  1188.           BEGIN
  1189.            b:=GetDotXY(x1+(i shl 2)+plane,j);
  1190.            Write(f,b)
  1191.           END;
  1192.  close(f);
  1193.  fehler:=fehler or (ioresult<>0);
  1194.  
  1195.  assign(f2,Palname_lang);  {Palette schreiben}
  1196.  fehler:=fehler or (ioresult<>0);
  1197.  IF NOT fehler THEN rewrite(f2,1);
  1198.  fehler:=fehler or (ioresult<>0);
  1199.  IF NOT fehler THEN blockwrite(f2,ActualColors[0],Succ(WORD(mask))*3);
  1200.  close(f2);
  1201.  fehler:=fehler or (ioresult<>0);
  1202.  {$I+}
  1203.  IF fehler
  1204.   THEN sound(500)
  1205.   ELSE sound(1000);
  1206.  delay(100); nosound;
  1207.  
  1208.  IF Update(Filename_lang[8])  {Filenamen für nächsten Aufruf generieren}
  1209.   THEN IF Update(Filename_lang[7])
  1210.         THEN Update(Filename_lang[6]);
  1211.  IF Update(Palname_lang[8])   {Palettennamen für nächsten Aufruf generieren}
  1212.   THEN IF Update(Palname_lang[7])
  1213.         THEN Update(Palname_lang[6]);
  1214. END;
  1215.  
  1216. {Auflistung der BIOS-Grafikmodi: MaxX,MaxY,MaxColor,XORPlotXY(),GetDotXY()}
  1217. {Adressen werden zu NIL initialisiert und bei der Installation gesetzt}
  1218. {(Textmodi/nichtunterstützte Modi erhalten überall 0)}
  1219. CONST
  1220.  resolution:ARRAY[4..19] OF GraphicMode=(
  1221.   (x:319; y:199; m:  3; put:CGAXORDot;    get:CGAGetDot),     {Mode 4}
  1222.   (x:319; y:199; m:  3; put:CGAXORDot;    get:CGAGetDot),     {Mode 5}
  1223.   (x:639; y:199; m:  1; put:CGAXORDot;    get:CGAGetDot),     {Mode 6}
  1224.   (x:  0; y:  0; m:  0; put:BiosXORDot;   get:BiosGetDot),
  1225.   (x:  0; y:  0; m:  0; put:BiosXORDot;   get:BiosGetDot),
  1226.   (x:319; y:199; m: $F; put:BiosXORDot;   get:BiosGetDot),    {Mode 9}
  1227.   (x:639; y:199; m:  3; put:BiosXORDot;   get:BiosGetDot),    {Mode 10}
  1228.   (x:  0; y:  0; m:  0; put:BiosXORDot;   get:BiosGetDot),
  1229.   (x:  0; y:  0; m:  0; put:BiosXORDot;   get:BiosGetDot),
  1230.   (x:319; y:199; m: $F; put:EGAVGAXORDot; get:EGAVGAGetDot),  {Mode 13}
  1231.   (x:639; y:199; m: $F; put:EGAVGAXORDot; get:EGAVGAGetDot),  {Mode 14}
  1232.   (x:639; y:349; m:  3; put:EGAVGAXORDot; get:EGAVGAGetDot),  {Mode 15}
  1233.   (x:639; y:349; m: $F; put:EGAVGAXORDot; get:EGAVGAGetDot),  {Mode 16}
  1234.   (x:  0; y:  0; m:  0; put:BiosXORDot;   get:BiosGetDot),
  1235.   (x:639; y:479; m: $F; put:EGAVGAXORDot; get:EGAVGAGetDot),  {Mode 18}
  1236.   (x:319; y:199; m:$FF; put:NormalMode13hXORDot; get:NormalMode13hGetDot) {Mode 19}
  1237.   );
  1238.  
  1239.  
  1240. FUNCTION PopUp:WORD; FAR;
  1241. { in: resolution enthaelt die richtigen Zugriffsdaten (BIOS/nicht-BIOS) }
  1242. {out: - }
  1243. {rem: Dies ist die eigentliche residente Popup-Routine, die beim betätigen}
  1244. {     des Hotkeys auftaucht, den Benutzer einen Bildausschnitt auswählen  }
  1245. {     läßt und diesen als Spritefile abspeichert!}
  1246. LABEL quit,again;
  1247. CONST BackgroundMaxX=319; {Hintergrundbildschirm = 320x200 Punkte}
  1248.       BackgroundMaxY=199;
  1249. VAR i:WORD;
  1250.     SpriteModus:BOOLEAN;
  1251.     ch:CHAR;
  1252.  
  1253.  PROCEDURE FlipModus;
  1254.  VAR breite,hoehe:WORD;
  1255.  BEGIN
  1256.   SpriteModus:=NOT SpriteModus;
  1257.   IF SpriteModus
  1258.    THEN BEGIN breite:=pred(maxwidth); hoehe:=pred(maxheight) END
  1259.    ELSE BEGIN breite:=BackgroundMaxX; hoehe:=BackgroundMaxY END;
  1260.   x2:=x1+breite;
  1261.   IF x2>maxx THEN BEGIN x2:=maxx; x1:=x2-breite END;
  1262.   y2:=y1+hoehe;
  1263.   IF y2>maxy THEN BEGIN y2:=maxy; y1:=y2-hoehe END;
  1264.   xor_box(x1,y1,x2,y2)
  1265.  END;
  1266.  
  1267.  PROCEDURE FindVGARegisters; ASSEMBLER;
  1268.  ASM
  1269.    MOV DX,3CCh
  1270.    IN AL,DX
  1271.    TEST AL,1
  1272.    MOV DX,3D4h
  1273.    JNZ @L1
  1274.    MOV DX,3B4h
  1275.   @L1:
  1276.    MOV CRTAddress,DX
  1277.    ADD DX,6
  1278.    MOV StatusReg,DX
  1279.  END;
  1280.  
  1281. BEGIN
  1282.  maxx:=resolution[mode].x; {dirty programmiert: Bereichsueberpruefung}
  1283.  maxy:=resolution[mode].y; {muss abgeschaltet sein!                  }
  1284.  mask:=resolution[mode].m;
  1285.  
  1286.  IF (mode<4) or (mode>19) or (maxx=0)   {nichtunterstützter Modus?}
  1287.   THEN BEGIN
  1288.         sound(500); delay(500); nosound;
  1289.         exit
  1290.        END;
  1291.  
  1292.  FindVGARegisters;  {ermittle CRTAddress und StatusReg}
  1293.  
  1294.  IF (mode<4) OR (mode>6)  {fuer die CGA-Modi gibt es keine variable Startad.}
  1295.   THEN ASM {aktuelle Grafikseite ermitteln}
  1296.          CLI
  1297.          MOV DX,CRTAddress
  1298.          MOV AL,0Ch
  1299.          OUT DX,AL
  1300.          INC DX
  1301.          IN AL,DX
  1302.          MOV AH,AL
  1303.          DEC DX
  1304.          MOV AL,0DH
  1305.          OUT DX,AL
  1306.          INC DX
  1307.          IN AL,DX
  1308.          MOV pageadr,AX
  1309.          STI
  1310.        END;
  1311.  
  1312.  
  1313.  IF mask<=15
  1314.   THEN BEGIN
  1315.         GetBigPalette(ActualColors); {256 Farben der CLUT auslesen}
  1316.         GetSmallPalette(palette);    {16 Palettenfarben auslesen  }
  1317.         ConvertToDACValues(palette,mask,ActualColors) {echte Farbwerte ermitteln}
  1318.        END
  1319.   ELSE BEGIN
  1320.         GetBigPalette(ActualColors); {256 Farben auslesen}
  1321.        END;
  1322.  
  1323.  Zugriff:=SaveMode;  {alten Schreib-/Lesemodus retten}
  1324.  IF mode=19
  1325.   THEN BEGIN  {Spezieller, eigener Mode $13 ?}
  1326.         ASM
  1327.            CLI
  1328.            MOV DX,3C4h
  1329.            MOV AL,4
  1330.            OUT DX,AL
  1331.            INC DX
  1332.            IN AL,DX
  1333.            AND AL,0Ch
  1334.            MOV temp,AL
  1335.            STI
  1336.         END;
  1337.         IF temp=$4
  1338.          THEN BEGIN
  1339.                PlotXY  :=SpecialMode13hXORDot;  {ja, spezielle Routinen!}
  1340.                GetDotXY:=SpecialMode13hGetDot
  1341.               END
  1342.          ELSE BEGIN
  1343.                PlotXY  :=resolution[mode].put; {nein, normale Routinen}
  1344.                GetDotXY:=resolution[mode].get
  1345.               END
  1346.        END
  1347.   ELSE BEGIN
  1348.         PlotXY  :=resolution[mode].put;  {alle anderen Modi sowieso normal}
  1349.         GetDotXY:=resolution[mode].get
  1350.        END;
  1351.  
  1352.  x1:=0; y1:=0; x2:=maxwidth-1; y2:=maxheight-1; SpriteModus:=TRUE;
  1353.  SaveMouse; ResetMouse;
  1354.  WHILE Keypressed DO ch:=Readkey; {Tastaturpuffer löschen}
  1355.  
  1356.  xor_box(x1,y1,x2,y2);
  1357.  REPEAT
  1358.   again:;  {hierher, wenn Modusänderung stattfand}
  1359.  
  1360.   IF SpriteModus
  1361.    THEN BEGIN {Spritebox zeigen}
  1362.          REPEAT
  1363.  
  1364.           WHILE (MouseButtons=LeftButton) AND (NOT keypressed) DO
  1365.            BEGIN {Box veraendern, wenn linker Button gedrueckt}
  1366.             GetMouseMovement(deltax,deltay);
  1367.  
  1368.             {rechte untere Ecke bewegen:}
  1369.             INC(deltax,x2);
  1370.             IF deltax<0 THEN deltax:=0
  1371.             ELSE IF deltax>maxx THEN deltax:=maxx;
  1372.             INC(deltay,y2);
  1373.             IF deltay<0 THEN deltay:=0
  1374.             ELSE IF deltay>maxy THEN deltay:=maxy;
  1375.  
  1376.             {max. Groesse nicht ueberschritten?}
  1377.             breite:=succ(deltax-x1);
  1378.             IF breite>maxwidth THEN DEC(deltax,breite-maxwidth);
  1379.             hoehe :=succ(deltay-y1);
  1380.             IF hoehe>maxheight THEN DEC(deltay,hoehe-maxheight);
  1381.  
  1382.             x1old:=x1; y1old:=y1; x2old:=x2; y2old:=y2;
  1383.             {min. Groesse unterschritten (= untere rechte Ecke ueber/links von}
  1384.             {oberer rechter?}
  1385.             IF breite<0 THEN swap(x1,deltax); {entsprechende Punkte vertauschen}
  1386.             IF hoehe <0 THEN swap(y1,deltay);
  1387.  
  1388.             IF (deltax<>x2) OR (deltay<>y2) {delta? gibt die neue untere re. Ecke an}
  1389.              THEN BEGIN
  1390.                    xor_box(x1old,y1old,x2old,y2old);
  1391.                    x2:=deltax; y2:=deltay;
  1392.                    xor_box(x1,y1,x2,y2)
  1393.                   END;
  1394.            END;
  1395.  
  1396.           WHILE (MouseButtons=NoButton) AND (NOT keypressed) DO
  1397.            BEGIN  {Box verschieben}
  1398.             GetMouseMovement(deltax,deltay);
  1399.             breite:=x2-x1; hoehe:=y2-y1;
  1400.             {rechte untere Ecke verschieben:}
  1401.             INC(deltax,x2);
  1402.             IF deltax<breite THEN deltax:=breite
  1403.             ELSE IF deltax>maxx THEN deltax:=maxx;
  1404.             INC(deltay,y2);
  1405.             IF deltay<hoehe THEN deltay:=hoehe
  1406.             ELSE IF deltay>maxy THEN deltay:=maxy;
  1407.  
  1408.             {linke obere Ecke neu berechnen:}
  1409.             x1old:=x1; y1old:=y1; x2old:=x2; y2old:=y2;
  1410.             x1:=deltax-breite; y1:=deltay-hoehe;
  1411.  
  1412.             IF (deltax<>x2) OR (deltay<>y2) {delta? gibt die neue untere re. Ecke an}
  1413.              THEN BEGIN
  1414.                    xor_box(x1old,y1old,x2old,y2old);
  1415.                    x2:=deltax; y2:=deltay;
  1416.                    xor_box(x1,y1,x2,y2)
  1417.                   END;
  1418.            END;
  1419.  
  1420.           MB:=MouseButtons;
  1421.          UNTIL (MB=RightButton) OR (MB=BothButtons) OR (keypressed);
  1422.          xor_box(x1,y1,x2,y2);
  1423.  
  1424.           IF keypressed
  1425.       THEN BEGIN
  1426.                 ch:=Upcase(readkey);
  1427.                 IF ch=#27 THEN goto quit;  {Escape}
  1428.                 IF ch=' ' THEN BEGIN FlipModus; goto again END;
  1429.                END;
  1430.  
  1431.          FOR i:=1 TO 10000 DO
  1432.           BEGIN {User etwas Zeit lassen, um beide Buttons "gleichzeitig" zu drücken}
  1433.            MB:=MB OR MouseButtons
  1434.           END;
  1435.  
  1436.          IF MB=BothButtons
  1437.           THEN BEGIN
  1438.                 {do nothing}
  1439.                END
  1440.           ELSE BEGIN {RightButton = "Return"}
  1441.                 ComputeSprite;       {"Sprite" in x1,y1,x2,y2 berechnen}
  1442.                 IF Sprite.SpriteLength<>0 THEN WriteSpriteToDisk
  1443.                END;
  1444.          goto quit; {das war's!}
  1445.         END
  1446.  
  1447.  
  1448.    ELSE BEGIN {Backgroundmode}
  1449.          REPEAT
  1450.           MB:=MouseButtons;
  1451.  
  1452.           {Box verschieben}
  1453.           GetMouseMovement(deltax,deltay);
  1454.           {rechte untere Ecke verschieben:}
  1455.           INC(deltax,x2);
  1456.           IF deltax<BackgroundMaxX THEN deltax:=BackgroundMaxX
  1457.           ELSE IF deltax>maxx THEN deltax:=maxx;
  1458.           INC(deltay,y2);
  1459.           IF deltay<BackgroundMaxY THEN deltay:=BackgroundMaxY
  1460.           ELSE IF deltay>maxy THEN deltay:=maxy;
  1461.  
  1462.           {linke obere Ecke neu berechnen:}
  1463.           x1old:=x1; y1old:=y1; x2old:=x2; y2old:=y2;
  1464.           x1:=deltax-BackgroundMaxX; y1:=deltay-BackgroundMaxY;
  1465.  
  1466.           IF (deltax<>x2) OR (deltay<>y2) {delta? gibt die neue untere re. Ecke an}
  1467.            THEN BEGIN
  1468.                  xor_box(x1old,y1old,x2old,y2old);
  1469.                  x2:=deltax; y2:=deltay;
  1470.                  xor_box(x1,y1,x2,y2)
  1471.                 END;
  1472.          UNTIL (MB=RightButton) OR (MB=BothButtons) OR keypressed;
  1473.          xor_box(x1,y1,x2,y2);
  1474.  
  1475.          IF keypressed
  1476.       THEN BEGIN
  1477.                 ch:=Upcase(readkey);
  1478.                 IF ch=#27 THEN goto quit;  {Escape}
  1479.                 IF ch=' ' THEN BEGIN FlipModus; goto again END;
  1480.                END;
  1481.  
  1482.          FOR i:=1 TO 10000 DO
  1483.           BEGIN {etwas Zeit lassen, um beide Buttons "gleichzeitig" zu drücken}
  1484.            MB:=MB OR MouseButtons
  1485.           END;
  1486.  
  1487.          IF MB<>RightButton
  1488.           THEN BEGIN {beide Buttons gedrückt}
  1489.                 {do nothing}
  1490.                END
  1491.           ELSE BEGIN {RightButton = "Return"}
  1492.                 WriteBackgroundToDisk
  1493.                END;
  1494.          goto quit;
  1495.         END;
  1496.  
  1497. UNTIL FALSE;
  1498.  
  1499. quit:
  1500.  RestoreMode(Zugriff);
  1501.  RestoreMouse;
  1502.  PopUp:=0;  {Null Zeichen in Tastaturpuffer ablegen}
  1503. END;
  1504.  
  1505. PROCEDURE Error;
  1506. BEGIN
  1507.  WRITELN('Call GrabSprite without parameters or with "BIOS" to use '+
  1508.          'INT10h-calls.'+#13+#10+
  1509.          'Program has _not_ been installed!');
  1510.  Halt
  1511. END;
  1512.  
  1513. PROCEDURE Init;
  1514. var i,j:word;
  1515.     IsVGA:BOOLEAN;
  1516.     s:STRING[127];
  1517. BEGIN
  1518.  ASM
  1519.   MOV AX,$1A00  {VGA Identify-Adapter-Funktion}
  1520.   INT $10
  1521.   CMP AL,$1A
  1522.   MOV AL,0
  1523.   JNE @noVGA
  1524.   CMP BL,7      {VGAMono?}
  1525.   JB @noVGA
  1526.   CMP BL,8      {VGAColor?}
  1527.   JA @noVGA
  1528.   INC AL
  1529. @noVGA:
  1530.   MOV IsVGA,AL
  1531.  END;
  1532.  
  1533.  IF NOT IsVGA
  1534.   THEN BEGIN
  1535.         WRITELN('*** Error: No VGA card found');
  1536.         Halt
  1537.        END;
  1538.  IF NOT InitMouse(i)
  1539.   THEN BEGIN
  1540.         WRITELN('*** Error: No mouse installed');
  1541.         Halt
  1542.        END;
  1543.  IF MemToStoreMouseState>SaveArea
  1544.   THEN BEGIN
  1545.         WRITELN('Not enough memory to save mouse state!');
  1546.         Halt
  1547.        END;
  1548.  s:='';
  1549.  IF (ParamCount>1) THEN Error;
  1550.  FOR j:=1 TO ParamCount DO
  1551.   BEGIN
  1552.    s:=ParamStr(j);
  1553.    FOR i:=1 TO Length(s) DO s[i]:=UpCase(s[i]);
  1554.    IF (s[1]='-') OR (s[1]='/') THEN Delete(s,1,1);
  1555.    IF s='BIOS'
  1556.     THEN BEGIN
  1557.           FOR i:=4 TO 19 DO
  1558.        BEGIN
  1559.             resolution[i].put:=BiosXORDot;
  1560.             resolution[i].get:=BiosGetDot;
  1561.            END;
  1562.            WRITELN('All data will be read by using Video-BIOS INT10h');
  1563.            s:=''
  1564.          END
  1565.    ELSE Error;
  1566.   END;
  1567. END;
  1568.  
  1569. {$IFDEF Test}
  1570. PROCEDURE FakeInit;
  1571. var
  1572.   grDriver : Integer;
  1573.   grMode   : Integer;
  1574.   ErrCode  : Integer;
  1575.   Color    : Word;
  1576.   Pal      : PaletteType;
  1577.   lb,hb:Byte;
  1578. begin
  1579.   grDriver := VGA;
  1580.   grMode   := VGAHi;
  1581.   InitGraph(grDriver,grMode,'');
  1582.   ErrCode := GraphResult;
  1583.   if ErrCode = grOk then
  1584.     begin
  1585.       Graph.GetPalette(Pal);
  1586.       if Pal.Size <> 1 then
  1587.         for Color := Pred(Pal.Size) DOWNTO 0 do
  1588.         begin
  1589.           SetColor(Color);
  1590.           Line(0, Color, 100, Color);
  1591.         end
  1592.       else Line(0, 0, 100, 0);
  1593.     end
  1594.   else
  1595.     WriteLn('Graphics error:',GraphErrorMsg(ErrCode));
  1596.  
  1597.  fillchar(savemousearea,sizeof(savemousearea),0)
  1598. end;
  1599. {$ENDIF}
  1600.  
  1601. BEGIN
  1602.  Init;
  1603. {$IFDEF Test}
  1604.  FakeInit;
  1605.  PopUp;
  1606.  CloseGraph;
  1607. {$ELSE}
  1608.   TSRInstall('GrabSprite V2.0 (c) - by Kai Rohrbacher, 1992',
  1609.              PopUp,
  1610.              altkey+ctrlkey,
  1611.              'G');
  1612. {$ENDIF}
  1613. END.
  1614.