企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
Begin VB.Form KF_FrmStockChoice 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "采购入库单选择"
   ClientHeight    =   4335
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8865
   Icon            =   "采购入库单选择.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4335
   ScaleWidth      =   8865
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Gridsz 
      Caption         =   "保存表格格式"
      Height          =   300
      Index           =   0
      Left            =   7260
      TabIndex        =   4
      Top             =   3960
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.CommandButton CmdOK 
      Caption         =   "确定(&O)"
      Height          =   315
      Left            =   3420
      TabIndex        =   3
      Top             =   3960
      Width           =   1245
   End
   Begin VB.CommandButton CmdChoice 
      Caption         =   "选定(&C)"
      Height          =   315
      Left            =   1830
      TabIndex        =   2
      Top             =   3960
      Width           =   1245
   End
   Begin VB.CommandButton CmdExit 
      Caption         =   "退出(&E)"
      Height          =   315
      Left            =   240
      TabIndex        =   1
      Top             =   3960
      Width           =   1245
   End
   Begin VSFlex8Ctl.VSFlexGrid vs 
      Height          =   3675
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   8595
      _ExtentX        =   15161
      _ExtentY        =   6482
      Appearance      =   1
      BorderStyle     =   1
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MousePointer    =   0
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      BackColorFixed  =   -2147483633
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   1
      Cols            =   1
      FixedRows       =   1
      FixedCols       =   0
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   0   'False
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   0
      ExplorerBar     =   0
      PicturesOver    =   0   'False
      FillStyle       =   0
      RightToLeft     =   0   'False
      PictureType     =   0
      TabBehavior     =   0
      OwnerDraw       =   0
      Editable        =   0   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
   End
End
Attribute VB_Name = "KF_FrmStockChoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'*    模 块 名 称 :采购入库单选择
'*    功 能 描 述 :
'*    程序员姓名  :张万成
'*    最后修改人  :张万成
'*    最后修改时间:2001/09/20
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'******************************************************************
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Dim strMain As String
Dim strSub As String
Public Bln As Boolean
Private Sub CmdChoice_Click()
With vs
    For Rowjsq = .FixedRows To .Rows - 1
        If .IsSelected(Rowjsq) Then
            vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = "√"
        Else
            vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = ""
        End If
    Next Rowjsq
End With
End Sub
Private Sub CmdExit_Click()
    KF_FrmMateInCxjg.StrTemp1 = ""
    KF_FrmMateInCxjg.StrTemp2 = ""
    Unload Me
End Sub
Private Sub CmdOK_Click()
strMain = ""
strSub = ""
With vs
    For Rowjsq = .FixedRows To .Rows - 1
        If vs.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = "√" Then
            strMain = strMain + Trim(.TextMatrix(Rowjsq, 0)) + ","
            strSub = strSub + Trim(.TextMatrix(Rowjsq, 1)) + ","
        End If
    Next Rowjsq
End With
If strMain <> "" Then
    KF_FrmMateInCxjg.StrTemp1 = Mid(Trim(strMain), 1, Len(Trim(strMain)) - 1)
End If
If strSub <> "" Then
    KF_FrmMateInCxjg.StrTemp2 = Mid(Trim(strSub), 1, Len(Trim(strSub)) - 1)
End If
 Unload Me
