企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Begin VB.Form CL_BillChalkitupCond 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "单据记帐条件"
   ClientHeight    =   4305
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4440
   HelpContextID   =   130401
   Icon            =   "处理_单据记帐条件.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4305
   ScaleWidth      =   4440
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton YdCommand 
      Height          =   315
      Left            =   3990
      Picture         =   "处理_单据记帐条件.frx":1042
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   3420
      Width           =   315
   End
   Begin VB.TextBox Lrtext 
      Height          =   315
      Left            =   2280
      MaxLength       =   10
      TabIndex        =   12
      Top             =   3420
      Width           =   1695
   End
   Begin VB.Frame Frame1 
      Caption         =   "仓库"
      Height          =   2865
      Left            =   90
      TabIndex        =   7
      Top             =   90
      Width           =   4245
      Begin VB.ListBox Lst_WareHouse 
         Height          =   2085
         Left            =   150
         Style           =   1  'Checkbox
         TabIndex        =   10
         Top             =   270
         Width           =   3945
      End
      Begin VB.CommandButton QcCommand 
         Caption         =   "全消"
         Height          =   300
         Left            =   1770
         TabIndex        =   9
         Top             =   2460
         Width           =   1120
      End
      Begin VB.CommandButton QxuCommand 
         Caption         =   "全选"
         Height          =   300
         Left            =   3000
         TabIndex        =   8
         Top             =   2460
         Width           =   1120
      End
   End
   Begin VB.CommandButton QdCommand 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   1980
      TabIndex        =   6
      Top             =   3900
      Width           =   1120
   End
   Begin VB.CommandButton QxCommand 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   3180
      TabIndex        =   5
      Top             =   3900
      Width           =   1120
   End
   Begin VB.CheckBox Chk_Sum 
      Caption         =   "每张单据输出合计"
      Height          =   315
      Left            =   90
      TabIndex        =   4
      Top             =   3900
      Value           =   1  'Checked
      Width           =   1785
   End
   Begin VB.Frame Frame2 
      Caption         =   "记帐状态"
      Height          =   705
      Left            =   90
      TabIndex        =   1
      Top             =   3060
      Width           =   2085
      Begin VB.OptionButton Opt_Wjz 
         Caption         =   "未记帐"
         Height          =   315
         Left            =   180
         TabIndex        =   3
         Top             =   240
         Value           =   -1  'True
         Width           =   945
      End
      Begin VB.OptionButton Opt_Yjz 
         Caption         =   "已记帐"
         Height          =   315
         Left            =   1110
         TabIndex        =   2
         Top             =   240
         Width           =   885
      End
   End
   Begin VB.CheckBox UnloadCheck 
      Caption         =   "卸载窗体"
      Height          =   615
      Left            =   5190
      TabIndex        =   0
      Top             =   870
      Width           =   825
   End
   Begin VB.Label Lbl_Date 
      AutoSize        =   -1  'True
      Caption         =   "截止日期:"
      Height          =   195
      Left            =   2310
      TabIndex        =   11
      Top             =   3150
      Width           =   765
   End
End
Attribute VB_Name = "CL_BillChalkitupCond"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mWhcode() As String              '仓库编码
Dim mWhcodeStr As String             '选中仓库编码
Dim Tsxx As String
Dim Jsqte As Long
Private Sub Form_Load()
    Dim Rectemp As Recordset
    
    '仓库列表
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("SELECT  Gy_Warehouse.* FROM Gy_Warehouse " & _
           " LEFT OUTER JOIN  Gy_Whlimit ON Gy_Warehouse.WhCode = Gy_Whlimit.WhCode " & _
           " WHERE Gy_Whlimit.Czybm = '" & Xtczybm & "' and Gy_Warehouse.chhsuseflag=1 " & _
           " and enddealflagchhs=0 order by Gy_Warehouse.Whcode")
    
    If Not Rectemp.EOF Then
        
        ReDim mWhcode(Rectemp.RecordCount)
        
        For Jsqte = 0 To Rectemp.RecordCount - 1
            If Not Rectemp.Fields("enddealflagchhs") Then
                Lst_WareHouse.AddItem Trim(Rectemp.Fields("whname")) + "（" + Trim(Rectemp.Fields("whcode")) + "）--- " + Trim(Rectemp.Fields("pricemode"))
                Lst_WareHouse.Selected(Lst_WareHouse.NewIndex) = True
                mWhcode(Lst_WareHouse.NewIndex) = Trim(Rectemp.Fields("whcode"))
            End If
            Rectemp.MoveNext
        Next
    End If
    
    LrText.Text = ""
    Lbl_Date = "截止日期"
    
