rs_class.cls

VB开发的ERP系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Rs_Class"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Public Function RS_cipher(Text As String, length As Integer)
Dim i As Integer
For i = 0 To length
    If Len(Text) >= length Then Exit For Else Text = "0" & Text
Next i
RS_cipher = Text
End Function


Public Sub Rec_Close(Rec As Recordset)
If Rec.State = 1 Then
P_RecordCount = 0
P_RecordCount = Rec.RecordCount
Rec.Close
End If
Set Rec = Nothing
End Sub


Public Sub ComBo_AddList(Com As ComboBox, Str As String)   '添加Combox
Dim aDo_Com As New Recordset
Dim i As Integer
Dim Ssql As String
If Str <> "部门" Then
Ssql = "select * from RsT_CorrelationSort A,RsT_CorrelationList B where " _
     & "A.SortID=b.SortID and A.SortName='" & Trim(Str) & "' order by B.ListID"
Else
Ssql = "select * from Gy_Department where StopUse='0'"
End If
Set aDo_Com = Conn_RS.Execute(Ssql)


i = 1

Com.Clear
Com.AddItem ""
Com.ItemData(0) = 0
If Str = "部门" Then
ReDim Dept_Code(aDo_Com.RecordCount + 1)
End If
Do While Not aDo_Com.EOF
   If Str <> "部门" Then
    Com.AddItem Trim(aDo_Com!Listname)
    Com.ItemData(i) = aDo_Com!ListID
    Else
    Com.AddItem Trim(aDo_Com!deptname)
    Dept_Code(i) = Trim(aDo_Com!deptcode)
   End If
    i = i + 1
    aDo_Com.MoveNext
Loop
Class_Rs.Rec_Close aDo_Com
End Sub


Public Function Help_Str(Str As String, tf As Boolean) As String  '截点前、点后

    Dim i As Integer
    Str = Trim(Str)
    For i = 1 To Len(Str)
      If Mid(Str, i, 1) = "." Then Exit For
    Next i
    
    If tf = True Then
       Help_Str = Mid(Str, 1, i - 1)
       Else
       If i = Len(Str) + 1 Then
          Help_Str = "0"
          Else
          Help_Str = Mid(Str, i + 1, Len(Str))
       End If
    End If
End Function
Public Function Rows_int(Str As String, StrText As String)   '查找记录的条数
Dim aDo_Rec As New Recordset
Dim Ssql As String
Select Case Trim(Str)
       Case "部门"
       
       Ssql = "select * from Gy_Department where DepTName='" & StrText & "'"
       Case "岗位"
       Ssql = "select * from RsT_EmpolyeeGroup where Name='" & StrText & "'"
       Case Else
       
      Ssql = "select * from RsT_CorrelationSort A,RsT_CorrelationList B where " _
             & "A.SortID=b.SortID and A.SortName='" & Trim(Str) & "' and listname='" & Trim(StrText) & "'"
End Select

 Set aDo_Rec = Conn_RS.Execute(Ssql)
Rows_int = aDo_Rec.RecordCount


'--------------------------------
If Rows_int < 1 Then

    Select Case Trim(Str)
           Case "部门"
           
           Ssql = "select * from Gy_Department where DepTCode='" & StrText & "'"
           Case "岗位"
           Ssql = "select * from RsT_EmpolyeeGroup where code='" & StrText & "'"
           
           Case Else
           
          Ssql = "select * from RsT_CorrelationSort A,RsT_CorrelationList B where " _
                 & "A.SortID=b.SortID and A.SortName='" & Trim(Str) & "' and listID=" & Val(StrText)
    End Select

 Set aDo_Rec = Conn_RS.Execute(Ssql)
 Rows_int = aDo_Rec.RecordCount
 
End If

If Rows_int > 0 Then
  Select Case Str
         Case "岗位"
            P_Name = aDo_Rec!Name
            P_Code = aDo_Rec!code
          Case "部门"
            P_Name = aDo_Rec!deptname
            P_Code = aDo_Rec!deptcode
         Case Else
            P_Name = aDo_Rec!Listname
            P_Code = aDo_Rec!ListID
  End Select
End If

Class_Rs.Rec_Close aDo_Rec
End Function


Public Function setPicture(ByVal rs As ADODB.Recordset, ByVal Employee_ID As String, i As Integer)

  ' note: this requires the record to already exist - it will insert the
  ' picture at the current position in the recordset
  ' Returns true if success - false otherwise
  Const BlockSize = 150000


  Dim ByteData() As Byte   'Byte array for Blob data.
  Dim SourceFile As Integer
  Dim FileLength As Long
  Dim Numblocks As Integer
  Dim LeftOver As Long: Dim S As Integer
 ' On Error GoTo Line1
  