End Sub
Private Sub Form_Load()
    GridCode = "KF_StockChoice"
    Call BzWgcsh(vs, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = vs.Cols - 1
    vs.ExplorerBar = flexExNone
    strMain = ""
    strSub = ""
    Call Fillstock(Bln)
    
End Sub
Private Sub Fillstock(Bln As Boolean)
 Dim str As String
 Dim adostock As New ADODB.Recordset
 Dim jsq As Long
 If Trim(KF_FrmMateInCxjg.strWhCode) <> "" And Trim(KF_FrmMateInCxjg.strMnumber) <> "" Then
    If KF_FrmMateInCxjg.Option2.Value Then
        If Bln Then
            str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan ,billnum from kf_v_stockin  where suppliercode in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strWhCode), 1, Len(Trim(KF_FrmMateInCxjg.strWhCode)) - 1)) & ") and balancedate is null order by  inoutmainid"
        Else
            str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin  where suppliercode in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strWhCode), 1, Len(Trim(KF_FrmMateInCxjg.strWhCode)) - 1)) & ") and balancedate is not null order by  inoutmainid"
        End If
    Else
        If Bln Then
            str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin  where mnumber in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strMnumber), 1, Len(Trim(KF_FrmMateInCxjg.strMnumber)) - 1)) & ") and balancedate is null order by  inoutmainid"
        Else
            str = "select mnumber,mname,emoney,suppliercode,supplierName,inoutmainid,inoutsubid,FactReceiptquan,billnum from kf_v_stockin  where mnumber in(" & Trim(Mid(Trim(KF_FrmMateInCxjg.strMnumber), 1, Len(Trim(KF_FrmMateInCxjg.strMnumber)) - 1)) & ") and balancedate is not null order by  inoutmainid"
        End If
    End If
    
       Set adostock = Cw_DataEnvi.DataConnect.Execute(str)
       vs.Rows = vs.FixedRows
       jsq = vs.FixedRows
       With adostock
           If Not .EOF Then
               Do While Not .EOF
                       vs.AddItem ""
                       vs.TextMatrix(jsq, 0) = Val(.Fields("inoutmainid"))
                       vs.TextMatrix(jsq, 1) = Val(.Fields("inoutsubid"))
                       vs.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("suppliername") & "")
                       vs.TextMatrix(jsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("billnum") & "")
                       vs.TextMatrix(jsq, Sydz("003", GridStr(), Szzls)) = Val(.Fields("Emoney") & "")
                       vs.TextMatrix(jsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("mnumber") & "") + "-" + Trim(.Fields("mname") & "")
                       vs.TextMatrix(jsq, Sydz("006", GridStr(), Szzls)) = Val(.Fields("FactReceiptquan") & "")
                       vs.RowHeight(jsq) = Sjhgd
                    jsq = jsq + 1
                   .MoveNext
               Loop
           End If
       End With
       vs.SelectionMode = flexSelectionListBox
 End If
End Sub
Public Sub Bcwggs(Bcgsgrid As vsFlexGrid, Wggsdm As String, GridStr() As String)            '保存网格格式(包括网格列宽,网格列顺序)
  
    '过程参数:Bcgsgrid 保存格式网格对象,Wggsdm 网格格式代码(网格参数),GridStr() 从中取网格列索引信息
  
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集
    Dim Qslzte As Integer                            '起始列值
    Dim Tsxx As String                               '系统信息提示
  
    Cw_DataEnvi.DataConnect.BeginTrans
    On Error GoTo Swcwcl
    If RecTemp.State = 1 Then RecTemp.Close
    RecTemp.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With RecTemp
        If Not .EOF Then
            Qslzte = .Fields("BeginCol")
            .MoveNext
        End If
    
        Do While Not .EOF
            For jsqte = Qslzte To Bcgsgrid.Cols - 1
                If Trim(.Fields("ColIndex")) = Trim(GridStr(jsqte, 1)) Then
                    Exit For
                End If
            Next jsqte
            If jsqte <= Bcgsgrid.Cols - 1 Then
                .Fields("ColId") = jsqte - Qslzte + 1
                .Fields("ColWidth") = Bcgsgrid.ColWidth(jsqte)
                .Update
            End If
            .MoveNext
        Loop
    End With
  
    Cw_DataEnvi.DataConnect.CommitTrans
  
    Tsxx = "表格格式保存完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
End Sub
Private Sub Gridsz_Click(Index As Integer)
    Call Bcwggs(vs, GridCode, GridStr())
End Sub
Private Sub vs_DblClick()
    If vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = "√" Then
        vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = ""
    Else
        vs.TextMatrix(vs.Row, Sydz("004", GridStr(), Szzls)) = "√"
    End If
End Sub

						