home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adapm_15.zip / win_bak.adb < prev    next >
Text File  |  1994-03-14  |  44KB  |  1,165 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                               PM Bindings                                --
  4. --                                                                          --
  5. --                                  WIN                                     --
  6. --                                                                          --
  7. --                                 Body                                     --
  8. --                                                                          --
  9. --                            $Revision: .14 $                              --
  10. --                                                                          --
  11. --     Copyright (c) 1994 Dimensional Media Systems, All Rights Reserved    --
  12. --                                                                          --
  13. --   The PM bindings are free software; you can redistribute them and/or    --
  14. --   modify them under terms of the GNU General Public License as published --
  15. --   by the Free Software Foundation; either version 2, or (at your         --
  16. --   option) any later version.  The PM bindings are distributed in the     --
  17. --   hope that they will be useful, but WITH OUT ANY WARRANTY; without even --
  18. --   the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR    --
  19. --   PURPOSE.  See the GNU General Public License for more details.  You    --
  20. --   should have received a copy of the GNU General Public License          --
  21. --   distributed with The PM bindings; see file COPYING.  If not, write to  --
  22. --   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25. --                                                                          --
  26. --   For more information about these PM bindings and their usage with GNAT --
  27. --   you can contact Bill Yow at                                            --
  28. --                                                                          --  
  29. --      Dimensional Media Systems (DMS)                                     --
  30. --      1522 Festival Dr.                                                   --
  31. --      Houston TX, 77062                                                   --
  32. --      Phone - (713) 488-7050                                              --
  33. --      Email - Byow@mci.com                                                --
  34. --                                                                          --
  35. ------------------------------------------------------------------------------
  36.  
  37. with System;
  38. with Pm_Types;
  39.  
  40. with Text_IO;
  41.  
  42. with Unchecked_Conversion;
  43.  
  44. package body Win is
  45.  
  46.   Short_True     : constant Pm_Types.U_Short := 1;
  47.   Short_False    : constant Pm_Types.U_Short := 0;
  48.  
  49.   Long_True      : constant Pm_Types.U_Long := 1;
  50.   Long_False     : constant Pm_Types.U_Long := 0;
  51.  
  52.   Boolean_Value  : constant array (Boolean) of PM_Types.U_Long := (0, 1);
  53.  
  54.   Boolean_Result : constant array (Pm_Types.U_Long range 0 .. 1) 
  55.                      of Boolean := (False, True);
  56.  
  57.   MB_Response : constant array (Pm_Types.U_Short range 1 .. 9) 
  58.                    of MB_Response_Type :=
  59.      (1 => MB_Ok_Pressed,
  60.       2 => MB_Cancel_Pressed,
  61.       3 => Mb_Abort_Pressed,
  62.       4 => Mb_Retry_Pressed,
  63.       5 => Mb_Ignore_Pressed,
  64.       6 => Mb_Yes_Pressed,
  65.       7 => Mb_No_Pressed,
  66.       8 => Mb_Help_Pressed,
  67.       9 => Mb_Enter_Pressed); 
  68.  
  69.   MB_Buttons : constant array (Mb_Button_Styles_Type) of Pm_Types.U_Long := 
  70.      (MB_Ok                 => 16#0000#,
  71.       MB_Ok_Cancel          => 16#0001#,
  72.       MB_Cancel             => 16#0006#,
  73.       MB_Enter              => 16#0007#,
  74.       MB_Enter_Cancel       => 16#0008#,
  75.       MB_Retry_Cancel       => 16#0002#,
  76.       MB_Abort_Retry_Ignore => 16#0003#,
  77.       MB_Yes_No             => 16#0004#,
  78.       MB_Yes_No_Cancel      => 16#0005#);
  79.  
  80.   MB_Icons : constant array (Mb_Icon_Styles_Type) of Pm_Types.U_Long := 
  81.       (Mb_No_Icon          => 16#0000#,
  82.        Mb_Icon_Hand        => 16#0040#,
  83.        Mb_Icon_Question    => 16#0010#,
  84.        Mb_Icon_Exclamation => 16#0020#,
  85.        Mb_Icon_Asterisk    => 16#0030#,
  86.        Mb_Information      => 16#0030#,
  87.        Mb_Query            => 16#0010#,
  88.        Mb_Warning          => 16#0020#,
  89.        Mb_Error            => 16#0040#);
  90.  
  91.   MB_Action : constant array (Mb_Default_Action_Type) of Pm_Types.U_Long := 
  92.        (MB_Default_on_Button_1 => 16#0000#,
  93.         MB_Default_on_Button_2 => 16#0100#,
  94.         MB_Default_on_Button_3 => 16#0200#);
  95.  
  96.   MB_Modality : constant array (Mb_Modality_Type) of Pm_Types.U_Long := 
  97.        (Mb_Application_Modal => 16#0000#,
  98.         Mb_System_Modal      => 16#1000#);
  99.  
  100.   MB_Help     : constant array (Boolean) 
  101.                     of Pm_Types.U_Long := (16#0000#, 16#2000#);
  102.   MB_Moveable : constant array (Boolean) 
  103.                     of Pm_Types.U_Long := (16#0000#, 16#4000#);
  104.  
  105.   ------------------------------------------------
  106.  
  107.   Win_Style_Values : constant array (Class_Style_Type) of Pm_Types.U_Long :=
  108.        (Cs_Size_Redraw    => 16#0000_0004#,
  109.         Cs_Sync_Paint     => 16#0200_0000#,
  110.         Cs_Move_Notify    => 16#0000_0001#,
  111.         Cs_Clip_Children  => 16#2000_0000#,
  112.         Cs_Clip_Siblings  => 16#1000_0000#,
  113.         Cs_Parent_Clip    => 16#0800_0000#,
  114.         Cs_Save_Bits      => 16#0400_0000#,
  115.         Cs_Public         => 16#0000_0010#,
  116.         Cs_Hit_Test       => 16#0000_0008#,
  117.         Cs_Frame          => 16#0000_0020#); 
  118.          
  119.   ------------------------------------------------
  120.  
  121.    Win_Position_Values : constant array (Position_Options_Type) 
  122.                                                      of Pm_Types.U_Long :=
  123.        (Swp_Size             => 16#0001#,
  124.         Swp_Move             => 16#0002#,
  125.         Swp_Z_Order          => 16#0004#,
  126.         Swp_Show             => 16#0008#,
  127.         Swp_Hide             => 16#0010#,
  128.         Swp_No_Redraw        => 16#0020#,
  129.         Swp_No_Adjust        => 16#0040#,
  130.         Swp_Activate         => 16#0080#,
  131.         Swp_Deactivate       => 16#0100#,
  132.         Swp_Ext_State_Change => 16#0200#,
  133.         Swp_Minimize         => 16#0400#,
  134.         Swp_Maximize         => 16#0800#,
  135.         Swp_Restore          => 16#1000#,
  136.         Swp_Focus_Active     => 16#2000#,
  137.         Swp_Focus_Deactivate => 16#4000#,
  138.         Swp_No_Auto_Close    => 16#8000#);
  139.  
  140.   ------------------------------------------------
  141.  
  142.    Window_Style_Values : constant array (Window_Style_Type) 
  143.                                         of PM_Types.U_Long := (
  144.       Ws_Sync_Paint         => 16#0200_0000#,
  145.       Ws_Clip_Children      => 16#2000_0000#,
  146.       Ws_Clip_Siblings      => 16#1000_0000#,
  147.       Ws_Disabled           => 16#4000_0000#,
  148.       Ws_Maximized          => 16#0080_0000#,
  149.       Ws_Mimimized          => 16#0100_0000#,
  150.       Ws_Parent_Clip        => 16#0800_0000#,
  151.       Ws_Save_Bits          => 16#0400_0000#,
  152.       Ws_Visible            => 16#8000_0000#,
  153.       Ws_Animate            => 16#0040_0000#,
  154.       Ws_Group              => 16#0001_0000#,
  155.       Ws_Tab_Stop           => 16#0002_0000#,
  156.       Ws_Multi_Select       => 16#0004_0000#,
  157.  
  158.       Fs_Screen_Align       => 16#0000_0200#,
  159.       Fs_Mouse_Align        => 16#0000_0400#,
  160.       Fs_Sizing_Border      => 16#0000_0800#,
  161.       Fs_Border             => 16#0000_0100#,
  162.       Fs_Dialog_Border      => 16#0000_0080#,
  163.       Fs_System_Modal       => 16#0000_0040#,
  164.       Fs_No_Byte_Align      => 16#0000_0010#,
  165.       Fs_Task_List          => 16#0000_0008#,
  166.       Fs_No_Move_With_Owner => 16#0000_0020#,
  167.       Fs_Auto_Icon          => 16#0000_1000#);
  168.  
  169.   ------------------------------------------------
  170.  
  171.    Frame_Values : constant array (Frame_Control_Flag_Type) 
  172.                    of Pm_Types.U_Long := (
  173.         Fcf_Title_Bar          => 16#0000_0001#,
  174.         Fcf_System_Menu        => 16#0000_0002#,
  175.         Fcf_Menu               => 16#0000_0004#,
  176.         Fcf_Min_Max            => 16#0000_0030#,
  177.         Fcf_Min_Button         => 16#0000_0010#,
  178.         Fcf_Max_Button         => 16#0000_0020#,
  179.         Fcf_Vert_Scroll_Bar    => 16#0000_0040#,
  180.         Fcf_Horz_Scroll_Bar    => 16#0000_0080#,
  181.         Fcf_Sizing_Border      => 16#0000_0008#,
  182.         Fcf_Border             => 16#0000_0200#,
  183.         Fcf_Dialog_Border      => 16#0000_0100#,
  184.         Fcf_Accel_Table        => 16#0000_8000#,
  185.         Fcf_Icon               => 16#0000_4000#,
  186.         Fcf_Shell_Position     => 16#0000_0400#,
  187.         Fcf_System_Modal       => 16#0001_0000#,
  188.         Fcf_No_Byte_Align      => 16#0000_1000#,
  189.         Fcf_Task_List          => 16#0000_0800#,
  190.         Fcf_No_Move_With_Owner => 16#0000_2000#,
  191.         Fcf_Standard           => 16#0000_CC3F#,
  192.         Fcf_Screen_Align       => 16#0002_0000#,
  193.         Fcf_Mouse_Align        => 16#0004_0000#,
  194.         Fcf_Auto_Icon          => 16#4000_0000#,
  195.         Fcf_Hide_Button        => 16#0100_0000#,
  196.         Fcf_Hide_Max           => 16#0100_0020#);
  197.  
  198.   Frame_Id_Values : constant array (Frame_Id_Type) of Pm_Types.U_Long := (
  199.          Fid_System_Menu      => 16#8002#,
  200.          Fid_Titlebar         => 16#8003#,
  201.          Fid_Min_Max          => 16#8004#,
  202.          Fid_Menu             => 16#8005#,
  203.          Fid_Vert_Scroll_Bar  => 16#8006#,
  204.          Fid_Horz_Scroll_Bar  => 16#8007#,
  205.          Fid_Client           => 16#8008#,
  206.          Fid_DBE_App_Stat     => 16#8010#,
  207.          Fid_DBE_Kbd_Stat     => 16#8011#,
  208.          Fid_DBE_Pecic        => 16#8012#,
  209.          Fid_Dbe_KK_Pop_Up    => 16#8013#);
  210.  
  211.    Command_Source_Values : constant array (Pm_Types.U_Short range 0 .. 7) 
  212.                             of Command_Source_Type := 
  213.        (0 => Cmd_Src_Other,
  214.         1 => Cmd_Src_Push_Button,
  215.         2 => Cmd_Src_Menu,
  216.         3 => Cmd_Src_Accelerator,
  217.         4 => Cmd_Src_Font_Dialog,
  218.         5 => Cmd_Src_File_Dialog,
  219.         6 => Cmd_Src_Print_Dialog,
  220.         7 => Cmd_Src_Color_Dialog);
  221.  
  222.   ------------------------------------------------
  223.  
  224.    MIS_Values : constant array (Menu_Style_Type) of Pm_Types.U_Short := (
  225.        MIS_Submenu          => 16#0010#,
  226.        MIS_Mult_Menu        => 16#0020#,
  227.        MIS_Sys_Command      => 16#0030#,
  228.        MIS_Help             => 16#0080#,
  229.        MIS_Static           => 16#0100#,
  230.        MIS_Button_Separator => 16#0200#,
  231.        MIS_Break            => 16#0400#,
  232.        MIS_Break_Separator  => 16#0800#,
  233.        MIS_Group            => 16#1000#,
  234.        MIS_Single           => 16#2000#);
  235.  
  236.   ------------------------------------------------
  237.  
  238.    MIA_Values : constant array (Menu_Attribute_Type) of Pm_Types.U_Short := (
  239.         MIA_No_Dismiss  => 16#0020#,
  240.         MIA_Framed      => 16#1000#,
  241.         MIA_Checked     => 16#2000#,
  242.         MIA_Disabled    => 16#4000#,
  243.         MIA_Highlighted => 16#8000#);
  244.  
  245.   ------------------------------------------------
  246.  
  247.   function To_Boolean   (Void : Void_Type) return Boolean is
  248.     begin
  249.       return Void = 1;
  250.     end To_Boolean;
  251.  
  252.   ------------------------------------------------
  253.  
  254.   function To_Short     (Void : Void_Type) return Pm_Types.Short is
  255.     begin
  256.       return Pm_Types.Short (Void);
  257.     end To_Short;
  258.  
  259.   ------------------------------------------------
  260.  
  261.   function To_U_Short   (Void : Void_Type) return Pm_Types.U_Short is
  262.     begin
  263.       return Pm_Types.U_Short (Void);
  264.     end To_U_Short;
  265.  
  266.   ------------------------------------------------
  267.  
  268.   function Parm_to_SPT is new Unchecked_Conversion (
  269.                                  Target => Short_Point_Type,
  270.                                  Source => Win.Parameter_Type);
  271.  
  272.   ------------------------------------------------
  273.  
  274.   function Is_Null (Window       : Handle_Type) return Boolean is
  275.     begin
  276.       return Window = Null_Window;
  277.     end Is_Null;
  278.  
  279.   ------------------------------------------------
  280.  
  281.   function Is_Null (Queue        : Queue_Handle_Type) return Boolean is
  282.     begin
  283.       return Queue = Null_Queue;
  284.     end Is_Null;
  285.  
  286.   ------------------------------------------------
  287.  
  288.   function Is_Null (Anchor_Block : Anchor_Block_Handle_Type) return Boolean is
  289.     begin
  290.       return Anchor_Block = Null_Anchor_Block;
  291.     end Is_Null;
  292.  
  293.   ------------------------------------------------
  294.  
  295.   function Is_Null (PS           : PS_Type) return Boolean is
  296.     begin
  297.       return PS = Null_Ps;
  298.     end Is_Null;
  299.  
  300.   ------------------------------------------------
  301.  
  302.   function Get_Error_Info (Anchor_Block : Anchor_Block_Handle_Type)
  303.                                      return Error_Info_Pointer_Type is
  304.      function WinGetErrorInfo (Hab : Anchor_Block_Handle_Type) 
  305.                                         return Error_Info_Pointer_Type;
  306.       pragma Import (Convention => C,
  307.                      Entity     => WinGetErrorInfo,
  308.                      Link_Name  => "*WinGetErrorInfo");
  309.      
  310.     begin
  311.       return WinGetErrorInfo (Anchor_Block);
  312.     end Get_Error_Info;
  313.  
  314.   ------------------------------------------------
  315.  
  316.   function Get_Last_Error (Anchor_Block : Anchor_Block_Handle_Type) 
  317.                                                   return Pm_Types.U_Long is
  318.   
  319.      function WinGetLastError (Hab : Anchor_Block_Handle_Type)
  320.                                                   return Pm_Types.U_Long;
  321.       pragma Import (Convention => C,
  322.                      Entity     => WinGetLastError,
  323.                      Link_Name  => "*WinGetLastError");
  324.      
  325.       Error : Pm_Types.U_Long;     
  326.     begin
  327.  
  328.       Text_IO.Put ("Pm_Types.U_Long Size => ");
  329.       Text_Io.Put_Line (Integer'Image (Pm_Types.U_Long'size));
  330.  
  331.       Error := WinGetLastError (Anchor_Block);
  332.       Text_Io.Put ("Error num is ");
  333.       Text_Io.Put_Line (Integer'image (Integer (Error)));
  334.       return Error;
  335.     end Get_Last_Error;
  336.  
  337.   ------------------------------------------------
  338.  
  339.   function Initialize (
  340.                        Options : Pm_Types.U_Long := System_Default  
  341.                                        ) return Anchor_Block_Handle_Type is
  342.  
  343.       function WinInitialize (Options : Pm_Types.U_Long) 
  344.                                           return Anchor_Block_Handle_Type;
  345.          pragma Import (Convention => C,
  346.                         Entity     => WinInitialize,
  347.                         Link_Name  => "*WinInitialize");
  348.     begin
  349. --      return Null_Anchor_Block;
  350.       return WinInitialize (Options);
  351.     end Initialize;
  352.  
  353.   ------------------------------------------------
  354.  
  355.   procedure Initialize (
  356.                Options      : in     Pm_Types.U_Long := System_Default;
  357.                Anchor_Block :    out Anchor_Block_Handle_Type) is
  358.     begin
  359.       Anchor_Block := Initialize (Options);
  360.       --Currently OS/2 does not use the Anchor_Block parameter.  It is 
  361.       --usally set to null and not used.  
  362.     end Initialize;
  363.  
  364.   ------------------------------------------------
  365.  
  366.    function Register_Class (Anchor_Block   : Anchor_Block_Handle_Type;
  367.                            Class_Name      : String;
  368.                            Message_Handler : Message_Handler_Function;
  369.                            Class_Style     : Class_Styles_Type;
  370.                            Extra_Storage   : Pm_Types.U_Short)
  371.                                                         return Boolean is
  372.  
  373.       function WinRegisterClass (Anchor_Block  : Anchor_Block_Handle_Type;
  374.                                  Name          : System.Address;
  375.                                  Msg_Handler   : Message_Handler_Function;
  376.                                  Win_Style     : Pm_Types.U_Long;
  377.                                  Extra_Storage : Pm_Types.U_Short) 
  378.                                                      return Pm_Types.U_Long;
  379.        pragma Import (Convention => C,
  380.                       Entity     => WinRegisterClass,
  381.                       Link_Name  => "*WinRegisterClass");
  382.  
  383.        Class_Str : String (Class_Name'first .. Class_Name'last + 1);
  384.  
  385.        Style     : Pm_Types.U_Long := 0;
  386.  
  387.        Result    : Pm_Types.U_Long;
  388.  
  389.       use Pm_Types;
  390.     begin
  391.  
  392.        Class_Str (Class_Str'first .. Class_Str'last - 1) := Class_Name;
  393.        Class_Str (Class_Str'last) := Ascii.Nul;
  394.  
  395.        for I in Class_Style'range loop
  396.          if Class_Style (I) then
  397.            Style := Style + Win_Style_Values (I);
  398.          end if;
  399.        end loop;
  400.  
  401.        Result := WinRegisterClass (
  402.             Anchor_Block  => Anchor_Block,
  403.             Name          => Class_Str (Class_Str'first)'address,
  404.             Msg_Handler   => Message_Handler,
  405.             Win_Style     => Style,
  406.             Extra_Storage => Extra_Storage); 
  407.  
  408.        if Result = 1 then
  409.           return True;
  410.        end if;
  411.  
  412.       return False;
  413.  
  414.     end Register_Class;
  415.  
  416.   ------------------------------------------------
  417.  
  418.   procedure Register_Class (Anchor_Block    : Anchor_Block_Handle_Type;
  419.                             Class_Name      : String;
  420.                             Message_Handler : Message_Handler_Function;
  421.                             Class_Style     : Class_Styles_Type;
  422.                             Extra_Storage   : Pm_Types.U_Short) is
  423.    begin
  424.     if Register_Class (Anchor_Block, 
  425.                        Class_Name, 
  426.                        Message_Handler, 
  427.                        Class_Style, 
  428.                        Extra_Storage) then
  429.       null;
  430.     else
  431.       raise Register_Failed;
  432.     end if;
  433.    end Register_Class;
  434.  
  435.   ------------------------------------------------
  436.  
  437.    Kc_Flag_Values : constant array (Key_Flag_Type) of Pm_Types.U_Short :=
  438.        (Kc_None              => 16#0000#,
  439.         Kc_Char              => 16#0001#,
  440.         Kc_Virtual_Key       => 16#0002#,
  441.         Kc_Scan_Code         => 16#0004#,
  442.         Kc_Shift             => 16#0008#,
  443.         Kc_Ctrl              => 16#0010#,
  444.         Kc_Atl               => 16#0020#,
  445.         Kc_Key_Up            => 16#0040#,
  446.         Kc_Previous_Down     => 16#0080#,
  447.         Kc_Lone_Key          => 16#0100#,
  448.         Kc_Dead_Key          => 16#0200#,
  449.         Kc_Composite         => 16#0400#,
  450.         Kc_Invalid_Composite => 16#0800#,
  451.         Kc_Toggle            => 16#1000#,
  452.         Kc_Invalid_Character => 16#2000#,
  453.         Kc_DB_CSR_SR_VD1     => 16#4000#,
  454.         Kc_Db_CSR_SR_VD2     => 16#8000#);
  455.  
  456.  
  457.     function Set_Flags (Key_Flag_Values : Pm_Types.U_Short) 
  458.                                               return Key_Flags_Type is
  459.        Values : Pm_Types.U_Short := Key_Flag_Values; 
  460.        Flags  : Key_Flags_Type := (Others => False);
  461.  
  462.        use Pm_Types;
  463.  
  464.     begin
  465.       
  466.        if Key_Flag_Values = 0 then
  467.           Flags (Kc_None) := True;
  468.        else
  469.  
  470.          for I in reverse Flags'range loop
  471.  
  472.            exit when I = Flags'first;
  473.  
  474.            if Values >= Kc_Flag_Values (I) then
  475.               Flags (I) := True;
  476.               Values := Values - Kc_Flag_Values (I);
  477.            end if;
  478.  
  479.          end loop;
  480.        end if;             
  481.          
  482.        return Flags;
  483.    end Set_Flags;
  484.  
  485.   ------------------------------------------------
  486.  
  487.    function Set_Virtual_Key (Virtual_Code : Pm_Types.U_Short) 
  488.                                             return Virtual_Key_Type is
  489.       V_Key : Virtual_Key_Type;
  490.      begin
  491.        
  492.        if Virtual_Code in 16#01# .. 16#38# then
  493.           V_Key := Virtual_Key_Type'Val (Integer (Virtual_Code) - 1);
  494.        else
  495.           V_Key := Vk_Null;
  496.        end if;
  497.  
  498.        if V_Key = Vk_F10 then
  499.           V_Key := Vk_Menu;
  500.        end if;
  501.  
  502.        return V_Key;
  503.      end Set_Virtual_Key;
  504.  
  505.  ------------------------------------------------
  506.  
  507.   type CM_1_Type is
  508.     record
  509.      Flags    : PM_Types.U_Short;
  510.      Repeat   : Pm_Types.U_Byte;
  511.      Scancode : Pm_Types.U_Byte;
  512.     end record;
  513.  
  514.   function Parm_To_Cm_1 is new Unchecked_Conversion (
  515.                                     Source => Parameter_Type,
  516.                                     Target => Cm_1_Type);  
  517.  
  518.   type Cm_2_Type is 
  519.     record
  520.      Char_Code    : Pm_Types.U_Short;
  521.      Virtual_Code : Pm_Types.U_Short;
  522.     end record; 
  523.  
  524.   function Parm_To_Cm_2 is new Unchecked_Conversion (
  525.                                     Source => Parameter_Type,
  526.                                     Target => Cm_2_Type);  
  527.  
  528.  function Key_Info_Is (Message_Parameter_1 : Parameter_Type;
  529.                        Message_Parameter_2 : Parameter_Type) 
  530.                                      return Key_Press_Info_Type is
  531.      Info : Key_Press_Info_Type;
  532.  
  533.      Cm_1 : Cm_1_Type;
  534.      Cm_2 : Cm_2_Type;
  535.  
  536.     begin
  537.  
  538.       Cm_1 := Parm_To_Cm_1 (Message_Parameter_1);
  539.       Cm_2 := Parm_To_Cm_2 (Message_Parameter_2);
  540.  
  541.       Info.Flags          := Set_Flags (Cm_1.Flags);
  542.       Info.Repeat_Count   := Cm_1.Repeat;
  543.       Info.Scan_Code      := Cm_1.Scancode;
  544.  
  545.       Info.Character_Code := Cm_2.Char_Code;
  546.       Info.Virtual_Key    := Set_Virtual_Key (Cm_2.Virtual_Code); 
  547.  
  548.       return Info;
  549.  
  550.     end Key_Info_Is;
  551.  
  552.   ------------------------------------------------
  553.  
  554.   type Command_Info_2_Type is 
  555.     record
  556.      Source     : Pm_Types.U_Short;
  557.      By_Pointer : Pm_Types.U_Short; 
  558.     end record; 
  559.  
  560.   function Parm_To_CI_2 is new Unchecked_Conversion (
  561.                                    Source => Parameter_Type,
  562.                                    Target => Command_Info_2_Type);  
  563.  
  564.   function Command_Info_Is (Message_Parameter_1 : Parameter_Type;
  565.                             Message_Parameter_2 : Parameter_Type) 
  566.                                           return Command_Info_Type is
  567.      Info   : Command_Info_Type;
  568.      Info_2 : Command_Info_2_Type; 
  569.     begin
  570.       
  571.       Info.Id         := Command_Id_Type (Message_Parameter_1);
  572.       Info_2          := Parm_To_Ci_2 (Message_Parameter_2);
  573.       Info.Source     := Command_Source_Values (Info_2.Source);
  574.       Info.By_Pointer := Info_2.By_Pointer = 1;
  575.  
  576.       return Info;
  577.     end Command_Info_Is;
  578.  
  579.   ------------------------------------------------
  580.  
  581.   function Pointer_Is (Parameter : Parameter_Type) return Point_Type is
  582.      Spt : Short_Point_Type;
  583.    begin
  584.      Spt := Parm_To_Spt (Parameter);
  585.      return (Pixel_Type (Spt.X), Pixel_Type (Spt.Y));
  586.    end Pointer_Is;
  587.  
  588.   ------------------------------------------------
  589.  
  590.      type Two_Shorts is
  591.        record
  592.          Short_1 : Pm_Types.U_Short;
  593.          Short_2 : Pm_Types.U_Short;
  594.        end record;
  595.      
  596.      function Shorts_To_Mp is new Unchecked_Conversion (
  597.                                            Target => Parameter_Type, 
  598.                                            Source => Two_Shorts);
  599.  
  600.      function Check_Menu_Item (
  601.               Menu    : Handle_Type;
  602.               Item_Id : Command_Id_Type;
  603.               Check   : Boolean) return Boolean is
  604.  
  605.        Mp_1   : Parameter_Type;
  606.        Mp_2   : Parameter_Type;
  607.  
  608.        Values : Two_Shorts; 
  609.  
  610.        Result : Boolean;
  611.       
  612.      begin 
  613.  
  614.         Values.Short_1 := Pm_Types.U_Short (Item_Id);
  615.         Values.Short_2 := Short_True; 
  616.         Mp_1 := Shorts_To_Mp (Values);
  617.  
  618.         Values.Short_1 := MIA_Values (Mia_Checked);
  619.  
  620.         if Check then
  621.           Values.Short_2 := MIA_Values (Mia_Checked);
  622.         else
  623.           Values.Short_2 := Short_False;
  624.         end if;
  625.  
  626.         Mp_2 := Shorts_To_Mp (Values);
  627.  
  628.         Result := To_Boolean (
  629.                     Send_Message (
  630.                         To_Window   => Menu,
  631.                         Message     => MM_Set_Item_Attr,
  632.                         Parameter_1 => Mp_1,
  633.                         Parameter_2 => Mp_2));
  634.                       
  635.         return Result;
  636.  
  637.       end Check_Menu_Item; 
  638.  
  639.   ------------------------------------------------
  640.  
  641.   function Default_Window_Procedure 
  642.                           (Window              : Handle_Type;
  643.                            Message             : Message_Type;
  644.                            Message_Parameter_1 : Parameter_Type;  
  645.                            Message_Parameter_2 : Parameter_Type)                  
  646.                                               return Pm_Types.U_Long is
  647.  
  648.      function WinDefWindowProc 
  649.                           (Window              : Handle_Type;
  650.                            Message             : Message_Type;
  651.                            Message_Parameter_1 : Parameter_Type;  
  652.                            Message_Parameter_2 : Parameter_Type)                  
  653.                                                return Pm_Types.U_Long;
  654.          pragma Import (Convention => C,
  655.                         Entity     => WinDefWindowProc,
  656.                         Link_Name  => "*WinDefWindowProc");
  657.        
  658.       Result : Pm_Types.U_Long;
  659.     begin
  660.       Result := WinDefWindowProc (
  661.                          Window              => Window, 
  662.                          Message             => Message, 
  663.                          Message_Parameter_1 => Message_Parameter_1, 
  664.                          Message_Parameter_2 => Message_Parameter_2);
  665.       return Result;
  666.  
  667.     end Default_Window_Procedure;
  668.  
  669.   ------------------------------------------------
  670.  
  671.   function Window_From_Id (
  672.             Parent_Window : Handle_Type;
  673.             Frame_Id      : Frame_Id_Type) return Handle_Type is
  674.     
  675.         function WinWindowFromId (
  676.             Parent_Window : Handle_Type;
  677.             Frame_Id      : Pm_Types.U_Long) return Handle_Type;
  678.     
  679.         pragma Import (Convention => C,
  680.                         Entity     => WinWindowFromId,
  681.                         Link_Name  => "*WinWindowFromID");
  682.      Window : Handle_Type;       
  683.    begin
  684.  
  685.      Window := WinWindowFromId (
  686.                 Parent_Window => Parent_Window,
  687.                 Frame_id      => Frame_id_Values (Frame_ID));
  688.  
  689.      return Window;
  690.  
  691.    end Window_From_Id;
  692.  
  693.   ------------------------------------------------
  694.  
  695.  
  696.   function Create_Standard_Window (
  697.             Parent_Window       : Handle_Type;
  698.             Window_Styles       : Window_Styles_Type;
  699.             Frame_Control_Flags : Frame_Control_Flags_Type;
  700.             Class_Name          : String;
  701.             Window_Title        : String;
  702.             Class_Style         : Class_Styles_Type;
  703.             Resource            : PULong;
  704.             Resource_ID         : Pm_Types.U_Long;
  705.             New_Window          : Handle_Pointer_Type)
  706.                                           return Handle_Type is
  707.  
  708.      function WinCreateStdWindow (
  709.             Parent_Window       : Handle_Type;
  710.             Window_Styles       : Pm_Types.U_Long;
  711.             Frame_Control_Flags : System.Address;
  712.             Class_Name          : System.Address;
  713.             Window_Title        : System.Address;
  714.             Class_Style         : Pm_Types.U_Long;
  715.             Resource            : PULong;
  716.             Resource_ID         : Pm_Types.U_Long;
  717.             New_Window          : Handle_Pointer_Type) 
  718.                                               return Handle_Type;
  719.  
  720.          pragma Import (Convention => C,
  721.                         Entity     => WinCreateStdWindow,
  722.                         Link_Name  => "*WinCreateStdWindow");
  723.  
  724.        Class_Str   : String (Class_Name'first .. Class_Name'last + 1);
  725.        Title_Str   : String (Window_Title'first .. Window_Title'last + 1);
  726.  
  727.        Frame_Value : Pm_Types.U_Long := 0; 
  728.        Win_Style   : Pm_Types.U_Long := 0;
  729.        Style       : Pm_Types.U_Long := 0;
  730.  
  731.        use PM_Types;
  732.     begin
  733.  
  734.       Class_Str (Class_Str'first .. Class_Str'last - 1) := Class_Name;
  735.       Class_Str (Class_Str'last) := Ascii.Nul;
  736.  
  737.       Title_Str (Title_Str'first .. Title_Str'last - 1) := Window_Title;
  738.       Title_Str (Title_Str'last) := Ascii.Nul;
  739.  
  740.       for I in Frame_Control_Flags'range loop
  741.         if Frame_Control_Flags (I) then
  742.            Frame_Value := Frame_Value + Frame_Values (I);
  743.         end if;
  744.       end loop;
  745.       
  746.       for I in Window_Styles'range loop
  747.         if Window_Styles (I) then
  748.            Win_Style := Win_Style + Window_Style_Values (I);
  749.         end if;
  750.       end loop;
  751.  
  752.        for I in Class_Style'range loop
  753.          if Class_Style (I) then
  754.            Style := Style + Win_Style_Values (I);
  755.          end if;
  756.        end loop;
  757.  
  758.       return WinCreateStdWindow (
  759.                Parent_Window       => Parent_Window,
  760.                Window_Styles       => Win_Style,
  761.                Frame_Control_Flags => Frame_Value'address,
  762.                Class_Name          => Class_Str (Class_Str'first)'address,
  763.                Window_Title        => Title_Str (Title_Str'first)'address,
  764.                Class_Style         => Style,
  765.                Resource            => Resource,
  766.                Resource_Id         => Resource_Id,
  767.                New_Window          => New_Window); 
  768.  
  769.   end Create_Standard_Window;
  770.  
  771.   ------------------------------------------------
  772.  
  773.   function Set_Window_Position (
  774.               Window           : Handle_Type;
  775.               Behind_Window    : Handle_Type;
  776.               X                : Device_Screen_Space_Type;
  777.               Y                : Device_Screen_Space_Type;
  778.               Width            : Device_Screen_Space_Type;
  779.               Height           : Device_Screen_Space_Type;
  780.               Position_Options : Position_Type) return Boolean is
  781.  
  782.     function WinSetWindowPos (
  783.               Window           : Handle_Type;
  784.               Behind_Window    : Handle_Type;
  785.               X                : Device_Screen_Space_Type;
  786.               Y                : Device_Screen_Space_Type;
  787.               Width            : Device_Screen_Space_Type;
  788.               Height           : Device_Screen_Space_Type;
  789.               Position_Options : Pm_Types.U_Long) return Pm_Types.U_Long;    
  790.  
  791.          pragma Import (Convention => C,
  792.                         Entity     => WinSetWindowPos,
  793.                         Link_Name  => "*WinSetWindowPos");
  794.      Pos_Value : Pm_Types.U_Long := 0;
  795.      use Pm_Types;
  796.    begin
  797.  
  798.      if Boolean_Value (Position_Options (Swp_Minimize)) +
  799.         Boolean_Value (Position_Options (Swp_Maximize)) +
  800.         Boolean_Value (Position_Options (Swp_Restore)) > 1 then
  801.           raise Min_Max_Restore_Usage_Error;
  802.      end if;
  803.  
  804.      for I in Position_Options'range loop
  805.        if Position_Options (I) then
  806.          Pos_Value := Pos_Value + Win_Position_Values (I);
  807.        end if;
  808.      end loop;
  809.  
  810.      return 0 /= WinSetWindowPos (
  811.                    Window           => Window,
  812.                    Behind_Window    => Behind_Window,
  813.                    X                => X,
  814.                    Y                => Y,
  815.                    Width            => Width,
  816.                    Height           => Height,
  817.                    Position_Options => Pos_Value);
  818.    end Set_Window_Position;
  819.  
  820.   ------------------------------------------------
  821.  
  822.   procedure Set_Window_Position (
  823.               Window           : in Handle_Type;
  824.               Behind_Window    : in Handle_Type;
  825.               X                : in Device_Screen_Space_Type;
  826.               Y                : in Device_Screen_Space_Type;
  827.               Width            : in Device_Screen_Space_Type;
  828.               Height           : in Device_Screen_Space_Type;
  829.               Position_Options : in Position_Type) is
  830.     begin
  831.       if Set_Window_Position (Window, 
  832.                               Behind_Window, 
  833.                               X, Y, 
  834.                               Width, Height, 
  835.                               Position_Options) then
  836.         null;
  837.       else
  838.         raise Set_Failed;
  839.       end if;
  840.     end Set_Window_Position;
  841.  
  842.   ------------------------------------------------
  843.  
  844.   function WinTerminate (Anchor : Anchor_Block_Handle_Type)
  845.                                             return Pm_Types.U_Long;
  846.  
  847.    pragma Import (Convention => C,
  848.                   Entity     => WinTerminate,
  849.                   Link_Name  => "*WinTerminate");
  850.  
  851.  function Terminate_App (Anchor : Anchor_Block_Handle_Type) return Boolean is
  852.  
  853.    begin
  854.      return WinTerminate (Anchor) /= 0;
  855.    end Terminate_App;
  856.  
  857.   ------------------------------------------------
  858.  
  859.   function Create_Message_Queue (
  860.               Anchor_Block  : Anchor_Block_Handle_Type;
  861.               Queue_Size    : Pm_Types.Long := System_Default)
  862.                               return Queue_Handle_Type is
  863.         function WinCreateMsgQueue (
  864.               Anchor_Block  : Anchor_Block_Handle_Type;
  865.               Queue_Size    : Pm_Types.Long := System_Default)
  866.                               return Queue_Handle_Type;
  867.         pragma Import (Convention => C,
  868.                        Entity     => WinCreateMsgQueue,
  869.                        Link_Name  => "*WinCreateMsgQueue");
  870.    begin
  871.      return WinCreateMsgQueue (Anchor_Block, Queue_Size);
  872.    end Create_Message_Queue;
  873.  
  874.   ------------------------------------------------
  875.  
  876.   procedure Create_Message_Queue (
  877.               Anchor_Block  : in     Anchor_Block_Handle_Type;
  878.               Queue_Size    : in     Pm_Types.Long := System_Default;
  879.               Queue         :    out Queue_Handle_Type) is
  880.      Temp_Queue : Queue_Handle_Type := Null_Queue;
  881.     begin
  882.       Temp_Queue := Create_Message_Queue (Anchor_Block, Queue_Size);
  883.  
  884.       if Is_Null (Temp_Queue) then
  885.         raise Message_Queue_Was_Not_Created;
  886.       end if;
  887.  
  888.       Queue := Temp_Queue;
  889.     end Create_Message_Queue;
  890.  
  891.   ------------------------------------------------
  892.  
  893.   procedure Terminate_App (Anchor : in out Anchor_Block_Handle_Type) is
  894.     Temp : Boolean;
  895.    begin
  896.     Temp   := Terminate_App (Anchor);
  897.     Anchor := Null_Anchor_Block;
  898.    end Terminate_App;
  899.  
  900.   ------------------------------------------------
  901.  
  902.   procedure Destroy_Message_Queue (Message_Queue : in out Queue_Handle_Type) is
  903.     Temp : Boolean;
  904.    begin
  905.      Temp := Destroy_Message_Queue (Message_Queue);
  906.      --Could add a check here and raise an exception if the message queue is
  907.      --not destroyed. BJY 1/31/94
  908.      Message_Queue := Null_Queue;
  909.    end Destroy_Message_Queue;
  910.  
  911.   ------------------------------------------------
  912.  
  913.   function Destroy_Message_Queue (Message_Queue : Queue_Handle_Type)
  914.                                                             return Boolean is
  915.    
  916.     function WinDestroyMsgQueue (Queue : Queue_Handle_Type)
  917.                                                      return Pm_Types.U_Long;
  918.  
  919.     pragma Import (Convention => C,
  920.                    Entity     => WinDestroyMsgQueue,
  921.                    Link_Name  => "*WinDestroyMsgQueue");
  922.    begin
  923.      return WinDestroyMsgQueue (Message_Queue) /= 0;
  924.    end Destroy_Message_Queue;
  925.  
  926.   ------------------------------------------------
  927.  
  928.   procedure Destroy_Window (Window : in out Handle_Type) is
  929.      Temp : Boolean;
  930.     begin
  931.      Temp := Destroy_Window (Window);
  932.      --Could add a check and raise and exception if the windows 
  933.      --is not destroyed.  BJY 1/31/94
  934.      Window := Null_Window;
  935.     end Destroy_Window;
  936.      
  937.   ------------------------------------------------
  938.  
  939.   function Destroy_Window (Window : Handle_Type) return Boolean is
  940.    
  941.     function WinDestroyWindow (Window : Handle_Type) return Pm_Types.U_Long;
  942.  
  943.     pragma Import (Convention => C,
  944.                    Entity     => WinDestroyWindow,
  945.                    Link_Name  => "*WinDestroyWindow");
  946.    begin
  947.      return WinDestroyWindow (Window) /= 0;
  948.    end Destroy_Window;
  949.  
  950.   ------------------------------------------------
  951.  
  952.    function Make_Style (
  953.             Buttons        : MB_Button_Styles_Type;
  954.             Icons          : MB_Icon_Styles_Type;   
  955.             Default_Action : MB_Default_Action_Type;
  956.             Modality       : MB_Modality_Type := MB_Application_Modal;
  957.             Help_Button    : Boolean          := False;
  958.             Moveable       : Boolean          := True) 
  959.                                             return Pm_Types.U_Long is
  960.        Style_Value : Pm_Types.U_Long := 0;
  961.        use Pm_Types;
  962.      begin
  963.        Style_Value := Mb_Buttons (Buttons)
  964.                        + MB_Icons (Icons)
  965.                         + MB_Action (Default_Action)
  966.                          + MB_Modality (Modality)
  967.                           + MB_Help (Help_Button)
  968.                            + MB_Moveable (Moveable);
  969.        return Style_Value; 
  970.      end Make_Style;
  971.  
  972.   ------------------------------------------------
  973.  
  974.   function Message_Box (
  975.             Parent_Window  : Handle_Type;
  976.             Request_Owner  : Handle_Type;
  977.             Message        : String;
  978.             Title          : String;
  979.             Help_Id        : Help_Id_Type;
  980.             Buttons        : MB_Button_Styles_Type;
  981.             Icons          : MB_Icon_Styles_Type;   
  982.             Default_Action : MB_Default_Action_Type;
  983.             Modality       : MB_Modality_Type := MB_Application_Modal;
  984.             Help_Button    : Boolean          := False;
  985.             Moveable       : Boolean          := True)
  986.                                             return MB_Response_Type is
  987.  
  988.        function WinMessageBox (
  989.                    Parent    : Handle_Type;
  990.                    Owner     : Handle_Type;
  991.                    Text      : System.Address;
  992.                    Title     : System.Address;
  993.                    Window_Id : Pm_Types.U_Short;
  994.                    Style     : Pm_Types.U_Long) return Pm_Types.U_Short;
  995.  
  996.         pragma Import (Convention => C,
  997.                        Entity     => WinMessageBox,
  998.                        Link_Name  => "*WinMessageBox");
  999.        Response : Pm_Types.U_Short;
  1000.        Result   : Mb_Response_Type;
  1001.        Style    : Pm_Types.U_Long;
  1002.  
  1003.        Text_Str  : String (Message'first .. Message'last + 1);
  1004.        Title_Str : String (Title'first .. Title'last + 1); 
  1005.  
  1006.     begin
  1007.  
  1008.       Text_Str (Text_Str'first .. Text_Str'last - 1) := Message;
  1009.       Text_Str (Text_Str'last) := AscII.Nul;
  1010.  
  1011.       Title_Str (Title_Str'first .. Title_Str'last - 1) := Title;
  1012.       Title_Str (Title_Str'last) := AscII.Nul; 
  1013.  
  1014.       Style := Make_Style (Buttons, 
  1015.                            Icons, 
  1016.                            Default_Action, 
  1017.                            Modality, 
  1018.                            Help_Button, 
  1019.                            Moveable);
  1020.  
  1021.       Response := WinMessageBox (
  1022.                         Parent    => Parent_Window,
  1023.                         Owner     => Request_Owner, 
  1024.                         Text      => Text_Str (Text_Str'first)'address,
  1025.                         Title     => Title_Str (Title_Str'first)'address,
  1026.                         Window_Id => Pm_Types.U_Short (Help_Id),    
  1027.                         Style     => Style);
  1028.  
  1029.       if Response in MB_Response'range then
  1030.          return Mb_Response (Response);
  1031.       end if;
  1032.  
  1033.       return Mb_Error;
  1034.  
  1035.     end Message_Box;
  1036.  
  1037.   ------------------------------------------------
  1038.  
  1039.      function WinGetMsg (
  1040.                Anchor_Block : Anchor_Block_Handle_Type;
  1041.                Message      : Queue_Message_Pointer_Type;
  1042.                Window       : Handle_Type;
  1043.                First        : Pm_Types.U_Long;
  1044.                Last         : Pm_Types.U_Long) return Pm_Types.U_Long;
  1045.         pragma Import (Convention => C,
  1046.                        Entity     => WinGetMsg,
  1047.                        Link_Name  => "*WinGetMsg");
  1048.  
  1049.    function Get_Message (
  1050.                Anchor_Block : Anchor_Block_Handle_Type;
  1051.                Message      : Queue_Message_Pointer_Type;
  1052.                Window       : Handle_Type;
  1053.                First        : Pm_Types.U_Long;
  1054.                Last         : Pm_Types.U_Long) return Boolean is
  1055.      
  1056.      begin         
  1057.         return WinGetMsg (Anchor_Block, Message, Window, First, Last) = 1;
  1058.      end Get_Message;
  1059.  
  1060.   ------------------------------------------------
  1061.  
  1062.      Function WinDispatchMsg (
  1063.                Anchor_Block : in Anchor_Block_Handle_Type;
  1064.                Message      : in Queue_Message_Pointer_Type) 
  1065.                                                 return Pm_Types.U_Long;
  1066.         pragma Import (Convention => C,
  1067.                        Entity     => WinDispatchMsg,
  1068.                        Link_Name  => "*WinDispatchMsg");
  1069.  
  1070.    procedure Dispatch_Message (
  1071.                Anchor_Block : in Anchor_Block_Handle_Type;
  1072.                Message      : in Queue_Message_Pointer_Type) is
  1073.      
  1074.     Junk : Pm_Types.U_Long;
  1075.    begin
  1076.     Junk :=  WinDispatchMsg (Anchor_Block, Message);
  1077.    end Dispatch_Message;
  1078.  
  1079.   ------------------------------------------------
  1080.  
  1081.    function Send_Message (   
  1082.          To_Window   : Handle_Type;
  1083.          Message     : Message_Type;
  1084.          Parameter_1 : Parameter_Type;
  1085.          Parameter_2 : Parameter_Type) return Void_Type is
  1086.  
  1087.      function WinSendMsg (   
  1088.            To_Window   : Handle_Type;
  1089.            Message     : Message_Type;
  1090.            Parameter_1 : Parameter_Type;
  1091.            Parameter_2 : Parameter_Type) return Void_Type;
  1092.        
  1093.         pragma Import (Convention => C,
  1094.                        Entity     => WinSendMsg,
  1095.                        Link_Name  => "*WinSendMsg");
  1096.  
  1097.      Result : Void_Type;
  1098.    begin
  1099.      Result := WinSendMsg (
  1100.                 To_Window   => To_Window,
  1101.                 Message     => Message,
  1102.                 Parameter_1 => Parameter_1,
  1103.                 Parameter_2 => Parameter_2);
  1104.  
  1105.      return Result;
  1106.    end Send_Message;
  1107.   
  1108.   ------------------------------------------------
  1109.  
  1110.       function WinPostMsg (   
  1111.          To_Window   : Handle_Type;
  1112.          Message     : Message_Type;
  1113.          Parameter_1 : Parameter_Type;
  1114.          Parameter_2 : Parameter_Type) return Boolean;
  1115.        
  1116.         pragma Import (Convention => C,
  1117.                        Entity     => WinPostMsg,
  1118.                        Link_Name  => "*WinPostMsg");
  1119.    function Post_Message (   
  1120.          To_Window   : Handle_Type;
  1121.          Message     : Message_Type;
  1122.          Parameter_1 : Parameter_Type;
  1123.          Parameter_2 : Parameter_Type) return Boolean is
  1124.  
  1125.      begin
  1126.        return WinPostMsg (To_Window, Message, Parameter_1, Parameter_2);
  1127.      end Post_Message;
  1128.  
  1129.   ------------------------------------------------
  1130.  
  1131.      function WinGetPS (Window : Handle_Type) return Ps_Type;
  1132.  
  1133.      pragma Import (Convention => C,
  1134.                     Entity     => WinGetPS,
  1135.                     Link_Name  => "*WinGetPS");
  1136.  
  1137.    function Get_PS (Window : Handle_Type) return Ps_Type is 
  1138.  
  1139.      begin
  1140.        return WinGetPS (Window);
  1141.      end Get_Ps;
  1142.  
  1143.   ------------------------------------------------
  1144.  
  1145.     function WinReleasePs (Ps_Handle : Ps_Type) return Pm_Types.U_Long;
  1146.  
  1147.     pragma Import (Convention => C,
  1148.                    Entity     => WinReleasePS,
  1149.                    Link_Name  => "*WinReleasePS");
  1150.  
  1151.    procedure Release_Ps (Ps_Handle : in out Ps_Type) is
  1152.  
  1153.     begin
  1154.       if WinReleasePs (PS_Handle) = 1 then
  1155.          PS_Handle := Null_Ps;
  1156.       end if;
  1157.     end Release_Ps; 
  1158.      
  1159.   ------------------------------------------------
  1160.  
  1161. end Win;
  1162.    
  1163.  
  1164.  
  1165.