home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / formdev / fonts.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  3.6 KB  |  167 lines
  1. '***********************************************************************
  2. '    FormDev: Fonts.RLZ
  3. '
  4. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  5. '    All rights reserved.
  6. '
  7. '***********************************************************************
  8.  
  9. 'FONTS table
  10. 'fonts.name[]    ("" = empty entry)
  11. 'fonts.size[]
  12. 'fonts.style[]    (_Bold=1, _Italic=2, _Underline=4, _StrikeOut=8)
  13. 'fonts.refs[]    number of references to the font
  14.  
  15. 'Add to ITEM structure
  16. 'item.font[]    refers to the table entry
  17.  
  18. PROC InitFonts
  19.     CLEAR fonts
  20.  
  21.     fonts.name[1] = "dummy"
  22.     fonts.size[1] = "0"
  23.     fonts.style[1] = "0"
  24.     fonts.refs[1] = 0
  25. END PROC
  26.  
  27. PROC FdFontLoadAll
  28.     LOCAL i, fontdata
  29.  
  30.     FOR i = 2 to EndValid(fonts.name)
  31.         IF fonts.name[i] <> "" THEN
  32.             fontdata[1] = fonts.name[i]
  33.             fontdata[2] = fonts.size[i]
  34.             fontdata[3] = fonts.style[i]
  35.             FontNew(i; fontdata)
  36.         END IF
  37.     NEXT i
  38. END PROC
  39.  
  40. FUNC FdFontLookup(name, size, style)
  41.     LOCAL i, n
  42.  
  43.     IF name = "" THEN
  44.         RETURN 0
  45.     END IF
  46.     FOR i = 2 to EndValid(fonts.name)
  47.         IF name = fonts.name[i] THEN
  48.             IF size = fonts.size[i] AND style = fonts.style[i] THEN
  49.                 RETURN i
  50.             END IF
  51.         END IF
  52.     NEXT i
  53.     n = -1
  54.     FOR i = 2 to EndValid(fonts.name)
  55.         IF fonts.name[i] = "" THEN
  56.             n = i
  57.             EXIT FOR
  58.         END IF
  59.     NEXT i
  60.     IF n = -1 THEN
  61.         n = EndValid(fonts.name) + 1
  62.     END IF
  63.     fonts.name[n] = name
  64.     fonts.size[n] = size
  65.     fonts.style[n] = style
  66.     fonts.refs[n] = 0
  67.     FontNew(n; {name, size, style})
  68.     RETURN n
  69. END FUNC
  70.         
  71. PROC FdFontDelete(fontnum)
  72.     IF fontnum <> 0 THEN
  73.         fonts.name[fontnum] = ""
  74.         FontSelect(fontnum)
  75.         FontControl(_Close)
  76.     END IF
  77. END PROC
  78.  
  79. PROC FdFontRefDec(fontnum)
  80.     IF fontnum <> 0 THEN
  81.         fonts.refs[fontnum] = fonts.refs[fontnum] - 1
  82.         IF fonts.refs[fontnum] = 0 THEN
  83.             FdFontDelete(fontnum)
  84.         END IF
  85.     END IF
  86. END PROC
  87.  
  88. PROC FdFontRefInc(fontnum)
  89.     IF fontnum <> 0 THEN
  90.         fonts.refs[fontnum] = fonts.refs[fontnum] + 1
  91.     END IF
  92. END PROC
  93.  
  94. FUNC FdFontModal (fontnum)
  95.     LOCAL    orig, newfont, tempfont
  96.  
  97.     IF fontnum THEN
  98.         orig = {fonts.name[fontnum], fonts.size[fontnum], fonts.style[fontnum]}
  99.     ELSE
  100.         orig = {"", "", ""}
  101.     END IF
  102.     FormNew(FormQUnique)
  103.     FormControl(_Size; _Center, _Center, 40 pct, 35 pct)
  104.     FormSetObject(10, _CaptionCenter, "Current font: ", _Center, 5 pct, 100 pct, _Default)
  105.     FormSetObject(15, _CaptionCenter, FdFontStr(orig), _Center, 25 pct, 100 pct, _Default)
  106.     FormSetObject(20, _Button, "Select Font", _Center, 50 pct, 50 pct, _Default)
  107.     FormSetObject(1, _Button, "OK", _Left, _Bottom)
  108.     FormSetObject(2, _Button, "Cancel", _Right, _Bottom)
  109.     newfont = orig
  110.     result = fontnum
  111.     LOOP
  112.         SELECT CASE FormWait
  113.             CASE 1    'OK
  114.                 IF Sum(newfont <> orig) THEN
  115.                     result = FDFontLookup(newfont[1], newfont[2], newfont[3])
  116.                     IF result <> fontnum THEN
  117.                         FDFontRefDec(fontnum)
  118.                         FDFontRefInc(result)
  119.                     END IF
  120.                 END IF
  121.                 EXIT LOOP
  122.  
  123.             CASE 2    'Cancel
  124.                 EXIT LOOP
  125.  
  126.             CASE 20    'Select Font
  127.                 tempfont = StdFont()
  128.                 IF tempfont[1] <> "" THEN
  129.                     newfont = tempfont
  130.                     FormModifyObject(15, _Normal, FdFontStr(newfont))
  131.                 END IF
  132.         END SELECT
  133.     END LOOP
  134.     FormControl(_Close)
  135.     RETURN result
  136. END FUNC
  137.  
  138.  
  139. FUNC FdFontStr (fontvect)
  140.     LOCAL    flags, s
  141.  
  142.     IF fontvect[1] = "" THEN
  143.         RETURN "<default font>"
  144.     END IF
  145.     s = fontvect[1] + "-" + fontvect[2]
  146.     flags = StrToNum(fontvect[3])
  147.     IF flags THEN
  148.         s = s + "/"
  149.         IF flags mod 2 THEN
  150.             s = s + "b"
  151.         END IF
  152.         flags = flags \ 2
  153.         IF flags mod 2 THEN
  154.             s = s + "i"
  155.         END IF
  156.         flags = flags \ 2
  157.         IF flags mod 2 THEN
  158.             s = s + "u"
  159.         END IF
  160.         flags = flags \ 2
  161.         IF flags mod 2 THEN
  162.             s = s + "s"
  163.         END IF
  164.     END IF
  165.     RETURN s
  166. END FUNC
  167.