企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form KF_FrmStartEnd 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "期初结帐"
   ClientHeight    =   3885
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4125
   HelpContextID   =   1212005
   Icon            =   "期初_期初单据记帐.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3885
   ScaleWidth      =   4125
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin TabDlg.SSTab SSTab1 
      Height          =   3315
      Left            =   30
      TabIndex        =   0
      Top             =   0
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   5847
      _Version        =   393216
      Style           =   1
      Tabs            =   2
      TabHeight       =   520
      TabCaption(0)   =   "期初结帐"
      TabPicture(0)   =   "期初_期初单据记帐.frx":1042
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Frame1(0)"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "恢复期初结帐"
      TabPicture(1)   =   "期初_期初单据记帐.frx":105E
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Frame1(1)"
      Tab(1).ControlCount=   1
      Begin VB.Frame Frame1 
         Height          =   2805
         Index           =   1
         Left            =   -74850
         TabIndex        =   7
         Top             =   390
         Width           =   3765
         Begin VB.CommandButton QdQuitU 
            Caption         =   "退出"
            Height          =   330
            Left            =   2490
            TabIndex        =   11
            Top             =   1890
            Width           =   1125
         End
         Begin VB.CommandButton QdOkU 
            Caption         =   "恢复结帐"
            Height          =   330
            Left            =   2490
            TabIndex        =   10
            Top             =   1320
            Width           =   1125
         End
         Begin VB.CommandButton QdAllU 
            Caption         =   "全选"
            Height          =   330
            Left            =   2490
            TabIndex        =   9
            Tag             =   "全消"
            Top             =   750
            Width           =   1125
         End
         Begin VB.ListBox Lst_Uncheck 
            Height          =   2160
            Left            =   120
            Style           =   1  'Checkbox
            TabIndex        =   8
            Top             =   450
            Width           =   2235
         End
      End
      Begin VB.Frame Frame1 
         Height          =   2805
         Index           =   0
         Left            =   150
         TabIndex        =   1
         Top             =   390
         Width           =   3765
         Begin VB.ListBox Lst_Check 
            Height          =   2160
            Left            =   120
            Style           =   1  'Checkbox
            TabIndex        =   5
            Top             =   450
            Width           =   2235
         End
         Begin VB.CommandButton QdAll 
            Caption         =   "全选"
            Height          =   330
            Left            =   2490
            TabIndex        =   4
            Tag             =   "全消"
            Top             =   750
            Width           =   1120
         End
         Begin VB.CommandButton QdOk 
            Caption         =   "结帐"
            Height          =   330
            Left            =   2490
            TabIndex        =   3
            Top             =   1320
            Width           =   1120
         End
         Begin VB.CommandButton QdQuit 
            Caption         =   "退出"
            Height          =   330
            Left            =   2490
            TabIndex        =   2
            Top             =   1890
            Width           =   1120
         End
      End
   End
   Begin MSComctlLib.ProgressBar PB 
      Height          =   225
      Left            =   90
      TabIndex        =   6
      Top             =   3630
      Width           =   3945
      _ExtentX        =   6959
      _ExtentY        =   397
      _Version        =   393216
      Appearance      =   1
      MousePointer    =   13
      Scrolling       =   1
   End
   Begin VB.Label Lb 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   1410
      TabIndex        =   12
      Top             =   3420
      Width           =   90
   End
End
Attribute VB_Name = "KF_FrmStartEnd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************************
'   模块名称：期初单据结帐
'   模块功能：期初单据结帐
'   编 制 者：张万成
'   编制日期：2001/11/27
'   备    注：
'*****************************************************************
Dim adoWare As New ADODB.Recordset
Dim Tsxx As String
Dim strWhCode() As String
Dim strWh As String
Dim bls As Boolean
Public Function FillHouse(BType As Integer) As Boolean
    Set adoWare = Cw_DataEnvi.DataConnect.Execute("KF_SP_InitWareHouse '" & Trim(Xtczybm) & "'," & BType)
End Function
Private Sub FillWare(L As ListBox)  '填充仓库
Dim i As Integer
ReDim strWhCode(adoWare.RecordCount)
    L.Clear
    With L
        For i = 0 To adoWare.RecordCount - 1
             .AddItem Trim(adoWare.Fields("whcode")) + "-" + Trim(adoWare.Fields("whname"))
             strWhCode(i) = Trim(adoWare.Fields("whcode"))
             adoWare.MoveNext
        Next i
    End With
