home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / knight / knight.bas next >
BASIC Source File  |  1993-02-05  |  11KB  |  268 lines
  1. DefInt A-Z
  2.  
  3. ' --------------------------------------------------------
  4. ' Get any errors during execution of common OpenSave
  5. ' --------------------------------------------------------
  6. Declare Function CommDlgExtendedError Lib "COMMDLG.DLL" () As Long
  7. ' --------------------------------------------------------
  8.  
  9. ' --------------------------------------------------------
  10. ' File Open/Save structures and declarations
  11. ' --------------------------------------------------------
  12. Type DLGFILENAME
  13.      lStructSize As Long
  14.      hwndOwner As Integer
  15.      hInstance As Integer
  16.      lpstrFilter As Long
  17.      lpstrCustomFilter As Long
  18.      nMaxCustFilter As Long
  19.      nFilterIndex As Long
  20.      lpstrFile As Long
  21.      nMaxFile As Long
  22.      lpstrFileTitle As Long
  23.      nMaxFileTitle As Long
  24.      lpstrInitialDir As Long
  25.      lpstrTitle As Long
  26.      Flags As Long
  27.      nFileOffset As Integer
  28.      nFileExtension As Integer
  29.      lpstrDefExt As Long
  30.      lCustData As Long
  31.      lpfnHook As Long
  32.      lpTemplateName As Long
  33. End Type
  34.  
  35. Declare Function GetOpenFileName Lib "COMMDLG.DLL" (pDLGFILENAME As DLGFILENAME) As Integer
  36. Declare Function GetSaveFileName Lib "COMMDLG.DLL" (pDLGFILENAME As DLGFILENAME) As Integer
  37. Declare Function GetFileTitle Lib "COMMDLG.DLL" (ByVal FName As String, ByVal Title As String, Size As Integer)
  38.  
  39. Global Const OFN_READONLY = &H1
  40. Global Const OFN_OVERWRITEPROMPT = &H2
  41. Global Const OFN_HIDEREADONLY = &H4
  42. Global Const OFN_NOCHANGEDIR = &H8
  43. Global Const OFN_SHOWHELP = &H10
  44. Global Const OFN_ENABLEHOOK = &H20
  45. Global Const OFN_ENABLETEMPLATE = &H40
  46. Global Const OFN_ENABLETEMPLATEHANDLE = &H80
  47. Global Const OFN_NOVALIDATE = &H100
  48. Global Const OFN_ALLOWMULTISELECT = &H200
  49. Global Const OFN_EXTENSIONDIFFERENT = &H400
  50. Global Const OFN_PATHMUSTEXIST = &H800
  51. Global Const OFN_FILEMUSTEXIST = &H1000
  52. Global Const OFN_CREATEPROMPT = &H2000
  53. Global Const OFN_SHAREAWARE = &H4000
  54. Global Const OFN_NOREADONLYRETURN = &H8000
  55. Global Const OFN_NOTESTFILECREATE = &H10000
  56. Global Const OFN_SHAREFALLTHROUGH = 2
  57. Global Const OFN_SHARENOWARN = 1
  58. Global Const OFN_SHAREWARN = 0
  59.  
  60. ' --------------------------------------------------------
  61. ' GLOBAL MEMORY Stuff
  62. ' --------------------------------------------------------
  63. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  64. Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  65. Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  66. Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
  67.  
  68. Global Const GMEM_MOVEABLE = &H2
  69. Global Const GMEM_ZEROINIT = &H40
  70. Global Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  71.  
  72. Declare Sub hmemcpy Lib "Kernel" (lpDest As Any, lpSource As Any, ByVal dwBytes As Long)
  73. ' --------------------------------------------------------
  74.  
  75. Function CmdError$ (x&)
  76.     If x& = 32765 Then
  77.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function failed during initialization (not enough memory?)."
  78.     ElseIf x& = 32761 Then
  79.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function failed to load a specified string."
  80.     ElseIf x& = 32760 Then
  81.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function failed to load a specified resource."
  82.     ElseIf x& = 32759 Then
  83.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function failed to lock a specified resource."
  84.     ElseIf x& = 32758 Then
  85.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function unable to allocate memory for internal data structures."
  86.     ElseIf x& = 32757 Then
  87.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Common dialog function unable to lock memory associated with a handle."
  88.     ElseIf x& = 32755 Then
  89.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Cancel was selected."
  90.     ElseIf x& = 32752 Then
  91.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Couldn't allocate memory for FileName or Filter."
  92.     ElseIf x& = 32751 Then
  93.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The call to WinHelp failed.  Check the Help property values."
  94.     ElseIf x& = 28671 Then
  95.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The PD_RETURNDEFAULT flag was set in the Flags member of PRINTDLG data structure, but either hDevMode or hDevNames field were nonzero."
  96.     ElseIf x& = 28670 Then
  97.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "Load of the required resources failed."
  98.     ElseIf x& = 28669 Then
  99.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The common dialog function failed to parse the strings in the [devices] section of the WIN.INI file."
  100.     ElseIf x& = 28668 Then
  101.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The PD_RETURNDEFAULT flag was set in the Flags member of PRINTDLG data structure, but either hDevMode or hDevNames field were nonzero."
  102.     ElseIf x& = 28667 Then
  103.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The PRINTDLG function failed to load the specified printer's device driver."
  104.     ElseIf x& = 28666 Then
  105.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The printer device-driver failed to initialize a DEVMODE data structure (print driver written for WIN 3.0 or later)."
  106.     ElseIf x& = 28665 Then
  107.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The PRINTDLG function failed during initialization."
  108.     ElseIf x& = 28664 Then
  109.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "No printer device-drivers were found."
  110.     ElseIf x& = 28663 Then
  111.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "A default printer does not exist."
  112.     ElseIf x& = 28662 Then
  113.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The data in the DEVMODE and DEVNAMES data structrues describes two different printers."
  114.     ElseIf x& = 28661 Then
  115.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The PRINTDLG function failed when it attempted to create an information context."
  116.     ElseIf x& = 28660 Then
  117.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The [devices] section of the WIN.INI file does not contain an entry for requested printer."
  118.     ElseIf x& = 24574 Then
  119.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "No fonts exist.  Must set internally to CF_BOTH, CF_PRINTERFONTS or CF_SCREENFONTS."
  120.     ElseIf x& = 20478 Then
  121.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "An attempt to subclass a listbox failed due to insufficient memory."
  122.     ElseIf x& = 20477 Then
  123.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "File name is invalid."
  124.     ElseIf x& = 20476 Then
  125.         PError$ = "#" + LTrim$(Str$(x&)) + ",  " + "The buffer at which the member lpstrFile points to is too small."
  126.     Else
  127.         PError$ = "Unknow Printer Error:  #" + Str$(x&)
  128.     End If
  129. End Function
  130.  
  131. '
  132.   ' ----------------------------------------------------
  133.   ' Status% = 0 means everything OK
  134.   ' Status% = 1 means couldn't allocate global memory
  135.   ' Status% = 2 means couldn't lock global memory
  136.   ' Status% = 3 means had error returned from common dialog
  137.   ' FError& tells you WHAT error if Status% = 3
  138.   ' ----------------------------------------------------
  139. '
  140. Function OpenFile$ (MyForm As Form, Status%, FError&, Filter$, IDir$, Title$, Index%, Flags&)
  141.     
  142.   MyForm.Cls
  143.   OpenFile$ = "": Status% = 0: SaveError% = 0
  144.  
  145.   Dim O As DLGFILENAME
  146.   Dim Address As Long
  147.  
  148.   ' ----------------------------------------------------
  149.   ' First Copy the strings to the Global Memory Block
  150.   ' Use a sub-allocation scheme to avoid overloading
  151.   '   the LDT
  152.   ' ----------------------------------------------------
  153.   szFile$ = String$(256, 0)
  154.   szFilter$ = Filter$
  155.   szInitialDir$ = IDir$
  156.   szTitle$ = Title$
  157.   wSize = Len(szFile$) + Len(szFilter$) + Len(szInitialDir$) + Len(szTitle$)
  158.   MemHandle = GlobalAlloc(GHND, wSize)
  159.   If MemHandle = 0 Then
  160.     Status% = 1
  161.     Exit Function
  162.   End If
  163.     
  164.   Address = GlobalLock(MemHandle) ' Lock global memory, then copy it to local memory
  165.   If Address = 0 Then
  166.     Status% = 2
  167.     Exit Function
  168.   Else
  169.     Call hmemcpy(ByVal Address, ByVal (szFile$ + szFilter$ + szInitialDir$ + szTitle$), wSize)
  170.   End If
  171.     
  172.   O.lStructSize = Len(O)
  173.   O.hwndOwner = MyForm.hWnd
  174.   O.Flags = Flags&
  175.   O.nFilterIndex = Index%
  176.   O.lpstrFile = Address
  177.   O.nMaxFile = Len(szFile$)
  178.   O.lpstrFilter = Address + Len(szFile$)
  179.   O.lpstrInitialDir = O.lpstrFilter + Len(szFilter$)
  180.   O.lpstrTitle = O.lpstrInitialDir + Len(szInitialDir$)
  181.  
  182.   Result = GetOpenFileName(O)
  183.   FError& = CommDlgExtendedError()
  184.     
  185.   If Result = 0 Then
  186.     Status% = 3
  187.   Else
  188.     Call hmemcpy(ByVal szFile$, ByVal Address, Len(szFile$))
  189.   End If
  190.     
  191.   OK = GlobalUnlock(MemHandle)    'Free The Memory
  192.   OK = GlobalFree(MemHandle)
  193.  
  194.   If Result = 0 Then Exit Function
  195.   OpenFile$ = Left$(szFile$, InStr(szFile$, Chr$(0)) - 1)
  196.  
  197. End Function
  198.  
  199. '
  200.   ' ----------------------------------------------------
  201.   ' Status% = 0 means everything OK
  202.   ' Status% = 1 means couldn't allocate global memory
  203.   ' Status% = 2 means couldn't lock global memory
  204.   ' Status% = 3 means had error returned from common dialog
  205.   ' FError& tells you WHAT error if Status% = 3
  206.   ' ----------------------------------------------------
  207. '
  208. Function SaveFile$ (MyForm As Form, Status%, FError&, Filter$, IDir$, FileMask$, Index%, Title$, Flags&)
  209.     
  210.   MyForm.Cls
  211.   SaveFile$ = "": Status% = 0: FError& = 0
  212.  
  213.   ' This is similar to GetOpenFileName
  214.   Dim S As DLGFILENAME
  215.   Dim Address As Long
  216.   ' ----------------------------------------------------
  217.   ' First Copy the strings to the Global Memory Block
  218.   ' Use a sub-allocation scheme to avoid wearing down
  219.   '   the LDT
  220.   ' ----------------------------------------------------
  221.   NoTitle$ = FileMask$
  222.   szFile$ = NoTitle$ + String$(256 - Len(NoTitle$), 0)
  223.   szFilter$ = Filter$
  224.   szInitialDir$ = IDir$
  225.   szTitle$ = Title$
  226.   wSize = Len(szFile$) + Len(szFilter$) + Len(szInitialDir$) + Len(szTitle$)
  227.   MemHandle = GlobalAlloc(GHND, wSize)
  228.   If MemHandle = 0 Then
  229.     Status% = 1
  230.     Exit Function
  231.   End If
  232.  
  233.   Address = GlobalLock(MemHandle)
  234.   If Address = 0 Then
  235.     Status% = 2
  236.     Exit Function
  237.   Else
  238.     Call hmemcpy(ByVal Address, ByVal (szFile$ + szFilter$ + szInitialDir$ + szTitle$), wSize)
  239.   End If
  240.  
  241.   S.lStructSize = Len(S)
  242.   S.hwndOwner = MyForm.hWnd
  243.   S.Flags = Flags&
  244.   S.nFilterIndex = Index%
  245.   S.lpstrFile = Address
  246.   S.nMaxFile = Len(szFile$)
  247.   S.lpstrFilter = Address + Len(szFile$)
  248.   S.lpstrInitialDir = S.lpstrFilter + Len(szFilter$)
  249.   S.lpstrTitle = S.lpstrInitialDir + Len(szInitialDir$)
  250.  
  251.   Result = GetSaveFileName(S)
  252.   FError& = CommDlgExtendedError()
  253.  
  254.   If Result = 0 Then
  255.     Status% = 3
  256.     Exit Function
  257.   Else
  258.     Call hmemcpy(ByVal szFile$, ByVal Address, Len(szFile$))
  259.   End If
  260.  
  261.   OK = GlobalUnlock(MemHandle)    'Free The Memory
  262.   OK = GlobalFree(MemHandle)
  263.  
  264.   SaveFile$ = Left$(szFile$, InStr(szFile$, Chr$(0)) - 1)
  265.  
  266. End Function
  267.  
  268.