Attribute VB_Name = "base"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function BackupData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long
Public Declare Function ResumeData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long
Public Declare Function GetBit Lib "storage.dll" (ByVal bit As Long, ByVal index As Integer) As Integer
Public Declare Function GetBits Lib "storage.dll" (ByVal bit As String, ByVal l As Integer) As Long
Public Declare Function ShowHelp Lib "storage.dll" (ByVal hwnd As Long, ByVal chmname As String, ByVal htmlname As String) As Long
Public Declare Function AddWndMsg Lib "storage.dll" (ByVal hwnd As Long, ByVal msg As Long, ByVal procaddress As Long) As Long

Public Declare Function ClearPrintData Lib "FxPrint.dll" () As Integer
Public Declare Function SetPrintDataWidth Lib "FxPrint.dll" (ByVal width As Integer) As Integer
Public Declare Function AddPrintData Lib "FxPrint.dll" (ByVal data As String) As Integer
Public Declare Function ShowPrint Lib "FxPrint.dll" (ByVal title As String) As Integer
Public Declare Function SaveToFile Lib "FxPrint.dll" () As Integer

Public fMainForm As frmMain '主窗口句柄
Public DataPath As String '數(shù)據(jù)庫路徑
Public DataConnectString As String '數(shù)據(jù)庫連接源字符串
Public UserName As String '用戶名
Public UserPas As String '用戶密碼
Public Purview As Long  '操作權(quán)限
Public 權(quán)限類別(16) As Integer '17種權(quán)限類別


Public Function ShowPrintDlg(ByVal ado As Adodc, ByVal title As String)
    
    '清除以前的打印數(shù)據(jù)
    ClearPrintData
    
    Dim count As Integer
    On Error GoTo quit:
    count = ado.Recordset.Fields.count
    
    If count <= 0 Then
        MsgBox "沒有需打印的數(shù)據(jù)", vbInformation
        Exit Function
    End If
    
    
    '設(shè)置打印列寬度
    SetPrintDataWidth count
    
    '保存當(dāng)前位置的狀態(tài)pos
    Dim pos As Long
    pos = ado.Recordset.AbsolutePosition
    
    '移到記錄最前面
    ado.Recordset.MoveFirst
    
    Dim i As Integer
    
    '寫入眉頭
    For i = 0 To count - 1

        AddPrintData ado.Recordset.Fields(i).name
          
    Next
    
    '寫入數(shù)據(jù)
    While ado.Recordset.EOF = False
        
        For i = 0 To count - 1
            
            If ado.Recordset.Fields(i).ActualSize > 0 Then
                AddPrintData ado.Recordset.Fields(i).Value
            Else
                AddPrintData ""
            End If
        Next
        
        ado.Recordset.MoveNext
        
    Wend
    
    '恢復(fù)以前的記錄
    ado.Recordset.MoveFirst
    If pos > 1 Then ado.Recordset.Move pos - 1

    ShowPrint title
    
    Exit Function
quit:
    MsgBox "沒有打印數(shù)據(jù)或打印數(shù)據(jù)未初始化!", vbInformation
    
End Function

Public Function ShowHelpWnd(index As Long)
    
    If index = 0 Then
        ShowHelp fMainForm.hwnd, App.HelpFile, ""
    Else
        Dim htmlname As String
        htmlname = "倉庫管理系統(tǒng).htm/#"
        
        Dim v As String
        v = LTrim(Str(index))
        
        Dim i As Integer
        For i = 1 To Len(v)
            htmlname = htmlname + Mid(v, i, 1)
            If i <> Len(v) Then htmlname = htmlname + "_"
        Next
    
        ShowHelp fMainForm.hwnd, App.HelpFile, htmlname
    End If
    
End Function

'屏蔽flash右鍵彈出菜單
Public Function FlashNoRButton(ByVal hwnd As Long, ByVal msg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long
        
        FlashNoRButton = 1
    
End Function

'刪除記錄中的所有數(shù)據(jù)
Public Function DeleteRecordData(Re As Recordset)
    
    If Re.RecordCount <= 0 Then Exit Function
    
    Re.MoveFirst
    While Re.EOF = False
        Re.Delete
        Re.MoveFirst
    Wend
    
End Function


Sub Main()
    
    '檢測是否已運(yùn)行
    If App.PrevInstance Then
        MsgBox App.title + " 已運(yùn)行!"
        End
    End If

    '初始化數(shù)據(jù)庫文件路徑
    DataPath = App.Path + "\storage.mdb"
    DataConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password=prowind"
    
    '啟動起始屏
    frmSplash.Show vbModal

    '啟動登陸對話框
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    
    If Not fLogin.OK Then
       '登錄失敗，退出應(yīng)用程序
        End
    End If
    Unload fLogin

    '啟動主窗口
    Set fMainForm = New frmMain
    fMainForm.Show
    
End Sub



'此源碼由程序太平洋收集整理發(fā)布,任何人都可自由轉(zhuǎn)載,但需保留本站信息
'╭⌒╮┅~ ¤　歡迎光臨程序太平洋╭⌒╮
'╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
',︶︶︶︶,''︶~~ ,''~︶︶　 ,''
'╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
'╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
'╬　　　　　　　http://www.5ivb.net ╬
'╬　 ╭○╮●　                   　╬
'╬　　/■\/■\　　                  ╬
'╬　　 <|　||　   有希望,就有成功！ ╬
'╬　　　　　　　　　　　　　　　　　╬
'╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
'
'說明：
'專業(yè)提供VB、．NET、Delphi、ASP、PB源碼下載
'包括:程序源碼,控件,商業(yè)源碼,系統(tǒng)方案，開發(fā)工具，書籍教程，技術(shù)文檔