home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD78497162000.psc / general.bas < prev    next >
Encoding:
BASIC Source File  |  2000-07-16  |  3.4 KB  |  121 lines
  1. Attribute VB_Name = "general"
  2.  
  3. Option Explicit
  4. Public Crystal_Report_Application As New CRAXDRT.Application
  5. Public The_Crystal_Report As CRAXDRT.Report
  6. Public Const DLLName As String = "pdsodbc.dll"
  7. '
  8.  
  9. Public Sub center_form(the_form As Form)
  10.     the_form.Left = (Screen.Width / 2) - (the_form.Width / 2)
  11.     the_form.Top = (Screen.Height / 2) - (the_form.Height / 2)
  12.     the_form.Refresh
  13. End Sub
  14. Sub NumbersOnly(t As Control, KeyAscii As Integer)
  15.     If KeyAscii < Asc(" ") Then     ' Is this Control char?
  16.         Exit Sub                    ' Yes, let it pass
  17.     End If
  18.     CheckPeriod t                   ' Remove excess periods
  19.     If KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Then
  20.         ' keep digit
  21.     ElseIf KeyAscii = Asc(".") Then
  22.         ' keep .
  23.     ElseIf KeyAscii = Asc("-") And t.SelStart = 0 Then
  24.         ' Keep - only if first char
  25.     Else
  26.         KeyAscii = 0                ' Discard all other chars
  27.     End If
  28.     ' This code keeps you from typing any characters in front of
  29.     ' a minus sign.
  30.     '
  31.     If Mid$(t.Text, t.SelStart + t.SelLength + 1, 1) = "-" Then
  32.         KeyAscii = 0                ' Discard chars before -
  33.     End If
  34. End Sub
  35.  
  36. Public Function GetFilename(ByVal TempPath As String, ReturnType As Integer)
  37.  
  38. 'function to get the filename and its parts
  39.  
  40.     Dim DriveLetter As String
  41.     Dim DirPath As String
  42.     Dim fname As String
  43.     Dim Extension As String
  44.     Dim PathLength As Integer
  45.     Dim ThisLength As Integer
  46.     Dim Offset As Integer
  47.     Dim FileNameFound As Boolean
  48.  
  49.  
  50.     If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 And ReturnType <> 3 Then
  51.         Err.Raise 1
  52.         Exit Function
  53.     End If
  54.  
  55.     DriveLetter = ""
  56.     DirPath = ""
  57.     fname = ""
  58.     Extension = ""
  59.  
  60.  
  61.     If Mid(TempPath, 2, 1) = ":" Then ' Find the drive letter.
  62.         DriveLetter = Left(TempPath, 2)
  63.         TempPath = Mid(TempPath, 3)
  64.     End If
  65.  
  66.     PathLength = Len(TempPath)
  67.  
  68.  
  69.     For Offset = PathLength To 1 Step -1 ' Find the next delimiter.
  70.         Select Case Mid(TempPath, Offset, 1)
  71.         Case ".": ' This indicates either an extension or a . or a ..
  72.         ThisLength = Len(TempPath) - Offset
  73.  
  74.  
  75.         If ThisLength >= 1 Then ' Extension
  76.             Extension = Mid(TempPath, Offset, ThisLength + 1)
  77.         End If
  78.  
  79.         TempPath = Left(TempPath, Offset - 1)
  80.         Case "\": ' This indicates a path delimiter.
  81.         ThisLength = Len(TempPath) - Offset
  82.  
  83.  
  84.         If ThisLength >= 1 Then ' Filename
  85.             fname = Mid(TempPath, Offset + 1, ThisLength)
  86.             TempPath = Left(TempPath, Offset)
  87.             FileNameFound = True
  88.             Exit For
  89.         End If
  90.  
  91.         Case Else
  92.         End Select
  93.     Next Offset
  94.     If FileNameFound = False Then
  95.         fname = TempPath
  96.     Else
  97.         DirPath = TempPath
  98.     End If
  99.     If ReturnType = 0 Then
  100.         GetFilename = DriveLetter
  101.     ElseIf ReturnType = 1 Then
  102.         GetFilename = DirPath
  103.     ElseIf ReturnType = 2 Then
  104.         GetFilename = fname
  105.     ElseIf ReturnType = 3 Then
  106.         GetFilename = Extension
  107.     End If
  108.  
  109. End Function
  110. Sub CheckPeriod(t As Control)
  111.     Dim i As Integer
  112.     
  113.     i = InStr(1, t.Text, ".")   ' Look for a period
  114.     If i > 0 And InStr(i + 1, t.Text, ".") > 0 Then
  115.         t.SelStart = t.SelStart - 1
  116.         t.SelLength = 1         ' Select new period
  117.         t.SelText = ""          ' Remove new period
  118.     End If
  119. End Sub
  120.  
  121.