home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / FONT.PRG < prev    next >
Text File  |  1994-02-22  |  6KB  |  163 lines
  1. ////////////////////////////
  2. //
  3. //    Clip-4-Win font demo
  4. //
  5. //    Copyright (C) 1992 Skelton Software, Kendal Cottage, Hillam, Leeds, UK.
  6. //    All Rights Reserved.
  7. //
  8. //
  9. //    Compile:    font /n /w
  10. //    Link:        /se:600 font achoice,,,,clip4win.def
  11. //
  12. //
  13. //    Note: I apologise to those who would prefer "font" to be used
  14. //          properly (i.e. as distinct from a type face).  I guess
  15. //          the MS people either didn't realise the difference or
  16. //          didn't care.  I'm going to continue the trend.  Sorry.
  17. //
  18. ////////////////////////////
  19.  
  20. #include "windows.ch"
  21. #include "font.ch"
  22. #include "textmetr.ch"
  23.  
  24.  
  25. static    hWnd
  26. static    cAppName := "C4WFont"
  27.  
  28.  
  29. function main()
  30. local    nEvent, hDC, hFont, hOldFont, nColour := RGB(0, 0, 0), i
  31. local    aFont := {16, 16, 450, 0, 400, .f., .f., .f., 1, 0, 0, 0, 0, "Arial"}
  32. local    aShow := { {200, 200, 300}, {50, 200, 900}, {400, 50, 3150} }
  33. local    lDelFont := .f.        // this isn't actually needed, because it's
  34.                 // ok to use DeleteObject() with stock objects
  35.                 // (it's ignored)
  36. local    nKey, aTM
  37. local    aStockFonts :=                    ;
  38. {                            ;
  39.     {"OEM_FIXED_FONT",    OEM_FIXED_FONT},    ;
  40.     {"ANSI_FIXED_FONT",    ANSI_FIXED_FONT},    ;
  41.     {"ANSI_VAR_FONT",    ANSI_VAR_FONT},        ;
  42.     {"SYSTEM_FONT",        SYSTEM_FONT},        ;
  43.     {"DEVICE_DEFAULT_FONT",    DEVICE_DEFAULT_FONT},    ;
  44.     {"SYSTEM_FIXED_FONT",    SYSTEM_FIXED_FONT}    ;
  45. }
  46.  
  47. hWnd = WinSetup(cAppName, "Clip-4-Win font demo")
  48. SetColor("n/w,+w/n,+w,+w,+w/n")
  49.  
  50. do while .t.
  51.     do while (nEvent := ChkEvent()) == EVENT_NONE
  52.     enddo
  53.  
  54.     do case
  55.     case nEvent == EVENT_REDRAW
  56.     // You can see the difference between ? and @ ... SAY
  57.     @ 1,0 say "  Press 1 to choose a stock font"
  58.     @ 2,0 say "  Press 2 to use ChooseFont()..."
  59.     SetPos(15, 0)
  60.     ? "  Press 1 to choose a stock font"
  61.     ? "  Press 2 to use ChooseFont()..."
  62.  
  63.     case nEvent == EVENT_KEY .and. (nKey := inkey(0)) == asc("1")
  64.     if (i := achoice(5, 5, 20, 75, aColumn(aStockFonts, 1))) != 0
  65.         InvalidateRect(hWnd)    // clear the window
  66.         UpdateWindow(hWnd)        // and make sure it's finished
  67.         if lDelFont
  68.         DeleteObject(C4W_SetFont())    // delete the old font
  69.         endif
  70.  
  71.         // this works but is dumb (slow, and thrashes the VMM):
  72.         // hFont = GetStockObject(aColumn(aStockFonts, 2)[i])
  73.         hFont = GetStockObject(aStockFonts[i, 2])
  74.  
  75.         // NOTE:  See the NOTE below about proportional fonts.
  76.         hDC = GetDC(hWnd)
  77.         hOldFont = SelectObject(hDC, hFont)
  78.         if GetTextMetrics(hDC, @aTM)    // see TEXTMETR.PRG
  79.         C4W_SetFont(hFont, (aTM[TM_AveCharWidth] + aTM[TM_MaxCharWidth]) / 2)
  80.         else
  81.         C4W_SetFont(hFont)
  82.         endif
  83.         SelectObject(hDC, hOldFont)
  84.         ReleaseDC(hWnd, hDC)
  85.  
  86.         lDelFont = .f.        // no need to delete the new font
  87.     endif
  88.  
  89.     case nEvent == EVENT_KEY .and. nKey == asc("2")
  90.     aFont = ChooseFont(aFont, , , @nColour)
  91.     if aFont != nil        // else user chose cancel/close or hit Esc
  92.         InvalidateRect(hWnd)    // clear the window
  93.         UpdateWindow(hWnd)        // and make sure it's finished
  94.  
  95.         hDC = GetDC(hWnd)
  96.         SetTextColor(hDC, nColour)
  97.         for i = 1 to len(aShow)
  98.         aFont[LF_Escapement] = aShow[i, 3]
  99.         hFont = CreateFont(aFont)
  100.         hOldFont = SelectObject(hDC, hFont)
  101.         TextOut(hDC, aShow[i, 1], aShow[i, 2], "Clip-4-Win")
  102.         SelectObject(hDC, hOldFont)
  103.         DeleteObject(hFont)
  104.         next i
  105.         /*
  106.          *  NOTE:
  107.          *
  108.          *  Using a proportional font for Clipper's output
  109.          *  (i.e. for ?, ??, @ ... SAY, TBrowse, etc.) is going to
  110.          *  cause problems.  Clipper doesn't have built-in support
  111.          *  for proportional fonts, and it puts output characters
  112.          *  either at a row,col position or at the current position
  113.          *  (possibly +1 col).  Neither of these is entirely right
  114.          *  for proportional fonts: the 1st means you need to use the
  115.          *  width of the widest character to decide where columns are
  116.          *  (otherwise some chars will overlap others), and the 2nd
  117.          *  way of positioning output means tabular output may not
  118.          *  line up properly.
  119.          *
  120.          *  Getting the caret (if you have one) in the right place is
  121.          *  bound to be a litle painful.  You're *advised* to use
  122.          *  non-proportional (i.e. fixed) fonts!!  Otherwise, you might
  123.          *  like to consider using GetTextExtent(), quite possibly with
  124.          *  DrawText() or TextOut().
  125.          *
  126.          *  The C4W_SetFont() function can return the width and height
  127.          *  that will be used for the chars of the font.  It defaults
  128.          *  to using the average char width (see TEXTMETR.CH).  If you
  129.          *  are careful with how you do output, that is fine and lets
  130.          *  you get nicely formatted output, despite using e.g. @ ... SAY.
  131.          *  You might like to consider using "SAY.CH", of course.
  132.          *
  133.          *  However, for this sample let's change the column width to
  134.          *  be the average of the average and widest chars.
  135.          */
  136.         if lDelFont
  137.         DeleteObject(C4W_SetFont())    // delete the old font
  138.         endif
  139.         aFont[LF_Escapement] = 0
  140.         hFont = CreateFont(aFont)        // here's the new font
  141.         hOldFont = SelectObject(hDC, hFont)
  142.         if GetTextMetrics(hDC, @aTM)    // see TEXTMETR.PRG
  143.         C4W_SetFont(hFont, (aTM[TM_AveCharWidth] + aTM[TM_MaxCharWidth]) / 2)
  144.         else
  145.         C4W_SetFont(hFont)
  146.         endif
  147.         SelectObject(hDC, hOldFont)
  148.         ReleaseDC(hWnd, hDC)
  149.         lDelFont = .t.        // need to delete this font eventually
  150.     endif
  151.     endcase
  152. enddo
  153.  
  154. return 0
  155.  
  156.  
  157. // this isn't terribly fast, but it's handy
  158. static function aColumn(aTable, n)    // --> column n of aTable
  159. local    aRet := {}
  160. aeval(aTable, {|a| aadd(aRet, a[n])})    // aeval() and aadd() are both slow!
  161. return aRet
  162.  
  163.