home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / aliaspkg.adb next >
Encoding:
Text File  |  1995-12-22  |  8.4 KB  |  250 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/aliaspkg.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/12/20 17:22:16 $ $Author: mg $ 
  3. -- $Id: pcx.adb 1.5 1995/02/08 18:30:27 mps Exp mps $
  4. --
  5. --   PROGRAM: pcx.adb 
  6. --
  7. --   PURPOSE: Provide display of PCX files
  8. -- 
  9. --   COMMENTS:
  10. --   The LabTek PCX Application Example is a sample application
  11. --   that you can use to get an idea of how to perform some of the simple
  12. --   functionality that the Windows GDI API implements.
  13. --   Note that no 'use' clauses were used to help get a better idea on where 
  14. --   various type are located in the binding.  Readability improves greatly
  15. --   once a 'use Win32;' is used.
  16. --
  17. --   NOTES:
  18. --   There is currently no help file.
  19. --   pcxops.adb uses Unix style opens and reads instead of the Win32 variants.
  20. --
  21.  
  22. with Ada.Unchecked_Conversion;
  23. with File;
  24. with PcxOps;
  25.  
  26. package body AliasPkg is
  27.  
  28. use type Interfaces.C.INT;
  29. use type Interfaces.C.UNSIGNED_SHORT;
  30. use type Win32.BOOL;
  31. --
  32. -- These are declared in pcx.h as well.  If these are modified, then pcx.h must
  33. -- be modified as well!
  34. --
  35. IDM_NEW          : constant := 100;
  36. IDM_OPEN         : constant := 101;
  37. IDM_SAVE         : constant := 102;
  38. IDM_SAVEAS       : constant := 103;
  39. IDM_PRINT        : constant := 104;
  40. IDM_PRINTSETUP   : constant := 105;
  41. IDM_EXIT         : constant := 106;
  42. IDM_UNDO         : constant := 200;
  43. IDM_CUT          : constant := 201;
  44. IDM_COPY         : constant := 202;
  45. IDM_PASTE        : constant := 203;
  46. IDM_LINK         : constant := 204;
  47. IDM_LINKS        : constant := 205;
  48. IDM_HELPCONTENTS : constant := 300;
  49. IDM_HELPSEARCH   : constant := 301;
  50. IDM_HELPHELP     : constant := 302;
  51. IDM_ABOUT        : constant := 303;
  52. DLG_VERFIRST     : constant := 400;
  53. DLG_VERLAST      : constant := 401;
  54.  
  55.  
  56. function CP(S : Win32.CHAR_Array) return Win32.LPCSTR is
  57.     function UC is new Ada.Unchecked_Conversion(System.Address,Win32.LPCSTR);
  58. begin
  59.     return UC(S(S'First)'Address);
  60. end CP;
  61.  
  62. function To_CA (S: String) return Win32.CHAR_Array is
  63. begin
  64.    return Win32.To_Win(Interfaces.C.To_C(S));
  65. end To_CA;
  66.  
  67. function To_DWORD is new Ada.Unchecked_Conversion(
  68.     Win32.WPARAM, Win32.DWORD);
  69.  
  70. -- Standard "About" box display.
  71. --
  72. function About(HDLG    : Win32.WinDef.HWND;
  73.                MESSAGE : Win32.UINT;
  74.                WPARAM  : Win32.WPARAM;
  75.                LPARAM  : Win32.LPARAM) return Win32.BOOL is
  76.  
  77.     CMDID   : Win32.WORD;
  78.     BRESULT : Win32.BOOL;
  79.  
  80. begin
  81.   case MESSAGE is
  82.  
  83.   when Win32.WinUser.WM_COMMAND =>
  84.       CMDID := Win32.Utils.LoWord(To_DWORD(WPARAM));
  85.       if ((CMDID = Win32.WinUser.IDOK) or 
  86.           (CMDID = Win32.WinUser.IDCANCEL)) then
  87.         BRESULT := Win32.WinUser.EndDialog (HDLG, 1);
  88.         return Win32.TRUE;
  89.       end if;
  90.  
  91.   when others =>
  92.       return Win32.FALSE;
  93.  
  94.   end case;
  95.   return Win32.FALSE;
  96.  
  97. end About;
  98.  
  99.  
  100.  
  101. --
  102. -- This is the standard windows procedure which accepts and handles
  103. -- the various messages.
  104. --
  105. function WndProc(HWND    : Win32.WinDef.HWND;
  106.                  MESSAGE : Win32.UINT;
  107.                  WPARAM  : Win32.WPARAM;
  108.                  LPARAM  : Win32.LPARAM) return Win32.LRESULT is
  109.  
  110.     use type Win32.LONG;
  111.  
  112.  
  113.     WMID         : Win32.WORD;
  114.     WMEVENT      : Win32.WORD;
  115.     BRESULT      : Win32.BOOL;
  116.     LRESULT      : Win32.LONG;
  117.     PREVMIXMODE  : Win32.INT;
  118.     CURSOR       : Win32.WinDef.HCURSOR;
  119.     HELP_PTR     : Win32.LPCSTR;
  120.  
  121. begin
  122.   case MESSAGE is
  123.  
  124.     when Win32.WinUser.WM_COMMAND =>
  125.       WMID     := Win32.Utils.LoWord(To_DWORD(WPARAM));
  126.       WMEVENT  := Win32.Utils.HiWord(To_DWORD(WPARAM));
  127.  
  128.       case WMID is
  129.  
  130. --
  131. -- This message implies that the user wants to select a pcx file.  Obtain the
  132. -- filename and begin the display.
  133. --
  134.         when IDM_OPEN =>
  135.           PCXFILENAME := File.ReadFile;
  136. --
  137. -- Change to the hourglass in the upper left corner while displaying.  TL_POINT
  138. -- is the Top & Left corner of the client window (which is used to compute
  139. -- the "resting" position of the mouse while a redraw is taking place).
  140. -- The BR_POINT is used to save the original position of the mouse.
  141. --
  142.           BRESULT := Win32.WinUser.GetWindowRect(HWND, CURSOR_RECT'access);
  143.           TL_POINT.X := CURSOR_RECT.LEFT;
  144.           TL_POINT.Y := CURSOR_RECT.TOP;
  145.           BRESULT := Win32.WinUser.SetCursorPos(Win32.INT(TL_POINT.X + 10), 
  146.                                                 Win32.INT(TL_POINT.Y + 10));
  147.           CURSOR := Win32.WinUser.LoadCursor(
  148.                                          System.Null_Address,
  149.                                          Win32.LPCSTR(Win32.WinUser.IDC_WAIT));
  150.           CURSOR := Win32.WinUser.SetCursor(CURSOR);
  151.           PcxOps.Initial_Display(HINST, HWND, PCXFILENAME);
  152.           CURSOR := Win32.WinUser.SetCursor(CURSOR);-- set cursor back to arrow
  153.           FILE_DISPLAYED := TRUE;
  154.  
  155.         when IDM_ABOUT =>
  156.           IRESULT := Win32.WinUser.DialogBox(HINST, CP(aboutbox), 
  157.                                              HWND,  About'Access);
  158.  
  159.         when IDM_EXIT =>
  160.           BRESULT := Win32.WinUser.DestroyWindow(HWND);
  161.       
  162. --
  163. -- Although we could have declared the help strings as constants 
  164. -- (for example 'aboutbox' above) , they are created at runtime for 
  165. -- demonstration.
  166. --
  167.         when IDM_HELPCONTENTS =>
  168.           HELP_STR(0..7) := To_CA("pcx.hlp");
  169.           HELP_PTR := CP(HELP_STR);
  170.           BRESULT := Win32.WinUser.WinHelp(HWND, 
  171.                                            HELP_PTR,
  172.                                            Win32.WinUser.HELP_CONTENTS,
  173.                                             0); 
  174.           if BRESULT = Win32.FALSE then
  175.             HELP_STR(0..23) := To_CA("Unable to activate help");
  176.             HELP_PTR := CP(HELP_STR);
  177.             IRESULT := Win32.WinUser.MessageBox(Win32.WinUser.GetFocus, 
  178.                              HELP_PTR,
  179.                              szappname,
  180.                              (Win32.WinUser.MB_SYSTEMMODAL or 
  181.                               Win32.WinUser.MB_OK or
  182.                               Win32.WinUser.MB_ICONHAND));
  183.           end if;
  184.  
  185.         when IDM_HELPSEARCH =>
  186.           HELP_STR(0..7) := To_CA("pcx.hlp");
  187.           HELP_PTR := CP(HELP_STR);
  188.           BRESULT := Win32.WinUser.WinHelp(HWND, 
  189.                                            HELP_PTR,
  190.                                            Win32.WinUser.HELP_PARTIALKEY, 
  191.                                            0);
  192.           if BRESULT = Win32.FALSE then 
  193.             HELP_STR(0..23) := To_CA("Unable to activate help");
  194.             HELP_PTR := CP(HELP_STR);
  195.             IRESULT := Win32.WinUser.MessageBox (Win32.WinUser.GetFocus, 
  196.                              HELP_PTR,
  197.                              szappname,
  198.                              (Win32.WinUser.MB_SYSTEMMODAL or 
  199.                               Win32.WinUser.MB_OK or
  200.                               Win32.WinUser.MB_ICONHAND));
  201.           end if;
  202.  
  203.         when IDM_HELPHELP =>
  204.           BRESULT := Win32.WinUser.WinHelp(HWND, 
  205.                                            null,
  206.                                            Win32.WinUser.HELP_HELPONHELP, 
  207.                                            0);
  208.           if BRESULT = Win32.FALSE then
  209.             HELP_STR(0..23) := To_CA("Unable to activate help");
  210.             HELP_PTR := CP(HELP_STR);
  211.             IRESULT := Win32.WinUser.MessageBox(Win32.WinUser.GetFocus, 
  212.                              HELP_PTR,
  213.                              szappname,
  214.                              (Win32.WinUser.MB_SYSTEMMODAL or 
  215.                               Win32.WinUser.MB_OK or
  216.                               Win32.WinUser.MB_ICONHAND));
  217.           end if;
  218.  
  219.         when others =>
  220.           return Win32.WinUser.DefWindowProc(HWND, MESSAGE, WPARAM, LPARAM);
  221.  
  222.       end case;
  223.  
  224.     when Win32.WinUser.WM_DESTROY =>
  225.       Win32.WinUser.PostQuitMessage(0);
  226.   
  227.     when others =>
  228.       return Win32.WinUser.DefWindowProc(HWND, MESSAGE, WPARAM, LPARAM);
  229.  
  230.   end case;
  231.   return Win32.FALSE;
  232.  
  233. end WndProc;
  234.  
  235. -------------------------------------------------------------------------------
  236. --
  237. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  238. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  239. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  240. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  241. -- use of this file.
  242. --
  243. -- Copyright (c) Intermetrics, Inc. 1995
  244. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  245. -- reproduction and further distribution of this file is permitted.
  246. --
  247. -------------------------------------------------------------------------------
  248.  
  249. end AliasPkg;
  250.