With EmployeeInfo.vsFlexGrid1(2)
  ' Save Picture image to the table column.
  SourceFile = FreeFile
  
  Open .TextMatrix(i, 4) For Binary Access Read As SourceFile
  FileLength = LOF(SourceFile)  ' Get the length of the file.

  If FileLength = 0 Then
    Close SourceFile
    setPicture = False
    Exit Function
  Else
    Numblocks = FileLength / BlockSize
    LeftOver = FileLength Mod BlockSize
    ReDim ByteData(LeftOver)

    rs.AddNew
    rs!MapID = .TextMatrix(i, 0)
    rs!MapName = .TextMatrix(i, 1)
    rs!EmployeeID = Employee_ID
    
    Get SourceFile, , ByteData()
    rs("Map").AppendChunk ByteData()
    ReDim ByteData(BlockSize)
    For S = 1 To Numblocks
      Get SourceFile, , ByteData()
      rs("Map").AppendChunk ByteData()
    Next S

    rs.Update   'Commit the new data.
    Close SourceFile
    setPicture = True
  End If
  
End With
Line1:
End Function
'
Public Function getPicture(strPicField As String, ByVal rs As ADODB.Recordset, M As Integer) As Boolean
  Const BlockSize = 150000
  Dim ByteData() As Byte   'Byte array for picture file.
  Dim DestFileNum As Integer
  Dim DiskFile As String
  Dim FileLength As Long
  Dim Numblocks As Integer
  Dim LeftOver As Long
  Dim i As Integer
 ' On Error GoTo Line1
  ' Remove any existing destination file.

  DiskFile = App.Path & "\" & M & "temp.bmp"
  If Len(Dir$(DiskFile)) > 0 Then
     Kill DiskFile
  End If

  DestFileNum = FreeFile
  FileLength = rs(strPicField).ActualSize
  Open DiskFile For Binary As DestFileNum

  Numblocks = FileLength / BlockSize
  LeftOver = FileLength Mod BlockSize

  rs.Move 0, adBookmarkCurrent
  ByteData() = rs(strPicField).GetChunk(LeftOver)
  Put DestFileNum, , ByteData()

  For i = 1 To Numblocks - 1
      ByteData() = rs(strPicField).GetChunk(BlockSize)
      Put DestFileNum, , ByteData()
  Next i

  Close DestFileNum

'  Set getPicture = LoadPicture(App.Path & "\temp.bmp")
  getPicture = True

Line1:
End Function
'

Public Sub Enployeeinfo_Query(Ssql_2 As String)

'Dim aDo_Reco As New Recordset
'Dim aDo_Item As New Recordset
'Dim h As Integer: Dim c As Integer
'Dim Str_Field As String
'Dim ssql_1 As String
'ssql_1 = Ssql_2
'If ssql_1 = "" Then
'ssql_1 = "select * from RsV_EmployeeBasicInfo"
'Else
'ssql_1 = "select * from RsV_EmployeeBasicInfo a where " & ssql_1
'End If
'
'Set aDo_Reco = Conn_RS.Execute(ssql_1)
'Set aDo_Item = Conn_RS.Execute("select * from RsT_Item where ISID=1 and YNShow='1' order by tab")
'With Q_EnployeeInfo.vsFlexGrid1
'
'
'    c = 1: h = 1
'    .Rows = aDo_Reco.RecordCount + 1
'
'
'    Do While Not aDo_Item.EOF
'
'      Str_Field = Str_Field & "^" & aDo_Item!ItemChineseName & "|"
'      aDo_Item.MoveNext
'    Loop
'    .Clear
'    .FormatString = "<编号  |" & Str_Field
'    .Cols = .Cols - 1
'    aDo_Item.MoveFirst
'
'
'    Do While Not aDo_Reco.EOF
'
'             Do While Not aDo_Item.EOF
'              If aDo_Item!yncode = 1 Then
'                .TextMatrix(h, c) = Trim("" & aDo_Reco("N_" & Trim(aDo_Item!ItemFieldName)))
'                Else
'               .TextMatrix(h, c) = Trim("" & aDo_Reco(Trim(aDo_Item!ItemFieldName)))
'              End If
'               c = c + 1
'               aDo_Item.MoveNext
'             Loop
'              .TextMatrix(h, 0) = h
'             aDo_Item.MoveFirst
'             c = 1
'             h = h + 1
'    aDo_Reco.MoveNext
'    Loop
'    aDo_Item.MoveFirst
'
'    c = 1
'    Do While Not aDo_Item.EOF
'      .ColWidth(c) = aDo_Item!Width
'      aDo_Item.MoveNext
'     c = c + 1
'    Loop
'
'
'End With
'
'Class_Rs.Rec_Close aDo_Reco
'Class_Rs.Rec_Close aDo_Item
'End Sub
'
'
'
'
'
'
'
'
'End With
End Sub


Public Sub Print_EnployeeInfo()   '打印
 
Dim Max_y As Integer
With DY_Tybbyldy.Tydy
        '-----------------
        .X1 = 0: .Y1 = 0: .X2 = 0: .Y2 = 0
    
        '-----------------
