home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / connectpkg.adb < prev    next >
Encoding:
Text File  |  1995-12-22  |  3.7 KB  |  112 lines

  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/connectpkg.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/12/20 17:22:15 $ $Author: mg $ 
  3.  
  4. with Ada.Unchecked_Conversion;
  5. with Interfaces.C;
  6. with Win32;
  7. with Win32.Windef;
  8. with Win32.Wingdi;
  9. with Win32.Winmain;
  10. with Win32.Winuser;
  11.  
  12. package body ConnectPkg is
  13.  
  14.     use Win32;
  15.     use Win32.Windef;
  16.     use Win32.Wingdi;
  17.     use Win32.Winuser;
  18.  
  19.     use type Interfaces.C.Char_Array;
  20.     use type System.Address;
  21.     use type Interfaces.C.Int;
  22.  
  23.  
  24.     MAXPOINTS: constant := 1000;
  25.     type       POINT_Array is array(0..MAXPOINTS-1) of POINTS;
  26.     points   : POINT_Array;
  27.     nCount   : Integer := 0;
  28.  
  29.     function WndProc (hwnd   : Win32.Windef.HWND;
  30.                       msg    : Win32.UINT;
  31.                       wParam : Win32.WPARAM;
  32.                       lParam : Win32.LPARAM) return Win32.LRESULT is
  33.  
  34.         hdc     : Win32.Windef.HDC;
  35.             function To_DWORD is new Ada.Unchecked_Conversion
  36.                 (Win32.LPARAM, Win32.DWORD);
  37.         dwLparam: constant Win32.DWORD := To_DWORD(lParam);
  38.             IgnoredC: Win32.Windef.COLORREF;
  39.             IgnoredI: Win32.INT;
  40.  
  41.         use type Interfaces.C.Unsigned;     -- to get "and"
  42.     begin
  43.         case msg is
  44.         when WM_LBUTTONDOWN =>
  45.             nCount := 0;
  46.             IgnoredB := InvalidateRect(hwnd, null, Win32.TRUE);
  47.  
  48.         when WM_MOUSEMOVE =>
  49.             if(((wParam and MK_LBUTTON) /= 0) and (nCount < MAXPOINTS)) then
  50.                 points(nCount) := MAKEPOINTS(dwlParam);
  51.                 nCount         := nCount + 1;
  52.                 hdc            := GetDC(hwnd);
  53.                 IgnoredC       := SetPixel(hdc, INT(LOWORD(dwLparam)), 
  54.                                            INT(HIWORD(dwLparam)), 0);
  55.                 IgnoredI       := ReleaseDC(hwnd, hdc);
  56.             end if;
  57.  
  58.         when WM_LBUTTONUP =>
  59.             IgnoredB := InvalidateRect(hwnd, null, Win32.FALSE);
  60.  
  61.         when WM_PAINT =>
  62.             hdc := BeginPaint(hwnd, ps'access);
  63.  
  64.             for i in 0..nCount -2 loop
  65.                 for j in 1..nCount-1 loop
  66.                     IgnoredB := MoveToEx(hdc, INT(points(i).x), 
  67.                                          INT(points(i).y), null);
  68.                     IgnoredB := LineTo(hdc, INT(points(j).x), 
  69.                                        INT(points(j).y));
  70.                 end loop;
  71.             end loop;
  72.  
  73.             IgnoredB := EndPaint(hwnd, ps'access);
  74.  
  75.         when WM_DESTROY =>
  76.             PostQuitMessage(0);
  77.  
  78.         when others =>
  79.             return DefWIndowProc(hwnd, msg, wParam, lParam);
  80.         end case;
  81.  
  82.         return 0;   -- all cases but "others" end up here
  83.     end WndProc;
  84.  
  85. -------------------------------------------------------------------------------
  86. --
  87. -- This program has been derived by Intermetrics, Inc. from the 
  88. -- connect.c program in "Programming Windows 3.1", third edition, 
  89. -- by Charles Petzold, Microsoft Press.
  90. -- The program is derived from source code which is restricted 
  91. -- by the license and under the following copyrights:
  92. --
  93. --      Copyright (c) 1992 by Charles Petzold
  94. --
  95. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  96. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  97. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  98. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  99. -- and the use of this file.  This file may be used only by licensees of 
  100. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  101. -- the terms of the licensee's End-User License Agreement for Microsoft 
  102. -- Software for the WIN32 Development Kit.
  103. --
  104. -- Copyright (c) Intermetrics, Inc. 1995
  105. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  106. -- Microsoft is a registered trademark and Windows and Windows NT are 
  107. -- trademarks of Microsoft Corporation.
  108. --
  109. -------------------------------------------------------------------------------
  110.  
  111. end ConnectPkg;
  112.