home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / win32-winbase.adb < prev    next >
Encoding:
Text File  |  1995-12-27  |  4.1 KB  |  96 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/win32-winbase.adb,v $ 
  2. -- $Revision: 1.4 $ $Date: 95/02/02 15:57:54 $ $Author: mg $ 
  3. -------------------------------------------------------------------------------
  4. --
  5. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  6. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  7. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  8. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  9. -- use of this file.
  10. --
  11. -- Copyright (c) Intermetrics, Inc. 1995
  12. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  13. -- reproduction and further distribution of this file is permitted.
  14. --
  15. -------------------------------------------------------------------------------
  16.  
  17.  
  18. with Ada.Unchecked_Conversion;
  19. with Stdarg.Impl;
  20. with Win32.Utils;
  21.  
  22. package body Win32.Winbase is
  23.  
  24.     function GlobalDiscard(hglbMem: Win32.Windef.HGLOBAL)
  25.         return Win32.Windef.HGLOBAL is
  26.     begin
  27.         return GlobalReAlloc(hglbMem, 0, GMEM_MOVEABLE);
  28.     end GlobalDiscard;
  29.  
  30.     function LocalDiscard(hlocMem: Win32.Windef.HLocal)
  31.         return Win32.Windef.HLocal is
  32.     begin
  33.         return LocalReAlloc(hlocMem, 0, LMEM_MOVEABLE);
  34.     end LocalDiscard;
  35.  
  36.     function MAKEINTATOM(wInteger: WORD) return Win32.Winnt.LPTSTR is
  37.         function To_LPTSTR is new Ada.Unchecked_Conversion(
  38.             DWORD, Win32.Winnt.LPTSTR);
  39.     begin
  40.         return To_LPTSTR(Win32.Utils.MAKELONG(Low=>wInteger, High=>0));
  41.     end MAKEINTATOM;
  42.  
  43.     function FormatMessageA(dwFlags     : Win32.DWORD;
  44.                             lpSource    : Win32.LPCVOID;
  45.                             dwMessageId : Win32.DWORD;
  46.                             dwLanguageId: Win32.DWORD;
  47.                             lpBuffer    : Win32.LPSTR;
  48.                             nSize       : Win32.DWORD;
  49.                             Arguments   : Stdarg.ArgList := Stdarg.Empty)
  50.                                           return Win32.DWORD is
  51.  
  52.         function Doit(  dwFlags     : Win32.DWORD;
  53.                         lpSource    : Win32.LPCVOID;
  54.                         dwMessageId : Win32.DWORD;
  55.                         dwLanguageId: Win32.DWORD;
  56.                         lpBuffer    : Win32.LPSTR;
  57.                         nSize       : Win32.DWORD;
  58.                         Arguments   : access Stdarg.Impl.Param_Access)
  59.                                       return Win32.DWORD;
  60.         pragma Import(Stdcall, Doit, "FormatMessageA");
  61.  
  62.         Param_Addr: aliased Stdarg.Impl.Param_Access := 
  63.             Stdarg.Impl.Address_of_First_Arg(Arguments);
  64.     begin
  65.         return Doit(dwFlags, lpSource, dwMessageId, dwLanguageId, 
  66.                     lpBuffer, nSize, Param_Addr'access);    -- strange
  67.     end FormatMessageA;
  68.  
  69.     function FormatMessageW(dwFlags     : Win32.DWORD;
  70.                             lpSource    : Win32.LPCVOID;
  71.                             dwMessageId : Win32.DWORD;
  72.                             dwLanguageId: Win32.DWORD;
  73.                             lpBuffer    : Win32.LPWSTR;
  74.                             nSize       : Win32.DWORD;
  75.                             Arguments   : Stdarg.ArgList := Stdarg.Empty)
  76.                                           return Win32.DWORD is
  77.  
  78.         function Doit(  dwFlags     : Win32.DWORD;
  79.                         lpSource    : Win32.LPCVOID;
  80.                         dwMessageId : Win32.DWORD;
  81.                         dwLanguageId: Win32.DWORD;
  82.                         lpBuffer    : Win32.LPWSTR;
  83.                         nSize       : Win32.DWORD;
  84.                         Arguments   : access Stdarg.Impl.Param_Access)
  85.                                       return Win32.DWORD;
  86.         pragma Import(Stdcall, Doit, "FormatMessageW");
  87.  
  88.         Param_Addr: aliased Stdarg.Impl.Param_Access := 
  89.             Stdarg.Impl.Address_of_First_Arg(Arguments);
  90.     begin
  91.         return Doit(dwFlags, lpSource, dwMessageId, dwLanguageId, 
  92.                     lpBuffer, nSize, Param_Addr'access);    -- strange
  93.     end FormatMessageW;
  94.  
  95. end Win32.Winbase;
  96.