home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 January / pcwk_01_1999.iso / Wtestowe / Vistdstd / Install / Data.Z / VBinv.BAS < prev    next >
BASIC Source File  |  1996-09-04  |  9KB  |  303 lines
  1. Attribute VB_Name = "VBINV1"
  2. ' -----------------------------------------------------------------------------
  3. ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
  4. '
  5. ' You have a royalty-free right to use, modify, reproduce and distribute
  6. ' the Sample Application Files (and/or any modified version) in any way
  7. ' you find useful, provided that you agree that Visio has no warranty,
  8. ' obligations or liability for any Sample Application Files.
  9. ' -----------------------------------------------------------------------------
  10.  
  11. Option Explicit
  12. Option Base 0
  13.  
  14. '--
  15. '-- Win 3.1 API Helpers
  16. '--
  17.  
  18. Global Const OFN_HIDEREADONLY = &H4&
  19. Global Const OFN_OVERWRITEPROMPT = &H2&
  20.  
  21. Global Const IDYES = 6
  22. Global Const IDNO = 7
  23.  
  24. Global Const MB_YESNO = 4
  25. Global Const MB_ICONQUESTION = 32
  26. Global Const MB_ICONEXCLAMATION = 48
  27. Global Const MB_ICONINFORMATION = 64
  28.  
  29.  
  30. Global Const G_VERSION = "v1.1"
  31.  
  32. '--
  33. '--   The globals below store the delimter and separator lists used in
  34. '-- exporting.  g_TextDelims() contains the total text delimiters available
  35. '-- and g_TextDelimIdx indicates which one is to be used.  The same goes for
  36. '-- field separators.  Both arrays use zero based indexes.
  37. '--
  38. '--   Finally there is a boolean Integer which decided if field names are to
  39. '-- be included during exports.
  40. '--
  41.  
  42. Global g_TextDelims()  As String
  43. Global g_iTextDelimIdx As Integer
  44.  
  45. Global g_FieldSeps() As String
  46. Global g_iFieldSepIdx As Integer
  47.  
  48. Global g_bIncFieldNames As Integer
  49.  
  50. Sub AppConnect()
  51. '----------------------------------------
  52. '--- AppConnect -------------------------
  53. '--
  54. '--   Connects to Visio.  If not present we end.
  55. '--
  56.  
  57.     If vaoGetObject() <> visOK Then
  58.         MsgBox "Visio could not be run.", MB_ICONEXCLAMATION, ""
  59.         End
  60.     End If
  61. End Sub
  62.  
  63. Function ApplyTextDel(ByVal strField As String) As String
  64. '------------------------------------
  65. '--- ApplyTextDel -------------------
  66. '--
  67. '--   Formats a text field for output by adding text delimiters if needed and
  68. '-- checking for embedded delimiters.
  69. '--
  70.  
  71.     Dim strTemp As String, strDelim As String, I As Integer
  72.  
  73.     strDelim = g_TextDelims(g_iTextDelimIdx)
  74.  
  75.     If strDelim <> "" Then                      '-- If Using A Delimiter
  76.         strTemp = strTemp + strDelim
  77.  
  78.         For I = 1 To Len(strField)
  79.             Select Case Mid(strField, I, 1)
  80.                 Case strDelim:
  81.                     strTemp = strTemp + strDelim
  82.             End Select
  83.  
  84.             strTemp = strTemp + Mid(strField, I, 1)
  85.         Next I
  86.  
  87.         strTemp = strTemp + strDelim
  88.     Else
  89.         strTemp = strField
  90.     End If
  91.  
  92.     ApplyTextDel = strTemp
  93. End Function
  94.  
  95. Sub BeginWaitCursor()
  96. '------------------------------------
  97. '--- BeginWaitCursor ----------------
  98. '--
  99. '--   Use this procedure in conjuction with EndWaitCursor to toggle the cursor
  100. '-- between an hourglass, wait mode, and a regular pointer.
  101. '--
  102.  
  103.   Screen.MousePointer = 11                      '-- Set Cursor To Hourglass
  104. End Sub
  105.  
  106. Function ConvertDelimSep(strSepDel As String) As String
  107. '------------------------------------
  108. '--- ConvertDelimSep ----------------
  109. '--
  110. '--   Converts the text separator or delimiter passed to it into a human
  111. '-- readable form.  Only useful for special control characters.
  112. '--
  113.  
  114.     Select Case strSepDel
  115.         Case "": ConvertDelimSep = "{none}"
  116.         Case Chr$(9): ConvertDelimSep = "{tab}"
  117.         Case Chr$(10): ConvertDelimSep = "{LF}"
  118.         Case Chr$(13): ConvertDelimSep = "{CR}"
  119.         Case Chr$(32): ConvertDelimSep = "{space}"
  120.         Case Else: ConvertDelimSep = strSepDel
  121.     End Select
  122. End Function
  123.  
  124. Sub EndWaitCursor()
  125. '------------------------------------
  126. '--- EndWaitCursor ------------------
  127. '--
  128. '--   Use this procedure in conjuction with BeginWaitCursor to toggle the cursor
  129. '-- between an hourglass, wait mode, and a regular pointer.
  130. '--
  131.  
  132.   Screen.MousePointer = 0                   '-- Restore Default Mouse Pointer
  133. End Sub
  134.  
  135. Sub ExportToFile(strFile As String)
  136. '------------------------------------
  137. '--- ExportToFile -------------------
  138. '--
  139. '--   Exports the grid to a file.
  140. '--
  141.  
  142.     On Error GoTo FileExportErrHandler
  143.     
  144.     Dim iRow As Integer, iCol As Integer, Temp As String
  145.     Dim iOldRow As Integer, iOldCol As Integer
  146.     Dim iFileNum As Integer, ctlQueryGrid As Grid
  147.     Dim sFieldSep As String
  148.     
  149.     Set ctlQueryGrid = frmMainWindow.ctlQueryGrid      '-- Alias Grid
  150.  
  151.     sFieldSep = g_FieldSeps(g_iFieldSepIdx)
  152.     iFileNum = FreeFile
  153.  
  154.     Open strFile For Output As iFileNum
  155.  
  156.     iOldRow = ctlQueryGrid.Row                  '-- Save Last Row And Column
  157.     iOldCol = ctlQueryGrid.Col
  158.  
  159.     If g_bIncFieldNames Then
  160.         ctlQueryGrid.Row = 0                    '-- Move To Field Row
  161.  
  162.         For iCol = 0 To ctlQueryGrid.Cols - 1
  163.             ctlQueryGrid.Col = iCol
  164.  
  165.             If iCol <> 0 Then Temp = Temp + sFieldSep
  166.  
  167.             Temp = Temp + ApplyTextDel(ctlQueryGrid.Text)
  168.         Next iCol
  169.  
  170.         Temp = Temp + Chr$(13) + Chr$(10)       '-- Append CR/LF
  171.         Print #iFileNum, Temp;                  '-- Print Field Names
  172.     End If
  173.  
  174.     For iRow = 1 To ctlQueryGrid.Rows - 1
  175.         ctlQueryGrid.Row = iRow
  176.         Temp = ""
  177.  
  178.         For iCol = 0 To ctlQueryGrid.Cols - 1
  179.             ctlQueryGrid.Col = iCol
  180.  
  181.             If iCol <> 0 Then Temp = Temp + sFieldSep
  182.  
  183.             Temp = Temp + ApplyTextDel(ctlQueryGrid.Text)
  184.         Next iCol
  185.  
  186.         Temp = Temp + Chr$(13) + Chr$(10)       '-- Append CR/LF
  187.         Print #iFileNum, Temp;                  '-- Output To File
  188.     Next iRow
  189.  
  190.     ctlQueryGrid.Row = iOldRow                  '-- Restore Last Row And Column
  191.     ctlQueryGrid.Col = iOldCol
  192.  
  193.     Close iFileNum
  194.     Exit Sub
  195.  
  196. FileExportErrHandler:
  197.     If iFileNum > 0 Then Close iFileNum
  198.     Exit Sub
  199.     Resume Next
  200. End Sub
  201.  
  202. Function iIsWithin%(CompVal As Integer, LowerBnd As Integer, UpperBnd As Integer)
  203. '------------------------------------
  204. '--- iIsWithin ----------------------
  205. '--
  206. '--   Performs a range check on the two parameters.  Note, it checks that
  207. '-- CompVal is equal to or within the bounds, not inbetween.
  208. '--
  209. '-- To overload this function just use a new prefix/suffix combination for the
  210. '-- type you want to compare on and adjust the parameter types.
  211. '--
  212. '-- Parameters : CompVal      Value to apply range check to.
  213. '--              LowerBnd     Lower bound of range.
  214. '--              UpperBnd     Upper bound of range.
  215. '--
  216. '--
  217. '--    Returns : BOOLEAN    True if
  218. '--
  219.  
  220.   If CompVal >= LowerBnd And CompVal <= UpperBnd Then
  221.     iIsWithin% = True
  222.   Else
  223.     iIsWithin% = False
  224.   End If
  225. End Function
  226.  
  227. Function iMax(Param1 As Integer, Param2 As Integer) As Integer
  228. '------------------------------------
  229. '--- iMax ---------------------------
  230. '--
  231. '--   Returns the largest object of the two passed.  To overload this function
  232. '-- just use a new prefix/suffix combination for the type you want to compare
  233. '-- on and adjust the parameter types.
  234. '--
  235. '-- Parameters : Param1, Param2     Values to compare.
  236. '--
  237. '--    Returns : The larger of the two values passed.
  238. '--
  239.  
  240.   If Param1 < Param2 Then
  241.     iMax = Param2
  242.   Else
  243.     iMax = Param1
  244.   End If
  245. End Function
  246.  
  247. Sub InitExportOptions()
  248. '------------------------------------
  249. '--- InitExportOptions --------------
  250. '--
  251. '--   Sets up the text delimiters and field separators for exporting.
  252. '--
  253.  
  254.     g_bIncFieldNames = True                 '-- Default To Include Field Names
  255.  
  256.   '-- Setup Text Delimiters
  257.  
  258.     ReDim g_TextDelims(0 To 2)              '-- Setup Text Delimiters....
  259.     g_TextDelims(0) = ""                    '--   Nothing
  260.     g_TextDelims(1) = Chr$(34)              '--   Double Quote
  261.     g_TextDelims(2) = "'"                   '--   Single Quote
  262.     
  263.  
  264.     g_iTextDelimIdx = 0                     '-- Default To First Delimiter
  265.  
  266.   '-- Setup Field Separators
  267.  
  268.     ReDim g_FieldSeps(0 To 2)               '-- Setup Field Separators....
  269.     g_FieldSeps(0) = Chr$(9)                '--   Tab
  270.     g_FieldSeps(1) = ","                    '--   Comma
  271.     g_FieldSeps(2) = " "                    '--   Space
  272.     
  273.     g_iFieldSepIdx = 0                      '-- Default To First Separator
  274. End Sub
  275.  
  276. Function StripPath(strFileName As String) As String
  277. '------------------------------------
  278. '--- StripPath ----------------------
  279. '--
  280. '--   Strips the path out of a string passed.
  281. '--
  282. '-- Parameters : strFileName  String containing the file name whose path is to
  283. '--                           be stripped out.
  284. '--
  285. '--    Returns : String containg file name with path stripped out.
  286. '--
  287.  
  288.   Dim I As Integer
  289.   Dim strFile As String
  290.  
  291.   strFile = strFileName                     '-- Default To No Path
  292.  
  293.   For I = Len(strFileName) To 1 Step -1
  294.     If Mid$(strFileName, I, 1) = "\" Or Mid$(strFileName, I, 1) = ":" Then
  295.       strFile = Right$(strFileName, Len(strFileName) - I)
  296.       Exit For
  297.     End If
  298.   Next I
  299.  
  300.   StripPath = strFile                       '-- Return File Name
  301. End Function
  302.  
  303.