home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / DIALOG.ADB < prev    next >
Encoding:
Text File  |  1995-12-05  |  11.4 KB  |  302 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/dialog.adb,v $ 
  2. -- $Revision: 1.1 $ $Date: 95/02/11 13:49:09 $ $Author: mg $ 
  3. -- $Id: dialog.adb 1.2 1995/01/25 15:52:42 teg Exp teg $
  4. --
  5. --  package Dialog body
  6. --
  7. --  This package body is a translation of dialog.c which is part of the 
  8. --  Microsoft gdidemo sample application
  9. --
  10.  
  11. with Win32;
  12. with Win32.WinBase;
  13. with Win32.WinDef;
  14. with Win32.WinGdi;
  15. with Win32.WinUser;
  16. with Gdidemo_Util;
  17.  
  18. with Unchecked_Conversion;
  19. with Interfaces.C.Strings;
  20. with Interfaces.C;          use Interfaces.C;
  21.  
  22. package body Dialog is
  23.  
  24.   use type System.Address;
  25.  
  26.   -- Used in PaintWindow
  27.   rect_p   : aliased Win32.WinDef.RECT;
  28.   ps       : aliased Win32.WinUser.PAINTSTRUCT;
  29.  
  30.   -- dummy function return values,
  31.   bResult : Win32.BOOL;
  32.   iResult : Win32.INT;
  33.   uResult : Win32.UINT;
  34.   hResult : Win32.Windef.HWND;
  35.  
  36.   function LPVOID_TO_LOGPALETTE_P is new Unchecked_Conversion 
  37.                                          (Win32.LPVOID,
  38.                                           Win32.WinGdi.PLOGPALETTE); 
  39.  
  40. -- | DISPLAY DIALOG BOX
  41. -- |   This is a routine to display a generic modal-dialog box.
  42. -- |
  43. function DisplayDialogBox (hWnd_p       : Win32.WinDef.HWND;
  44.                            lpszTemplate : Win32.LPCSTR;
  45.                            lpfFunction  : Win32.WinUser.DLGPROC;
  46.                            lExtra       : Win32.LONG) return Win32.INT is
  47.   hInst : Win32.Winnt.HANDLE;
  48.   nRet  : Win32.INT;
  49. begin
  50.   nRet  := -1;
  51.   hInst := Gdidemo_Util.GETINSTANCE (hWnd_p); 
  52.   nRet  := Win32.WinUser.DialogBoxParam (
  53.              hInstance      => Win32.Windef.HINSTANCE (hInst),
  54.              lpTemplateName => lpszTemplate,
  55.              hWndParent     => hWnd_p,
  56.              lpDialogFunc   => lpfFunction,
  57.              dwInitParam    => lExtra);
  58.   return nRet;
  59. end DisplayDialogBox;
  60.  
  61.  
  62. -- | ABOUT DIALOG PROCEDURE
  63. -- |   This is the main dialog box routine for the HELPABOUT template.
  64. function AboutDlgProc (hDlg     : Win32.WinDef.HWND;
  65.                        wMsg     : Win32.UINT;
  66.                        wParam_p : Win32.WPARAM;
  67.                        lParam_p : Win32.LPARAM) return Win32.BOOL is
  68. begin
  69.  
  70.   case wMsg is
  71.  
  72.     -- /*
  73.     -- ** Set the focus to the OK button.
  74.     -- */
  75.     when Win32.WinUser.WM_INITDIALOG =>
  76.       hResult := Win32.WinUser.SetFocus (
  77.                    Win32.WinUser.GetDlgItem (hDlg,Win32.WinUser.IDOK));
  78.  
  79.     -- /*
  80.     -- ** Look for an ESC or RETURN event.
  81.     -- */
  82.     when Win32.WinUser.WM_COMMAND =>
  83.  
  84.       case wParam_p is
  85.         when Win32.WinUser.IDOK | Win32.WinUser.IDCANCEL =>
  86.           bResult := Win32.WinUser.EndDialog (hDlg, Win32.TRUE);
  87.  
  88.         when others =>
  89.           return Win32.FALSE;
  90.  
  91.       end case;
  92.  
  93.     -- /*
  94.     -- ** Wash the background of the aboutbox to give it a nice blue-scaling
  95.     -- ** effect.  Invalidate the OK button to force it to the top.  This
  96.     -- ** seems to be necessary since the OK button gets overwritten during
  97.     -- ** the washing.
  98.     -- */
  99.     when Win32.WinUser.WM_PAINT =>
  100.     declare
  101.       null_rect : Win32.WinGdi.ac_RECT_t;
  102.     begin
  103.       PaintWindow (hDlg, Gdidemo_Util.COLOR_SCALE_BLUE);
  104.       bResult := Win32.WinUser.InvalidateRect (
  105.                    Win32.WinUser.GetDlgItem (hDlg, Win32.WinUser.IDOK),
  106.                    null_rect,
  107.                    Win32.TRUE);
  108.     end;
  109.  
  110.     -- ** Default handler.
  111.     when others =>
  112.       return Win32.FALSE;
  113.  
  114.   end case;
  115.  
  116.   return Win32.TRUE;
  117. end AboutDlgProc;
  118.  
  119.  
  120. -- | PAINT WND BACKGROUND
  121. -- |   This routine is used to wash the background of a window.
  122. -- |
  123. procedure PaintWindow (hWnd_p : Win32.WinDef.HWND;
  124.                        nColor : Win32.INT) is
  125.   hDC_p    : Win32.WinDef.HDC;
  126.   hBrush_p : Win32.WinDef.HBRUSH;
  127.   hPal     : Win32.WinDef.HPALETTE;
  128.   null_size  : Win32.WinDef.LPSIZE;
  129.   null_point : Win32.WinDef.LPPOINT;
  130.   nMapMode,idx,nSize,nReserved,nLoop : Win32.INT;
  131.   uResult    : Win32.UINT;
  132. begin
  133.   hDC_p := Win32.WinUser.BeginPaint (hWnd_p, ps'Access);
  134.   bResult := Win32.WinUser.GetClientRect (hWnd_p,rect_p'Access);
  135.   nMapMode := Win32.WinGdi.SetMapMode (hDC_p, Win32.WinGdi.MM_ANISOTROPIC);
  136.  
  137.   if (Interfaces.C.Unsigned (Win32.Wingdi.GetDeviceCaps 
  138.                       (hDC_p, Win32.WinGdi.RASTERCAPS)) and 
  139.       Win32.WinGdi.RC_PALETTE) > 0 then
  140.     nReserved := Win32.WinGdi.GetDeviceCaps (hDC_p, Win32.WinGdi.NUMRESERVED);
  141.     nSize     := Win32.WinGdi.GetDeviceCaps (hDC_p, Win32.WinGdi.SIZEPALETTE) 
  142.                  - nReserved;
  143.  
  144.     hPal := CreateColorScalePalette (hDC_p, nColor);
  145.  
  146.     if hPal /= System.Null_Address then 
  147.       hPal := Win32.WinGdi.SelectPalette (hDC_p,hPal,Win32.FALSE);
  148.       uResult := Win32.WinGdi.RealizePalette (hDC_p);
  149.  
  150.       bResult := Win32.WinGdi.SetWindowExtEx (hDC_p,nSize,nSize,null_size);
  151.       bResult := Win32.WinGdi.SetViewportExtEx 
  152.                  (hDC_p,Interfaces.C.Int (rect_p.right),
  153.                   (-1)*Interfaces.C.Int (rect_p.bottom),
  154.                   null_size);
  155.       bResult := Win32.WinGdi.SetViewportOrgEx 
  156.                  (hDC_p, 0, Interfaces.C.Int (rect_p.bottom), null_point);
  157.       nLoop := nSize / 2;
  158.       for idx in 0 .. nLoop - 1 loop
  159.         hBrush_p := Win32.WinGdi.CreateSolidBrush (
  160.                       Win32.WinGdi.PALETTEINDEX (
  161.                       Win32.WORD (idx + nLoop)));
  162.         bResult := Win32.WinUser.SetRect 
  163.                    (rect_p'Access, idx, idx, (nSize - idx), (nSize - idx));
  164.         iResult := Win32.WinUser.FillRect (hDC_p, rect_p'Access, hBrush_p);
  165.         bResult := Win32.WinGdi.DeleteObject (Win32.Windef.HGDIOBJ (hBrush_p));
  166.       end loop;
  167.  
  168.       bResult := Win32.WinGdi.DeleteObject (Win32.Windef.HGDIOBJ (
  169.                  (Win32.WinGdi.SelectPalette(hDC_p,hPal,Win32.FALSE))));
  170.       uResult := Win32.WinGdi.RealizePalette(hDC_p);
  171.     end if;
  172.   else
  173.     bResult := Win32.WinGdi.SetWindowExtEx(hDC_p,512,512,null_size);
  174.     bResult := Win32.WinGdi.SetViewportExtEx
  175.                             (hDC_p, Interfaces.C.Int (rect_p.right),
  176.                              (-1)*Interfaces.C.Int (rect_p.bottom),null_size);
  177.     bResult := Win32.WinGdi.SetViewportOrgEx(hDC_p,0,
  178.                      Interfaces.C.Int (rect_p.bottom),null_point);
  179.  
  180.     for idx in 0 .. 255 loop
  181.       hBrush_p := Win32.WinGdi.CreateSolidBrush(
  182.                   Win32.WinGdi.RGB(0,0,Win32.BYTE(idx)));
  183.       bResult := Win32.WinUser.SetRect
  184.                  (rect_p'Access,Interfaces.C.Int (idx),
  185.                   Interfaces.C.Int (idx),
  186.                   Interfaces.C.Int (512-idx), 
  187.                   Interfaces.C.Int (512-idx));
  188.       iResult := Win32.WinUser.FillRect(hDC_p,rect_p'Access,hBrush_p);
  189.       bResult := Win32.WinGdi.DeleteObject (Win32.Windef.HGDIOBJ (hBrush_p));
  190.     end loop;
  191.   end if;
  192.  
  193.   iResult := Win32.WinGdi.SetMapMode(hDC_p,nMapMode);
  194.   bResult := Win32.WinUser.EndPaint(hWnd_p,ps'Access);
  195.  
  196. end PaintWindow;
  197.  
  198.  
  199. -- | CREATE COLOR SCALE PALETTE
  200. -- |   This routine creates a palette representing the scale values of a
  201. -- |   particular RGB color.  A gray-scale palette can also be created.
  202. -- |
  203. function CreateColorScalePalette (hDC_p  : Win32.WinDef.HDC;
  204.                                   nColor : Win32.INT) 
  205.                                            return Win32.WinDef.HPALETTE is
  206.   hPalette_p : Win32.WinDef.HPALETTE;
  207.   hMem     : Win32.WinDef.HGLOBAL;
  208.   lpMem    : Win32.WinGdi.PLOGPALETTE;
  209.   idx_index,nReserved,nSize : Win32.INT;
  210.   idx : integer;
  211.   dummy_handle : Win32.WinDef.HGLOBAL;
  212.   void_result : Win32.LPVOID;
  213. begin
  214.  
  215.   if (Interfaces.C.Unsigned (
  216.         Win32.WinGdi.GetDeviceCaps (hDC_p, Win32.WinGdi.RASTERCAPS)) and 
  217.       Win32.WinGdi.RC_PALETTE) > 0
  218.   then
  219.     nReserved := Win32.WinGdi.GetDeviceCaps(hDC_p,Win32.WinGdi.NUMRESERVED);
  220.     nSize     := Win32.WinGdi.GetDeviceCaps(hDC_p,Win32.WinGdi.SIZEPALETTE) 
  221.                  - nReserved;
  222.     --  remember to divide by 8 to get the size in bytes
  223.     hMem      := Win32.WinBase.GlobalAlloc (Win32.WinBase.GHND,
  224.                  Win32.DWORD ((Win32.WinGdi.LOGPALETTE'size + 
  225.                               (Win32.WinGdi.PALETTEENTRY'size * nSize)) / 8));
  226.  
  227.     if hMem /= System.Null_Address then 
  228.       void_result := Win32.WinBase.GlobalLock (hMem);
  229.       if void_result /= System.Null_Address then 
  230.         lpMem := LPVOID_TO_LOGPALETTE_P (void_result);
  231.         lpMem.palNumEntries := Win32.WORD (nSize);
  232.         lpMem.palVersion    := Win32.WORD (16#0300#);
  233.  
  234.         case nColor is
  235.               
  236.           when Gdidemo_Util.COLOR_SCALE_RED =>
  237.             for idx_index in 0 .. (nSize - 1) loop
  238.               idx := integer (idx_index);
  239.               lpMem.palPalEntry(idx).peRed   := Win32.BYTE (idx);
  240.               lpMem.palPalEntry(idx).peGreen := 0;
  241.               lpMem.palPalEntry(idx).peBlue  := 0;
  242.               lpMem.palPalEntry(idx).peFlags := Win32.WinGdi.PC_RESERVED;
  243.             end loop;
  244.  
  245.           when Gdidemo_Util.COLOR_SCALE_GREEN =>
  246.             for idx_index in 0 .. (nSize - 1) loop
  247.               idx := integer (idx_index);
  248.               lpMem.palPalEntry(idx).peRed   := 0;
  249.               lpMem.palPalEntry(idx).peGreen := Win32.BYTE (idx);
  250.               lpMem.palPalEntry(idx).peBlue  := 0;
  251.               lpMem.palPalEntry(idx).peFlags := Win32.WinGdi.PC_RESERVED;
  252.             end loop;
  253.  
  254.           when Gdidemo_Util.COLOR_SCALE_BLUE =>
  255.             for idx_index in 0 .. (nSize - 1) loop
  256.               idx := integer (idx_index);
  257.               lpMem.palPalEntry(idx).peRed   := Win32.BYTE (0);
  258.               lpMem.palPalEntry(idx).peGreen := 0;
  259.               lpMem.palPalEntry(idx).peBlue  := Win32.BYTE (idx);
  260.               lpMem.palPalEntry(idx).peFlags := Win32.WinGdi.PC_RESERVED;
  261.             end loop;
  262.  
  263.           when others =>   -- COLOR_SCALE_GRAY
  264.             for idx_index in 0 .. (nSize - 1) loop
  265.               idx := integer (idx_index);
  266.               lpMem.palPalEntry(idx).peRed   := Win32.BYTE (idx);
  267.               lpMem.palPalEntry(idx).peGreen := Win32.BYTE (idx);
  268.               lpMem.palPalEntry(idx).peBlue  := Win32.BYTE (idx);
  269.               lpMem.palPalEntry(idx).peFlags := Win32.WinGdi.PC_RESERVED;
  270.             end loop;
  271.         end case;
  272.         hPalette_p := Win32.WinGdi.CreatePalette (
  273.                       Win32.Wingdi.PLOGPALETTE(lpMem));
  274.         bResult    := Win32.WinBase.GlobalUnlock (hMem);
  275.       end if;
  276.       dummy_handle := Win32.WinBase.GlobalFree (hMem);
  277.     end if;
  278.   end if;
  279.   return hPalette_p;
  280.  
  281. end CreateColorScalePalette;
  282.  
  283. -------------------------------------------------------------------------------
  284. --
  285. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS PROVIDED "AS IS" WITHOUT 
  286. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT 
  287. -- LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR 
  288. -- A PARTICULAR PURPOSE.  The user assumes the entire risk as to the accuracy 
  289. -- and the use of this file.  This file may be used only by licensees of 
  290. -- Microsoft Corporation's WIN32 Software Development Kit in accordance with 
  291. -- the terms of the licensee's End-User License Agreement for Microsoft 
  292. -- Software for the WIN32 Development Kit.
  293. --
  294. -- Copyright (c) Intermetrics, Inc. 1995
  295. -- Portions (c) 1985-1994 Microsoft Corporation with permission.
  296. -- Microsoft is a registered trademark and Windows and Windows NT are 
  297. -- trademarks of Microsoft Corporation.
  298. --
  299. -------------------------------------------------------------------------------
  300.  
  301. end Dialog;
  302.