home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / PMEXAM / DIALOG / HELPDIAL.ADB < prev    next >
Text File  |  1996-08-13  |  8KB  |  226 lines
  1. with System;
  2. with os2; use os2;
  3. with os2.bse ; use os2.bse ;
  4. with os2.pmwb; use os2.pmwb;
  5. with os2.pmsc; use os2.pmsc;
  6. with os2.pmwd; use os2.pmwd;
  7. with os2.pmcp; use os2.pmcp;
  8. with os2.pmcl; use os2.pmcl;
  9. with os2.pmer; use os2.pmer;
  10. with os2.Gpi ; use os2.Gpi ;
  11. with text_io; use text_io;
  12. with builtin; use builtin;
  13. package body helpdial is
  14.  
  15. function MyWindowProc(hwn:HWND ; msg:ULONG;mp1,mp2:MPARAM) return ulong is
  16. hp     :HPS    ;                      -- Presentation space handle
  17. pt     :aliased POINTL ;    -- String screen coordinates
  18. rc     :aliased RECTL  ;    -- Window rectangle
  19. begin
  20.  
  21.  case  msg is
  22. when       WM_CREATE  =>
  23. --  Window initialization - load "You live in" string from resource
  24.  
  25.  rcl  := WinLoadString( ha,
  26.                 0,        -- Resource is in .EXE file
  27.                 ID_RESPONSE,          -- String identifier
  28.                 long(length_string),                 -- Size of buffer
  29.                 szResponse'address);     -- Buffer
  30. when       WM_COMMAND  =>
  31.  
  32. -- When the user chooses "Where..." from the Options pull-down,
  33. -- the application displays a dialog box. WinDlgBox calls the
  34. -- dialog procedure below. WinDlgBox does not return until the
  35. -- dialog procedure returns.
  36. -- WinInvalidateRegion sends a WM_PAINT message.
  37. --
  38.     case  mp1  is
  39.       when ID_WHERE  =>
  40.  
  41. rcul:=  WinDlgBox( HWND_DESKTOP,         -- Place anywhere on desktop
  42.                    hwndFrame,            -- Owned by frame
  43.                    MyDlgProc'address,    -- Address of dialog procedure
  44.                    0         ,           -- Module handle
  45.                    ID_MYDIALOG        ,  -- Dialog identifier in resource
  46.                    System.Null_Address); -- Initialization data
  47.  
  48. rcb32:=  WinInvalidateRegion( hwn, 0, 0 ); -- Force a repaint
  49. -- put_edit(" WinInvalidateRegion ",integer(rcb32));
  50.  
  51.     when      ID_EXITPROGRAM  =>
  52. --
  53. rcb32:=   WinPostMsg( hwn, WM_CLOSE, 0 , 0);
  54.  
  55.    when others =>
  56.           return WinDefWindowProc( hwn, msg, mp1, mp2 );
  57.   end case;
  58.  
  59.     when  WM_PAINT  =>
  60. --  Window contents are drawn here. First time through, bComplete
  61. --  is 0, so window is simply filled with SYSCLR_WINDOW.
  62. --  On subsequent passes, if bComplete has been set to TRUE in the
  63. --  dialog procedure, GpiCharStringAt draws the text.
  64.  
  65.             hp := WinBeginPaint( hwn, 0   , rc'unchecked_access );
  66.             rcb32:=WinFillRect( hp, rc'unchecked_access, SYSCLR_WINDOW );
  67. -- put_edit(" WinFillRect ",integer(rcb32));
  68. -- new_line; put_edit(" bComplete ",integer(bComplete));
  69.   if  bComplete > 0 then
  70.         rcb:= GpiSetColor( hp, CLR_NEUTRAL ); -- Text color same as PM
  71. -- put_edit(" GpiSetColor ",integer(rcb  ));
  72.               pt.x := 50 ; pt.y := 50 ;    -- Coordinates of "You live in"
  73.         rcl:= GpiCharStringAt( hp, pt'unchecked_access, LONG(szResponse'length),
  74.                               szResponse'address);
  75. -- put_edit(" GpiCharStringAt 1 ",integer(rcl  ));
  76.               pt.x := 50 ; pt.y := 30 ;         -- Coordinates of location
  77.         rcl:= GpiCharStringAt( hp, pt'unchecked_access, LONG(szLocation'length), szLocation(1)'address );
  78. -- put_edit(" GpiCharStringAt 2 ",integer(rcl  ));
  79.   end if;
  80.   rcb:=     WinEndPaint( hp );               -- Drawing is complete
  81. -- put_edit(" WinEndPaint ",integer(rcb  ));
  82.         when Ulong(WM_CLOSE) =>
  83.   rcb32:= WinPostMsg( hwn, WM_QUIT ,0, 0 );     -- Cause termination
  84. --   put_edit(" WinPostMsg ",integer(rcb32));
  85.  
  86.         when others =>
  87.  
  88. -- Must have WinDefWindowProc in your window procedure
  89.  
  90.   return WinDefWindowProc( hwn, msg, mp1, mp2 );
  91. end case ;
  92. return  0;
  93. end MyWindowProc;
  94.  
  95. function  MyDlgProc (hwndDlg:HWND ; msg:ULONG;mp1,mp2:MPARAM)  return ulong is
  96.  
  97. begin
  98.  
  99.  case   msg is
  100.  when       WM_INITDLG  =>
  101.  SetSysMenu(hwndDlg);             -- remove unused sys. menu items
  102.  
  103.  when WM_COMMAND =>                    -- Posted by pushbutton or key
  104.  
  105. -- PM sends a WM_COMMAND message when the user presses either
  106. -- the Enter or Escape pushbuttons.
  107.     case mp1  is      -- Extract the command value
  108.     when      DID_OK  =>    -- The Enter pushbutton or key.
  109.                       -- WinQueryWindowText copies the
  110.                      -- contents of the entry field
  111.                      -- into szLocation.
  112.       rcl  := WinQueryWindowText( WinWindowFromID( hwndDlg, ID_ENTRYFIELD ),
  113.                                long(length_string),
  114.                                szLocation'address );
  115.       bComplete := 1   ;         -- Set case so strings are
  116.                                          -- drawn in WM_PAINT processing.
  117.  
  118.       rcul:= ulong(WinDefDlgProc( hwndDlg, msg, mp1, mp2 ));
  119.       return rcul;
  120.  
  121.     when      DID_CANCEL  =>       -- The Cancel pushbutton or Escape key
  122.        rcb32:=    WinDismissDlg( hwndDlg, 1 );  -- Removes the dialog box
  123.                   return  0;
  124.        when others => null ;
  125.     end case;
  126.     when others =>
  127.  
  128. --  Any event messages that the dialog procedure has not processed
  129. --  come here and are processed by WinDefDlgProc.
  130. --  This call MUST exist in your dialog procedure.
  131.  
  132.       rcul:= ulong(WinDefDlgProc( hwndDlg, msg, mp1, mp2 ));
  133.       return rcul;
  134.  
  135.  end case;
  136.  return 0;
  137. end MyDlgProc;
  138.  
  139. function ProdInfoDlgProc(hwn:HWND ; msg:ULONG;mp1,mp2:MPARAM )  return ulong is
  140. begin
  141.  
  142.  case msg is
  143.  
  144.  when       WM_INITDLG  =>
  145.   SetSysMenu(hwn);              -- remove unused sys. menu items
  146.  
  147. when       WM_COMMAND  =>
  148.  
  149. --  No matter what the command, close the dialog
  150.  
  151. rcb:=        WinDismissDlg(hwn, 1);
  152.  
  153. when others =>
  154.   rcl:=       WinDefDlgProc(hwn, msg, mp1, mp2) ;
  155.   return Ulong(rcl);
  156. end case;
  157. return 0;
  158. end ProdInfoDlgProc;
  159.  
  160. procedure DisplayMessage(str:astring) is
  161. errstr:astring(1..37):= "Error Messages For The Dialog Sample" & nul_char;
  162. begin
  163.  
  164. --  This routine calls WinMessageBox to display error messages to the
  165. --  user.
  166. --
  167. rcb32:= WinMessageBox(HWND_DESKTOP, HWND_DESKTOP, str'address,
  168.         errstr'address , ID_MESSAGEBOX,
  169.         MB_OK or MB_APPLMODAL or MB_MOVEABLE or MB_ERROR);
  170.  
  171. end DisplayMessage;
  172.  
  173. procedure SetSysMenu(hwndDlg:HWND ) is
  174.  
  175. sMenuItems    :Long     ;
  176. usItemid      :Long             ;
  177. menu_Item     :aliased MENUITEM:=(0,0,0,0,0,0)  ;
  178. menu_null     :MENUITEM :=(0,0,0,0,0,0) ;
  179. hwndSubMenu   :HWND             ;
  180. begin
  181.    new_line; put("SetSysMenu"); 
  182. -- Determine the definition of the system menu
  183.  
  184.    WinSendDlgItemMsg(hwndDlg,FID_SYSMENU , MM_QUERYITEM,
  185.                         SC_SYSMENU,
  186.                        menu_Item'unchecked_access );
  187.    hwndSubMenu := menu_Item.hwndSubMenu;
  188.  
  189. --  Find the number of items in the in the submenu
  190.    sMenuItems :=  Long (WinSendMsg(hwndSubMenu,
  191.                 mm_queryitemcount,0 ,menu_null ));
  192.  
  193. --     * Loop through the submenu items and remove disabled
  194. --     * menu items and menu separators.
  195.  
  196. loop
  197.    put_edit(" WinSendMsg ",integer(sMenuItems));
  198.     sMenuItems := sMenuItems -1 ;
  199.     exit when sMenuItems = 0;
  200.  
  201. --  Find the item ID for the current position.
  202.      usItemid := Long  (WinSendMsg(hwndSubMenu,MM_ITEMIDFROMPOSITION,
  203.                     Mparam(sMenuItems), menu_null));
  204.  return;
  205.  
  206. -- Query the definition of the current item
  207.      rcl  := WinSendMsg(hwndSubMenu, MM_QUERYITEM,
  208.                    Mparam(usItemid) , menu_Item );
  209.  
  210. --  If the menu item is disabled or the item has a style
  211. --  of MIS_SEPARATOR - delete it.
  212.  
  213.     menu_null.iposition := short(mia_disabled) ;
  214.     if WinSendMsg(hwndSubMenu, MM_QUERYITEMATTR,
  215.            Mparam(usItemid) , menu_null    ) > 0 or
  216.          (Ulong(menu_Item.afStyle) =  MIS_SEPARATOR )
  217.     then
  218.     menu_null.iposition := 0  ;
  219.        rcl := WinSendMsg(hwndSubMenu, MM_DELETEITEM,
  220.        Mparam(usItemid) ,menu_null );
  221.    end if;
  222. end loop;
  223. end SetSysMenu;
  224.  
  225. end helpdial;
  226.