home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / keylook_pkg.adb < prev    next >
Encoding:
Text File  |  1995-12-18  |  8.0 KB  |  254 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/keylook_pkg.adb,v $ 
  2. -- $Revision: 1.2 $ $Date: 95/12/18 17:03:18 $ $Author: mg $ 
  3.  
  4.  
  5. with Interfaces.C;
  6. with Stdarg;
  7. with Ada.text_io;
  8.  
  9. package body Keylook_Pkg is
  10.  
  11.     -- aliased for function WndProc
  12.     ps       : aliased Win32.Winuser.PAINTSTRUCT;
  13.     tm       : aliased Win32.Wingdi.TEXTMETRIC;
  14.  
  15.  
  16.     function CP(C_Str : Win32.CHAR_Array) return Win32.LPCSTR is
  17.         function UC is new Ada.Unchecked_Conversion
  18.                                (System.Address, Win32.LPCSTR);
  19.     begin
  20.         return UC(C_Str(C_Str'First)'Address);
  21.     end CP;
  22.  
  23.     function To_DWORD is new Ada.Unchecked_Conversion(
  24.     Win32.lParam, Win32.DWORD);
  25.  
  26.     use type Win32.Char_Array;            -- to get "&"
  27.     Nul: Win32.Char renames Win32.Nul;
  28.  
  29.     procedure ShowKey (
  30.     hwnd   : Win32.Windef.HWND;
  31.     iType  : Win32.INT;
  32.     Message: Win32.CHAR_Array;
  33.     wParam : Win32.UINT;
  34.     lParam : Win32.LONG) is
  35.  
  36.     use type Interfaces.C.Int;        -- to get "-"
  37.     use type Interfaces.C.Unsigned_Short;    -- to get "and"
  38.     use type Interfaces.C.Unsigned_Long;    -- to get "and"
  39.  
  40.     F0: constant Win32.CHAR_Array := 
  41.         "%-14s %3d    %c %6u %4d %3s %3s %4s %4s" & Nul;
  42.     F1: constant Win32.CHAR_Array := 
  43.         "%-14s %3d    %c %6u %4d %3s %3s %4s %4s" & Nul;
  44.  
  45.     type Sarray is array (Win32.INT range 0..1) of Win32.LPCSTR;
  46.     szFormat: constant Sarray := (CP(F0), CP(F1));
  47.  
  48.     szBuffer: Win32.CHAR_Array(0..79);
  49.     hdc     : Win32.Windef.HDC;
  50.     -- dwLparam: constant Win32.DWORD := Win32.DWORD(lParam);
  51.     dwLparam: constant Win32.DWORD := To_DWORD(lParam);
  52.  
  53.     -- Functions that replace the x?y:z expressions in the C version
  54.     function charparam return Win32.CHAR is
  55.     begin
  56.         if Itype /= 0 then
  57.         return Win32.CHAR'Val(
  58.            Win32.Windef.LOWORD(Win32.DWORD(wParam)) and 16#ff#);
  59.         else
  60.         return ' ';
  61.         end if;
  62.     end;
  63.  
  64.     function bit25 return Win32.CHAR_Array is
  65.     begin
  66.         if (dwLparam and 16#100_0000#) /= 0 then
  67.             return "Yes" & Nul;
  68.         else
  69.             return "No" & Nul;
  70.         end if;
  71.     end;
  72.     
  73.     function bit30 return Win32.CHAR_Array is
  74.     begin
  75.         if (dwLparam and 16#2000_0000#) /= 0 then
  76.         return "Yes" & Nul;
  77.         else
  78.         return "No" & Nul;
  79.         end if;
  80.     end;
  81.     
  82.     function bit31 return Win32.CHAR_Array is
  83.     begin
  84.         if (dwLparam and 16#4000_0000#) /= 0 then
  85.         return "Down" & Nul;
  86.         else
  87.         return "Up" & Nul;
  88.         end if;
  89.     end;
  90.     
  91.     function bit32 return Win32.CHAR_Array is
  92.         use type Interfaces.C.LONG;
  93.     begin
  94.         if lParam < 0 then 
  95.             return "Up" & Nul; 
  96.         else 
  97.             return "Down" & Nul; 
  98.         end if;
  99.     end;
  100.  
  101.  
  102.     -- use name "+" to avoid conflict with Standard."&" for strings.
  103.     function "+" (Args: Stdarg.ArgList; Arg: Win32.Char_Array)
  104.         return Stdarg.ArgList is
  105.         function "&" is new Stdarg.Concat(Win32.LPSTR);
  106.     begin
  107.         return Args & Win32.LPSTR(CP(Arg));
  108.     end "+";
  109.  
  110.     function "&" is new Stdarg.Concat(Win32.BYTE);
  111.     function "&" is new Stdarg.Concat(Win32.CHAR);
  112.     function "&" is new Stdarg.Concat(Win32.WORD);
  113.     function "&" is new Stdarg.Concat(Win32.UINT);
  114.  
  115.     begin    -- ShowKey
  116.     IgnoredB := Win32.Winuser.ScrollWindow(
  117.             hwnd, 0, -cyChar, rect'access, rect'access);
  118.     hdc := Win32.Winuser.GetDC(hwnd);
  119.     IgnoredH := Win32.Wingdi.SelectObject(hdc,
  120.         Win32.Wingdi.GetStockObject(Win32.Wingdi.SYSTEM_FIXED_FONT));
  121.     IgnoredB := Win32.Wingdi.TextOut(
  122.         hdc, cxChar, Win32.INT(rect.bottom) - cyChar, 
  123.         CP(szBuffer),
  124.         Win32.Winuser.wsprintf(
  125.             Win32.LPSTR(CP(szBuffer)),            -- buffer
  126.             szFormat(iType),                    -- format
  127.             (Stdarg.Empty +
  128.               Message) &                        -- message name
  129.               wParam &                        -- key
  130.               charparam &                        -- char
  131.               Win32.Windef.LOWORD(dwlParam) &    -- repeat count
  132.               Win32.Windef.LOBYTE(Win32.Windef.HIWORD(dwlParam)) +
  133.                               -- scan code
  134.               bit25 + bit30 + bit31 + bit32));    -- 4 bit fields
  135.  
  136.     IgnoredI := Win32.Winuser.ReleaseDC(hwnd, hdc);
  137.     IgnoredB := Win32.Winuser.ValidateRect(hwnd, null);
  138.     end ShowKey;
  139.     
  140.  
  141.     szTop   : constant Win32.CHAR_Array := 
  142.           "Message        Key Char Repeat Scan Ext ALT Prev Tran" & Nul;
  143.     szUnd   : constant Win32.CHAR_Array := 
  144.           "Message        ___ ____ ______ ____ ___ ___ ____ ____" & Nul;
  145.  
  146.     function WndProc (hwnd:   Win32.Windef.HWND;
  147.               msg:    Win32.UINT;
  148.               wParam: Win32.WPARAM;
  149.               lParam: Win32.LPARAM) return Win32.LRESULT is
  150.  
  151.     use type Interfaces.C.int;    -- to get '*'
  152.     use type Interfaces.C.long;    -- to get '*'
  153.  
  154.     hdc     : Win32.Windef.HDC;
  155.     -- dwLparam: constant Win32.DWORD := Win32.DWORD(lParam);
  156.     dwLparam: constant Win32.DWORD := To_DWORD(lParam);
  157.  
  158.     begin
  159.     case msg is
  160.         when Win32.Winuser.WM_CREATE =>
  161.         hdc      := Win32.Winuser.GetDC(hwnd);
  162.         IgnoredH := Win32.Wingdi.SelectObject(hdc,
  163.                      Win32.Wingdi.GetStockObject(
  164.                      Win32.Wingdi.SYSTEM_FIXED_FONT));
  165.         IgnoredB := Win32.Wingdi.GetTextMetrics(hdc, tm'access);
  166.         cxChar   := Win32.INT(tm.tmAveCharWidth);
  167.         cyChar   := Win32.INT(tm.tmHeight);
  168.         IgnoredI := Win32.Winuser.ReleaseDC(hwnd, hdc);
  169.         rect.top := 3 * Win32.LONG(cyChar)/2;
  170.  
  171.         when Win32.Winuser.WM_SIZE =>
  172.         rect.right  := Win32.LONG(Win32.Windef.LOWORD(dwlParam));
  173.         rect.bottom := Win32.LONG(Win32.Windef.HIWORD(dwLparam));
  174.         IgnoredB    := Win32.Winuser.UpdateWindow(hwnd);
  175.  
  176.         when Win32.Winuser.WM_PAINT =>
  177.         IgnoredB := Win32.Winuser.InvalidateRect(hwnd, null,
  178.                     Win32.TRUE);
  179.         hdc      := Win32.Winuser.BeginPaint(hwnd, ps'access);
  180.         IgnoredH := Win32.Wingdi.SelectObject(hdc,
  181.                      Win32.Wingdi.GetStockObject(
  182.                      Win32.Wingdi.SYSTEM_FIXED_FONT));
  183.         IgnoredI := Win32.Wingdi.SetBkMode(hdc,
  184.                            Win32.Wingdi.TRANSPARENT);
  185.         IgnoredB := Win32.Wingdi.TextOut(hdc, cxChar, cyChar/2,
  186.                     CP(szTop), szTop'Length-1);
  187.         IgnoredB := Win32.Wingdi.TextOut(hdc, cxChar, cyChar/2,
  188.                      CP(szUnd), szUnd'Length-1);
  189.         IgnoredB := Win32.Winuser.EndPaint(hwnd, ps'access);
  190.  
  191.         when Win32.Winuser.WM_KEYDOWN =>
  192.         ShowKey(hwnd, 0, "WM_KEYDOWN" & Nul,     wParam, lParam);
  193.  
  194.         when Win32.Winuser.WM_KEYUP =>
  195.         ShowKey(hwnd, 0, "WM_KEYUP" & Nul,       wParam, lParam);
  196.  
  197.         when Win32.Winuser.WM_CHAR =>
  198.         ShowKey(hwnd, 1, "WM_CHAR" & Nul,        wParam, lParam);
  199.  
  200.         when Win32.Winuser.WM_DEADCHAR =>
  201.         ShowKey(hwnd, 1, "WM_DEADCHAR" & Nul,    wParam, lParam);
  202.  
  203.         when Win32.Winuser.WM_SYSKEYDOWN =>
  204.         ShowKey(hwnd, 0, "WM_SYSKEYDOWN" & Nul,  wParam, lParam);
  205.  
  206.         when Win32.Winuser.WM_SYSKEYUP =>
  207.         ShowKey(hwnd, 0, "WM_SYSKEYUP" & Nul,    wParam, lParam);
  208.  
  209.         when Win32.Winuser.WM_SYSCHAR =>
  210.         ShowKey(hwnd, 1, "WM_SYSCHAR" & Nul,     wParam, lParam);
  211.  
  212.         when Win32.Winuser.WM_SYSDEADCHAR =>
  213.         ShowKey(hwnd, 1, "WM_SYSDEADCHAR" & Nul, wParam, lParam);
  214.  
  215.         when Win32.Winuser.WM_DESTROY =>
  216.         Win32.Winuser.PostQuitMessage(0);
  217.  
  218.         when others =>
  219.         return Win32.Winuser.DefWIndowProc(hwnd, msg, wParam, lParam);
  220.     end case;
  221.  
  222.  
  223.     return 0;    -- all cases except "others" end up here
  224.     end WndProc;
  225.  
  226. -------------------------------------------------------------------------------
  227. --
  228. -- This program has been derived by Intermetrics, Inc. from the 
  229. -- keylook.c program in "Programming Windows 3.1", third edition, 
  230. -- by Charles Petzold, Microsoft Press.
  231. -- The program is derived from source code which is restricted 
  232. -- by the license and under the following copyrights:
  233. --
  234. --      Copyright (c) 1992 by Charles Petzold
  235. --
  236. --
  237. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  238. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  239. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  240. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  241. -- and the use of this file.  This file may be used only by licensees of 
  242. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  243. -- the terms of the licensee's End-User License Agreement for Microsoft 
  244. -- Software for the WIN32 Development Kit.
  245. --
  246. -- Copyright (c) Intermetrics, Inc. 1995
  247. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  248. -- Microsoft is a registered trademark and Windows and Windows NT are 
  249. -- trademarks of Microsoft Corporation.
  250. --
  251. -------------------------------------------------------------------------------
  252.  
  253. end Keylook_Pkg;
  254.