home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / theight.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  4.5 KB  |  144 lines

  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. PROGRAM name ;
  29.  
  30.   CONST
  31.     {$I gemconst.pas}
  32.  
  33.   TYPE
  34.     {$I gemtype.pas}
  35.  
  36.   VAR
  37.     height : integer ;
  38.     s : Str255 ;
  39.  
  40.   {$I gemsubs.pas}
  41.  
  42.   { Text_Height - Set the height in pixels of text, when it is drawn using the
  43.       Draw_String library call. }
  44.  
  45.   PROCEDURE Text_Height( height : integer ) ;
  46.  
  47.     TYPE
  48.       Ctrl_Parms      = ARRAY [ 0..11 ] OF integer ;
  49.       Int_In_Parms    = ARRAY [ 0..15 ] OF integer ;
  50.       Int_Out_Parms   = ARRAY [ 0..45 ] OF integer ;
  51.       Pts_In_Parms    = ARRAY [ 0..11 ] OF integer ;
  52.       Pts_Out_Parms   = ARRAY [ 0..11 ] OF integer ;
  53.  
  54.     VAR
  55.       control : Ctrl_Parms ;
  56.       int_in  : Int_In_Parms ;
  57.       int_out : Int_Out_Parms ;
  58.       pts_in  : Pts_In_Parms ;
  59.       pts_out : Pts_Out_Parms ;
  60.  
  61.     PROCEDURE VDI_Call( cmd, sub_cmd : integer ; nints, npts : integer ;
  62.                 VAR ctrl : Ctrl_Parms ;
  63.                 VAR int_in : Int_In_Parms ; VAR int_out : Int_Out_Parms ;
  64.                 VAR pts_in : Pts_In_Parms ; VAR pts_out : Pts_Out_Parms ;
  65.                 translate : boolean ) ;
  66.       EXTERNAL ;
  67.  
  68.     BEGIN
  69.       pts_in[0] := 0 ;
  70.       pts_in[1] := height ;
  71.       VDI_Call(12, 0, 0, 2, control, int_in, int_out, pts_in, pts_out, false);
  72.     END ;
  73.  
  74.   { Get_Height - Get the height in pixels of text, when it is drawn using the
  75.       Draw_String library call. }
  76.  
  77.   FUNCTION Get_Height : integer ;
  78.  
  79.     TYPE
  80.       Ctrl_Parms      = ARRAY [ 0..11 ] OF integer ;
  81.       Int_In_Parms    = ARRAY [ 0..15 ] OF integer ;
  82.       Int_Out_Parms   = ARRAY [ 0..45 ] OF integer ;
  83.       Pts_In_Parms    = ARRAY [ 0..11 ] OF integer ;
  84.       Pts_Out_Parms   = ARRAY [ 0..11 ] OF integer ;
  85.  
  86.     VAR
  87.       control : Ctrl_Parms ;
  88.       int_in  : Int_In_Parms ;
  89.       int_out : Int_Out_Parms ;
  90.       pts_in  : Pts_In_Parms ;
  91.       pts_out : Pts_Out_Parms ;
  92.  
  93.     PROCEDURE VDI_Call( cmd, sub_cmd : integer ; nints, npts : integer ;
  94.                 VAR ctrl : Ctrl_Parms ;
  95.                 VAR int_in : Int_In_Parms ; VAR int_out : Int_Out_Parms ;
  96.                 VAR pts_in : Pts_In_Parms ; VAR pts_out : Pts_Out_Parms ;
  97.                 translate : boolean ) ;
  98.       EXTERNAL ;
  99.  
  100.     BEGIN
  101.       VDI_Call(131, 0, 0, 0, control, int_in, int_out, pts_in, pts_out, false);
  102.       Get_Height := pts_out[9] ;
  103.     END ;
  104.  
  105.  
  106.  
  107.   PROCEDURE wait_button ;
  108.  
  109.     VAR
  110.       msg : Message_Buffer ;
  111.       junk : integer ;
  112.  
  113.     BEGIN
  114.       junk := Get_Event( E_Button, 1, 1, 1, 0,
  115.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  116.                         msg, junk, junk, junk, junk, junk, junk ) ;
  117.       junk := Get_Event( E_Button, 1, 0, 1, 0,
  118.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  119.                         msg, junk, junk, junk, junk, junk, junk ) ;
  120.     END ;
  121.  
  122.   BEGIN
  123.     IF Init_Gem >= 0 THEN
  124.       BEGIN
  125.         s := 'nn mm This is a test-- xyzlq' ;
  126.         s[4] := chr( Get_Height DIV 10 + ord( '0' ) ) ;
  127.         s[5] := chr( Get_Height MOD 10 + ord( '0' ) ) ;
  128.         Draw_String( 20, 190, s ) ;
  129.         wait_button ;
  130.         FOR height := 2 TO 99 DO
  131.           BEGIN
  132.             Text_Height( height ) ;
  133.             s[1] := chr( height DIV 10 + ord( '0' ) ) ;
  134.             s[2] := chr( height MOD 10 + ord( '0' ) ) ;
  135.             s[4] := chr( Get_Height DIV 10 + ord( '0' ) ) ;
  136.             s[5] := chr( Get_Height MOD 10 + ord( '0' ) ) ;
  137.             Draw_String( 20, 190, s ) ;
  138.             wait_button ;
  139.           END ;
  140.         Exit_Gem ;
  141.       END ;
  142.   END.
  143.  
  144. NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN