initdata.cls

来自「一个关于电脑管理汽车的软件」· CLS 代码 · 共 860 行 · 第 1/3 页

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "InitData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Public CheckedButton As Boolean
Public SearGoodsBS As Integer
Private SQLStr() As String
Public StockBS As Boolean
Public SellBS As Boolean
Public SearchSimpleCodeBS As Integer
Public StoreBS As Boolean
Public SearchClientData As Integer
Public SearchProvideData As Integer
Public SearchCarDocu As Integer
Public SearchMaintainSet As Integer
Public SearchMaintainAppend As Integer
Public SysPrompt As String
Public OKSymbol As String
Public MoneyFormat As String
Public EachPageRSCount As Long


Public Sub InitSQLStr()
 ReDim SQLStr(1 To 50)
 SQLStr(1) = "Select billnum, provide, stockdate, payway, principal, checkman, gcount, gmoney, gitemcount, operateman, invoicetype, invoiceno, billtype From stocktable "
 SQLStr(2) = "Select * From stocktable2 "
'SQLStr(2) = "Select goodscoding, goodsname, goodsstandard, goodscount, unit, goodsprice, money, goodspos, sellprice, changeprice, brand, goodssort, producehere, replacecoding, orgprice  From stocktable2 "
 SQLStr(3) = "Select goodscoding, goodsname, venglishname,goodsstandard,goodssort, brand, producehere, unit, replacecoding, bakcoding, orgprice, buyprice, sellprice, maxstore, minstore, bakintro From goodsdata "
 'SQLStr(4) = "Select goodsname, alias, simplecode, customcoding From simplecodetable "
 SQLStr(4) = "Select * From simplecodetable "
 SQLStr(5) = "Select coding, clientsimple, companyname, companyaddress, companyphone, linkman, handset, fax, mailaddress, mailcoding From providedatatable "
 SQLStr(6) = "Select * From clientdatatable "
 'SQLStr(7) = "Select goodscoding, goodsname, venglishname,goodsstandard,goodssort, brand, producehere, unit, replacecoding, goodscount, needprice, needclient, needdate From clientneedtable "
 SQLStr(7) = "Select * From clientneedtable "
 SQLStr(8) = "Select * From cardocutable "
 SQLStr(9) = "Select * From addressbook "
 SQLStr(10) = "Select * From storegoodstable "
 SQLStr(11) = "Select * From sendbackgoods "
 SQLStr(12) = "Select * From sendbackgoods2 "
 'SQLStr(12) = "Select goodscoding, goodsname, goodsstandard, goodscount, unit, goodsprice, money, goodspos, sellprice, changeprice, brand, goodssort, producehere, replacecoding, orgprice  From sendbackgoods2 "
 SQLStr(13) = "Select * From stockhistory "
 SQLStr(14) = "Select billnum, goodscoding, goodsname, goodsstandard, goodscount, unit, goodsprice, money, goodspos, sellprice, changeprice, brand, goodssort, producehere, replacecoding, orgprice From stockhistory2 "
 SQLStr(15) = "Select * From selltable "
 SQLStr(16) = "Select * From selltable2 "
' SQLStr(16) = "Select goodscoding, goodsname, goodsstandard, goodscount, unit, sellmoney, realsellmoney, goodspos, sellprice, realsellprice, brand, goodssort, producehere, replacecoding From selltable2 "
 SQLStr(17) = "Select * From sellbacktable "
 SQLStr(18) = "Select * From sellbacktable2 "
 'SQLStr(18) = "Select goodscoding, goodsname, goodsstandard, goodscount, unit, sellmoney, realsellmoney, goodspos, sellprice, realsellprice, brand, goodssort, producehere, replacecoding From sellbacktable2 "
 SQLStr(19) = "Select * From sellhistory "
 SQLStr(20) = "Select billnum, goodscoding, goodsname, goodsstandard, goodscount, unit, sellmoney, realsellmoney, goodspos, sellprice, realsellprice, brand, goodssort, producehere, replacecoding From sellhistory2 "
 SQLStr(21) = "Select * From workertable "
 SQLStr(22) = "Select coding, operatename From operatesettable "
 SQLStr(23) = "Select * From popedomtable "
 'SQLStr(24) = "Select itemcode, datacontxt, sort, workprice, workhour, money, nothour From maintainsettable "
 SQLStr(24) = "Select * From maintainsettable "
 SQLStr(25) = "Select * From maintainappendtable "
 SQLStr(26) = "Select priceref From pricereftable "
 SQLStr(27) = "Select * From quotebilltable "
 SQLStr(28) = "Select * From quotebilltable2 "
 SQLStr(29) = "Select billnum, date, operateman, lookthroughman, gitemcount, profitlosscount, profitlossmoney From storedealtable "
 SQLStr(30) = "Select * From storedealtable2 "
 SQLStr(31) = "Select * From storehistory "
 SQLStr(32) = "Select * From storehistory2 "
 SQLStr(33) = "Select * From meetcartable "
 SQLStr(34) = "Select * From maintainitem "
 SQLStr(35) = "Select * From partitem "
 SQLStr(36) = "Select * From otheritem "
