module1.bas

这是一个我帮师妹做的软件的大作业

Attribute VB_Name = "Module1"
Public tbfn As String
Public dbfn As String

Public fMainForm As frmMain
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


Public Sub Explode(Newform As Form, Increment As Integer)
Dim Size As RECT ' setup form as rect type
GetWindowRect Newform.hwnd, Size
Dim FormWidth, FormHeight As Integer ' establish dimension variables
FormWidth = (Size.Right - Size.Left)
FormHeight = (Size.Bottom - Size.Top)
Dim TempDC
TempDC = GetDC(ByVal 0&) ' obtain memory dc for resizing
Dim Count, LeftPoint, TopPoint, nWidth, nHeight As Integer ' establish resizing variables
For Count = 1 To Increment ' loop to new sizes
nWidth = FormWidth * (Count / Increment)
nHeight = FormHeight * (Count / Increment)
LeftPoint = Size.Left + (FormWidth - nWidth) / 2
TopPoint = Size.Top + (FormHeight - nHeight) / 2
Rectangle TempDC, LeftPoint, TopPoint, LeftPoint + nWidth, TopPoint + nHeight ' draw rectangles to build form
Next Count
DeleteDC (TempDC) ' release memory resource
End Sub
Public Function ConnectString() _
   As String
'returns a DB ConnectString
   ConnectString = "provider=Microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "/xs.mdb"
End Function
Public Function ExecuteSQL(ByVal SQL _
   As String) _
   As ADODB.Recordset
'executes SQL and returns Recordset
   Dim cnn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sTokens() As String
   
On Error GoTo ExecuteSQL_Error
sTokens = Split(SQL)
   Set cnn = New ADODB.Connection
   cnn.Open ConnectString
   If InStr("INSERT,DELETE,UPDATE", _
      UCase$(sTokens(0))) Then
      cnn.Execute SQL
     
   Else
      Set rst = New ADODB.Recordset
      rst.Open Trim$(SQL), cnn, _
         adOpenKeyset, _
         adLockOptimistic
      'rst.MoveLast     'get RecordCount
      Set ExecuteSQL = rst
     
   End If
ExecuteSQL_Exit:
   Set rst = Nothing
   Set cnn = Nothing
   Exit Function
   
ExecuteSQL_Error:
   
   Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
    If Keyasc = 13 Then
        SendKeys "{TAB}"
    End If
End Sub


Public Function Testtxt(txt As String) As Boolean
    If Trim(txt) = "" Then
        Testtxt = False
    Else
        Testtxt = True
    End If
End Function

Function GridSort(cgrid As MSFlexGrid, ccol As Integer, sType As Integer)
  cgrid.Redraw = False
  cgrid.Row = 1
  cgrid.RowSel = cgrid.Rows - 1
  cgrid.Col = ccol
  cgrid.Sort = sType
  cgrid.Redraw = True
  cgrid.TopRow = 1
End Function