home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qb_sub / transa2a.sub < prev    next >
Encoding:
Text File  |  1987-07-14  |  2.9 KB  |  108 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: TRANSA2A.SUB                    LAST UPDATE: 05-24-1987     %
  7. '%                                                                           %
  8. '%  DESCRIPTION: Translates an ATTRIBUTE value used by many video interupt   %
  9. '%               calls to an ANSI color control string used by ANSI.SYS      %
  10. '%                                                                           %
  11. '%         CALL: CALL TRANSA2A(ATTR%,ANSI$)                                  %
  12. '%                                                                           %
  13. '%       INPUTS: ATTR% = Attribute value (0-255).                            %
  14. '%                                                                           %
  15. '%      OUTPUTS: ANSI$ = ANSI.SYS compatible color control string            %
  16. '%                                                                           %
  17. '%         NOTE: If the attribute value is out of range, the foreground      %
  18. '%               color will be returned as white (37) and the background     %
  19. '%               color will be returned as black (40).                       %
  20. '%                                                                           %
  21. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  22.  
  23.  
  24. SUB TRANSA2A(ATTR%,ANSI$) Static
  25.  
  26.  
  27. 'initialize ansi color control strings
  28.  
  29.     DIM FG$(7), BG$(7)
  30.  
  31.     FG$(0)="30m" : BG$(0)="40;"
  32.     FG$(1)="34m" : BG$(1)="44;"
  33.     FG$(2)="32m" : BG$(2)="42;"
  34.     FG$(3)="36m" : BG$(3)="46;"
  35.     FG$(4)="31m" : BG$(4)="41;"
  36.     FG$(5)="35m" : BG$(5)="45;"
  37.     FG$(6)="33m" : BG$(6)="43;"
  38.     FG$(7)="37m" : BG$(7)="47;"
  39.  
  40.  
  41. 'initialize temporary vars
  42.  
  43.     FG%=0 : BG%=0
  44.  
  45.  
  46. 'check attribute for out of range
  47.  
  48.     IF ATTR% < 0 OR ATTR% > 255 THEN
  49.       ANSI$=CHR$(27)+"[0;40;37m"
  50.       EXIT SUB
  51.     END IF
  52.  
  53.  
  54. 'initialize ansi color control string
  55.  
  56.     ANSI$=CHR$(27)+"[0;"
  57.  
  58.  
  59. 'if blink then add blink code to string
  60.  
  61.     IF (ATTR% AND 128) THEN
  62.       ANSI$=ANSI$+"5;"
  63.     END IF
  64.  
  65.  
  66. 'determine background color and add to code to string
  67.  
  68.     IF (ATTR% AND 64) THEN
  69.       BG%=BG%+4
  70.     END IF
  71.  
  72.     IF (ATTR% AND 32) THEN
  73.       BG%=BG%+2
  74.     END IF
  75.  
  76.     IF (ATTR% AND 16) THEN
  77.       BG%=BG%+1
  78.     END IF
  79.  
  80.     ANSI$=ANSI$+BG$(BG%)
  81.  
  82.  
  83. 'if high intensity then add high intensity code to string
  84.  
  85.     IF (ATTR% AND 8) THEN
  86.       ANSI$=ANSI$+"1;"
  87.     END IF
  88.  
  89.  
  90. 'determine foreground color and add to code to string
  91.  
  92.     IF (ATTR% AND 4) THEN
  93.       FG%=FG%+4
  94.     END IF
  95.  
  96.     IF (ATTR% AND 2) THEN
  97.       FG%=FG%+2
  98.     END IF
  99.  
  100.     IF (ATTR% AND 1) THEN
  101.       FG%=FG%+1
  102.     END IF
  103.  
  104.     ANSI$=ANSI$+FG$(FG%)
  105.  
  106.  
  107. END SUB 'transa2a
  108.