home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / ZOOMIN.ADB < prev    next >
Encoding:
Text File  |  1995-12-06  |  8.8 KB  |  261 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/zoomin.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/02/11 14:30:50 $ $Author: mg $ 
  3. --
  4. --/****************************** Module Header *******************************
  5. --* Module Name: zoomin.c
  6. --*
  7. --* Microsoft ZoomIn utility.  This tool magnifies a portion of the screen,
  8. --* allowing you to see things at a pixel level.
  9. --*
  10. --* History:
  11. --* 01/01/88                              Created.
  12. --* 01/01/92                              Ported to NT.
  13. --* 03/06/92                              Cleanup.
  14. --* 10/20/94                              Ported To Ada. (mps)
  15. --* 01/23/95                              Ported to Inmet bindings
  16. --*
  17. --****************************************************************************/
  18. --
  19.  
  20. pragma Linker_Options("-lwin32ada");
  21.  
  22.  
  23. with Win32;
  24. with Win32.WinDef; 
  25. with Win32.WinUser;
  26. with Win32.WinGdi;
  27. with Win32.Malloc;
  28. with Win32.Utils;
  29. with Win32.WinMain;
  30. with Interfaces.C; 
  31. with Unchecked_Conversion;
  32. with Zoomin_Pkg;
  33.  
  34. use Win32;
  35. use Win32.WinDef;
  36. use Zoomin_Pkg;
  37.  
  38. procedure Zoomin is
  39.  
  40.     package ZP renames Zoomin_Pkg;
  41.  
  42.     use type Win32.BOOL;
  43.     use type Win32.LONG;
  44.     use type Win32.INT;
  45.     use type Interfaces.C.Unsigned;
  46.     use type Interfaces.C.Unsigned_Short;
  47.     use type Win32.Wingdi.PLOGPALETTE;
  48.     use type System.Address;
  49.  
  50.  
  51. --
  52. --/************************************************************************
  53. --* CreatePhysicalPalette
  54. --*
  55. --* Creates a palette for the app to use.  The palette references the
  56. --* physical palette, so that it can properly display images grabbed
  57. --* from palette managed apps.
  58. --*
  59. --* History:
  60. --*
  61. --************************************************************************/
  62. --
  63. function CreatePhysicalPalette return WinDef.HPALETTE is
  64.  
  65. pragma Suppress(range_check); -- this version doesn't use "extensible arrays"
  66.  
  67.     PPAL      : Win32.Wingdi.PLOGPALETTE;
  68.     HPAL      : Win32.Windef.HPALETTE := System.Null_Address;
  69.  
  70.     function Void_To_Logpalette is new Unchecked_Conversion(
  71.                                  Win32.PVOID, Win32.WinGdi.PLOGPALETTE);
  72. begin
  73.   PPAL := Void_To_Logpalette(
  74.                    Win32.Malloc.Malloc((Win32.WinGdi.LOGPALETTE'size)/8 + 
  75.                    NPAL*((WinGdi.PALETTEENTRY'size)/8)));
  76.   if PPAL /= null then
  77.     PPAL.PALVERSION := 16#300#;
  78.     PPAL.PALNUMENTRIES := NPAL;
  79.     for I in 0..NPAL - 1 loop
  80.       PPAL.PALPALENTRY(I).PEFLAGS := Win32.BYTE(WinGdi.PC_EXPLICIT);
  81.       PPAL.PALPALENTRY(I).PERED := Win32.BYTE(I);
  82.       PPAL.PALPALENTRY(I).PEGREEN := 0;
  83.       PPAL.PALPALENTRY(I).PEBLUE := 0;
  84.     end loop;
  85.     HPAL := WinGdi.CreatePalette(PPAL);
  86.   end if;
  87.   return HPAL;
  88. end CreatePhysicalPalette;
  89.  
  90.  
  91. --
  92. --/************************************************************************
  93. --* InitInstance
  94. --*
  95. --* Instance initialization for the app.
  96. --*
  97. --* Arguments:
  98. --*
  99. --* History:
  100. --*
  101. --************************************************************************/
  102. --
  103. function InitInstance(HINST   : Win32.Windef.HINSTANCE;
  104.                       CMDSHOW : Win32.INT) return Win32.BOOL is
  105.  
  106.     icon       : constant LPCSTR := ZP.CP(ZP.icon_str);
  107.     DX         : Win32.LONG;
  108.     DY         : Win32.LONG;
  109.     FLSTYLE    : Win32.DWORD;
  110.     RC         : Win32.Windef.LPRECT;
  111.     BRESULT    : Win32.BOOL;
  112.     IRESULT    : Win32.INT;
  113.     SYSTEM_MSG : Win32.LPSTR;
  114.     ERROR_LEN  : Win32.DWORD;
  115.  
  116. begin
  117.   GHINST := HINST;
  118. -- /*
  119. --  * Register a class for the main application window.
  120. --  */
  121.   ZP.WC.HCURSOR       := WinUser.LoadCursor(System.Null_Address, 
  122.                                             LPCSTR(WinUser.IDC_ARROW));
  123.   ZP.WC.HICON         := WinUser.LoadIcon(HINST, icon);
  124.   ZP.WC.LPSZMENUNAME  := LPCSTR(WinUser.MakeIntResource(IDMENU_ZOOMIN));
  125.   ZP.WC.LPSZCLASSNAME := SZAPPNAME;
  126.   ZP.WC.HBRBACKGROUND := WinDef.HBRUSH(WinGdi.GetStockObject(WinGdi.BLACK_BRUSH));
  127.   ZP.WC.HINSTANCE     := HINST;
  128.   ZP.WC.STYLE         := WinUser.CS_BYTEALIGNCLIENT or 
  129.                          WinUser.CS_VREDRAW or 
  130.                          WinUser.CS_HREDRAW;
  131.   ZP.WC.LPFNWNDPROC   := ZP.AppWndProc'access;
  132.   ZP.WC.CBWNDEXTRA    := 0;
  133.   ZP.WC.CBCLSEXTRA    := 0;
  134.  
  135.   if WinUser.RegisterClass(ZP.WC'access) = 0 then
  136.     SYSTEM_MSG := Win32.LPSTR(ZP.CP(ZP.BUFFER));
  137.     ERROR_LEN := Win32.WinBase.FormatMessage(
  138.                                     Win32.WinBase.format_message_from_system,
  139.                                     System.Null_Address,
  140.                                     Win32.WinBase.GetLastError,
  141.                                     DWORD(Win32.WinNT.MakeLangId(
  142.                                                Win32.WinNT.lang_english,
  143.                                                Win32.WinNT.sublang_english_us)),
  144.                                     SYSTEM_MSG,
  145.                                     DWORD(ZP.BUFFER'last));
  146.     IRESULT := Win32.WinUser.MessageBox(
  147.                                   Win32.WinUser.GetFocus,
  148.                                   LPCSTR(SYSTEM_MSG),
  149.                                   icon,
  150.                                   Win32.WinUser.MB_OK);
  151.  
  152.     return Win32.FALSE;
  153.   end if;
  154.  
  155.   GHACCELTABLE := WinUser.LoadAccelerators(HINST, 
  156.                               LPCSTR(WinUser.MakeIntResource(IDACCEL_ZOOMIN)));
  157.   if GHACCELTABLE = System.Null_Address then
  158.     return Win32.FALSE;
  159.   end if;
  160.  
  161.   GHPALPHYSICAL := CreatePhysicalPalette;
  162.   if GHPALPHYSICAL = System.Null_Address then
  163.     return Win32.FALSE;
  164.   end if;
  165.  
  166.   GCXSCREENMAX := Win32.LONG(WinUser.GetSystemMetrics(WinUser.SM_CXSCREEN) - 1);
  167.   GCYSCREENMAX := Win32.LONG(WinUser.GetSystemMetrics(WinUser.SM_CYSCREEN) - 1);
  168.  
  169.   FLSTYLE := WinUser.WS_CAPTION     or WinUser.WS_OVERLAPPED or 
  170.              WinUser.WS_SYSMENU     or WinUser.WS_THICKFRAME or
  171.              WinUser.WS_MINIMIZEBOX or WinUser.WS_VSCROLL;
  172.  
  173.   DX := 44 * GNZOOM;
  174.   DY := 36 * GNZOOM;
  175.  
  176.   RC := new WinDef.RECT;
  177.   bResult := WinUser.SetRect(RC, 0, 0, INT (DX), INT (DY));
  178.   bResult := WinUser.AdjustWindowRect(RC, FLSTYLE, Win32.TRUE);
  179.  
  180.   GHWNDAPP := WinUser.CreateWindow(
  181.                       lpClassName    => SZAPPNAME, 
  182.                       lpWindowName   => SZAPPNAME, 
  183.                       dwStyle        => FLSTYLE,
  184.                       X              => WinUser.CW_USEDEFAULT, 
  185.                       Y              => 0, 
  186.                       nWidth         => INT (RC.RIGHT - RC.LEFT), 
  187.                       nHeight        => INT (RC.BOTTOM - RC.TOP),
  188.                       hWndParent     => System.Null_Address,
  189.                       hMenu          => System.Null_Address, 
  190.                       hInstance      => HINST, 
  191.                       lpParam        => System.Null_Address);
  192.  
  193.   if GHWNDAPP = System.Null_Address then
  194.     return Win32.FALSE;
  195.   end if;
  196.  
  197.   bResult := WinUser.ShowWindow(GHWNDAPP, CMDSHOW);
  198.  
  199.   return Win32.TRUE;
  200. end InitInstance;
  201.  
  202. --
  203. --
  204. --/************************************************************************
  205. --* Zoomin
  206. --*
  207. --* Main entry point for the application.
  208. --*
  209. --* Arguments:
  210. --*
  211. --* History:
  212. --*
  213. --************************************************************************/
  214. --
  215. begin
  216.   GNZOOM        := 4;
  217.   GFREFENABLE   := Win32.FALSE;
  218.   GNREFINTERVAL := 20;
  219.   GFTRACKING    := Win32.FALSE;
  220.   GPTZOOM       := new POINT'(100,100);
  221.   HINST         := Win32.WinMain.Get_hInstance;
  222.   NCMDSHOW       := Win32.WinMain.Get_nCmdShow;
  223.   if InitInstance(HINST, NCMDSHOW) = Win32.FALSE then
  224.     return;
  225.   end if;
  226. -- /*     
  227. --  * Polling messages from event queue
  228. --  */
  229.   MESSAGE := new WinUser.MSG;
  230.   while WinUser.GetMessage(MESSAGE, System.Null_Address, 0, 0) = Win32.TRUE loop
  231. --
  232. -- For now, keep like this...need to correct NULL_PTR.
  233. --
  234. --  if WinUser.TranslateAccelerator(GHWNDAPP, GHACCELTABLE, MESSAGE) =
  235. --     INT (Win32.FALSE)
  236. --    then
  237.       bResult := WinUser.TranslateMessage(WinUser.ac_MSG_t(MESSAGE));
  238.       longResult := WinUser.DispatchMessage(WinUser.ac_MSG_t(MESSAGE));
  239. --    end if;
  240.   end loop;
  241.  
  242. -------------------------------------------------------------------------------
  243. --
  244. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  245. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  246. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  247. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  248. -- and the use of this file.  This file may be used only by licensees of 
  249. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  250. -- the terms of the licensee's End-User License Agreement for Microsoft 
  251. -- Software for the WIN32 Development Kit.
  252. --
  253. -- Copyright (c) Intermetrics, Inc. 1995
  254. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  255. -- Microsoft is a registered trademark and Windows and Windows NT are 
  256. -- trademarks of Microsoft Corporation.
  257. --
  258. -------------------------------------------------------------------------------
  259.  
  260. end Zoomin;
  261.