home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / FILE.ADB < prev    next >
Encoding:
Text File  |  1995-12-16  |  4.1 KB  |  122 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/file.adb,v $ 
  2. -- $Revision: 1.3 $ $Date: 95/12/15 16:49:37 $ $Author: mg $ 
  3. -- $Id: file.adb 1.3 1995/02/08 18:28:32 mps Exp mps $
  4. --
  5. -- This package contains the functions needed to process the file commands.  
  6. -- It uses the common dialog controls (Win32.CommDlg) to give the application a 
  7. -- familiar look and feel.
  8. --
  9. with Win32.WinDef;
  10. with Win32.WinUser;
  11. with Win32.CommDlg;
  12. with Interfaces.C;
  13. with Interfaces.C.Strings;
  14.  
  15. use Win32.WinDef;
  16.  
  17.  
  18. package body File is
  19.  
  20.     use Win32;
  21.     use type Interfaces.C.INT;
  22.  
  23.     maxfilename  : constant := 1024;
  24.  
  25.     BUFFER       : Win32.CHAR_Array(0..maxfilename);
  26.     SZFILE       : Win32.LPSTR;
  27.  
  28.  
  29.     -- aliased for function GetFileName
  30.     filter_str      : aliased constant Win32.CHAR_Array := 
  31.              "PCX Files (*.PCX)" & Nul & "*.PCX" & nul & nul;
  32.     title_str       : aliased constant Win32.CHAR_Array :=
  33.                 "Open Graphic Files" & Nul;
  34.     defext_str      : aliased constant Win32.CHAR_Array := "pcx" & Nul;
  35.     error_str       : aliased constant Win32.CHAR_Array :=
  36.                 "No File Opened" & Nul;
  37.     error_title_str : aliased constant Win32.CHAR_Array :=
  38.                 "Pcx Information" & Nul;
  39.     OFN             : aliased Win32.CommDlg.OPENFILENAME;
  40.  
  41.  
  42.     function CP(S : Win32.CHAR_Array) return Win32.LPCSTR is
  43.     function UC is new 
  44.         Ada.Unchecked_Conversion(System.Address,Win32.LPCSTR);
  45.     begin
  46.     return UC(S(S'First)'Address);
  47.     end CP;
  48.  
  49.     function GetFileName(PSTR : LPSTR) return LPCSTR is
  50.  
  51.     filter          : constant Win32.LPCSTR := CP(filter_str);
  52.     title           : constant Win32.LPCSTR := CP(title_str);
  53.     defext          : constant Win32.LPCSTR := CP(defext_str);
  54.     error           : constant Win32.LPCSTR := CP(error_str);
  55.     error_title     : constant Win32.LPCSTR := CP(error_title_str);
  56.  
  57.     BRESULT         : BOOL;
  58.     IRESULT         : INT;
  59.  
  60. begin
  61. --
  62. -- Fill in non-variant fields of OPENFILENAME struct.
  63. --
  64.   OFN.LSTRUCTSIZE       := DWORD(Win32.CommDlg.OPENFILENAME'size / 8);
  65.   OFN.HWNDOWNER         := System.Null_Address;
  66.   OFN.HINSTANCE         := System.Null_Address;
  67.   OFN.LPSTRFILTER       := filter;
  68.   OFN.LPSTRCUSTOMFILTER := null;
  69.   OFN.NMAXCUSTFILTER    := 0;
  70.   OFN.NFILTERINDEX      := 0;
  71.   OFN.LPSTRFILE         := PSTR;
  72.   OFN.NMAXFILE          := maxfilename;
  73.   OFN.LPSTRFILETITLE    := null;
  74.   OFN.NMAXFILETITLE     := maxfilename;
  75.   OFN.LPSTRINITIALDIR   := null;
  76.   OFN.LPSTRTITLE        := title;
  77.   OFN.FLAGS             := Win32.CommDlg.OFN_FILEMUSTEXIST or 
  78.                            Win32.CommDlg.OFN_HIDEREADONLY;
  79.   OFN.NFILEOFFSET       := 0;
  80.   OFN.NFILEEXTENSION    := 0;
  81.   OFN.LPSTRDEFEXT       := defext;
  82.   OFN.LCUSTDATA         := 0;
  83.   OFN.LPFNHOOK          := null;
  84.   OFN.LPTEMPLATENAME    := null;
  85. --
  86. -- Use standard open dialog.
  87. --
  88.   BRESULT := Win32.CommDlg.GetOpenFileName(OFN'access);
  89.   if BRESULT = Win32.FALSE then
  90.     IRESULT := Win32.WinUser.MessageBox(Win32.WinUser.GetFocus,
  91.                                         error,
  92.                                         error_title,
  93.                                         Win32.WinUser.MB_OK);
  94.     return null;
  95.   else
  96.     return LPCSTR(OFN.LPSTRFILE);
  97.   end if;
  98. end GetFileName;
  99.  
  100. function ReadFile return Win32.LPCSTR is
  101. begin
  102.   BUFFER(BUFFER'first) := Interfaces.C.CHAR(Ascii.nul);
  103.   SZFILE := Win32.LPSTR(CP(BUFFER));
  104.   return GetFileName(SZFILE);
  105. end ReadFile;
  106.  
  107. -------------------------------------------------------------------------------
  108. --
  109. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  110. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  111. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  112. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  113. -- use of this file.
  114. --
  115. -- Copyright (c) Intermetrics, Inc. 1995
  116. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  117. -- reproduction and further distribution of this file is permitted.
  118. --
  119. -------------------------------------------------------------------------------
  120.  
  121. end File;
  122.