home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / generic_pkg.adb < prev    next >
Encoding:
Text File  |  1995-12-16  |  8.9 KB  |  271 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/generic_pkg.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/12/15 16:49:40 $ $Author: mg $ 
  3.  
  4.  
  5. with Ada.Unchecked_Conversion;
  6. with Interfaces.C;
  7. with Interfaces.C.Strings;
  8. with ma_extra;
  9.  
  10.  
  11. package body Generic_Pkg is
  12.  
  13.   use Win32;
  14.  
  15.   Help_Ptr    : Win32.LPCSTR := CP("generic.hlp" & Nul);
  16.   No_Help_Ptr : Win32.LPCSTR := CP("Unable to activate help" & Nul);
  17.  
  18.  
  19.   function CP(C_Str : Win32.CHAR_Array) return Win32.LPCSTR is
  20.       function UC is new Ada.Unchecked_Conversion
  21.                              (System.Address,Win32.LPCSTR);
  22.   begin
  23.       return UC(C_Str(C_Str'First)'Address);
  24.   end CP;
  25.  
  26.  
  27. --  FUNCTION: CenterWindow (HWND, HWND)
  28. --
  29. --  PURPOSE:  Center one window over another
  30. --
  31. --  COMMENTS:
  32. --
  33. --  Dialog boxes take on the screen position that they were designed at,
  34. --  which is not always appropriate. Centering the dialog over a particular
  35. --  window usually results in a better position.
  36.  
  37. function CenterWindow(hWndChild, hWndParent : Windef.HWND) return
  38.                                               Win32.BOOL is
  39.  
  40.   rChild_Ptr  : Windef.LPRECT;
  41.   rParent_Ptr : Windef.LPRECT;
  42.  
  43.   wChild  : Win32.LONG;
  44.   hChild  : Win32.LONG;
  45.   wParent : Win32.LONG;
  46.   hParent : Win32.LONG;
  47.   wScreen : Win32.LONG;
  48.   hScreen : Win32.LONG;
  49.   xNew    : Win32.LONG;
  50.   yNew    : Win32.LONG;
  51.   HDC     : Windef.HDC;
  52.  
  53.   use type Interfaces.C.Long;    -- to get '-'
  54.  
  55. begin
  56.   --  // Get the Height and Width of the child window
  57.   rChild_Ptr := rChild'Access;
  58.   bResult    := Winuser.GetWindowRect(hWndChild, rChild_Ptr);
  59.   wChild     := rChild.RIGHT - rChild.LEFT;
  60.   hChild     := rChild.BOTTOM - rChild.TOP;
  61.  
  62.   -- // Get the Height and Width of the parent window
  63.   rParent_Ptr := rParent'Access;
  64.   bResult     := Winuser.GetWindowRect(hWndParent, rParent_Ptr);
  65.   wParent     := rParent.RIGHT - rParent.LEFT;
  66.   hParent     := rParent.BOTTOM - rParent.TOP;
  67.  
  68.   -- // Get the display limits
  69.   HDC     := Winuser.GetDC(hWndChild);
  70.   wScreen := Win32.LONG(Wingdi.GetDeviceCaps(HDC, Wingdi.HORZRES));
  71.   hScreen := Win32.LONG(Wingdi.GetDeviceCaps(HDC, Wingdi.VERTRES));
  72.   iResult := Winuser.ReleaseDC(hWndChild, HDC);
  73.  
  74.   -- // Calculate new X position, then adjust for screen
  75.   xNew := rParent.LEFT + ((wParent - wChild) / 2);
  76.   if xNew < 0 then
  77.     xNew := 0;
  78.   elsif (xNew + wChild) > wScreen then
  79.     xNew := wScreen - wChild;
  80.   end if;
  81.  
  82.   -- // Calculate new Y position, then adjust for screen
  83.   yNew := rParent.TOP + ((hParent - hChild) / 2);
  84.   if yNew < 0 then
  85.     yNew := 0;
  86.   elsif (yNew + hChild) > hScreen then
  87.     yNew := hScreen - hChild;
  88.   end if;
  89.  
  90.   -- // Set it, and return
  91.   return Winuser.SetWindowPos(hWndChild, 
  92.                               System.Null_Address, 
  93.                               Win32.INT(xNew), Win32.INT(yNew), 0, 0,
  94.                               Winuser.SWP_NOSIZE or Winuser.SWP_NOZORDER);
  95. end CenterWindow;
  96.  
  97.  
  98.  
  99. --  FUNCTION: About(HWND, UINT, WPARAM, LPARAM)
  100. --
  101. --  PURPOSE:  Processes messages for "About" dialog box
  102. --
  103. --  MESSAGES:
  104. --
  105. --  WM_INITDIALOG - initialize dialog box
  106. --  WM_COMMAND    - Input received
  107. --
  108. --  COMMENTS:
  109. --
  110. --  Display version information from the version section of the
  111. --  application resource.
  112.  
  113. --  Wait for user to click on "Ok" button, then close the dialog box.
  114.  
  115. function About(hDlg    : Win32.Windef.HWND;
  116.                MESSAGE : Win32.UINT;
  117.                WPARAM  : Win32.WPARAM;
  118.                LPARAM  : Win32.LPARAM) return Win32.BOOL is
  119.  
  120.   use type Interfaces.C.UNSIGNED_SHORT;
  121.  
  122.   cmdId         : Win32.WORD;
  123.   Dummy         : Win32.BOOL;
  124.  
  125. begin
  126.   case MESSAGE is
  127.  
  128.   when Win32.Winuser.WM_INITDIALOG =>
  129.       -- Center the dialog over the application window
  130.       bResult := CenterWindow(hDlg, Win32.Winuser.GetWindow
  131.                                            (hDlg, Win32.Winuser.GW_OWNER));
  132.       return Win32.TRUE;
  133.       -- create a font to use
  134.       
  135.   when Winuser.WM_COMMAND =>
  136.       cmdId := WinDef.LOWORD(Win32.DWORD(WPARAM));
  137.       if ((cmdId = Winuser.IDOK) or (cmdId = Winuser.IDCANCEL)) then
  138.         Dummy := Winuser.EndDialog (hDlg, 1);
  139.         return Win32.TRUE;
  140.       end if;
  141.  
  142.   when others =>
  143.       return Win32.FALSE;
  144.  
  145.   end case;
  146.   return Win32.FALSE;
  147.  
  148. end About;
  149.  
  150.  
  151.  
  152. --  FUNCTION: WndProc(HWND, UINT, WPARAM, LPARAM)
  153. --
  154. --  PURPOSE:  Processes messages
  155. --
  156. --  MESSAGES:
  157. --
  158. --  WM_COMMAND    - application menu (About dialog box)
  159. --  WM_DESTROY    - destroy window
  160. --
  161. --  COMMENTS:
  162. --
  163. --  To process the IDM_ABOUT message, call MakeProcInstance() to get the
  164. --  current instance address of the About() function.  Then call Dialog
  165. --  box which will create the box according to the information in your
  166. --  generic.rc file and turn control over to the About() function.  When
  167. --  it returns, free the intance address.
  168. --
  169. function WndProc (hwnd    : Win32.Windef.HWND;
  170.                   message : Win32.UINT;
  171.                   wParam  : Win32.WPARAM;
  172.                   lParam  : Win32.LPARAM) return Win32.LRESULT is
  173.                   
  174.   use type Interfaces.C.INT;
  175.   
  176.   wmID: Win32.WORD;
  177.   wmEvent: Win32.WORD;
  178. begin
  179.   case message is 
  180.     when Winuser.WM_COMMAND =>
  181.       wmID     := WinDef.LOWORD(Win32.DWORD(WPARAM));
  182.       wmEvent  := WinDef.HIWORD(Win32.DWORD(WPARAM));
  183.  
  184.       case wmID is
  185.  
  186.         when ma_extra.IDM_ABOUT =>
  187.           iResult := Winuser.DialogBox(HINST,
  188.                                        Win32.LPCSTR(WinUser.MAKEINTRESOURCE(
  189.                                            ma_extra.IDD_ABOUTBOX)),
  190.                                        HWND, About'Access);
  191.  
  192.         when ma_extra.IDM_EXIT =>
  193.           bResult := Winuser.DestroyWindow(HWND);
  194.  
  195.         when ma_extra.IDM_HELPCONTENTS =>
  196.           bResult := Winuser.WinHelp(HWND,
  197.                                      Help_Ptr,
  198.                                      Winuser.HELP_CONTENTS,
  199.                                      0);
  200.           if bResult = Win32.FALSE then
  201.             iResult := Winuser.MessageBox(Winuser.GetFocus,
  202.                                           No_Help_Ptr,
  203.                                           SZAPPNAME,
  204.                                           (Winuser.MB_SYSTEMMODAL or 
  205.                                            Winuser.MB_OK or
  206.                                             Winuser.MB_ICONHAND));
  207.           end if;
  208.  
  209.         when ma_extra.IDM_HELPSEARCH =>
  210.           bResult := Winuser.WinHelp(HWND,
  211.                                      Help_Ptr,
  212.                                      Winuser.HELP_PARTIALKEY,
  213.                                      LPCSTR_To_DWORD(CP("CONTENTS" & Nul)));
  214.           if bResult = Win32.FALSE then
  215.             iResult := Winuser.MessageBox (Winuser.GetFocus,
  216.                                            No_Help_Ptr,
  217.                                            SZAPPNAME,
  218.                                            (Winuser.MB_SYSTEMMODAL or
  219.                                             Winuser.MB_OK or
  220.                                             Winuser.MB_ICONHAND));
  221.           end if;
  222.  
  223.         when ma_extra.IDM_HELPHELP =>
  224.           bResult := Winuser.WinHelp(HWND,
  225.                                      null,
  226.                                      Winuser.HELP_HELPONHELP, 0);
  227.           if bResult = Win32.FALSE then
  228.             iResult := Winuser.MessageBox(Winuser.GetFocus,
  229.                                           No_Help_Ptr,
  230.                                           SZAPPNAME,
  231.                                           (Winuser.MB_SYSTEMMODAL or
  232.                                            Winuser.MB_OK or
  233.                                            Winuser.MB_ICONHAND));
  234.           end if;
  235.  
  236.         when others =>
  237.           return Winuser.DefWindowProc(HWND, MESSAGE, WPARAM, LPARAM);
  238.  
  239.       end case;
  240.  
  241.     when Winuser.WM_DESTROY =>
  242.       Winuser.PostQuitMessage(0);
  243.  
  244.     when others =>
  245.       return Winuser.DefWindowProc(HWND, MESSAGE, WPARAM, LPARAM);
  246.  
  247.   end case;
  248.   return (0);
  249.  
  250. end WndProc;
  251.  
  252. -------------------------------------------------------------------------------
  253. --
  254. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  255. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  256. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  257. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  258. -- and the use of this file.  This file may be used only by licensees of 
  259. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  260. -- the terms of the licensee's End-User License Agreement for Microsoft 
  261. -- Software for the WIN32 Development Kit.
  262. --
  263. -- Copyright (c) Intermetrics, Inc. 1995
  264. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  265. -- Microsoft is a registered trademark and Windows and Windows NT are 
  266. -- trademarks of Microsoft Corporation.
  267. --
  268. -------------------------------------------------------------------------------
  269.  
  270. end Generic_Pkg;
  271.