End Sub
Private Sub Form_Load()
    If Not FillHouse(1) Then
        Call FillWare(Lst_Check)
    End If
    PB.Visible = False
    Me.Height = Me.Height - 500
End Sub
Private Sub QdAll_Click()
        
    If QdAll.Caption = "全选" Then
        QdAll.Tag = "全消"
        For i = 0 To Lst_Check.ListCount - 1
            Lst_Check.Selected(i) = True
        Next i
    Else
        For i = 0 To Lst_Check.ListCount - 1
          Lst_Check.Selected(i) = False
        Next i
    End If
    
    StrTemp = QdAll.Caption
    QdAll.Caption = QdAll.Tag
    QdAll.Tag = StrTemp
End Sub
Private Sub QdAllU_Click()
    If QdAllU.Caption = "全选" Then
        QdAllU.Tag = "全消"
        For i = 0 To Lst_Uncheck.ListCount - 1
            Lst_Uncheck.Selected(i) = True
        Next i
    Else
        For i = 0 To Lst_Uncheck.ListCount - 1
          Lst_Uncheck.Selected(i) = False
        Next i
    End If
    
    
    StrTemp = QdAllU.Caption
    QdAllU.Caption = QdAllU.Tag
    QdAllU.Tag = StrTemp
End Sub
Private Sub QdOk_Click()            '结帐
    If Not B_Status(Lst_Check) Then
        Tsxx = "您没有选仓库,请先选择!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    On Error GoTo Swcwcl
    Me.Height = Me.Height + 500
    Me.Refresh
    PB.Visible = True
    PB.Max = Lst_Check.ListCount
    PB.Min = 0: PB.Value = 0
    Cw_DataEnvi.DataConnect.BeginTrans
         For i = 0 To Lst_Check.ListCount - 1
            If Lst_Check.Selected(i) Then
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_StartCheck   '" & Trim(strWhCode(i)) & "','" & Xtczy & "',1")
            End If
            PB.Value = i + 1
            Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
            Lb.Refresh
         Next i
     Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "结帐成功!"
    Call Xtxxts(Tsxx, 0, 4)
    If Not FillHouse(1) Then
        Call FillWare(Lst_Check)
    End If
    Lb.Caption = ""
    PB.Visible = False
    Me.Height = Me.Height - 500
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "结帐失败,系统恢复到初始状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Me.Height = Me.Height - 500
    Exit Sub
End Sub
Private Sub QdOkU_Click()           '恢复结帐
    If Not B_Status(Lst_Uncheck) Then
        Tsxx = "您没有选仓库,请先选择!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    On Error GoTo Swcwcl
    Me.Height = Me.Height + 500
    Me.Refresh
    PB.Visible = True
    PB.Max = Lst_Uncheck.ListCount
    PB.Min = 0: PB.Value = 0
    Cw_DataEnvi.DataConnect.BeginTrans
         For i = 0 To Lst_Uncheck.ListCount - 1
            If Lst_Uncheck.Selected(i) Then
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_StartCheck   '" & Trim(strWhCode(i)) & "','" & Xtczy & "',0")
            End If
            PB.Value = i + 1
            Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
            Lb.Refresh
         Next i
     Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "恢复结帐成功!"
    Call Xtxxts(Tsxx, 0, 4)
    If Not FillHouse(0) Then
        Call FillWare(Lst_Uncheck)
    End If
    Lb.Caption = ""
    PB.Visible = False
    Me.Height = Me.Height - 500
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "恢复结帐失败,系统恢复到初始状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Me.Height = Me.Height - 500
    Exit Sub
End Sub
Private Sub QdQuit_Click()
    Unload Me
End Sub
Private Sub QdQuitU_Click()
    Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
    If SSTab1.Tab = 1 Then
        QdAllU.Caption = "全选"
        Call FillHouse(0)
        Call FillWare(Lst_Uncheck)
    Else
        QdAll.Caption = "全选"
        Call FillHouse(1)
        Call FillWare(Lst_Check)
    End If
End Sub
Private Function B_Status(L As ListBox) As Boolean
    For i = 0 To L.ListCount - 1
          B_Status = B_Status Or L.Selected(i)
    Next
End Function

						