home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / INIT.ADB < prev    next >
Encoding:
Text File  |  1995-12-19  |  12.0 KB  |  309 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/init.adb,v $ 
  2. -- $Revision: 1.3 $ $Date: 95/12/15 16:49:38 $ $Author: mg $ 
  3. -- $Id: init.adb 1.2 1995/01/25 15:54:53 teg Exp teg $
  4. --
  5. --  package Init body
  6. --
  7. --  This package contains a translation of the c functions found in init.c
  8. --  which is part of the Microsoft gdidemo sample application.
  9. --
  10. --| INITIALIZATION MODULE
  11. --|   This module contains startup-routines for the creation of windows for this
  12. --|   application.
  13. --|
  14. --|   RegisterAppClass
  15. --|   UnregisterAppClass
  16. --|   CreateAppWindow
  17. --|   CreateMDIClientWindow
  18. --|
  19.  
  20.  
  21. with Win32.WinDef;
  22. with Win32.WinGdi;
  23. with Win32.WinUser;
  24. with Gdidemo_Util;
  25. with Poly;
  26. with Xform;
  27. with Maze;
  28. with Draw;
  29. with Bounce;
  30. with Unchecked_Conversion;
  31. with Interfaces.C;
  32. with Interfaces.C.Strings;
  33. with Convert;
  34.  
  35. package body Init is
  36.  
  37.   use Win32;
  38.   use type Win32.Windef.ATOM;
  39.  
  40.   package GU renames Gdidemo_Util;
  41.  
  42.   appclass_str : aliased constant Win32.CHAR_Array := "GDIDEMO" & Nul;
  43.   apptitle_str : aliased constant Win32.CHAR_Array :=
  44.                              "Ada 95 Windows GDI Demonstration" & Nul;
  45.   APPCLASS : Win32.LPCSTR := Convert.CP(appclass_str);
  46.   APPTITLE : Win32.LPCSTR := Convert.CP(apptitle_str);
  47.  
  48.  
  49.   init_title_str : aliased constant Win32.CHAR_Array := "Init" & Nul;
  50.   init_title     : constant Win32.LPCSTR := Convert.CP(init_title_str);
  51.  
  52.   CWUSEDEF : constant := 16#80000000#;
  53.   function mod_to_int is new unchecked_conversion (Interfaces.C.unsigned_long,
  54.                                                    Win32.INT);
  55.   CW_USEDEF : Win32.INT := mod_to_int (CWUSEDEF); 
  56.   
  57.   --  dummy return values
  58.   bResult : Win32.BOOL;
  59.  
  60.   function LPCLIENTCREATESTRUCT_TO_LPVOID is new Unchecked_Conversion
  61.            (Win32.WinUser.LPCLIENTCREATESTRUCT, Win32.LPVOID);
  62.   
  63.   mdiclient_str : aliased constant Win32.CHAR_Array := "MDICLIENT" & Nul;
  64.   mdiclient     : constant Win32.LPCSTR := Convert.CP(mdiclient_str);
  65.  
  66.   ccs           : aliased Win32.WinUser.CLIENTCREATESTRUCT;
  67.   wndClass_p    : aliased Win32.WinUser.WNDCLASS;
  68.   
  69.  
  70.  
  71.  
  72. --  REGISTER APPLICATION CLASS
  73. --    This routine registers all classes necessary for the application.
  74. function RegisterAppClass (hInst : Win32.Windef.HINSTANCE) return Win32.BOOL is
  75. begin
  76.  
  77.   -- ** Set the common wndClass information.  This is common to all windows
  78.   -- ** of this application.
  79.   wndClass_p.style         := Win32.WinUser.CS_HREDRAW or 
  80.                               Win32.WinUser.CS_VREDRAW;
  81.   wndClass_p.cbClsExtra    := 0;
  82.   wndClass_p.cbWndExtra    := Win32.LONG'Size / 8;  --sizeof(LONG);
  83.   wndClass_p.hCursor       := Win32.WinUser.LoadCursor (System.Null_Address,
  84.                               Win32.LPCSTR(Win32.WinUser.IDC_ARROW));
  85.   wndClass_p.hInstance     := hInst;
  86.  
  87.   --/*
  88.   -- ** Register the main top-level window (frame).
  89.   --*/
  90.   wndClass_p.lpfnWndProc   := GU.WndProc'Access;
  91.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (hInst,
  92.                       Win32.LPCSTR(Win32.WinUser.MAKEINTRESOURCE(GU.APPICON)));
  93.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  94.                             Win32.WinGdi.GetStockObject(
  95.                             Win32.WinGdi.WHITE_BRUSH));
  96.   wndClass_p.lpszMenuName  := Win32.LPCSTR (
  97.                             Win32.WinUser.MAKEINTRESOURCE(GU.APPMENU));
  98.   wndClass_p.lpszClassName := APPCLASS;
  99.  
  100.   if Win32.WinUser.RegisterClass (wndClass_p'Access) = 0 then
  101.     return Win32.FALSE;
  102.   end if;
  103.  
  104.   --  /*
  105.   --  ** Register the polybezier demo window.
  106.   --  */
  107.   wndClass_p.lpfnWndProc   := Poly.PolyProc'Access;
  108.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (System.Null_Address,
  109.                             Win32.LPCSTR(Win32.WinUser.IDI_APPLICATION));
  110.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  111.                             Win32.WinGdi.GetStockObject(
  112.                             Win32.WinGdi.BLACK_BRUSH));
  113.   wndClass_p.lpszMenuName  := null;
  114.   wndClass_p.lpszClassName := Poly.POLYCLASS;
  115.  
  116.   if Win32.WinUser.RegisterClass(wndClass_p'Access) = 0 then
  117.     bResult := Win32.WinUser.UnregisterClass(APPCLASS,hInst);
  118.     return Win32.FALSE;
  119.   end if; 
  120.  
  121.   --  /*
  122.   --  ** Register the xform demo window.
  123.   --  */
  124.   wndClass_p.lpfnWndProc   := Xform.XFormProc'Access;
  125.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (System.Null_Address,
  126.                             Win32.LPCSTR(Win32.WinUser.IDI_APPLICATION));
  127.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  128.                             Win32.WinGdi.GetStockObject(
  129.                             Win32.WinGdi.BLACK_BRUSH));
  130.   wndClass_p.lpszClassName := Xform.XFORMCLASS;
  131.  
  132.   if Win32.WinUser.RegisterClass (wndClass_p'Access) = 0 then
  133.     bResult := Win32.WinUser.UnregisterClass (APPCLASS,       hInst);
  134.     bResult := Win32.WinUser.UnregisterClass (Poly.POLYCLASS, hInst);
  135.     return Win32.FALSE;
  136.   end if; 
  137.  
  138.  
  139.   --  /*
  140.   --  ** Register the maze demo window.
  141.   --  */
  142.   wndClass_p.lpfnWndProc   := Maze.MazeProc'Access;
  143.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (System.Null_Address,
  144.                             Win32.LPCSTR(Win32.WinUser.IDI_APPLICATION));
  145.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  146.                             Win32.WinGdi.GetStockObject(
  147.                             Win32.WinGdi.BLACK_BRUSH));
  148.   wndClass_p.lpszClassName := Maze.MAZECLASS;
  149.  
  150.   if Win32.WinUser.RegisterClass (wndClass_p'Access) = 0 then
  151.     bResult := Win32.WinUser.UnregisterClass (APPCLASS,         hInst);
  152.     bResult := Win32.WinUser.UnregisterClass (Poly.POLYCLASS,   hInst);
  153.     bResult := Win32.WinUser.UnregisterClass (Xform.XFORMCLASS, hInst);
  154.     return Win32.FALSE;
  155.   end if; 
  156.  
  157.  
  158.   --  /*
  159.   --  ** Register the random draw demo window.
  160.   --  */
  161.   wndClass_p.lpfnWndProc   := Draw.DrawProc'Access;
  162.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (System.Null_Address,
  163.                                 Win32.LPCSTR(Win32.WinUser.IDI_APPLICATION));
  164.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  165.                             Win32.WinGdi.GetStockObject (
  166.                             Win32.WinGdi.WHITE_BRUSH));
  167.   wndClass_p.lpszClassName := Draw.DRAWCLASS;
  168.  
  169.   if Win32.WinUser.RegisterClass (wndClass_p'Access) = 0 then
  170.     bResult := Win32.WinUser.UnregisterClass (APPCLASS, hInst);
  171.     bResult := Win32.WinUser.UnregisterClass (Poly.POLYCLASS, hInst);
  172.     bResult := Win32.WinUser.UnregisterClass (Xform.XFORMCLASS, hInst);
  173.     bResult := Win32.WinUser.UnregisterClass (Maze.MAZECLASS, hInst);
  174.     return Win32.FALSE;
  175.   end if; 
  176.  
  177.  
  178.   --  /*
  179.   --  ** Register the bouncing ball demo window.
  180.   --  */
  181.   wndClass_p.lpfnWndProc   := Bounce.BounceProc'Access;
  182.   wndClass_p.hIcon         := Win32.WinUser.LoadIcon (System.Null_Address,
  183.                             Win32.LPCSTR (
  184.                             Win32.WinUser.IDI_APPLICATION));
  185.   wndClass_p.hbrBackground := Win32.WinDef.HBRUSH (
  186.                             Win32.WinGdi.GetStockObject(
  187.                             Win32.WinGdi.WHITE_BRUSH));
  188.   wndClass_p.lpszClassName := Bounce.BOUNCECLASS;
  189.  
  190.   if Win32.WinUser.RegisterClass(wndClass_p'Access) = 0 then
  191.     bResult := Win32.WinUser.UnregisterClass (APPCLASS,         hInst);
  192.     bResult := Win32.WinUser.UnregisterClass (Poly.POLYCLASS,   hInst);
  193.     bResult := Win32.WinUser.UnregisterClass (Xform.XFORMCLASS, hInst);
  194.     bResult := Win32.WinUser.UnregisterClass (Maze.MAZECLASS,   hInst);
  195.     bResult := Win32.WinUser.UnregisterClass (Draw.DRAWCLASS,   hInst);
  196.     return Win32.FALSE;
  197.   end if; 
  198.  
  199.   return Win32.TRUE;
  200. end RegisterAppClass;
  201.  
  202.  
  203. -- | UNREGISTER APPLICATION CLASS
  204. -- |   This routine unregisters all classes registered for the application.
  205. -- |   It is typically called upon termination of the application.
  206. procedure UnregisterAppClass (hInst : Win32.WinDef.HINSTANCE) is
  207. begin
  208.  
  209.   bResult := Win32.WinUser.UnregisterClass (APPCLASS,              hInst);
  210.   bResult := Win32.WinUser.UnregisterClass (Poly.POLYCLASS,        hInst);
  211.   bResult := Win32.WinUser.UnregisterClass (Xform.XFORMCLASS,      hInst);
  212.   bResult := Win32.WinUser.UnregisterClass (Maze.MAZECLASS,        hInst);
  213.   bResult := Win32.WinUser.UnregisterClass (Draw.DRAWCLASS,        hInst);
  214.   bResult := Win32.WinUser.UnregisterClass (Bounce.BOUNCECLASS,    hInst);
  215. end UnregisterAppClass;
  216.  
  217. function CWTest (
  218.     dwExStyle    : Interfaces.C.Unsigned_Long; 
  219.     lpClassName  : Win32.LPCSTR; 
  220.     lpWindowName : Win32.LPCSTR; 
  221.     dwStyle      : Interfaces.C.Unsigned_Long; 
  222.     X            : Interfaces.C.Unsigned_Long; 
  223.     Y            : Interfaces.C.Unsigned_Long; 
  224.     nWidth       : Interfaces.C.Unsigned_Long; 
  225.     nHeight      : Interfaces.C.Unsigned_Long; 
  226.     hWndParent   : Interfaces.C.Unsigned; 
  227.     hMenu        : Interfaces.C.Unsigned; 
  228.     hInstance    : Interfaces.C.Unsigned; 
  229.     lpParam      : Integer) return Win32.Windef.HWND;
  230. pragma import (Stdcall, CWTest, "CreateWindowExA@48"); 
  231.  
  232. -- | CREATE APPLICATION WINDOW
  233. -- |   This routine creates the main top-level window.
  234. function CreateAppWindow (hInst : Win32.WinDef.HINSTANCE) return 
  235.                                                           Win32.WinDef.HWND is 
  236. begin
  237.    return Win32.WinUser.CreateWindow ( 
  238.     lpClassName  => APPCLASS,
  239.     lpWindowName => APPTITLE, 
  240.     dwStyle      => Win32.WinUser.WS_OVERLAPPEDWINDOW or
  241.                     Win32.WinUser.WS_CLIPCHILDREN,
  242.     X            => Win32.WinUser.CW_USEDEFAULT,
  243.     Y            => Win32.WinUser.CW_USEDEFAULT,
  244.     nWidth       => Win32.WinUser.CW_USEDEFAULT,
  245.     nHeight      => Win32.WinUser.CW_USEDEFAULT,
  246.     hWndParent   => System.Null_Address, 
  247.     hMenu        => System.Null_Address, 
  248.     hInstance    => hInst,
  249.     lpParam      => System.Null_Address); 
  250. end CreateAppWindow;
  251.  
  252.  
  253. -- | CREATE MDI CLIENT WINDOW
  254. -- |   This routine creates the client window which handles the MDI windows.
  255. -- |   The window will eventually be size to fit into the frame-window's client
  256. -- |   area.
  257. function CreateMDIClientWindow (hWndFrame : Win32.WinDef.HWND) 
  258.                                             return Win32.WinDef.HWND is
  259.   hWndClient : Win32.WinDef.HWND;
  260.   hInst      : Win32.Winnt.HANDLE;
  261.   ccs_ptr    : Win32.WinUser.LPCLIENTCREATESTRUCT;
  262. begin
  263.   --  ** Initialize the client struct to point to define the menu and child
  264.   --  ** identifiers.  The menu item specifies the parent menu in which the
  265.   --  ** the list of MDI childs will be appended to this menu.
  266.   ccs.hWindowMenu  := System.Null_Address;
  267.   ccs.idFirstChild := 0;
  268.   ccs_ptr := ccs'Access;
  269.  
  270.   hInst := GU.GETINSTANCE(hWndFrame);
  271.  
  272.   hWndClient := Win32.WinUser.CreateWindow (
  273.     lpClassName  => MDICLIENT,
  274.     lpWindowName => null,
  275.     dwStyle      => Win32.WinUser.WS_CHILD or 
  276.                     Win32.WinUser.WS_CLIPSIBLINGS or
  277.                     Win32.WinUser.WS_VISIBLE,
  278.     X            => 0,
  279.     Y            => 0,
  280.     nWidth       => 1,
  281.     nHeight      => 1, 
  282.     hWndParent   => hWndFrame,
  283.     hMenu        => System.Null_Address, 
  284.     hInstance    => Win32.Windef.HINSTANCE (hInst),
  285.     lpParam      => LPCLIENTCREATESTRUCT_TO_LPVOID (ccs_ptr));
  286.  
  287.     return hWndClient;
  288. end CreateMDIClientWindow; 
  289.  
  290. -------------------------------------------------------------------------------
  291. --
  292. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  293. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  294. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  295. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  296. -- and the use of this file.  This file may be used only by licensees of 
  297. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  298. -- the terms of the licensee's End-User License Agreement for Microsoft 
  299. -- Software for the WIN32 Development Kit.
  300. --
  301. -- Copyright (c) Intermetrics, Inc. 1995
  302. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  303. -- Microsoft is a registered trademark and Windows and Windows NT are 
  304. -- trademarks of Microsoft Corporation.
  305. --
  306. -------------------------------------------------------------------------------
  307.  
  308. end Init;
  309.