'     .StartDoc
'     .CurrentX = "3.5in"
'     .FontName = "宋体": .FontBold = True
'     .FontSize = 14
'     DY_Tybbyldy.Tydy = "人事档案"
'
'     .FontSize = 10
'     .CurrentX = "1in": .CurrentY = "1.4in"
'     DY_Tybbyldy.Tydy = "基本信息:"
'     .FontBold = False
'     .FontSize = 10
     '--------------------------
      Dim r As Integer
      Dim Height_Y As Integer
      Height_Y = 2100
      For r = 1 To frmcertificate.T_Label.Count - 1
         .CurrentX = 1600 + frmcertificate.T_Label(r).Left: .CurrentY = Height_Y + frmcertificate.T_Label(r).Top
         DY_Tybbyldy.Tydy = frmcertificate.T_Label(r).Caption & ":"
         .CurrentX = 1600 + frmcertificate.Text_T(r).Left + 100: .CurrentY = Height_Y + frmcertificate.T_Label(r).Top
         DY_Tybbyldy.Tydy = frmcertificate.Text_T(r).Text
         If .CurrentY > Max_y Then Max_y = .CurrentY
      Next r
      
      For r = 1 To frmcertificate.Label_C.Count - 1
         .CurrentX = 1600 + frmcertificate.Label_C(r).Left: .CurrentY = Height_Y + frmcertificate.Label_C(r).Top
         DY_Tybbyldy.Tydy = frmcertificate.Label_C(r).Caption & ":"
         .CurrentX = 1600 + frmcertificate.Combo_I(r).Left + 100: .CurrentY = Height_Y + frmcertificate.Label_C(r).Top
         DY_Tybbyldy.Tydy = frmcertificate.Combo_I(r).Text
         If .CurrentY > Max_y Then Max_y = .CurrentY
      Next r
     '--------------------------
     '<<<<<<<<<<<<<<<<<<<<<<<<<<<
     
     .FontBold = True
     Max_y = Max_y + 500
     .CurrentX = "1in": .CurrentY = Max_y
     DY_Tybbyldy.Tydy = "教育背景:"
     .FontBold = False
     
     '-----------------
     Dim Table_w As String
     Dim TableName As String
     Dim TableList As String
     Dim l
     '--------------

'     Table_w = "<+500|<+1200|<+1200|<+3000|<+1800|<+1300;"
'     TableName = "编号|开始时间|结束时间|学校名称|专业|备注;"
'
'     For l = 1 To frmcertificate.vsFlexGrid1(0).Rows - 2
'        TableList = TableList & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 0) & "|" _
'                   & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 1) & "|" & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 2) & "|" _
'                   & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 3) & "|" & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 4) & "|" _
'                   & frmcertificate.vsFlexGrid1(0).TextMatrix(l, 5) & ";"
'
'      Next
'
'     For r = l To 6
'       TableList = TableList & "|||||;"
'     Next r
'     '---------------
'    .StartTable
'       .AddTable Table_w, TableName, TableList, &HE0E0E0, , False
'
'    .EndTable
'
'     '-------------------------
'     .FontBold = True
'     .CurrentX = "1in": .CurrentY = .CurrentY + 200
'     DY_Tybbyldy.Tydy = "工作经历:"
'     .FontBold = False
'     '----------------
'
'     Table_w = "<+500|<+1200|<+1200|<+3000|<+1800|<+1300;"
'     TableName = "编号|开始时间|结束时间|公司名称|职务|备注;"
'     TableList = ""
'     For l = 1 To frmcertificate.vsFlexGrid1(1).Rows - 2
'        TableList = TableList & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 0) & "|" _
'                   & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 1) & "|" & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 2) & "|" _
'                   & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 3) & "|" & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 4) & "|" _
'                   & frmcertificate.vsFlexGrid1(1).TextMatrix(l, 5) & ";"
'
'      Next
'
'     For r = l To 6
'       TableList = TableList & "|||||;"
'     Next r
'     '---------------
'    .StartTable
'       .AddTable Table_w, TableName, TableList, &HE0E0E0, , False
'
'    .EndTable
'
'     .FontBold = True
'     .CurrentX = "1in": .CurrentY = .CurrentY + 200
'     DY_Tybbyldy.Tydy = "图片信息:"
'     .FontBold = False
'     '------------------
'      .CurrentX = .CurrentX + 100
'     For r = 1 To frmcertificate.vsFlexGrid1(2).Rows - 2
'         If frmcertificate.Image1.Height + .CurrentY > .PageHeight - 1675 Then .NewPage
'
'         frmcertificate.vsFlexGrid1(2).col = 3
'         frmcertificate.vsFlexGrid1(2).Row = r
'         .CurrentY = .CurrentY + 100
'
'         DY_Tybbyldy.Tydy = frmcertificate.vsFlexGrid1(2).TextMatrix(r, 1)
'         .CurrentX = .CurrentX + 100
'         frmcertificate.Image1.Picture = frmcertificate.vsFlexGrid1(2).CellPicture
'         .X1 = .CurrentX
'         .Y1 = .CurrentY
'         .X2 = frmcertificate.Image1.Width + .CurrentX
'         .Y2 = frmcertificate.Image1.Height + .CurrentY
'         .CurrentY = .CurrentY + frmcertificate.Image1.Height
'
'         .Picture = frmcertificate.Image1.Picture
'     Next
'
'     '----------------
'     frmcertificate.vsFlexGrid1(2).col = 1
     .EndDoc
     DY_Tybbyldy.Show 1
 End With
End Sub