auto32ld.bas

常用基本函数库,也许你需要的正在其中！如果不做程序

Attribute VB_Name = "Module1"

' On Top Sub Declaration
Public Declare Sub SetWindowPos Lib _
"user32" (ByVal hWnd _
As Integer, ByVal hWndInsertAfter As Integer, _
ByVal X As Integer, ByVal Y As Integer, _
ByVal cx As Integer, ByVal cy As Integer, _
ByVal wFlags As Integer)
  
'Play Sound Function declaration
Declare Function sndPlaySound Lib _
"winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

' MCI Send String Function Declaration (PlayMid)
Private Declare Function mciSendString Lib _
"winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Integer, _
ByVal hWndCallback As Integer) As Long


'GetCursorPos declaration, and required
'variables

'EXAMPLE:
'GetCursorPos Pnt
'Me.Move Str(Pnt.X) * 15, Str(Pnt.Y) * 15 '

Type PointAPI
    X As Long
    Y As Long
End Type

Public Pnt As PointAPI

Declare Function GetCursorPos Lib _
"user32" (lpPoint As PointAPI) As Long




Public Sub Center(frm As Object)

' center the Calling Form
' example: Center Me

frm.Move (Screen.Width / 2) - (frm.Width / 2), _
         (Screen.Height / 2) - (frm.Height / 2)

End Sub

Public Sub Wait(delay As Single)

'Delay app the selected no. of seconds
'example  Wait 3.5
'app will loop here for 3.5 seconds

starttime! = Timer
Do Until Timer >= starttime! + delay
Loop

End Sub

Public Sub OnTop(hWnd As Long)

'put hWnd  always on top
'example:
'    Sub Form1_Load()
'    OnTop hWnd
'    End Sub

Call SetWindowPos _
(hWnd, -1, 0, 0, 0, 0, &H2 Or &H1)

'NOTE: before showing additional forms,
'use OffTop to return the Main or calling
'form to normal.Ex:
                    'Sub mnuAbout_Click()
                    '
                    'OffTop hWnd
                    'frmAbout.Show vbModal
                    'OnTop hWnd
                    '
                    'End Sub
End Sub

Public Sub OffTop(hWnd As Long)

'take hWnd OFF always on top
'example:
'    Sub Form1_Load()
'    OffTop hWnd
'    End Sub

Call SetWindowPos _
(hWnd, -2, 0, 0, 0, 0, &H2 Or &H1)

End Sub



Public Function TrimPath(sPath As String) As String

'remove path from path & filename
'returns string AFTER last "\"
'example:
'nopath$ = TrimPath("C:\TXTFILES\JUSTFILE.TXT")
'nopath$ will = "JUSTFILE.TXT"

For I% = Len(sPath) To 1 Step -1
 If InStr(I%, sPath, "\", 1) = I% Then Exit For
Next I%

TrimPath = Right$(sPath, Len(sPath) - I%)

End Function

Public Function FixPath(sPath As String) As String

'add a "/" to the supplied string,only if needed
' example:
'fpn = FixPath(Dir1.Path) & File1.Filename

If Right$(sPath, 1) = "\" Then

   FixPath = sPath
                          Else
   FixPath = sPath & "\"
                          End If
                                        
End Function

Public Sub PlayMid(sFilename As String)

' Play a MID File
' example: PlayMid "C:\MIDFILES\MYSONG.MID"

Dim ReturnString As String * 128
ReturnString = Space(128)

For I% = 1 To 3

 Select Case I%
  Case 1
   CommandString = "close mymid"
  Case 2
   CommandString = "open " & sFilename & _
   " type sequencer alias mymid"
  Case 3
   CommandString = "play mymid from 1"
 End Select

 a& = mciSendString _
 (CommandString, ReturnString, Len(ReturnString), 0)

Next I%


End Sub

Public Sub PlayWav(sFilename As String)

X& = sndPlaySound(sFilename, 1)

End Sub

Public Sub StopMid()
'
'  stops and closes "mymid" ,
'  for use with PlayMid() only
'
'example:  Sub cmdStop_Click()
'
'          StopMid
'
'          End Sub

Dim ReturnString As String * 128
ReturnString = Space(128)

CommandString = "close mymid"

a& = mciSendString _
(CommandString, ReturnString, Len(ReturnString), 0)


End Sub

Public Function FindFile(sPath As String) As Boolean
'
'Checks for an existing File,
'returns True or False
'examples:
'If FindFile(Text1.Text) Then Label1 = "YES"
'If Not FindFile(Text1.Text) Then Label1 = "NO"

If Dir(sPath) = TrimPath(sPath) Then
     FindFile = True
                                Else
     FindFile = False
                                End If
'NOTE: this function uses
'the TrimPath function.


End Function

Public Sub SaveString(sText As String, sPath As String)

'Save a Text File

Dim fno As Integer

fno = FreeFile
Open sPath For Output As #fno
Write #fno, sText
Close #fno

End Sub

Public Function ReadString(sPath As String)

'read a Text File

Dim fno As Integer

fno = FreeFile
Open sPath For Input As #fno
Do Until EOF(fno)
 Input #fno, txt$
 ReadString = ReadString & txt$
Loop
Close #fno

End Function

Public Sub AddString(sText As String, sPath As String)

' Add a String to a Text File

Dim fno As Integer

fno = FreeFile
Open sPath For Append As #fno
Write #fno, sText
Close #fno

End Sub