' SQLStr(37) = "Select * From historyitem "
 SQLStr(37) = "Select * From meetcarbalance "
 SQLStr(38) = "Select * From maintainpartbill "
 SQLStr(39) = "Select drawbillnum, goodscoding, goodsname, goodsstandard, goodscount, unit, money, sellprice, brand, goodssort, producehere, replacecoding From maintainpartbill2 "
 SQLStr(40) = "Select * From userreftable "
End Sub
Public Function DisplaySQLVal(ByVal SQLIndex As Integer) As String
 DisplaySQLVal = SQLStr(SQLIndex)
End Function
Public Function DisplayDynSQLVal(ByVal BaseDataName As String) As String
 DisplayDynSQLVal = "Select datacontxt From basedatatable Where basedataname = " & Quote(BaseDataName)
End Function

Public Sub CheckFlatButtons(VarPicture() As PictureBox, ByVal VarCount As Integer)
    Dim i As Integer
    Dim Rec As RECT, Point As POINTAPI
    
    GetCursorPos Point
    
    For i = 0 To VarCount
        GetWindowRect VarPicture(i).hWnd, Rec
     If VarPicture(i).Visible = True Then
        If Point.x < Rec.left Or Point.x > Rec.right Or Point.Y < Rec.top Or Point.Y > Rec.bottom Then
            If CheckedButton = False Then
                VarPicture(i).BackColor = vb3DFace
                VarPicture(i).Line (0, 0)-(VarPicture(i).ScaleWidth - 1, VarPicture(i).ScaleHeight - 1), vb3DFace, B
            End If
        Else
            If CheckedButton = False Then
              
                VarPicture(i).BackColor = vb3DFace
                VarPicture(i).Line (0, 0)-(VarPicture(i).ScaleWidth - 1, 0), vb3DHighlight
                VarPicture(i).Line (0, 0)-(0, VarPicture(i).ScaleHeight - 1), vb3DHighlight
                VarPicture(i).Line (VarPicture(i).ScaleWidth - 1, 1)-(VarPicture(i).ScaleWidth - 1, VarPicture(i).ScaleHeight), vb3DShadow
                VarPicture(i).Line (0, VarPicture(i).ScaleHeight - 1)-(VarPicture(i).ScaleWidth - 1, VarPicture(i).ScaleHeight - 1), vb3DShadow
            End If
        End If
      End If
    Next i
End Sub
Public Sub DrawClickState(VarPicture As PictureBox)
  VarPicture.BackColor = vb3DFace
  VarPicture.Line (0, 0)-(VarPicture.ScaleWidth - 1, 0), vb3DShadow
  VarPicture.Line (0, 0)-(0, VarPicture.ScaleHeight - 1), vb3DShadow
  VarPicture.Line (VarPicture.ScaleWidth - 1, 1)-(VarPicture.ScaleWidth - 1, VarPicture.ScaleHeight), vb3DHighlight
  VarPicture.Line (0, VarPicture.ScaleHeight - 1)-(VarPicture.ScaleWidth - 1, VarPicture.ScaleHeight - 1), vb3DHighlight
End Sub
Public Function DealVarNo(ByVal VarStr As String, ByVal MaxLen As Integer, ByVal StartLetter) As String
 Dim i As Integer
 Dim TempVar As Integer
 Dim LVarStr As String
 Dim TempVal As Long
 Dim TempLen As Integer
 TempLen = Len(VarStr)
 If TempLen > 0 Then
  LVarStr = StartLetter
  TempVar = MaxLen - TempLen
  If TempVar > 0 Then
   For i = 1 To TempVar
    LVarStr = LVarStr & "0"
   Next i
  End If
  'TempVal = Val(VarStr)
  'TempVal = TempVal + 1
  DealVarNo = LVarStr & VarStr ' CStr(TempVal)
 End If
End Function
Public Sub InitBSE(VarControl As BSE, Optional ByVal BSEType As Integer = 8)
 VarControl.SchemeStyle = BSEType
 VarControl.EndSubClassing
 VarControl.InitSubClassing
End Sub
Public Sub InitBSE2(VarControl As BSE2, Optional ByVal BSEType As Integer = 0)
 VarControl.SchemeStyle = BSEType
 VarControl.EndSubClassing
 VarControl.InitSubClassing
