changing fonts and sizes IIIa

Thanks to Mike Ghan for continuing help. I got italics going, and it looks
good. I am encloseing more code here, trying to solve my problem on
insufficient destroying fonts after typing out a screenful.

\ typical font construction
7 CONSTANT ARIAI
: GET-ARIAI-FONT ( decipointsize -- hFont height )
   [OBJECTS LOGICAL-FONT MAKES FONT OBJECTS]
   ( point ) MY-DC LOGPIXELSY GetDeviceCaps
    720 */ NEGATE FONT Height !
   ANSI_CHARSET FONT CharSet C!
   VARIABLE_PITCH FF_SWISS OR FONT PitchAndFamily C!
   FW_NORMAL FONT Weight !
\ FW_BOLD FONT Weight !
   PROOF_QUALITY FONT Quality C!
   1 FONT Italic C! \ 1 FONT Underline C!
   S" Arial"
   FONT FaceName ZPLACE
   FONT ADDR CreateFontIndirect
   GET-FONT-MIN-HEIGHT ;

: CHANGE-FONTS \ ( --- )
\ complex loads VALUE ahFONT
\ with font handle, creates new font in my list
\ if none found.

   : SET-TEXT ( addr cnt -- )
\ -TRAILING
      TO rCNT TO pTEXT ;

\ ( taddr count Ypos Xpos frgndCOLOR bkgndCOLOR sFONT iFONT --- )
: .set-text \ same text can print to printer or screen
                     CHANGE-FONTS
    ahFONT MY-FORMAT SELECT-FONT
P-MODE @
IF \ printer
           2DROP MY-DC -ROT
           30 - 3 * SWAP 10 3 */
           4 ROLL 4 ROLL
           TextOut DROP
ELSE \ screen
           RAcolor TEXT-BG
           RAcolor TEXT-FG
           MY-FORMAT OTHER-POS
           MY-FORMAT SET-TEXT
           MY-FORMAT OUTPUT-LINE
THEN ;

: .type-text \ ( address.0th.byte )
( chooses typing or not-typing )
    IF <type-text> .set-text
    ELSE DROP
    THEN ;

: .print-s-all #R-ORG
      BEGIN DUP 1+ C@ K-mid >=
      WHILE DUP .type-text
>MOVE-AGAP \ >move-addr
      REPEAT DROP ;

: PRINT-ZZ .print-s-all ;

: FORMAT-TESTZ ( -- )

    0 0 800 800 MY-FORMAT SET-RECT
    MY-DC SaveDC DROP ( Save DC )
    MY-FORMAT HOME-POS ( Init XY Position )

   PRINT-ZZ

   MY-DC -1 ( Previous ) RestoreDC DROP
   A-DESTROY-FONTS ;

Program A-DESTROY-FONTS takes each font handle and goes through the destroy
font program. Alternatively, should I destroy the font upon each printing
out of one segment of type?

Best wishes --- Allen

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Thu Jun 26 2003 - 05:57:10 PDT