vbcode2.bas

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

'Windows API Constants

'This is a declaration of type structure and global var.
'for the printer orientation function

Type Orientstructure
    Orientation As Long
    Pad As String * 16
End Type

Global PrtStruct As Orientstructure

'These are the api declarations you need
Declare Function WritePrivateProfileSTring% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyname$, ByVal lpString$, ByVal lpFileName$)
Declare Function GetPrivateProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyname As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName$)
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyname As Any, ByVal lpDefault$, ByVal lpReturned$, ByVal Size%)
Declare Function SndPlaySound Lib "MMSYSTEM" (ByVal File$, ByVal PlayType%) As Integer
Declare Function PrtOrient% Lib "GDI" Alias "Escape" (ByVal hDC%, ByVal nEsc%, ByVal nLen%, lpData As Orientstructure, lpOut As Any)

'Examples for the three functions
'==================================================================================
'WriteProfile : Writes/Changes Keyword to ini file
'               Remark : ini file is created auto. when it is not already  there

    'WriteProfile "PC.INI","Program","Directory","C:\DOS"
'==================================================================================
'ReadProfile  : Reads Keyword from ini file
    
    ' result$ = ReadProfile("PC.INI","Program","Directory")
'==================================================================================
'Centerform   : Centers form on screen

    ' Centerform Form1
'==================================================================================
'PlaySound    : Plays wave file
    
    ' PlaySound "C:\BB.WAV"
'==================================================================================

'==================================================================================

'==================================================================================

Sub Centerform (CurForm As Form)
    
    ' Sub/Function Name       : Centerform
    ' Purpose                 : Centers form on screen
    ' Parameters              : Form Object
    ' Created by              : Paul Treffers
    ' Date Created            : 11/05/94
    
    
    Dim xPos As Integer
    Dim yPos As Integer
    Dim wForm As Integer
    Dim hForm As Integer
    Dim nTop As Integer
    Dim nLeft As Integer
    
    xPos = Screen.Width
    yPos = Screen.Height
    wForm = CurForm.Width
    hForm = CurForm.Height
    nTop = (yPos - hForm) / 2
    nLeft = (xPos - wForm) / 2
    CurForm.Top = nTop
    CurForm.Left = nLeft
End Sub

Function GetPrinterOrientation () As Integer
    
    ' Sub/Function Name       : GetPrinterOrientation
    ' Purpose                 : Returns Orientation of Default Printer
    ' Parameters              : None
    ' ReturnValue             : 1 = Printer Orientation is Portrait
    '                           2 = Printer Orientation is Landscape
    ' Created by              : Paul Treffers
    ' Date Created            : 11/08/94
    
    Dim Orientation As Integer
    PrtStruct.Orientation = 0
    Orientation = PrtOrient(Printer.hDC, 30, Len(PrtStruct), PrtStruct, 0&)
    GetPrinterOrientation = Orientation
End Function

Sub LandScape ()
    
    ' Sub/Function Name       : Landscape
    ' Purpose                 : Sets default printer to landscape
    ' Parameters              : None
    ' Created by              : Paul Treffers
    ' Date Created            : 11/08/94
    Dim ResValue As Integer
    PrtStruct.Orientation = 2
    ResValue = PrtOrient%(Printer.hDC, 30, Len(PrtStruct), PrtStruct, 0&)
    Printer.EndDoc
End Sub

Sub pLAYSOUND (SoundFile As String)
    
    ' Sub/Function Name       : PlaySound
    ' Purpose                 : Play Wave File
    ' Parameters              : Wave file
    ' Created by              : Paul Treffers
    ' Date Created            : 11/07/94
  
  Dim PlayType As Integer
  If SoundFile > "" Then
    On Error Resume Next
    PlayType = 1
    PlayType = SndPlaySound(SoundFile, PlayType)
    On Error GoTo 0
  Else
    Beep
  End If
End Sub

Sub Portrait ()
    
    ' Sub/Function Name       : Portrait
    ' Purpose                 : Sets default printer to portrait
    ' Parameters              : None
    ' Created by              : Paul Treffers
    ' Date Created            : 11/08/94
    
    Dim ResValue As Integer

    PrtStruct.Orientation = 1
    ResValue = PrtOrient%(Printer.hDC, 30, Len(PrtStruct), PrtStruct, 0&)
    Printer.EndDoc

End Sub

Function ReadProfile (IniFile As String, Section As String, Keyword As String) As String
    
    ' Sub/Function Name       : ReadProfile
    ' Purpose                 : Reads keyword from ini file
    ' Parameters              : IniFile -> Ini file to read
    '                           Section  -> Section name in ini file
    '                           Keyword   -> Keyword in section to read
    ' Return Value            : requested keyword

    ' Created by              : Paul Treffers
    ' Date Created            : 11/05/94

    Dim EntrySpecial As Integer
    Dim WinDir As String
    Dim Res As Integer
    Dim File As String
    Dim ReturnString As String
    Dim NullPos As Integer
    
    If Keyword = "0" Then
        EntrySpecial = 0
    End If
    
    'Here you get the Windows directory where the ini
    'file is stored in. If you do not want to have
    'the Windows directory as default, remove GetWindowsDirectory Function
    'and specify your own directory as your ini file directory
    
    WinDir = Space$(20)
    Res = GetWindowsDirectory(WinDir, 20)
    
    'Check here if Windir has a Null String and
    'add IniFile to var. File
    File = Left$(WinDir, InStr(1, WinDir$, Chr$(0)) - 1)
    File = File & "\" & IniFile
    
    ReturnString = Space$(200)
    
    If Keyword <> "0" Then
        'Get keyword from section and check if there is a Null
        'value in it. Just to be sure
        Res = GetPrivateProfileString%(Section, Keyword, "", ReturnString, 200, File)
        NullPos = InStr(1, ReturnString, Chr$(0))
        If NullPos > 0 Then
            ReadProfile = RTrim$(Left$(ReturnString, NullPos - 1))
        Else
            ReadProfile = RTrim$(ReturnString)
        End If
    Else
        Res = GetPrivateProfileString%(Section, 0&, "", ReturnString, 200, File)
        ReadProfile = ReturnString
    End If
End Function

Sub WriteProfile (IniFile As String, Section As String, Keyword As String, Entry As String)
    
    ' Sub/Function Name       : WriteProfile
    ' Purpose                 : Writes keyword to ini file
    ' Parameters              : IniFile  -> Ini file to read
    '                           Section  -> Section name in ini file
    '                           Keyword  -> Keyword in section to read
    '                           Entry    -> Keyword entry to save
    ' Created by              : Paul Treffers
    ' Date Created            : 11/05/94

    Dim WinDir As String
    Dim Res As Integer
    Dim File As String
    WinDir = Space$(20)
    Res = GetWindowsDirectory(WinDir, 20)
    File$ = Left$(WinDir, InStr(1, WinDir, Chr$(0)) - 1)
    File$ = File$ & "\" & IniFile
    Res% = WritePrivateProfileSTring(Section, Keyword, Entry, File)
End Sub