home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / PCX.ADB < prev    next >
Encoding:
Text File  |  1995-12-06  |  6.4 KB  |  178 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/pcx.adb,v $ 
  2. -- $Revision: 1.1 $ $Date: 95/02/12 10:22:48 $ $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. pragma Linker_Options("-lwin32ada");
  23.  
  24.  
  25. with AliasPkg;  use AliasPkg;
  26. with Interfaces.C;
  27. with File;
  28. with PcxOps;
  29. with PcxChild;
  30. with Win32.WinMain; 
  31. with Win32.WinUser; 
  32. with Win32.WinBase;
  33. with Win32.WinGdi;
  34. with Win32.WinDef; 
  35. with Unchecked_Conversion;
  36.  
  37. procedure Pcx is
  38.  
  39. use type Interfaces.C.INT;
  40. use type Interfaces.C.UNSIGNED_SHORT;
  41. use type Win32.BOOL;
  42.  
  43.  
  44. MSG              : Win32.WinUser.LPMSG;       -- ptr to current message
  45. HACCELTABLE      : Win32.WinDef.HACCEL;       -- translates accelerator msgs
  46. BOX_ACTIVE       : BOOLEAN;                   -- is rectangle being sized?
  47. RECTANGLE_DRAWN  : BOOLEAN;                   -- was rectangle drawn? (to erase)
  48. REPAINT_WANTED   : BOOLEAN;                   -- repaint during resizing?
  49. BRESULT          : Win32.BOOL;                -- temp to hold results 
  50. LRESULT          : Win32.LRESULT;             -- temp to hold results 
  51.  
  52. --
  53. -- Unchecked_Conversions.  
  54. -- This translates from an integer to an HBRUSH.
  55. -- 
  56. function Int_To_HBrush is new Unchecked_Conversion(Win32.INT, 
  57.                                                    Win32.WinDef.HBRUSH);
  58.  
  59.  
  60. --
  61. -- Register the window and the "child" windows.
  62. --
  63. function InitApplication(HINST : Win32.WinDef.HINSTANCE) return Win32.BOOL is
  64.  
  65.  
  66. begin
  67.   WC.STYLE := Win32.WinUser.CS_HREDRAW or Win32.WinUser.CS_VREDRAW;
  68.   WC.LPFNWNDPROC := WndProc'access;
  69.   WC.CBCLSEXTRA := 0; 
  70.   WC.CBWNDEXTRA := 0;
  71.   WC.HINSTANCE := HINST;
  72.   WC.HICON := Win32.WinUser.LoadIcon(HINST, szappname);
  73.   WC.HCURSOR := Win32.WinUser.LoadCursor(System.Null_Address,
  74.                                          Win32.LPCSTR(Win32.WinUser.IDC_ARROW));
  75.   WC.HBRBACKGROUND := Int_To_HBrush(Win32.WinUser.COLOR_WINDOW + 1); 
  76.   WC.LPSZMENUNAME  := szappname;
  77.   WC.LPSZCLASSNAME := szappname;
  78. --
  79. --  Register the main window class.
  80. --
  81.   if Win32.BOOL(Win32.WinUser.RegisterClass(WC'access)) /= 
  82.                                         Win32.FALSE then
  83.     WC.STYLE := Win32.WinUser.CS_HREDRAW or Win32.WinUser.CS_VREDRAW;
  84.     WC.LPFNWNDPROC := PcxChild.ChildWndProc'access;
  85.     WC.CBCLSEXTRA := 0; 
  86.     WC.CBWNDEXTRA := 0;
  87.     WC.HINSTANCE := HINST;
  88.     WC.HICON := Win32.WinUser.LoadIcon(HINST, szappname);
  89.     WC.HCURSOR := Win32.WinUser.LoadCursor(System.Null_Address,
  90.                                          Win32.LPCSTR(Win32.WinUser.IDC_ARROW));
  91.     WC.HBRBACKGROUND := Int_To_HBrush(Win32.WinUser.COLOR_WINDOW + 1); 
  92.     WC.LPSZMENUNAME  := null;
  93.     WC.LPSZCLASSNAME := PcxChild.SZCHILDNAME;
  94. --
  95. --  Register the child window class and return success/failure code.
  96. --
  97.     return Win32.BOOL(Win32.WinUser.RegisterClass(WC'access));
  98.   else
  99.     return Win32.FALSE;
  100.   end if;
  101. end InitApplication;
  102.  
  103. --
  104. -- Create the window for use with PCX.
  105. --
  106. function InitInstance(HINST     : Win32.WinDef.HINSTANCE;
  107.                       NCMDSHOW  : Win32.INT) return Win32.BOOL is
  108.  
  109.     use type System.Address;
  110.     
  111.     HWND : Win32.WinDef.HWND;
  112. begin
  113. --
  114. -- Create a main window for this application instance.
  115. --
  116.   HWND := Win32.WinUser.CreateWindow(
  117.                              lpClassName  => szappname, 
  118.                              lpWindowName => CP(pcxTitle),
  119.                              dwStyle      => Win32.WinUser.WS_OVERLAPPEDWINDOW,
  120.                              X            => Win32.WinUser.CW_USEDEFAULT,
  121.                              Y            => Win32.WinUser.CW_USEDEFAULT,
  122.                              nWidth       => 300,
  123.                              nHeight      => 200,
  124.                              hWndParent   => System.Null_Address,
  125.                              hMenu        => System.Null_Address,
  126.                              hInstance    => HINST,
  127.                              lpParam      => System.Null_Address);
  128. --
  129. -- If window could not be created, return "failure".
  130. --
  131.   if HWND = System.Null_Address then
  132.     return Win32.FALSE;
  133.   end if;
  134. --
  135. -- Make the window visible; update its client area; and return "success".
  136. --
  137.   BRESULT := Win32.WinUser.ShowWindow(HWND, NCMDSHOW); -- Show the window
  138.   BRESULT := Win32.WinUser.UpdateWindow(HWND);         -- Sends WM_PAINT message
  139.   
  140.   return Win32.TRUE;
  141. end InitInstance;
  142.  
  143.  
  144. begin  -- pcx
  145.   FILE_DISPLAYED  := FALSE;
  146.   BOX_ACTIVE      := FALSE;
  147.   RECTANGLE_DRAWN := FALSE;
  148.   REPAINT_WANTED  := TRUE;
  149.   HINST           := Win32.WinMain.Get_Hinstance;
  150.   BRESULT         := InitApplication(HINST);
  151.   BRESULT         := InitInstance(HINST, Win32.WinMain.Get_nCmdShow);
  152.   HACCELTABLE     := Win32.WinUser.LoadAccelerators(HINST, szappname);
  153.  
  154. --
  155. -- Acquire and dispatch messages until a WM_QUIT message is received. 
  156. --
  157.   MSG := new Win32.WinUser.MSG;
  158.   while (Win32.WinUser.GetMessage (MSG, System.Null_Address, 0, 0) /= 0) loop
  159.     IRESULT := Win32.WinUser.TranslateAccelerator(MSG.HWND, HACCELTABLE, MSG);
  160.     BRESULT := Win32.WinUser.TranslateMessage(Win32.WinUser.ac_MSG_t(MSG));
  161.     LRESULT := Win32.WinUser.DispatchMessage(Win32.WinUser.ac_MSG_t(MSG));
  162.   end loop;
  163.  
  164. -------------------------------------------------------------------------------
  165. --
  166. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  167. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  168. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  169. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  170. -- use of this file.
  171. --
  172. -- Copyright (c) Intermetrics, Inc. 1995
  173. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  174. -- reproduction and further distribution of this file is permitted.
  175. --
  176. -------------------------------------------------------------------------------
  177.  
  178. end Pcx;