Solo Programadores 22/SOLO_22.iso/packages/win32ada/data.z/generic_ada.adb

Text File | 1995-12-05 | 7.3 KB | 202 lines

-- $Source: /home/harp/1/proto/monoBANK/winnt/generic_ada.adb,v $
-- $Revision: 1.1 $ $Date: 95/02/09 14:57:10 $ $Author: mg $
--
-- Notes: All Ada main programs should be functions so they can return exit
--        status.
--        Reserved names.
--        Ordering of functions.
--
--   PROGRAM: Generic_Ada.adb  (based on Generic.c)
--        (changed by MG, from TG version, to go with Xmuter)
--
--   PURPOSE: Generic template for Windows applications
--
--   FUNCTIONS:
--
--   Generic_Ada() - calls initialization function, processes message loop
--   InitApplication() - initializes window data and registers window
--   InitInstance() - saves instance handle and creates main window
--   WndProc() - processes messages
--   CenterWindow() - used to center the "About" box over application window
--   About() - processes messages for "About" dialog box
--
--   COMMENTS:
--
--   The Windows SDK Generic Application Example is a sample application
--   that you can use to get an idea of how to perform some of the simple
--   functionality that all Applications written for Microsoft Windows
--   should implement. You can use this application as either a starting
--   point from which to build your own applications, or for quickly
--   testing out functionality of an interesting Windows API.

pragma Linker_Options("-lwin32ada");


with ma_extra;
with Interfaces.C;
with Interfaces.C.Strings;
with Generic_Pkg; use Generic_Pkg;
with Win32;    use Win32;
with Win32.Winnt;
with Win32.Windef;
with Win32.Winuser;
with Win32.Wingdi;
with Win32.WinMain;
with Ada.Text_IO; use Ada.Text_IO;
with Unchecked_Conversion;


procedure Generic_Ada is

use type Interfaces.C.INT;


SZTITLE     : Win32.LPCSTR := CP("Generic Sample Ada Application");    -- title

MSG         : Winuser.LPMSG;
HACCELTABLE : Windef.HACCEL;

lResult     : Win32.LRESULT;




--  FUNCTION: InitApplication(HINSTANCE)
--
--  PURPOSE: Initializes window data and registers window class
--
--  COMMENTS:
--
--  This function is called at initialization time only if no other
--  instances of the application are running.  This function performs
--  initialization tasks that can be done once for any number of running
--  instances.
--
--  In this case, we initialize a window class by filling out a data
--  structure of type WNDCLASS and calling the Windows RegisterClass()
--  function.  Since all instances of this application use the same window
--  class, we only need to do this when the first instance is initialized.

function InitApplication(hInstance : Windef.HINSTANCE)
    return Win32.BOOL is

  WC_Ptr : Winuser.PWNDCLASSA;
  ATOM   : Windef.ATOM;
begin
  wc := (
        style       => Winuser.CS_HREDRAW or
                       Winuser.CS_VREDRAW,
        lpfnWndProc => WndProc'Access,
        cbClsExtra  => 0,
        cbWndExtra  => 0,
        hInstance   => hInstance,
        hIcon       => WinUser.LoadIcon(hInstance,
                                        Win32.LPCSTR(WinUser.MAKEINTRESOURCE(
                                            ma_extra.IDI_APP))),
        hCursor       => WinUser.LoadCursor(System.Null_Address,
                                            Win32.LPCSTR(WinUser.IDC_CROSS)),
        hbrBackground => WinDef.HBRUSH(WinGdi.GetStockObject(
                                       WinGdi.LTGRAY_BRUSH)),
        lpszMenuName  => Win32.LPCSTR(WinUser.MAKEINTRESOURCE(
                                      ma_extra.IDR_GENERIC)),
        lpszClassName => SZAPPNAME);

  WC_Ptr := WC'Access;
  --  Register the window class and return success/failure code.
  return Win32.BOOL (Winuser.RegisterClass(Winuser.ac_WNDCLASSA_t(WC_Ptr)));

end InitApplication;


--  FUNCTION:  InitInstance(hinstance, int)
--
--  PURPOSE:  Saves instance handle and creates main window
--
--  COMMENTS:
--
--  This function is called at initialization time for every instance of
--  this application.  This function performs initialization tasks that
--  cannot be shared by multiple instances.
--
--  In this case, we save the instance handle in a static variable and
--  create and display the main program window.
function InitInstance(hinstance : Windef.HINSTANCE;
                      ncmdshow  : Win32.INT) return Win32.BOOL is

  use type System.Address;

  HWND : Windef.HWND;

begin
  -- // Create a main window for this application instance.
  HWND := WinUser.CreateWindow (
              lpClassName => SZAPPNAME,
              lpWindowName=> SZTITLE,
              dwStyle     => WinUser.WS_OVERLAPPEDWINDOW or
                             WinUser.WS_CLIPCHILDREN,
              X           => WinUser.CW_USEDEFAULT,
              Y           => WinUser.CW_USEDEFAULT,
              nWidth      => WinUser.CW_USEDEFAULT,
              nHeight     => WinUser.CW_USEDEFAULT,
              hWndParent  => System.Null_Address,
              hMenu       => System.Null_Address,
              hInstance   => hInstance,
              lpParam     => System.Null_Address);

  --  // If window could not be created, return "failure"
  if HWND = System.Null_Address then
    return Win32.FALSE;
  end if;

  -- // Make the window visible; update its client area; and return "success"
  bResult := Winuser.ShowWindow(HWND, NCMDSHOW); -- Show the window
  bResult := Winuser.UpdateWindow(HWND);         -- Sends WM_PAINT message

  -- /*
  -- ** DEMO MODE - PostMessage used for Demonstration only
  -- */
  bResult := Winuser.PostMessage(HWND, Winuser.WM_COMMAND,
                                 ma_extra.IDM_ABOUT, 0);
  return Win32.TRUE;

end InitInstance;


begin  -- GENERIC_ADA
  HINST   := WinMain.Get_Hinstance;
  bResult := InitApplication(HINST);
  bResult := InitInstance(HINST, WinMain.Get_nCmdShow);

  HACCELTABLE := Winuser.LoadAccelerators(HINST, SZAPPNAME);

  -- Acquire and dispatch messages until a WM_QUIT message is received.
  MSG := new Winuser.MSG;
  while (Winuser.GetMessage (MSG, System.Null_Address,
                             Win32.UINT(0), Win32.UINT(0)) /= 0)
  loop
    iResult := Winuser.TranslateAccelerator(MSG.HWND, HACCELTABLE,
                                            Winuser.ac_MSG_t(MSG));
    bResult := Winuser.TranslateMessage(Winuser.ac_MSG_t(MSG));
    lResult := Winuser.DispatchMessage(Winuser.ac_MSG_t(MSG));
  end loop;

-------------------------------------------------------------------------------
--
-- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT
-- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT
-- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR
-- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy
-- and the use of this file.  This file may be used only by licensees of
-- Microsoft Corporation's WIN32 Software Development Kit in accordance with
-- the terms of the licensee's End-User License Agreement for Microsoft
-- Software for the WIN32 Development Kit.
--
-- Copyright (c) Intermetrics, Inc. 1995
-- Portions (c) 1985-1994 Microsoft Corporation with permission.
-- Microsoft is a registered trademark and Windows and Windows NT are
-- trademarks of Microsoft Corporation.
--
-------------------------------------------------------------------------------

end Generic_Ada;