home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 85 / af085a.adf / archives / af85a1.lzx / Dialog_Procedures / Source / GetWBPalette.ASC < prev    next >
Encoding:
Text File  |  1978-07-26  |  1.1 KB  |  60 lines
  1. Procedure _GETWBPALETTE
  2.    '
  3.    F$=""
  4.    F=0
  5.    '
  6.    If Exist("Env:Sys/Palette.prefs")
  7.       F$="Env:Sys/Palette.prefs"
  8.       F=1
  9.    End If 
  10.    '
  11.    If F=0 and Exist("ENVARC:Sys/Palette.prefs")
  12.       F$="EnvArc:Sys/Palette.prefs"
  13.       F=1
  14.    End If 
  15.    '
  16.    If F=0 and Exist("Devs:System-Configuration")
  17.       F$="Devs:System-Configuration"
  18.       F=2
  19.    End If 
  20.    '
  21.    If F=0
  22.       Palette $999,$0,$FFF,$58A,$F00,$F0,$F,$FF0
  23.       Colour Back $999
  24.    End If 
  25.    '
  26.    ' *** Change To WB Colours.
  27.    '
  28.    If F=1
  29.       Open In 1,F$
  30.       L=Lof(1)
  31.       Close 1
  32.       A$=String$(" ",L)
  33.       Bload F$,Varptr(A$)
  34.       For A=0 To 7
  35.          R=Peek(Varptr(A$)+180+A*8)/16
  36.          G=Peek(Varptr(A$)+182+A*8)/16
  37.          B=Peek(Varptr(A$)+184+A*8)/16
  38.          Colour A,(R*256+G*16+B)
  39.          If A=0
  40.             Colour Back(R*256+G*16+B)
  41.          End If 
  42.       Next A
  43.       A$=""
  44.    End If 
  45.    '
  46.    If F=2
  47.       Open In 1,F$
  48.       L=Lof(1)
  49.       Close 1
  50.       A$=Space$(L)
  51.       Bload F$,Varptr(A$)
  52.       For A=0 To 3
  53.          Colour A,Deek(Varptr(A$)+110+A*2)
  54.          Colour A+16,Deek(Varptr(A$)+102+A*2)
  55.       Next A
  56.       A$=""
  57.    End If 
  58.    '
  59. End Proc
  60.