home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / zoomin_ext.adb < prev    next >
Encoding:
Text File  |  1995-12-05  |  30.5 KB  |  936 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/zoomin_ext.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/02/11 14:30:54 $ $Author: mg $ 
  3. --
  4. -- NOTE:
  5. --
  6. -- This version of zoomin attempts to use the extensible arrays package.  
  7. -- It does not work correctly at this time.  I (MPS) tracked the bug down 
  8. -- to the call in InitInstance: bResult := ShowWindow(GHWNDAPP, CMDSHOW);
  9. -- It is possible that gnat 2.02 does not handle generics well and as a result
  10. -- is scribbling over memory somewhere.  It is also possible that I do not
  11. -- fully comprehend how to use the package Extensible.
  12. -- Using DBG however, I was able to verify that the same addresses are generated
  13. -- for both PPAL and PALPALENTRY.
  14. --
  15. --/****************************** Module Header *******************************
  16. --* Module Name: zoomin.c
  17. --*
  18. --* Microsoft ZoomIn utility.  This tool magnifies a portion of the screen,
  19. --* allowing you to see things at a pixel level.
  20. --*
  21. --* History:
  22. --* 01/01/88                              Created.
  23. --* 01/01/92                              Ported to NT.
  24. --* 03/06/92                              Cleanup.
  25. --* 10/20/94                              Ported To Ada. (mps)
  26. --* 01/23/95                              Ported to Inmet bindings
  27. --*
  28. --****************************************************************************/
  29. --
  30. with Win32;
  31. with Win32.WinDef; 
  32. with Win32.WinUser;
  33. with Win32.WinGdi;
  34. with Win32.Malloc;
  35. with Win32.Utils;
  36. with Win32.WinMain;
  37. with Interfaces.C; 
  38. with Unchecked_Conversion;
  39. with Extensible;
  40.  
  41. use Win32;
  42. use Win32.WinDef;
  43.  
  44. procedure Zoomin is
  45.  
  46. use type Win32.BOOL;
  47. use type Win32.LONG;
  48. use type Win32.INT;
  49. use type Interfaces.C.Unsigned;
  50. use type Interfaces.C.Unsigned_Short;
  51.  
  52. MENU_HELP_ABOUT          : constant := 100;
  53. MENU_EDIT_COPY           : constant := 200;
  54. MENU_EDIT_REFRESH        : constant := 201;
  55. MENU_OPTIONS_REFRESHRATE : constant := 300;
  56. DID_ABOUT                : constant := 1000;
  57. DID_REFRESHRATE          : constant := 1100;
  58. DID_REFRESHRATEENABLE    : constant := 1101;
  59. DID_REFRESHRATEINTERVAL  : constant := 1102;
  60. IDMENU_ZOOMIN            : constant := 2000;
  61. IDACCEL_ZOOMIN           : constant := 3000;
  62. IDTIMER_ZOOMIN           : constant := 4000;
  63.  
  64. MIN_ZOOM      : constant := 1;
  65. MAX_ZOOM      : constant := 32;
  66. FASTDELTA     : constant := 8;
  67. MM10PERINCH   : constant := 254;         -- Tenths of a millimeter per inch.
  68. NPAL          : constant := 256;         -- Number of palette entries.
  69.  
  70. appname       : aliased constant Interfaces.C.CHAR_ARRAY := -- Application name
  71.                        Interfaces.C.To_C("Ada 9x ZoomIn");
  72. SZAPPNAME     : constant LPCSTR := appname(appname'first)'access;
  73. GHINST        : Windef.HINSTANCE;          -- Instance handle.
  74. GHWNDAPP      : Windef.HWND;               -- Main window handle.
  75. GHACCELTABLE  : Windef.HACCEL;             -- Main accelerator table.
  76. GNZOOM        : Win32.LONG;                -- Zoom (magnification) factor.
  77. GHPALPHYSICAL : Windef.HPALETTE;           -- Handle to the physical palette.
  78. GCXSCREENMAX  : Win32.LONG;                -- Width of the screen (less 1).
  79. GCYSCREENMAX  : Win32.LONG;                -- Height of the screen (less 1).
  80. GCXZOOMED     : Win32.LONG;                -- Client width in zoomed pixels.
  81. GCYZOOMED     : Win32.LONG;                -- Client height in zoomed pixels.
  82. GFREFENABLE   : Win32.BOOL;                -- TRUE if refresh is enabled.
  83. GNREFINTERVAL : Win32.UINT;                -- Refresh interval in 10ths of sec.
  84. GFTRACKING    : Win32.BOOL;                -- TRUE if tracking is in progress.
  85. GPTZOOM       : Windef.LPPOINT;            -- center of the zoomed area.
  86. MESSAGE       : WinUser.LPMSG;
  87. HINST         : Windef.HINSTANCE;
  88. NCMDSHOW      : Win32.INT;
  89. -- dummy return values for some of the WinAPI function calls
  90. bResult       : Win32.BOOL;
  91. siResult      : Win32.INT;
  92. hResult       : WinDef.HPALETTE;
  93. hgdiResult    : WinDef.HGDIOBJ;
  94. handResult    : Winnt.HANDLE;
  95. longResult    : Win32.LONG;
  96. hcurResult    : WinDef.HCURSOR;
  97. uResult       : Win32.UINT;
  98.  
  99. --
  100. -- This function was a macro in zoomin.h.
  101. --
  102. function Bound(X   : Win32.LONG;
  103.                MIN : Win32.LONG;
  104.                MAX : Win32.LONG) return Win32.LONG is
  105.  
  106. RETVAL : Win32.LONG;
  107.  
  108. begin
  109.   RETVAL := X;
  110.   if X < MIN then
  111.     RETVAL := MIN;
  112.   elsif X > MAX then
  113.     RETVAL := MAX;
  114.   end if;
  115.   return RETVAL;
  116. end Bound;
  117.  
  118.  
  119. --
  120. --/************************************************************************
  121. --* CreatePhysicalPalette
  122. --*
  123. --* Creates a palette for the app to use.  The palette references the
  124. --* physical palette, so that it can properly display images grabbed
  125. --* from palette managed apps.
  126. --*
  127. --* History:
  128. --*
  129. --************************************************************************/
  130. --
  131. function CreatePhysicalPalette return WinDef.HPALETTE is
  132.  
  133. HPAL        : WinDef.HPALETTE := null;
  134. LOGPALPTR   : Win32.WinGdi.PLOGPALETTE;
  135. PAL         : aliased Win32.WinGdi.LOGPALETTE;
  136.  
  137. package Ext is new Extensible(Win32.WinGdi.LOGPALETTE,
  138.                               Win32.WinGdi.PALETTEENTRY,
  139.                               PAL.PALPALENTRY'position);
  140.  
  141. function To_Plogpalette is new Unchecked_Conversion(Ext.Fixed_Ptr,
  142.                                                     Win32.WinGdi.PLOGPALETTE);
  143.  
  144. PPAL        : Ext.Extended_Ptr;
  145. PALPALENTRY : Ext.Big_Array_Ptr;
  146.  
  147.  
  148. begin
  149.   PPAL := Ext.Allocate(NPAL);
  150.   PALPALENTRY := Ext.Array_Part(PPAL);
  151.   --if PPAL /= null then
  152.     Ext.Fixed_Part(PPAL).PALVERSION := 16#300#;
  153.     Ext.Fixed_Part(PPAL).PALNUMENTRIES := NPAL;
  154.     for I in Interfaces.C.Unsigned range 0..NPAL - 1 loop
  155.       PALPALENTRY(I).PEFLAGS := Win32.BYTE(WinGdi.PC_EXPLICIT);
  156.       PALPALENTRY(I).PERED := Win32.BYTE(I);
  157.       PALPALENTRY(I).PEGREEN := 0;
  158.       PALPALENTRY(I).PEBLUE := 0;
  159.     end loop;
  160.     LOGPALPTR := To_Plogpalette(Ext.Fixed_Part(PPAL));
  161.     HPAL := WinGdi.CreatePalette(LOGPALPTR);
  162.   --end if;
  163.   return HPAL;
  164. exception
  165.   when constraint_error => HPAL := null; -- for breakpointing
  166.   when others => HPAL := null; -- for breakpointing
  167. end CreatePhysicalPalette;
  168.  
  169.  
  170. --
  171. --/************************************************************************
  172. --* CalcZoomedSize
  173. --*
  174. --* Calculates some globals.  This routine needs to be called any
  175. --* time that the size of the app or the zoom factor changes.
  176. --*
  177. --* History:
  178. --*
  179. --************************************************************************/
  180. --
  181. procedure CalcZoomedSize is
  182.  
  183. RC : WinDef.LPRECT;
  184.  
  185. begin
  186.   RC := new WinDef.RECT;
  187.   bResult := WinUser.GetClientRect(GHWNDAPP, RC);
  188.  
  189.   GCXZOOMED := (RC.RIGHT / GNZOOM) + 1;
  190.   GCYZOOMED := (RC.BOTTOM / GNZOOM) + 1;
  191. end CalcZoomedSize;
  192.  
  193. --
  194. --/************************************************************************
  195. --* DoTheZoomIn
  196. --*
  197. --* Does the actual paint of the zoomed image.
  198. --*
  199. --* Arguments:
  200. --*   HDC hdc - If not NULL, this hdc will be used to paint with.
  201. --*             If NULL, a dc for the apps window will be obtained.
  202. --*
  203. --* History:
  204. --*
  205. --************************************************************************/
  206. --
  207. procedure DoTheZoomIn(HDC_IN : WinDef.HDC) is
  208.  
  209. HDC_P     : WinDef.HDC;
  210. FRELEASE  : Win32.BOOL;
  211. HPALOLD   : WinDef.HPALETTE := null;
  212. HDCSCREEN : WinDef.HDC;
  213. X         : Win32.LONG;
  214. Y         : Win32.LONG;
  215.  
  216. begin
  217.   if HDC_IN = null then
  218.     HDC_P := WinUser.GetDC(GHWNDAPP);
  219.     FRELEASE := Win32.TRUE;
  220.   else
  221.     HDC_P := HDC_IN;
  222.     FRELEASE := Win32.FALSE;
  223.   end if;
  224.   if GHPALPHYSICAL /= null then
  225.     HPALOLD := WinGdi.SelectPalette(HDC_P, GHPALPHYSICAL, Win32.FALSE);
  226.     uResult := WinGdi.RealizePalette(HDC_P);
  227.   end if;
  228.  
  229. --  /*
  230. --   * The point must not include areas outside the screen dimensions.
  231. --   */
  232.   X := BOUND(GPTZOOM.X, GCXZOOMED / 2, GCXSCREENMAX - (GCXZOOMED / 2));
  233.   Y := BOUND(GPTZOOM.Y, GCYZOOMED / 2, GCYSCREENMAX - (GCYZOOMED / 2));
  234.  
  235.   HDCSCREEN := WinUser.GetDC(null);
  236.   siResult := WinGdi.SetStretchBltMode(HDC_P, WinGdi.COLORONCOLOR);
  237.   bResult := WinGdi.StretchBlt(HDC_P, 0, 0, 
  238.                                INT (GNZOOM * GCXZOOMED), 
  239.                                INT (GNZOOM * GCYZOOMED),
  240.                                HDCSCREEN, 
  241.                                INT (X - GCXZOOMED / 2),
  242.                                INT (Y - GCYZOOMED / 2), 
  243.                                INT (GCXZOOMED), 
  244.                                INT (GCYZOOMED), WinGdi.SRCCOPY);
  245.   siResult := WinUser.ReleaseDC(null, HDCSCREEN);
  246.  
  247.   if HPALOLD /= null then
  248.     hResult := WinGdi.SelectPalette(HDC_P, HPALOLD, Win32.FALSE);
  249.   end if;
  250.  
  251.   if FRELEASE /= Win32.FALSE then
  252.     siResult := WinUser.ReleaseDC(GHWNDAPP, HDC_P);
  253.   end if;
  254. end DoTheZoomIn;
  255.  
  256. --
  257. --/************************************************************************
  258. --* MoveView
  259. --*
  260. --* This function moves the current view around.
  261. --*
  262. --* Arguments:
  263. --*   INT nDirectionCode - Direction to move.  Must be VK_UP, VK_DOWN,
  264. --*                        VK_LEFT or VK_RIGHT.
  265. --*   BOOL fFast         - TRUE if the move should jump a larger increment.
  266. --*                        If FALSE, the move is just one pixel.
  267. --*   BOOL fPeg          - If TRUE, the view will be pegged to the screen
  268. --*                        boundary in the specified direction.  This overides
  269. --*                        the fFast parameter.
  270. --*
  271. --* History:
  272. --*
  273. --************************************************************************/
  274. --
  275. procedure MoveView(NDIRECTIONCODE : Win32.WPARAM;
  276.                    FFAST          : Win32.BOOL;
  277.                    FPEG           : Win32.BOOL) is
  278.  
  279. DDELTA : Win32.LONG;
  280.  
  281. begin
  282.   if FFAST /= Win32.FALSE then
  283.     DDELTA := FASTDELTA;
  284.   else
  285.     DDELTA := 1;
  286.   end if;
  287.   case NDIRECTIONCODE is
  288.   when WinUser.VK_UP =>
  289.     if FPEG /= Win32.FALSE then
  290.       GPTZOOM.Y := GCYZOOMED / 2;
  291.     else
  292.       GPTZOOM.Y := GPTZOOM.Y - DDELTA;
  293.     end if;
  294.     GPTZOOM.Y := BOUND(GPTZOOM.Y, 0, GCYSCREENMAX);
  295.  
  296.   when WinUser.VK_DOWN =>
  297.     if FPEG /= Win32.FALSE then
  298.       GPTZOOM.Y := GCYSCREENMAX - (GCYZOOMED / 2);
  299.     else
  300.       GPTZOOM.Y := GPTZOOM.Y + DDELTA;
  301.     end if;
  302.     GPTZOOM.Y := BOUND(GPTZOOM.Y, 0, GCYSCREENMAX);
  303.  
  304.   when WinUser.VK_LEFT =>
  305.     if FPEG /= Win32.FALSE then
  306.       GPTZOOM.X := GCXZOOMED / 2;
  307.     else
  308.       GPTZOOM.X := GPTZOOM.X - DDELTA;
  309.     end if;
  310.     GPTZOOM.X := BOUND(GPTZOOM.X, 0, GCXSCREENMAX);
  311.  
  312.   when WinUser.VK_RIGHT =>
  313.     if FPEG /= Win32.FALSE then
  314.       GPTZOOM.X := GCXSCREENMAX - (GCXZOOMED / 2);
  315.     else
  316.       GPTZOOM.X := GPTZOOM.X + DDELTA;
  317.     end if;
  318.     GPTZOOM.X := BOUND(GPTZOOM.X, 0, GCXSCREENMAX);
  319.  
  320.   when others => null;
  321.   end case;
  322.   DoTheZoomIn(null);
  323. end MoveView;
  324.  
  325. --
  326. --/************************************************************************
  327. --* DrawZoomRect
  328. --*
  329. --* This function draws the tracking rectangle.  The size and shape of
  330. --* the rectangle will be proportional to the size and shape of the
  331. --* app's client, and will be affected by the zoom factor as well.
  332. --*
  333. --* History:
  334. --*
  335. --************************************************************************/
  336. --
  337. procedure DrawZoomRect is
  338.  
  339. HDC_P : WinDef.HDC;
  340. RC    : WinDef.LPRECT;
  341. X     : Win32.LONG;
  342. Y     : Win32.LONG;
  343.  
  344. begin
  345.   X := BOUND(GPTZOOM.X, GCXZOOMED / 2, GCXSCREENMAX - (GCXZOOMED / 2));
  346.   Y := BOUND(GPTZOOM.Y, GCYZOOMED / 2, GCYSCREENMAX - (GCYZOOMED / 2));
  347.  
  348.   RC := new WinDef.RECT;
  349.  
  350.   RC.LEFT   := X - GCXZOOMED / 2;
  351.   RC.TOP    := Y - GCYZOOMED / 2;
  352.   RC.RIGHT  := RC.LEFT + GCXZOOMED;
  353.   RC.BOTTOM := RC.TOP + GCYZOOMED;
  354.  
  355.   bResult := WinUser.InflateRect(RC, 1, 1);
  356.  
  357.   HDC_P := WinUser.GetDC(null);
  358.  
  359.   bResult := WinGdi.PatBlt(HDC_P, Win32.INT (RC.LEFT), 
  360.                            Win32.INT (RC.TOP), Win32.INT (RC.RIGHT-RC.LEFT), 
  361.                            1, WinGdi.DSTINVERT);
  362.   -- note: input types INT can also be input as Win32.INT
  363.   bResult := WinGdi.PatBlt(HDC_P, INT (RC.LEFT), 
  364.                            INT (RC.BOTTOM), 1, 
  365.                            INT (-(RC.BOTTOM-RC.TOP)), 
  366.                            WinGdi.DSTINVERT);
  367.   bResult := WinGdi.PatBlt(HDC_P, INT (RC.RIGHT-1), 
  368.                            INT (RC.TOP), 1, 
  369.                            INT (RC.BOTTOM-RC.TOP),
  370.                            WinGdi.DSTINVERT);
  371.   bResult := WinGdi.PatBlt(HDC_P, INT (RC.RIGHT), 
  372.                            INT (RC.BOTTOM-1), 
  373.                            INT (-(RC.RIGHT-RC.LEFT)), 1, 
  374.                            WinGdi.DSTINVERT);
  375.  
  376.   siResult := WinUser.ReleaseDC(null, HDC_P);
  377. end DrawZoomRect;
  378.  
  379. --
  380. --/************************************************************************
  381. --* EnableRefresh
  382. --*
  383. --* This function turns on or off the auto-refresh feature.
  384. --*
  385. --* Arguments:
  386. --*   BOOL fEnable - TRUE to turn the refresh feature on, FALSE to
  387. --*                  turn it off.
  388. --*
  389. --* History:
  390. --*
  391. --************************************************************************/
  392. --
  393. procedure EnableRefresh(FENABLE : Win32.BOOL) is
  394.  
  395. URESULT : Win32.UINT;
  396.  
  397. begin
  398.   if FENABLE = Win32.TRUE then
  399. -- /*
  400. -- * Already enabled.  Do nothing.
  401. -- */
  402.     if GFREFENABLE = Win32.TRUE then
  403.       return;
  404.     end if;
  405.     URESULT := WinUser.SetTimer(GHWNDAPP, idtimer_zoomin, 
  406.                                 GNREFINTERVAL * 100, null);
  407.     if URESULT /= 0 then
  408.       GFREFENABLE := Win32.TRUE;
  409.     end if;
  410.   else
  411. -- /*
  412. -- * Not enabled yet.  Do nothing.
  413. -- */
  414.     if GFREFENABLE = Win32.FALSE then
  415.       return;
  416.     end if;
  417.     bResult := WinUser.KillTimer(GHWNDAPP, idtimer_zoomin);
  418.     GFREFENABLE := Win32.FALSE;
  419.   end if;
  420. end EnableRefresh;
  421.  
  422. --
  423. --/************************************************************************
  424. --* CopyToClipboard
  425. --*
  426. --* This function copies the client area image of the app into the
  427. --* clipboard.
  428. --*
  429. --* History:
  430. --*
  431. --************************************************************************/
  432. --
  433. procedure CopyToClipboard is
  434.  
  435. HDCSRC  : WinDef.HDC;
  436. HDCDST  : WinDef.HDC;
  437. RC      : WinDef.LPRECT;
  438. HBM     : WinDef.HBITMAP;
  439. RESULT  : Win32.BOOL;
  440. DEVCAPS : INT;
  441. SIZE_X  : INT;
  442. SIZE_Y  : INT;
  443.  
  444. begin
  445.   RESULT := WinUser.OpenClipboard(GHWNDAPP);
  446.   if RESULT = Win32.TRUE then
  447.     bResult := WinUser.EmptyClipboard;
  448.     HDCSRC := WinUser.GetDC(GHWNDAPP);
  449.     if HDCSRC /= null then
  450.       RC := new WinDef.RECT;
  451.       bResult := WinUser.GetClientRect(GHWNDAPP, RC);
  452.       HBM := WinGdi.CreateCompatibleBitmap(HDCSRC, 
  453.                                            INT (RC.RIGHT - RC.LEFT),
  454.                                            INT (RC.BOTTOM - RC.TOP));
  455.       if HBM /= null then
  456.         HDCDST := WinGdi.CreateCompatibleDC(HDCSRC);
  457.         if HDCDST /= null then
  458. -- /*
  459. --  * Calculate the dimensions of the bitmap and
  460. --  * convert them to tenths of a millimeter for
  461. --  * setting the size with the SetBitmapDimensionEx
  462. --  * call.  This allows programs like WinWord to
  463. --  * retrieve the bitmap and know what size to
  464. --  * display it as.
  465. --  */
  466.     
  467.           DEVCAPS := WinGdi.GetDeviceCaps(HDCSRC, WinGdi.LOGPIXELSX);
  468.           SIZE_X  := INT ((RC.RIGHT - RC.LEFT) * mm10perinch) / DEVCAPS;
  469.           DEVCAPS := WinGdi.GetDeviceCaps(HDCSRC, WinGdi.LOGPIXELSY);
  470.           SIZE_Y  := INT ((RC.BOTTOM - RC.TOP) * mm10perinch) / DEVCAPS;
  471.           bResult := WinGdi.SetBitmapDimensionEx(HBM, SIZE_X, SIZE_Y, null);
  472.           hgdiResult := WinGdi.SelectObject(HDCDST, WinDef.HGDIOBJ(HBM));
  473.           bResult := WinGdi.BitBlt(HDCDST, 0, 0,
  474.                                    INT (RC.RIGHT - RC.LEFT), 
  475.                                    INT (RC.BOTTOM - RC.TOP),
  476.                                    HDCSRC, 
  477.                                    INT (RC.LEFT), 
  478.                                    INT (RC.TOP), WinGdi.SRCCOPY);
  479.           bResult := WinGdi.DeleteDC(HDCDST);
  480.           handResult := WinUser.SetClipboardData(WinUser.CF_BITMAP, 
  481.                                                  Winnt.HANDLE (HBM));
  482.         else
  483.           bResult := WinGdi.DeleteObject(WinDef.HGDIOBJ(HBM));
  484.         end if;
  485.       end if;
  486.     end if;
  487.     siResult := WinUser.ReleaseDC(ghwndApp, hdcSrc);
  488.     bResult := WinUser.CloseClipboard;
  489.   else
  490.     bResult := WinUser.MessageBeep(0);
  491.   end if;
  492. end CopyToClipBoard;
  493.  
  494. --
  495. --/************************************************************************
  496. --* AboutDlgProc
  497. --*
  498. --* This is the About Box dialog procedure.
  499. --*
  500. --* History:
  501. --*
  502. --************************************************************************/
  503. --
  504. function AboutDlgProc(HWND_P   : WinDef.HWND;
  505.                       MSG      : Win32.UINT;
  506.                       WPARAM_P : Win32.WPARAM;
  507.                       LPARAM_P : Win32.LPARAM) return Win32.BOOL;
  508. pragma Convention(Stdcall, AboutDlgProc);
  509.  
  510. function AboutDlgProc(HWND_P   : WinDef.HWND;
  511.                       MSG      : Win32.UINT;
  512.                       WPARAM_P : Win32.WPARAM;
  513.                       LPARAM_P : Win32.LPARAM) return Win32.BOOL is
  514.  
  515. RETVAL : Win32.BOOL;
  516.  
  517. begin
  518.   case MSG is
  519.   when WinUser.WM_INITDIALOG =>
  520.     RETVAL := Win32.TRUE;
  521.   
  522.   when WinUser.WM_COMMAND =>
  523.     bResult := WinUser.EndDialog(HWND_P, WinUser.IDOK);
  524.     RETVAL  := Win32.TRUE;
  525.  
  526.   when others =>
  527.     RETVAL := Win32.FALSE;
  528.  
  529.   end case;
  530.   return RETVAL;
  531. end AboutDlgProc;
  532.  
  533. --
  534. --/************************************************************************
  535. --* RefreshRateDlgProc
  536. --*
  537. --* This is the Refresh Rate dialog procedure.
  538. --*
  539. --* History:
  540. --*
  541. --************************************************************************/
  542. --
  543. function RefreshRateDlgProc(HWND_P   : WinDef.HWND;
  544.                             MSG      : Win32.UINT;
  545.                             WPARAM_P : Win32.WPARAM;
  546.                             LPARAM_P : Win32.LPARAM) return Win32.BOOL;
  547. pragma Convention(Stdcall, RefreshRateDlgProc);
  548.  
  549. function RefreshRateDlgProc(HWND_P   : WinDef.HWND;
  550.                             MSG      : Win32.UINT;
  551.                             WPARAM_P : Win32.WPARAM;
  552.                             LPARAM_P : Win32.LPARAM) return Win32.BOOL is
  553.  
  554. FTRANSLATED : aliased Win32.BYTE;
  555. RETVAL      : Win32.BOOL;
  556.  
  557. begin
  558.   RETVAL := Win32.FALSE;
  559.   case MSG is
  560.   when WinUser.WM_INITDIALOG =>
  561.     longResult := WinUser.SendDlgItemMessage(HWND_P, did_refreshrateinterval, 
  562.                                              WinUser.EM_LIMITTEXT, 3, 0);
  563.     bResult := WinUser.SetDlgItemInt(HWND_P, did_refreshrateinterval, 
  564.                                      GNREFINTERVAL, Win32.FALSE);
  565.     bResult := WinUser.CheckDlgButton(HWND_P, did_refreshrateenable, 
  566.                                       Win32.UINT(GFREFENABLE));
  567.     RETVAL := Win32.TRUE;
  568.  
  569.   when WinUser.WM_COMMAND =>
  570.     case Utils.LoWord(DWORD(WPARAM_P)) is
  571.     when WinUser.IDOK =>
  572.       GNREFINTERVAL := WinUSer.GetDlgItemInt(HWND_P, 
  573.                                              did_refreshrateinterval, 
  574.                                              FTRANSLATED'access, 
  575.                                              Win32.FALSE);
  576. -- /*
  577. --  * Stop any existing timers then start one with the
  578. --  * new interval if requested to.
  579. --  */
  580.       EnableRefresh(Win32.FALSE);
  581.       EnableRefresh(Win32.BOOL(
  582.                WinUser.IsDlgButtonChecked(HWND_P, did_refreshrateenable)));
  583.       bResult := WinUser.EndDialog(HWND_P, WinUser.IDOK);
  584.     
  585.     when WinUser.IDCANCEL =>
  586.       bResult := WinUser.EndDialog(HWND_P, WinUser.IDCANCEL);
  587.  
  588.     when others =>
  589.       null;
  590.     end case;
  591.  
  592.   when others =>
  593.     null;
  594.   end case;
  595.   return RETVAL;
  596. end RefreshRateDlgProc;
  597.  
  598. --/************************************************************************
  599. --* AppWndProc
  600. --*
  601. --* Main window proc for the zoomin utility.
  602. --*
  603. --* Arguments:
  604. --*   Standard window proc args.
  605. --*
  606. --* History:
  607. --*
  608. --************************************************************************/
  609. --
  610. function AppWndProc(HWND_P   : WinDef.HWND;
  611.                     MSG      : Win32.UINT;
  612.                     WPARAM_P : Win32.WPARAM;
  613.                     LPARAM_P : Win32.LPARAM) return Win32.LRESULT;
  614. pragma Convention(Stdcall, AppWndProc);
  615.  
  616. function AppWndProc(HWND_P   : WinDef.HWND;
  617.                     MSG      : Win32.UINT;
  618.                     WPARAM_P : Win32.WPARAM;
  619.                     LPARAM_P : Win32.LPARAM) return Win32.LRESULT is
  620.  
  621. PS      : WinUser.LPPAINTSTRUCT;
  622. HCUROLD : WinDef.HCURSOR;
  623. RETVAL  : Win32.LRESULT;
  624.  
  625. begin
  626.   RETVAL := 0;
  627.   case MSG is
  628.   when WinUser.WM_CREATE =>
  629.     bResult := WinUser.SetScrollRange(hwnd_p, WinUser.SB_VERT, 
  630.                                       MIN_ZOOM, MAX_ZOOM, 
  631.                                       Win32.FALSE);
  632.     siResult := WinUser.SetScrollPos(hwnd_p, WinUser.SB_VERT, 
  633.                                      INT (GNZOOM), Win32.FALSE);
  634.  
  635.   when WinUser.WM_TIMER =>
  636. --  /*
  637. --   * Update on every timer message.  The cursor will be
  638. --   * flashed to the hourglash for some visual feedback
  639. --   * of when a snapshot is being taken.
  640. --   */
  641.     HCUROLD := WinUser.SetCursor(WinUser.LoadCursor(null,
  642.                                                     LPCSTR(WinUser.IDC_WAIT)));
  643.     DoTheZoomIn(null);
  644.     hcurResult := WinUser.SetCursor(HCUROLD);
  645.  
  646.   when WinUser.WM_PAINT =>
  647.     PS := new WinUser.PAINTSTRUCT;
  648.     handResult := Winnt.HANDLE(WinUser.BeginPaint(HWND_P, PS));
  649.     DoTheZoomIn(PS.HDC);
  650.     bResult := WinUser.EndPaint(HWND_P, Win32.WinUser.ac_PAINTt(PS));
  651.  
  652.   when WinUser.WM_SIZE =>
  653.     CalcZoomedSize;
  654.  
  655.   when WinUser.WM_LBUTTONDOWN =>
  656.     GPTZOOM.X := Win32.LONG(Utils.LoWord(DWORD(LPARAM_P)));
  657.     GPTZOOM.Y := Win32.LONG(Utils.HiWord(DWORD(LPARAM_P)));
  658.     bResult := WinUser.ClientToScreen(HWND_P, GPTZOOM);
  659.     DrawZoomRect;
  660.     DoTheZoomIn(null);
  661.  
  662.     handResult := Winnt.HANDLE (WinUser.SetCapture(HWND_P));
  663.     GFTRACKING := Win32.TRUE;
  664.  
  665.   when WinUser.WM_MOUSEMOVE =>
  666.     if GFTRACKING = Win32.TRUE then
  667.       DrawZoomRect;
  668.       GPTZOOM.X := Win32.LONG(Utils.LoWord(DWORD(LPARAM_P)));
  669.       GPTZOOM.Y := Win32.LONG(Utils.HiWord(DWORD(LPARAM_P)));
  670.       bResult := WinUser.ClientToScreen(HWND_P, GPTZOOM);
  671.       DrawZoomRect;
  672.       DoTheZoomIn(null);
  673.     end if;
  674.  
  675.   when WinUser.WM_LBUTTONUP =>
  676.     if gfTracking = Win32.TRUE then
  677.       DrawZoomRect;
  678.       bResult := WinUser.ReleaseCapture;
  679.       GFTRACKING := Win32.FALSE;
  680.     end if;
  681.  
  682.   when WinUser.WM_VSCROLL =>
  683.     case Utils.LoWord(DWORD(WPARAM_P)) is
  684.     when WinUser.SB_LINEDOWN =>
  685.       GNZOOM := GNZOOM + 1;
  686.  
  687.     when WinUser.SB_LINEUP =>
  688.       GNZOOM := GNZOOM - 1;
  689.  
  690.     when WinUser.SB_PAGEUP =>
  691.       GNZOOM := GNZOOM - 2;
  692.       
  693.     when WinUser.SB_PAGEDOWN =>
  694.       GNZOOM := GNZOOM + 2;
  695.       
  696.     when WinUser.SB_THUMBPOSITION | WinUser.SB_THUMBTRACK =>
  697.       GNZOOM := Win32.LONG(Utils.HiWord(DWORD(WPARAM_P)));
  698.   
  699.     when others => null;
  700.     end case;
  701.  
  702.     GNZOOM := BOUND(GNZOOM, MIN_ZOOM, MAX_ZOOM);
  703.     siResult := WinUser.SetScrollPos(HWND_P, WinUser.SB_VERT, 
  704.                                      INT (GNZOOM), Win32.TRUE);
  705.     CalcZoomedSize;
  706.     DoTheZoomIn(null);
  707.  
  708.   when WinUser.WM_KEYDOWN =>
  709.     case WPARAM_P is
  710.     when WinUser.VK_UP   | 
  711.          WinUser.VK_DOWN | 
  712.          WinUser.VK_LEFT | 
  713.          WinUser.VK_RIGHT =>
  714.       MoveView(WPARAM_P, 
  715.           Win32.BOOL(Win32.USHORT (Win32.USHORT (
  716.                      WinUser.GetKeyState(WinUser.VK_SHIFT)) and 
  717.                                          Win32.USHORT(16#8000#))),
  718.           Win32.BOOL(Win32.USHORT (Win32.USHORT (
  719.                      WinUser.GetKeyState(WinUser.VK_CONTROL)) and 
  720.                                          Win32.USHORT(16#8000#))));
  721.     when others => null;
  722.     end case;
  723.  
  724.   when WinUser.WM_COMMAND =>
  725.     case Utils.LoWord(DWORD(WPARAM_P)) is
  726.     when MENU_EDIT_COPY =>
  727.       CopyToClipBoard;
  728.  
  729.     when MENU_EDIT_REFRESH =>
  730.       DoTheZoomIn(null);
  731.  
  732.     when MENU_OPTIONS_REFRESHRATE =>
  733.       siResult := WinUser.DialogBox(GHINST, 
  734.                           LPCSTR(WinUser.MAKEINTRESOURCE(DID_REFRESHRATE)),
  735.                           HWND_P, 
  736.                           RefreshRateDlgProc'access);
  737.  
  738.     when MENU_HELP_ABOUT =>
  739.       siResult := WinUser.DialogBox(GHINST, 
  740.                                     LPCSTR(WinUser.MAKEINTRESOURCE(DID_ABOUT)),
  741.                                     HWND_P, 
  742.                                     AboutDlgProc'access);
  743.  
  744.     when others => null;
  745.     end case;
  746.   
  747.   when WinUser.WM_CLOSE =>
  748.     if GHPALPHYSICAL /= null then
  749.       bResult := WinGdi.DeleteObject(WinDef.HGDIOBJ(GHPALPHYSICAL));
  750.     end if;
  751.     bResult := WinUser.DestroyWindow(HWND_P);
  752.  
  753.   when WinUser.WM_DESTROY =>
  754.     WinUser.PostQuitMessage(0);
  755.  
  756.   when others =>
  757.     RETVAL := WinUser.DefWindowProc(HWND_P, MSG, WPARAM_P, LPARAM_P);
  758.   end case;
  759.   return RETVAL;
  760. end AppWndProc;
  761.  
  762. --
  763. --/************************************************************************
  764. --* InitInstance
  765. --*
  766. --* Instance initialization for the app.
  767. --*
  768. --* Arguments:
  769. --*
  770. --* History:
  771. --*
  772. --************************************************************************/
  773. --
  774. function InitInstance(HINST   : WinDef.HINSTANCE;
  775.                       CMDSHOW : Win32.INT) return Win32.BOOL is
  776.  
  777. icon_str   : aliased constant Interfaces.C.CHAR_ARRAY := 
  778.                                       Interfaces.C.To_C("zoomin");
  779. icon       : constant LPCSTR := icon_str(icon_str'first)'access;
  780.  
  781. WC         : aliased WinUser.WNDCLASS;
  782. DX         : Win32.LONG;
  783. DY         : Win32.LONG;
  784. FLSTYLE    : Win32.DWORD;
  785. RC         : WinDef.LPRECT;
  786. BRESULT    : BOOL;
  787. IRESULT    : INT;
  788. BUFFER     : aliased Interfaces.C.CHAR_ARRAY(0..1023);
  789. SYSTEM_MSG : LPSTR;
  790. ERROR_LEN  : DWORD;
  791.  
  792. begin
  793.   GHINST := HINST;
  794. -- /*
  795. --  * Register a class for the main application window.
  796. --  */
  797.   --WC := new WinUser.WNDCLASS_T;
  798.   WC.HCURSOR       := WinUser.LoadCursor(null, LPCSTR(WinUser.IDC_ARROW));
  799.   WC.HICON         := WinUser.LoadIcon(HINST, icon);
  800.   WC.LPSZMENUNAME  := LPCSTR(WinUser.MakeIntResource(IDMENU_ZOOMIN));
  801.   WC.LPSZCLASSNAME := SZAPPNAME;
  802.   WC.HBRBACKGROUND := WinDef.HBRUSH(WinGdi.GetStockObject(WinGdi.BLACK_BRUSH));
  803.   WC.HINSTANCE     := HINST;
  804.   WC.STYLE         := WinUser.CS_BYTEALIGNCLIENT or WinUser.CS_VREDRAW or 
  805.                       WinUser.CS_HREDRAW;
  806.   WC.LPFNWNDPROC   := AppWndProc'access;
  807.   WC.CBWNDEXTRA    := 0;
  808.   WC.CBCLSEXTRA    := 0;
  809.  
  810.   if WinUser.RegisterClass(WC'access) = 0 then
  811.     SYSTEM_MSG := BUFFER(BUFFER'first)'access;
  812.     ERROR_LEN := Win32.WinBase.FormatMessage(
  813.                                     Win32.WinBase.format_message_from_system,
  814.                                     null,
  815.                                     Win32.WinBase.GetLastError,
  816.                                     DWORD(Win32.WinNT.MakeLangId(
  817.                                                Win32.WinNT.lang_english,
  818.                                                Win32.WinNT.sublang_english_us)),
  819.                                     SYSTEM_MSG,
  820.                                     DWORD(BUFFER'last));
  821.     IRESULT := Win32.WinUser.MessageBox(
  822.                                   Win32.WinUser.GetFocus,
  823.                                   LPCSTR(SYSTEM_MSG),
  824.                                   icon,
  825.                                   Win32.WinUser.MB_OK);
  826.  
  827.     return Win32.FALSE;
  828.   end if;
  829.  
  830.   GHACCELTABLE := WinUser.LoadAccelerators(HINST, 
  831.                               LPCSTR(WinUser.MakeIntResource(IDACCEL_ZOOMIN)));
  832.   if GHACCELTABLE = null then
  833.     return Win32.FALSE;
  834.   end if;
  835.  
  836.   GHPALPHYSICAL := CreatePhysicalPalette;
  837.   if GHPALPHYSICAL = null then
  838.     return Win32.FALSE;
  839.   end if;
  840.  
  841.   GCXSCREENMAX := Win32.LONG(WinUser.GetSystemMetrics(WinUser.SM_CXSCREEN) - 1);
  842.   GCYSCREENMAX := Win32.LONG(WinUser.GetSystemMetrics(WinUser.SM_CYSCREEN) - 1);
  843.  
  844.   FLSTYLE := WinUser.WS_CAPTION or WinUser.WS_OVERLAPPED or 
  845.              WinUser.WS_SYSMENU or WinUser.WS_THICKFRAME or
  846.              WinUser.WS_MINIMIZEBOX or WinUser.WS_VSCROLL;
  847.  
  848.   DX := 44 * GNZOOM;
  849.   DY := 36 * GNZOOM;
  850.  
  851.   RC := new WinDef.RECT;
  852.   bResult := WinUser.SetRect(RC, 0, 0, INT (DX), INT (DY));
  853.   bResult := WinUser.AdjustWindowRect(RC, FLSTYLE, Win32.TRUE);
  854.  
  855.   GHWNDAPP := WinUser.CreateWindow(
  856.                       lpClassName    => SZAPPNAME, 
  857.                       lpWindowName   => SZAPPNAME, 
  858.                       dwStyle        => FLSTYLE,
  859.                       X              => WinUser.CW_USEDEFAULT, 
  860.                       Y              => 0, 
  861.                       nWidth         => INT (RC.RIGHT - RC.LEFT), 
  862.                       nHeight        => INT (RC.BOTTOM - RC.TOP),
  863.                       hWndParent     => null,
  864.                       hMenu          => null, 
  865.                       hInstance      => HINST, 
  866.                       lpParam        => null);
  867.  
  868.   if GHWNDAPP = null then
  869.     return Win32.FALSE;
  870.   end if;
  871.  
  872.   bResult := WinUser.ShowWindow(GHWNDAPP, CMDSHOW);
  873.  
  874.   return Win32.TRUE;
  875. end InitInstance;
  876.  
  877. --
  878. --
  879. --/************************************************************************
  880. --* Zoomin
  881. --*
  882. --* Main entry point for the application.
  883. --*
  884. --* Arguments:
  885. --*
  886. --* History:
  887. --*
  888. --************************************************************************/
  889. --
  890. begin
  891.   GNZOOM := 4;
  892.   GFREFENABLE := Win32.FALSE;
  893.   GNREFINTERVAL := 20;
  894.   GFTRACKING := Win32.FALSE;
  895.   GPTZOOM := new POINT'(100,100);
  896.   HINST := Win32.WinMain.Get_hInstance;
  897.   NCMDSHOW := Win32.WinMain.Get_nCmdShow;
  898.   if InitInstance(HINST, NCMDSHOW) = Win32.FALSE then
  899.     return;
  900.   end if;
  901. -- /*     
  902. --  * Polling messages from event queue
  903. --  */
  904.   MESSAGE := new WinUser.MSG;
  905.   while WinUser.GetMessage(MESSAGE, null, 0, 0) = Win32.TRUE loop
  906. --
  907. -- For now, keep like this...need to correct NULL_PTR.
  908. --
  909. --  if WinUser.TranslateAccelerator(GHWNDAPP, GHACCELTABLE, MESSAGE) =
  910. --     INT (Win32.FALSE)
  911. --    then
  912.       bResult := WinUser.TranslateMessage(WinUser.ac_MSG_t(MESSAGE));
  913.       longResult := WinUser.DispatchMessage(WinUser.ac_MSG_t(MESSAGE));
  914. --    end if;
  915.   end loop;
  916.  
  917. -------------------------------------------------------------------------------
  918. --
  919. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  920. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  921. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  922. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  923. -- and the use of this file.  This file may be used only by licensees of 
  924. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  925. -- the terms of the licensee's End-User License Agreement for Microsoft 
  926. -- Software for the WIN32 Development Kit.
  927. --
  928. -- Copyright (c) Intermetrics, Inc. 1995
  929. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  930. -- Microsoft is a registered trademark and Windows and Windows NT are 
  931. -- trademarks of Microsoft Corporation.
  932. --
  933. -------------------------------------------------------------------------------
  934.  
  935. end Zoomin;
  936.