End Sub
Private Sub LrText_GotFocus()
    
   LrText.SelStart = Len(LrText.Text)
   
End Sub
Private Sub Opt_Wjz_Click()
    Lbl_Date = "截止日期"
End Sub
Private Sub Opt_Yjz_Click()
   
    Lbl_Date = "起始日期"
End Sub
Private Sub QcCommand_Click()           '全消
    For Jsqte = 0 To Lst_WareHouse.ListCount - 1
        Lst_WareHouse.Selected(Jsqte) = False
    Next
End Sub
Private Sub QdCommand_Click()           '确定
Dim WareHouseCode As String
Dim Rectemp As Recordset
    '仓库
    If Lst_WareHouse.SelCount = 0 Then
       Tsxx = "至少选择一个仓库!"
       Call Xtxxts(Tsxx, 0, 1)
       Exit Sub
    End If
    
    '日期
    If Trim(LrText.Text) <> "" Then
        If IsDate(Trim(LrText.Text)) Then
            LrText.Text = Format(LrText.Text, "yyyy-mm-dd")
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & PGKjYear & " and period=" & PGNowmon)
            If Not Rectemp.EOF Then
                If CDate(LrText.Text) < Rectemp.Fields("qsrq") Or CDate(LrText.Text) > Rectemp.Fields("zzrq") Then
                    Tsxx = "输入日期必须介于" + CStr(Rectemp.Fields("qsrq")) + "与" + CStr(Rectemp.Fields("zzrq")) + "之间!"
                    LrText.SetFocus
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
            End If
        Else
            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
            Call Xtxxts(Tsxx, 0, 1)
            LrText.SetFocus
            Exit Sub
        End If
    End If
    
    '选中计价方式
    WareHouseCode = ""
    For Jsqte = 0 To Lst_WareHouse.ListCount - 1
        If Lst_WareHouse.Selected(Jsqte) Then
            If WareHouseCode = "" Then
                WareHouseCode = "'" & mWhcode(Jsqte) & "'"
            Else
                WareHouseCode = WareHouseCode + " , '" & mWhcode(Jsqte) & "'"
            End If
        End If
    Next
    
    Me.WhCode = "a.whcode in(" + WareHouseCode + ")"
    Me.Hide
    
    With CL_BillChalkitup
        .Timer1.Enabled = True
        .CxbbGrid.SetFocus
    End With
End Sub
Private Sub QxCommand_Click()           '取消
    Me.Hide
    With CL_BillChalkitup.SzToolbar
        If CL_BillChalkitup.CxbbGrid.Rows = CL_BillChalkitup.CxbbGrid.FixedRows Then
            .Buttons("Bill").Enabled = False
            .Buttons("mx").Enabled = False
            .Buttons("hz").Enabled = False
            .Buttons("jz").Enabled = False
            .Buttons("hf").Enabled = False
       End If
    End With
End Sub
Private Sub QxuCommand_Click()          '全选
    For Jsqte = 0 To Lst_WareHouse.ListCount - 1
        Lst_WareHouse.Selected(Jsqte) = True
    Next
End Sub
Public Property Get WhCode() As Variant
    WhCode = mWhcodeStr
End Property
Public Property Let WhCode(ByVal vNewValue As Variant)
    mWhcodeStr = vNewValue
End Property
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Call Drbmhelp("1", "", "")
  
    '根据设置选择显示编码和名称,并进行存储
    If Len(Xtfhcs) <> 0 Then
        LrText.Text = Xtfhcs
    End If
    LrText.SetFocus
End Sub

						