home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / adaada.zip / ADAADA.ZIP / SRC / CW_ADA / CW_ATTR_.ADA next >
Text File  |  1994-10-12  |  5KB  |  172 lines
  1. -- Copyright (c) 1994 ARINC Research Corporation
  2. -- From material copyright (c) 1991, 1992 Premia Corporation
  3. --
  4. -- This material may be reproduced by or for the US Government pursuant 
  5. -- to the copyright license under DFAR Clause 252.227-7013 (1988)
  6. --
  7. -- Developed for US Air Force under contract no. F41608-90-D-0544-0005
  8. --
  9. -- MODIFICATIONS
  10. --   94/06 - J. Neuse, SD/OSE/EA  - Initial code
  11. --   94/10 - O. Sluder, SD/OSE/EA - Cleanup
  12.  
  13. with SYSTEM;
  14.  
  15. -- *************
  16. -- *           *
  17. -- *  CW_ATTR  *  BODY
  18. -- *           *
  19. -- *************
  20.  
  21. package body CW_ATTR is
  22.  
  23.   -- The following pragmas are required by the Meridian OpenAda for
  24.   -- Windows 2.0 compiler in the package spec and body of code to be
  25.   -- included in a DLL, or an application calling the DLL will 
  26.   -- general protection fault
  27.   pragma SUPPRESS (elaboration_check);
  28.   pragma SUPPRESS (storage_check);
  29.  
  30.   -- .....................
  31.   -- .                   .
  32.   -- .  AttrFindVisible  .  BODY
  33.   -- .                   .
  34.   -- .....................
  35.  
  36.   function AttrFindVisible (visAttr  : in INTEGER;
  37.                             forward  : in BOOLEAN;
  38.                             matching : in BOOLEAN) return BOOLEAN is
  39.  
  40.     Pass_forward  : INTEGER;
  41.     Pass_Matching : INTEGER;
  42.     Return_Int    : INTEGER;
  43.  
  44.     -- ........................
  45.     -- .                      .
  46.     -- .  CW_AttrFindVisible  .  SPEC
  47.     -- .                      .
  48.     -- ........................
  49.  
  50.     function CW_AttrFindVisible (visAttr  : in INTEGER;
  51.                                  forward  : in INTEGER;
  52.                                  matching : in INTEGER) return INTEGER;
  53.     pragma INTERFACE (windows, CW_AttrFindVisible, "AttrFindVisible");
  54.  
  55.   begin --  function AttrFindVisible
  56.  
  57.     if forward then
  58.       Pass_Forward := 1;
  59.     else
  60.       Pass_Forward := 0;
  61.     end if;
  62.  
  63.     if matching then
  64.       Pass_matching := 1;
  65.     else
  66.       Pass_matching := 0;
  67.     end if;
  68.  
  69.     Return_Int := CW_AttrFindVisible (visAttr, Pass_forward, Pass_matching);
  70.     return (Return_Int /= 0);
  71.  
  72.   end AttrFindVisible;
  73.  
  74.   -- ..................
  75.   -- .                .
  76.   -- .  AttrSetColor  .  BODY
  77.   -- .                .
  78.   -- ..................
  79.   --
  80.   -- NOTES
  81.     --   Codewright's documentation on AttrSetColor (Programmer's
  82.     --   Reference, page 85) implies that the largest value to be used 
  83.     --   with this procedure is 16#7FFF_FFFF#. Therefore, we can use 
  84.     --   Meridian's Long_Integer type in the Ada interface
  85.  
  86.   procedure AttrSetColor (fline : in long_integer;
  87.                           lline : in long_integer;
  88.                           fcol  : in long_integer;
  89.                           lcol  : in long_integer;
  90.                           color : in integer) is
  91.  
  92.     -- .....................
  93.     -- .                   .
  94.     -- .  CW_AttrSetColor  .  SPEC
  95.     -- .                   .
  96.     -- .....................
  97.  
  98.     procedure CW_AttrSetColor (fline : in CW_TYPES.DWORD;
  99.                                lline : in CW_TYPES.DWORD;
  100.                                fcol  : in CW_TYPES.DWORD;
  101.                                lcol  : in CW_TYPES.DWORD;
  102.                                color : in integer);
  103.     pragma INTERFACE (windows, CW_AttrSetColor, "AttrSetColor");
  104.  
  105.   begin
  106.  
  107.     CW_AttrSetColor (CW_TYPES.DWORD (fline), CW_TYPES.DWORD (lline),
  108.                      CW_TYPES.DWORD (fcol), CW_TYPES.DWORD (lcol), color);
  109.  
  110.   end AttrSetColor;
  111.  
  112.   -- ....................
  113.   -- .                  .
  114.   -- .  AttrSetVisible  .  BODY
  115.   -- .                  .
  116.   -- ....................
  117.  
  118.   procedure AttrSetVisible (first   : in CW_TYPES.DWORD;
  119.                             last    : in CW_TYPES.DWORD;
  120.                             visAttr : in INTEGER) is
  121.  
  122.     Pass_forward  : INTEGER;
  123.     Pass_Matching : INTEGER;
  124.     Return_Int    : INTEGER;
  125.  
  126.     -- .......................
  127.     -- .                     .
  128.     -- .  CW_AttrSetVisible  .  SPEC
  129.     -- .                     .
  130.     -- .......................
  131.  
  132.     procedure CW_AttrSetVisible (first   : in CW_TYPES.DWORD;
  133.                                  last    : in CW_TYPES.DWORD;
  134.                                  visAttr : in INTEGER);
  135.     pragma INTERFACE (windows, CW_AttrSetVisible, "AttrSetVisible");
  136.  
  137.   begin --  function AttrSetVisible
  138.  
  139.     CW_AttrSetVisible (first, last, visAttr);
  140.  
  141.   end AttrSetVisible;
  142.  
  143.   -- ..........
  144.   -- .        .
  145.   -- .  Grep  .  BODY
  146.   -- .        .
  147.   -- ..........
  148.  
  149.   function Grep (str : in string) return LONG_INTEGER is
  150.  
  151.     Pass_LPSTR  : CW_TYPES.LPSTR;
  152.     Return_Long : LONG_INTEGER;
  153.  
  154.     -- .............
  155.     -- .           .
  156.     -- .  CW_Grep  .  SPEC
  157.     -- .           .
  158.     -- .............
  159.  
  160.     function CW_Grep (str : in SYSTEM.ADDRESS) return LONG_INTEGER;
  161.     pragma INTERFACE (windows, CW_Grep, "Grep");
  162.  
  163.   begin --  function Grep
  164.  
  165.     Pass_LPSTR  := new STRING'(str & ascii.nul);
  166.     Return_Long := CW_Grep (Pass_LPSTR.all (Pass_LPSTR.all'FIRST)'ADDRESS);
  167.     return Return_Long;
  168.  
  169.   end Grep;
  170.  
  171. end CW_ATTR;
  172.