home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qb_sub / transa2c.sub < prev    next >
Encoding:
Text File  |  1987-07-14  |  2.5 KB  |  89 lines
  1. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. '%  (C) 1987 HUMBLEWARE Custom Programming    Author: Lawrence A. Westhaver  %
  3. '%        247 Paul Martin Drive,  Baltimore MD  21227  (301) 799-1975        %
  4. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  5. '%                                                                           %
  6. '%     FILENAME: TRANSA2C.SUB                    LAST UPDATE: 05-24-1987     %
  7. '%                                                                           %
  8. '%  DESCRIPTION: Translates an ATTRIBUTE value used by many video interupt   %
  9. '%               calls to the COLOR n,n notation used by QuickBASIC.         %
  10. '%                                                                           %
  11. '%         CALL: CALL TRANSA2C(AT%,FG%,BG%)                                  %
  12. '%                                                                           %
  13. '%       INPUTS: AT% = Attribute value (0-255).                              %
  14. '%                                                                           %
  15. '%      OUTPUTS: FG% = Foreground color (0-31).                              %
  16. '%                                                                           %
  17. '%               BG% = Background color (0-7).                               %
  18. '%                                                                           %
  19. '%         NOTE: If the attribute value is out of range, the foreground      %
  20. '%               color will be returned as white (7) and the background      %
  21. '%               color will be returned as black (0).                        %
  22. '%                                                                           %
  23. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  24.  
  25.  
  26. SUB TRANSA2C(AT%,FG%,BG%) Static
  27.  
  28.  
  29. 'zero outputs
  30.  
  31.     FG%=0
  32.     BG%=0
  33.  
  34.  
  35. 'check attribute for out of range
  36.  
  37.     IF AT%<0 OR AT%>255 THEN
  38.       FG%=7
  39.       BG%=0
  40.       EXIT SUB
  41.     END IF
  42.  
  43.  
  44. 'set foreground blink
  45.  
  46.     IF (AT% AND 128) THEN
  47.       FG%=FG%+16
  48.     END IF
  49.  
  50.  
  51. 'set background color
  52.  
  53.     IF (AT% AND 64) THEN
  54.       BG%=BG%+4
  55.     END IF
  56.  
  57.     IF (AT% AND 32) THEN
  58.       BG%=BG%+2
  59.     END IF
  60.  
  61.     IF (AT% AND 16) THEN
  62.       BG%=BG%+1
  63.     END IF
  64.  
  65.  
  66. 'set foreground intensity
  67.  
  68.     IF (AT% AND 8) THEN
  69.       FG%=FG%+8
  70.     END IF
  71.  
  72.  
  73. 'set foreground color
  74.  
  75.     IF (AT% AND 4) THEN
  76.       FG%=FG%+4
  77.     END IF
  78.  
  79.     IF (AT% AND 2) THEN
  80.       FG%=FG%+2
  81.     END IF
  82.  
  83.     IF (AT% AND 1) THEN
  84.       FG%=FG%+1
  85.     END IF
  86.  
  87.  
  88. END SUB 'transa2c
  89.