home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPICHAR.BAS < prev    next >
BASIC Source File  |  1989-08-26  |  13KB  |  398 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: GpiChar.BAS
  4. '*
  5. '* Include File: GpiChar.BI
  6. '*
  7. '* Functions   :
  8. '*               GpiCharString
  9. '*               GpiCharStringAt
  10. '*               GpiQueryCharStringPos
  11. '*               GpiQueryCharStringPosAt
  12. '*               GpiQueryTextBox
  13. '*               GpiQueryDefCharBox
  14. '*               GpiSetCharBox
  15. '*               GpiQueryCharBox
  16. '*               GpiSetCharAngle
  17. '*               GpiQueryCharAngle
  18. '*               GpiSetCharShear
  19. '*               GpiQueryCharShear
  20. '*               GpiSetCharDirection
  21. '*               GpiQueryCharDirection
  22. '*               GpiSetCharMode
  23. '*               GpiQueryCharMode
  24. '*               GpiCharStringPos
  25. '*               GpiCharStringPosAt
  26. '*
  27. '* Description : This program demonstrates the functions
  28. '*               contained in GPICHAR.BI.  It prints
  29. '*               several strings, altering the attributes
  30. '*               to show the effects of the various
  31. '*               functions.  Because all the calls are done
  32. '*               in the WMPAINT message, this routine delays
  33. '*               before processing messages during a redraw.
  34. '***********************************************************
  35.  
  36. '*********         Initialization section        ***********
  37.  
  38. REM $INCLUDE: 'OS2Def.BI'
  39. REM $INCLUDE: 'PMBase.BI'
  40. REM $INCLUDE: 'GpiChar.BI'
  41. REM $INCLUDE: 'GpiCont.BI'
  42. REM $INCLUDE: 'GpiLine.BI'
  43.  
  44. DIM aqmsg AS QMSG
  45.  
  46. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  47.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  48.                  FCFSHELLPOSITION OR FCFTASKLIST
  49.  
  50. szClientClass$ = "ClassName" + CHR$(0)
  51.  
  52. hab&  = WinInitialize(0)
  53. hmq&  = WinCreateMsgQueue(hab&, 0)
  54.  
  55. bool% = WinRegisterClass(_
  56.         hab&,_
  57.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  58.         RegBas,_
  59.         0,_
  60.         0)
  61.  
  62. hwndFrame& = WinCreateStdWindow (_
  63.              HWNDDESKTOP,_
  64.              WSVISIBLE,_
  65.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  66.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  67.              0,_
  68.              0,_
  69.              0,_
  70.              0,_
  71.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  72.  
  73. '**************         Message loop         ***************
  74.  
  75. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  76.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  77. WEND
  78.  
  79. '***********         Finalize section        ***************
  80.  
  81. bool% = WinDestroyWindow(hwndFrame&)
  82. bool% = WinDestroyMsgQueue(hmq&)
  83. bool% = WinTerminate(hab&)
  84.  
  85. END
  86.  
  87.  
  88. '***********         Window procedure        ***************
  89.  
  90. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  91.      DIM ClientRect AS RECTL
  92.      ClientWndProc&=0
  93.      SELECT CASE msg%
  94.      CASE WMPAINT     'Paint the window with background color
  95.         hps&  = WinBeginPaint(hwnd&, 0,_
  96.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  97.         bool% = WinFillRect(hps&,_
  98.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  99.  
  100.         CALL GPICharTST(hps&)
  101.  
  102.         bool% = WinEndPaint(hps&)
  103.      CASE ELSE        'Pass control to system for other messages
  104.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  105.      END SELECT
  106. END FUNCTION
  107.  
  108.  
  109. SUB GPICharTST(hps AS LONG)
  110.  
  111. ' ** Print out strings with normal attributes to show contrast with
  112. '    later strings printed with changed attributes.
  113.  
  114.    DIM ptlStart AS POINTL
  115.  
  116.    GPIString$ = "This is a GPI Test String"
  117.  
  118.    ptlStart.x = 100
  119.    ptlStart.y = 100
  120.  
  121.    OPEN "GpiChar.OUT" FOR OUTPUT AS #1
  122.  
  123.    GPIReturn& = GpiCharStringAt(hps,_
  124.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  125.                 LEN(GPIString$),_
  126.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  127.    PRINT #1, "GpiCharStringAt:", GPIReturn&
  128.  
  129.    GPIString$ = " - This text should follow"
  130.  
  131.    GPIReturn& = GpiCharString(hps,_
  132.                 LEN(GPIString$),_
  133.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  134.    PRINT #1, "GpiCharString:", GPIReturn&
  135.  
  136. ' ** character primitive functions
  137. '    These don't display any values, results are sent to GpiChar.OUT file
  138.  
  139.    GPIString$ = "AAA BBbb"
  140.  
  141.    DIM aptl(LEN(GPIString$)) AS POINTL
  142.  
  143.    bool% = GpiQueryCharStringPos(hps, 0, LEN(GPIString$),_
  144.            MakeLong(VARSEG(GPIString$), SADD(GPIString$)), 0,_
  145.            MakeLong(VARSEG(aptl(0)),    VARPTR(aptl(0))))
  146.    PRINT #1, "GpiQueryCharStringPos:", bool%
  147.    PRINT #1, ""
  148.    PRINT #1, "VALUES FOR GPIQueryCharStringPos"
  149.    PRINT #1, "--------------------------------"
  150.  
  151.    FOR i% = 0 to (LEN(GPIString$))
  152.      PRINT #1, MID$(GPIString$,i% + 1,1),
  153.      PRINT #1, "("; aptl(i%).x, ","; aptl(i%).y;")"
  154.    NEXT
  155.  
  156.    ptlStart.x = 10
  157.    ptlStart.y = 20
  158.  
  159.    bool% = GpiQueryCharStringPosAt(hps,_
  160.            MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)), 0,_
  161.            LEN(GPIString$),_
  162.            MakeLong(VARSEG(GPIString$), SADD(GPIString$)), 0,_
  163.            MakeLong(VARSEG(aptl(0)),    VARPTR(aptl(0))))
  164.  
  165.    PRINT #1, "GpiQueryCharStringPosAt:",bool%
  166.    PRINT #1, ""
  167.    PRINT #1, "VALUES FOR GPIQueryCharStringPosAt"
  168.    PRINT #1, "----------------------------------"
  169.  
  170.    FOR i% = 0 to (LEN(GPIString$))
  171.      PRINT #1, MID$(GPIString$,i% + 1,1),
  172.      PRINT #1, "("; aptl(i%).x, ","; aptl(i%).y;")"
  173.    NEXT
  174.  
  175. ' ** Text Box - No screen output, output sent to GpiChar.OUT
  176.  
  177.    DIM sizl AS SIZEL
  178.  
  179.    bool% = GpiQueryDefCharBox(hps, MakeLong(VARSEG(sizl), VARPTR(sizl)))
  180.    PRINT #1, "GpiQueryDefCharBox:", bool%
  181.    PRINT #1, "("; sizl.cx, ","; sizl.cy; ")"
  182.  
  183.    REDIM aptl(TXTBOXCOUNT) AS POINTL
  184.  
  185.    bool% = GpiQueryTextBox(hps,         LEN(GPIString$),_
  186.            MakeLong(VARSEG(GPIString$), SADD(GPIString$)), TXTBOXCOUNT,_
  187.            MakeLong(VARSEG(aptl(0)),    VARPTR(aptl(0))))
  188.  
  189.    PRINT #1, "GpiQueryTextBox:", bool%
  190.    PRINT #1, ""
  191.    PRINT #1, "VALUES FOR GPIQueryTextBox"
  192.    PRINT #1, "----------------------------------"
  193.  
  194.    PRINT #1, "Top Left    : ("; aptl(TXTBOXTOPLEFT).x;",";_
  195.                                 aptl(TXTBOXTOPLEFT).y;")"
  196.    PRINT #1, "Bottom Left : ("; aptl(TXTBOXBOTTOMLEFT).x;",";_
  197.                                 aptl(TXTBOXBOTTOMLEFT).y;")"
  198.    PRINT #1, "Top Right   : ("; aptl(TXTBOXTOPRIGHT).x;",";_
  199.                                 aptl(TXTBOXTOPRIGHT).y;")"
  200.    PRINT #1, "Bottom Right: ("; aptl(TXTBOXBOTTOMRIGHT).x;",";_
  201.                                 aptl(TXTBOXBOTTOMRIGHT).y;")"
  202.  
  203. ' ** Character Mode - No screen output, output sent to GpiChar.OUT
  204.  
  205.    GPIReturn& = GpiQueryCharMode(hps)
  206.    PRINT #1, "Character Mode:", GPIReturn&
  207.  
  208.    ' Set to CMMODE3 - Vector Font, otherwise the other GPICHAR calls will
  209.    '                  show no effects.
  210.  
  211.    bool% = GpiSetCharMode       (hps, CMMODE3)
  212.    PRINT #1, "GpiSetCharMode:", bool%
  213.  
  214.    GPIReturn& = GpiQueryCharMode(hps)
  215.    PRINT #1, "Character Mode:", GPIReturn&
  216.  
  217. ' ** Character Box
  218.  
  219.    DIM sizfxBox AS SIZEF
  220.    DIM newsizfxBox AS SIZEF
  221.  
  222.    GPIString$ = "1) Character Box"
  223.  
  224.    ptlStart.x = 0
  225.    ptlStart.y = 200
  226.  
  227.    GPIReturn& = GpiCharStringAt(hps,_
  228.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  229.                 LEN(GPIString$),_
  230.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  231.  
  232.    ' Get current character box size
  233.  
  234.    bool% = GpiQueryCharBox(hps, MakeLong(VARSEG(sizfxBox), VARPTR(sizfxBox)))
  235.    PRINT #1, "GpiQueryCharBox:", bool%
  236.    PRINT #1, "Character Box: ("; sizfxBox.cx; ",";sizfxBox.cy;")"
  237.  
  238.    ' double the character box size
  239.  
  240.    newsizfxBox.cy = sizfxBox.cy * 2
  241.    newsizfxBox.cx = sizfxBox.cx * 2
  242.  
  243.    bool% = GpiSetCharBox(hps,_
  244.            MakeLong(VARSEG(newsizfxBox), VARPTR(newsizfxBox)))
  245.    PRINT #1, "GpiSetCharBox:", bool%
  246.  
  247.    GPIString$ = "2) Character Box"
  248.  
  249.    ptlStart.x = 0
  250.    ptlStart.y = 180
  251.  
  252.    GPIReturn& = GpiCharStringAt(hps,_
  253.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  254.                 LEN(GPIString$),_
  255.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  256.  
  257.    bool%      = GpiQueryCharBox(hps,_
  258.                 MakeLong(VARSEG(newsizfxBox), VARPTR(newsizfxBox)))
  259.  
  260.    ' restore old character box size
  261.  
  262.    PRINT #1, "GpiQueryCharBox:", bool%
  263.    PRINT #1, "Character Box: ("; sizfxBox.cx; ",";sizfxBox.cy;")"
  264.  
  265.    ' Set character box back to default
  266.  
  267.    bool% = GpiSetCharBox(hps, MakeLong(VARSEG(sizfxBox), VARPTR(sizfxBox)))
  268.  
  269. ' Character Angle
  270.  
  271.    DIM gradlAngle AS GRADIENTL
  272.  
  273.    GPIString$ = "Character Angle"
  274.  
  275.    bool% = GpiQueryCharAngle(hps,_
  276.            MakeLong(VARSEG(gradlAngle), VARPTR(gradlAngle)))
  277.    PRINT #1, "GpiQueryCharAngle:", bool%
  278.    PRINT #1, "Character Angle: ("; gradlAngle.x, ","; gradlAngle.y; ")"
  279.  
  280.    gradlAngle.x = 1
  281.    gradlAngle.y = 1
  282.  
  283.    bool% = GpiSetCharAngle(hps,_
  284.            MakeLong(VARSEG(gradlAngle), VARPTR(gradlAngle)))
  285.    PRINT #1, "GpiSetCharAngle:", bool%
  286.  
  287.    ptlStart.x = 200
  288.    ptlStart.y = 250
  289.  
  290.    ' rotate the characters around in a circle at 45 degree increments
  291.  
  292.    FOR angle% = 1 TO 360 STEP 45
  293.       ang = angle% * 3.1416 / 180!
  294.  
  295.       gradlAngle.x = sin(ang)
  296.       gradlAngle.y = cos(ang)
  297.  
  298.       bool%      = GpiSetCharAngle(hps,_
  299.                    MakeLong(VARSEG(gradlAngle), VARPTR(gradlAngle)))
  300.  
  301.       GPIReturn& = GpiCharStringAt(hps,_
  302.                    MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  303.                    LEN(GPIString$),_
  304.                    MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  305.    NEXT
  306.  
  307.    bool% = GpiQueryCharAngle(hps,_
  308.            MakeLong(VARSEG(gradlAngle), VARPTR(gradlAngle)))
  309.    PRINT #1, "GpiQueryCharAngle:", bool%
  310.    PRINT #1, "Character Angle: ("; gradlAngle.x, ","; gradlAngle.y; ")"
  311.  
  312.    gradlAngle.x = 1
  313.    gradlAngle.y = 0
  314.  
  315.    bool% = GpiSetCharAngle(hps,_
  316.            MakeLong(VARSEG(gradlAngle), VARPTR(gradlAngle)))
  317.  
  318. ' Character Shear
  319.  
  320.    DIM ptlshear AS POINTL
  321.  
  322.    GPIString$ = "Character Shear"
  323.  
  324.    bool% = GpiQueryCharShear(hps,_
  325.            MakeLong(VARSEG(ptlshear), VARPTR(ptlshear)))
  326.    PRINT #1, "GpiQueryCharShear:", bool%
  327.    PRINT #1, "Character Shear: ("; ptlshear.x, ","; ptlshear.y; ")"
  328.  
  329.    ptlshear.x = 1
  330.    ptlshear.y = 1
  331.  
  332.    bool% = GpiSetCharShear(hps, MakeLong(VARSEG(ptlshear), VARPTR(ptlshear)))
  333.    PRINT #1, "GpiSetCharShear:", bool%
  334.  
  335.    ptlStart.x = 0
  336.    ptlStart.y = 170
  337.  
  338.    GPIReturn& = GpiCharStringAt  (hps,_
  339.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  340.                 LEN(GPIString$),_
  341.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  342.  
  343.    bool%      = GpiQueryCharShear(hps,_
  344.                 MakeLong(VARSEG(ptlshear), VARPTR(ptlshear)))
  345.    PRINT #1, "GpiQueryCharShear:", bool%
  346.    PRINT #1, "Character Shear: ("; ptlshear.x, ","; ptlshear.y; ")"
  347.  
  348. ' Character Direction
  349. ' NOTE: This doesn't show any effect, as only current values that can be
  350. '       passed to GpiSetCharDirection are LEFT TO RIGHT.
  351.  
  352.    GPIString$ = "Character Direction"
  353.  
  354.    GPIReturn& = GpiQueryCharDirection(hps)
  355.    PRINT #1, "GpiQueryCharDirection:", GPIReturn&
  356.  
  357.    chardir& = CHDIRNDEFAULT
  358.    bool% = GpiSetCharDirection(hps,_
  359.            MakeLong(VARSEG(chardir&), VARPTR(chardir&)))
  360.    PRINT #1, "GpiSetCharDirection:", bool%
  361.  
  362.    ptlStart.x = 0
  363.    ptlStart.y = 160
  364.  
  365.    GPIReturn& = GpiCharStringAt(hps,_
  366.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  367.                 LEN(GPIString$),_
  368.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)))
  369.  
  370.    GPIReturn& = GpiQueryCharDirection(hps)
  371.    PRINT #1, "GpiQueryCharDirection:", GPIReturn&
  372.  
  373. ' Character String
  374.  
  375.    DIM rect AS RECTL
  376.  
  377.    GPIString$ = " Char String Pos1"
  378.  
  379.    GPIReturn& = GpiCharStringPos(hps,_
  380.                 MakeLong(VARSEG(rect), VARPTR(rect)),_
  381.                 CHSLEAVEPOS, LEN(GPIString$),_
  382.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)),_
  383.                 MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  384.  
  385.    ptlStart.x = 0
  386.    ptlStart.y = 150
  387.    GPIString$ = "Char String Pos2"
  388.  
  389.    GPIReturn& = GpiCharStringPosAt(hps,_
  390.                 MakeLong(VARSEG(ptlStart),   VARPTR(ptlStart)),_
  391.                 MakeLong(VARSEG(rect),       VARPTR(rect)),_
  392.                 CHSLEAVEPOS, LEN(GPIString$),_
  393.                 MakeLong(VARSEG(GPIString$), SADD(GPIString$)),_
  394.                 MakeLong(VARSEG(aptl(0)),    VARPTR(aptl(0))))
  395.    CLOSE #1
  396.  
  397. END SUB
  398.