End Sub
Public Function SureNameFrIndex(VarIndex As Integer) As String
 Dim TempStr As String
 Select Case VarIndex
  Case 0
   TempStr = "地区设置"
  Case 1
   TempStr = "客户分类"
  Case 2
   TempStr = "货品分类"
  Case 3
   TempStr = "商标品牌"
  Case 4
   TempStr = "货品产地"
  Case 5
   TempStr = "计量单位"
  Case 6
   TempStr = "支付方式"
  Case 7
   TempStr = "客户性质"
  Case 8
   TempStr = "车辆厂牌"
  Case 9
   TempStr = "维修分类"
  Case 10
   TempStr = "附项分类"
 
 End Select
 SureNameFrIndex = TempStr
End Function
Public Sub LoadData(VarList As Control, Optional VarSQL As String, Optional ByVal LoadType As Integer = 0, Optional PageNum As Long = 0)
Dim pRs As MYSQL_RS
Dim Filters As String
Dim TempSQL As String
    'Me.MousePointer = vbHourglass
    
    'Build Filter selection
   ' SQL = "Select billnum, provide From stocktable " '& Filters & " Order by FName, LName"
    TempSQL = VarSQL '"Select billnum, provide, stockdate, payway, principal, checkman, gcount, gmoney, gitemcount, operateman From stocktable " '& Filters & " Order by FName, LName"
   ' SQL = "Select `单号`, `供应单位`, `进货日期`, `支付方式`, `负责人`, `验货人`, `总数量`, `总金额`, `总项数`, `操作员` From stocktable " '& Filters & " Order by FName, LName"
   ' Debug.Print TempSQL
    Set pRs = gCnn.Execute(TempSQL)
    Select Case LoadType
     Case 0
      VarList.Sorted = False
      ListViewLoad VarList, pRs
     Case 1
      ComBoxLoad VarList, pRs
     Case 2
      VarList.Sorted = False
      VarFunction.ListViewLoad3 VarList, pRs, PageNum
     Case 3
      VarList.Sorted = False
      ListViewLoad VarList, pRs, 1
    End Select
    pRs.CloseRecordset
    pRs.ReleaseMemory
    'TempSQL = pRs.Fields(3).Name
    Set pRs = Nothing
    
    'Rebuld Filter combos
  '  FillCombo cmbCity, "City", "addressebook", "", True, True
  '  FillCombo cmbState, "State", "addressebook", "", True, True
    
   ' Me.MousePointer = vbNormal
    
    'Apply default sort
    'LastSortIndex = 1
    'LastSortDir = lvwAscending
    
    'Set focus
    On Error Resume Next
End Sub
Public Sub LoadData2(VarList As Control, VarSQL As String, VarHistory As ChangeHistory, Optional LoadType As Integer = 0)
Dim pRs As MYSQL_RS
Dim Filters As String
Dim TempSQL As String
'Dim TempHistory As ChangeHistory
    'Me.MousePointer = vbHourglass
    
    'Build Filter selection
   ' SQL = "Select billnum, provide From stocktable " '& Filters & " Order by FName, LName"
    TempSQL = VarSQL '"Select billnum, provide, stockdate, payway, principal, checkman, gcount, gmoney, gitemcount, operateman From stocktable " '& Filters & " Order by FName, LName"
   ' SQL = "Select `单号`, `供应单位`, `进货日期`, `支付方式`, `负责人`, `验货人`, `总数量`, `总金额`, `总项数`, `操作员` From stocktable " '& Filters & " Order by FName, LName"
    Set pRs = gCnn.Execute(TempSQL)
    Select Case LoadType
     Case 0
      VarList.Sorted = False
      'Set TempHistory = VarHistory
      VarFunction.ListViewLoad2 VarList, pRs, VarHistory
     Case 1
    End Select
    pRs.CloseRecordset
    pRs.ReleaseMemory
    'TempSQL = pRs.Fields(3).Name
    Set pRs = Nothing
    
    'Rebuld Filter combos
  '  FillCombo cmbCity, "City", "addressebook", "", True, True
  '  FillCombo cmbState, "State", "addressebook", "", True, True
    
   ' Me.MousePointer = vbNormal
    
    'Apply default sort
    'LastSortIndex = 1
    'LastSortDir = lvwAscending
    
    'Set focus
    On Error Resume Next
End Sub

Public Sub InitComBox(VarCombo As ComboBox)
 
End Sub
Public Sub ComBoxLoad(lvwData As ComboBox, rs As MYSQL_RS)
 
    On Error Resume Next

    lvwData.Clear
    lvwData.AddItem ""