利用VB+VSFLEXGrid做的订单信息编辑程序代码

2019-04-14 08:35发布

'**********************************************************************************************************************************************************
'*    模 块 名 称 : 订单信息-生产计划表(表:ddxx_Main; ddxx_Sub;ddxx_Mlxx;ddxx_Flxx;ddxx_Bwcm;ddxx_Bzxx)
'*    描       述 : 通过表:Xt_Grid 中的 Grid_Code 作为标识来操作。首先在表Xt_Grid中添加要操作的字段,并与VSFGrid中的列对应,
'*    说       明:  gridcol_fieldlx(1、字符型;2、数值型;3、日期型;4、逻辑型(Bit);0、uniqueidentifier型(该字段不保存,主键值,自动生成)
'*
'*    程  序  员 :  LMS/2017.10.18
'**********************************************************************************************************************************************************
Option Explicit


'针对VSFlexGrid,复制、粘贴、移除选中行
Private Sub VSFGrid_Sub_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then PopupMenu XT_Main.c_Edit
End Sub


Private Sub VSFGrid_Ml_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then PopupMenu XT_Main.c_Edit1
End Sub


Private Sub Form_Load()
    If DataEnv.DataConn.State = 0 Then DataEnv.DataConn.Open Glmk.PconnString
    
    MyVsf.VSFGrid_Header VSFGrid_Main, 1, 1, 21, False:  MyVsf.VSFGrid_Header VSFGrid_Sub, 2, 1, 16, False
    MyVsf.VSFGrid_Header VSFGrid_Ml, 1, 1, 8, False:     MyVsf.VSFGrid_Header VSFGrid_Cm, 1, 1, 4, False
    MyVsf.VSFGrid_Header VSFGrid_Bwcm, 1, 1, 3, False:   MyVsf.VSFGrid_Header VSFGrid_Fl, 1, 1, 8, False
    
    DTP1.value = Glmk.PXtrq:  TYwdh.Width = 1210
    
    With VSFGrid_Main
'        .ColHidden(VSFGrid_Main.Cols - 1) = True    '----隐藏 PmKey=最后一列
    End With
    
    With fpSpread_Bzxx
         .LoadFromFile (App.Path & "ExcelModelfrmscjh_main_bzxx1.ss8")
    End With
    Frame2.Top = -90: Frame2.Left = 30
    
    Glmk.System_Log Me.Caption, 1        '----写日志
End Sub


Private Sub Form_Resize()
    On Error Resume Next
    VSFGrid_Main.Width = Me.ScaleWidth - 90
    With SSTab1
       .Height = Me.ScaleHeight - ToolBar1.Height - VSFGrid_Main.Height - 150
       .Width = Me.ScaleWidth - 120
    End With
    With VSFGrid_Sub
       .Height = SSTab1.Height - SSTab1.TabHeight - 180
       .Width = SSTab1.Width - 180
    End With
    
    With VSFGrid_Ml
       .Height = VSFGrid_Sub.Height
       .Width = VSFGrid_Sub.Width
    End With
    With VSFGrid_Cm
       .Height = VSFGrid_Sub.Height - Frame1.Height - 60
    End With
    Frame1.Width = VSFGrid_Sub.Width
    With VSFGrid_Bwcm
       .Height = VSFGrid_Cm.Height
       .Width = VSFGrid_Sub.Width - VSFGrid_Cm.Width - 90
    End With
    
    With VSFGrid_Fl
       .Height = VSFGrid_Sub.Height
       .Width = VSFGrid_Sub.Width
    End With
    
    With fpSpread_Bzxx
       .Height = VSFGrid_Sub.Height
       .Width = VSFGrid_Sub.Width
    End With
    With fpSpread_Scbb
       .Height = VSFGrid_Sub.Height
       .Width = VSFGrid_Sub.Width
    End With
End Sub


Private Sub VSFGrid_Sub_CellChanged(ByVal Row As Long, ByVal Col As Long)
   XT_Main.StatusBar1.Panels(2).Text = "总计划数: " + CStr(MdlVsf.VSFG_SumCol(VSFGrid_Sub, 7))
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Main_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Main
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Sub_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Sub
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Ml_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Ml
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Cm_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Cm
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Bwcm_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Bwcm
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'第 列不允许编辑
Private Sub VSFGrid_Fl_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
    With VSFGrid_Fl
       If Col = .Cols - 1 Then Cancel = True
    End With
End Sub


'装入表内容和主表信息(制单日期)
Private Sub TYwdh_Change()
    Me.MousePointer = 11
    
    Dim rst As New ADODB.RecordSet, SQL As String, II As Integer, KK As Integer
    
    DTP1.value = MyNormal.GetFsrq_BySQL("select * from ddxx_Main where ywdh='" + Trim(TYwdh.Text) + "'")
    
    MyVsf.FillVSFGrid VSFGrid_Main, "select * from ddxx_Main where ywdh='" + Trim(TYwdh.Text) + "'", "ddxx_Main"                     '----订单信息-主表信息(ddxx_Main)
    MyVsf.FillVSFGrid VSFGrid_Sub, "select * from ddxx_Sub where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_sub"         '----订单信息-产品信息(ddxx_Sub)
    MyVsf.FillVSFGrid VSFGrid_Ml, "select * from ddxx_Mlxx where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_mlxx"        '----订单信息-面料信息(ddxx_Mlxx)
    MyVsf.FillVSFGrid VSFGrid_Cm, "select * from ddxx_Cmxx where ywdh='" + Trim(TYwdh.Text) + "' order by sort_id", "ddxx_cmxx"      '----订单信息-尺码信息(ddxx_Cmxx)
    MyVsf.FillVSFGrid VSFGrid_Fl, "select * from ddxx_Flxx where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_flxx"        '----订单信息-辅料信息(ddxx_Flxx)
    
    VSFGrid_Main.Rows = 2
    
    '----部位尺码+包装信息
'On Error GoTo err_cl
    '----  部位尺码  ----
    Call VSFGrid_Bwcm_Header    '部位尺码的动态表头部分(根据ddxx_cmxx表中的尺码来决定)
    '----装入数据
    Dim Bwcm_Arr() As String    '----定义一个数组,通过Split分割,取得所要的尺码相对应数据
    With VSFGrid_Bwcm
        Set rst = Nothing
        Set rst = DataEnv.DataConn.Execute("select * from ddxx_Bwcm where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id")
        If Not (rst.EOF And rst.BOF) Then
           II = .FixedRows
           Do While Not rst.EOF
             .AddItem ""
             .TextMatrix(II, 0) = II    '---在这里II= .FixedRows = 1
              .TextMatrix(II, 1) = rst("buwei")
              If rst("bwcm") <> "" Then
                 Bwcm_Arr() = Split(rst("bwcm"), ",")
                 For KK = 0 To UBound(Bwcm_Arr)
                     .TextMatrix(II, KK + 2) = Bwcm_Arr(KK)
                 Next KK
              End If
              .TextMatrix(II, .Cols - 1) = rst("PmKey")
              II = II + 1
              rst.MoveNext
           Loop
        End If
    End With
    '----  包装信息  ----
    Set rst = Nothing
    Set rst = DataEnv.DataConn.Execute("select * from ddxx_Bzxx where ywdh='" + Trim(TYwdh.Text) + "'")
    If Not (rst.EOF And rst.BOF) Then
       With fpSpread_Bzxx
           .Row = 1: .Col = 1: .Text = rst("bzff")
           .Row = 1: .Col = 2: .Text = rst("maitou")
           
           .Row = 0: .Col = 3:  .Text = rst("pic_kst1")
           .Row = 0: .Col = 4:  .Text = rst("pic_kst2")
           .Row = 0: .Col = 5:  .Text = rst("pic_kst3")
           
           .Row = 1: .Col = 3: .TypePictPicture = .LoadPicture(rst("pic_kst1"), PictureTypeJPEG)
           .Row = 1: .Col = 4: .TypePictPicture = .LoadPicture(rst("pic_kst2"), PictureTypeJPEG)
           .Row = 1: .Col = 5: .TypePictPicture = .LoadPicture(rst("pic_kst3"), PictureTypeJPEG)
       End With


    End If
    Set rst = Nothing
    Me.MousePointer = 0
    Exit Sub
    
err_cl:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
    Me.MousePointer = 0
End Sub


'-------- 保存或增行前先进行判断是否符合保存条件或主表信息必须符合才能增行 --------
Private Function Save_Check() As Boolean
    Save_Check = False
    
    If MyNormal.CheckShbz_ByYwdh("ddxx_Main", Trim(TYwdh.Text)) Then Exit Function               '----检查业务单是否已审核
    If MyNormal.CheckYwdh(TYwdh.Text, Trim(DTP1.value)) = False Then Exit Function
    If MyNormal.CheckZdry("ddxx_main", Trim(TYwdh.Text)) = False Then Exit Function              '----看计划制单人员是否与现在的保存人员一致
    If MyVsf.CheckRow_ByCols(VSFGrid_Main, "1,2,3") = False Then Exit Function                   '----订单信息主表 前2列(合同号,客户名称)不能为空
    
    Dim rst As New ADODB.RecordSet                      '----检查该合同号是否已被保存
    Set rst = Nothing
    Set rst = DataEnv.DataConn.Execute("select * from ddxx_Main where hth='" + Trim(VSFGrid_Main.TextMatrix(1, 1)) + "'")
    If Not (rst.EOF And rst.BOF) Then
       If Trim(TYwdh.Text) <> Trim(rst("ywdh")) Then
          MsgBox "合同号:" + VSFGrid_Main.TextMatrix(1, 1) + ",已做过生产计划,你可以通过查找该合同获取计划进行编辑!", vbOKOnly + vbExclamation, "提示"
          Set rst = Nothing
          Exit Function
       End If
    End If
    Set rst = Nothing
    If MyVsf.CheckRow_ByCols(VSFGrid_Sub, "1,2,3,4") = False Then Exit Function                  '----订单信息子表(产品信息) 前4列(pm+pf+sh+ys)不能为空
    
    Save_Check = True
End Function


'保存数据
Private Sub Save_sub()
    If Save_Check = False Then Exit Sub
    
    MyVsf.SaveVSFGrid_ByYwdhFsrq VSFGrid_Main, "ddxx_main", "ddxx_main", Trim(TYwdh.Text), DTP1.value, False      '1、保存到主表(ddxx_Main)
    
    MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Sub, "ddxx_sub", "ddxx_sub", Trim(TYwdh.Text), False                         '2、保存到子表(ddxx_Sub) 产品信息
    
    MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Ml, "ddxx_mlxx", "ddxx_mlxx", Trim(TYwdh.Text), False                        '3、保存到表(ddxx_Mlxx)  面料信息
    MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Fl, "ddxx_flxx", "ddxx_flxx", Trim(TYwdh.Text), False                         '4、保存到表(ddxx_Flxx)  辅料信息
    
    MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Cm, "ddxx_cmxx", "ddxx_cmxx", Trim(TYwdh.Text), False                        '5、保存到表(ddxx_cmxx)  尺码信息
    Call Save_Bwcm(False)                                                                                         '6、保存到表(ddxx_Bwcm)  部位尺码
    
    Call Save_Bzxx                                                                                                '7、保存到表(ddxx_Bzxx)  包装信息
    
    MsgBox "数据已成功保存!", vbOKOnly + vbExclamation, "提示"
    
    Glmk.System_Log Me.Caption, 3        '----写日志
End Sub


'6、保存到部位尺码(ddxx_bwcm)
Private Sub Save_Bwcm(Optional ByVal Mess_Bool As Boolean = True)
'On Error GoTo err_cl
     With VSFGrid_Bwcm
       If .Rows = .FixedRows Then Exit Sub
       Dim rst As New ADODB.RecordSet, SQL As String, II As Integer, KK As Integer, Bwcm_Str As String, Str As String


       DataEnv.DataConn.BeginTrans
       
       For II = .FixedRows To .Rows - 1
           Set rst = Nothing
           If Trim(.TextMatrix(II, .Cols - 1)) = "" Then
               SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' and 1=2"
           Else
               SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' and Pmkey='" + Trim(.TextMatrix(II, .Cols - 1)) + "'"     '-----主键值Pmkey"
           End If
           rst.Open SQL, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
           If rst.EOF And rst.BOF Then rst.AddNew
           rst("ywdh") = Trim(TYwdh.Text)
           rst("fl_id") = IIf(Val(.TextMatrix(II, 0)) = 0, 1, Val(.TextMatrix(II, 0)))
           rst("buwei") = Trim(.TextMatrix(II, 1))
           If .Cols > 3 Then
              For KK = 2 To .Cols - 2    '从第二列至第X列的值,用","连接成为一个总字符串(若需要通过数组拆分)
                  Str = Trim(.TextMatrix(II, KK))
                  Bwcm_Str = IIf(KK = 2, Str, Bwcm_Str + "," + Str)
              Next KK
              
           End If
           rst("bwcm") = Bwcm_Str
           rst.Update
       Next II
       '---- 以最后一列为主键值
       Set rst = Nothing
       SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id"
       Set rst = DataEnv.DataConn.Execute(SQL)
       rst.MoveFirst:  II = .FixedRows
       Do While Not rst.EOF
          .TextMatrix(II, .Cols - 1) = rst("Pmkey")     '唯一标识号
          rst.MoveNext
          II = II + 1
       Loop
    End With
    DataEnv.DataConn.CommitTrans
    Set rst = Nothing
    If Mess_Bool Then MsgBox "系统已经成功保存部位信息数据表!", vbOKOnly + vbExclamation, "系统提示"
    Exit Sub
    
err_cl:
    DataEnv.DataConn.RollbackTrans
    Set rst = Nothing
    MsgBox Err.Description, vbOKOnly + vbCritical, "系统提示"
End Sub


'7、保存到包装信息 表(ddxx_Bzxx)
Private Sub Save_Bzxx()
    Dim rst As New ADODB.RecordSet, SQL As String
    Set rst = Nothing
    SQL = "select * from ddxx_Bzxx where ywdh='" + Trim(TYwdh.Text) + "'"
    rst.Open SQL, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
    If rst.EOF And rst.BOF Then rst.AddNew
    rst("ywdh") = Trim(TYwdh.Text)
    With fpSpread_Bzxx
        .Row = 1: .Col = 1: rst("bzff") = .Text             '---- rst("bzff") = Trim(Txt_Bzff.Text)
        .Row = 1: .Col = 2: rst("maitou") = .Text           '---- rst("maitou") = Trim(Txt_Mt.Text)
                                                            '---- rst("pic_filepath") = Trim(Txt_FilePath.Text)
        .Row = 0: .Col = 3: rst("pic_kst1") = .Text         '---保存的是图片路径,不直接保存图片到数据库
        .Row = 0: .Col = 4: rst("pic_kst2") = .Text
        .Row = 0: .Col = 5: rst("pic_kst3") = .Text
    End With
    rst.Update
    Set rst = Nothing
End Sub


'---- 新建 ----
Private Sub New_Sub()
    TYwdh.Text = MyNormal.GetYwdh(Trim(DTP1.value), "ddxx_Main")            '----根据制单日期生成业务单号
    With VSFGrid_Main
         .TextMatrix(1, 3) = DTP1.value:  .TextMatrix(1, 6) = Glmk.Pczym    '----成衣交期 ,业务担当
    End With
'    VSFGrid_Sub.Rows = VSFGrid_Sub.FixedRows: VSFGrid_Ml.Rows = VSFGrid_Ml.FixedRows: VSFGrid_Cm.Rows = VSFGrid_Cm.FixedRows: VSFGrid_Fl.Rows = VSFGrid_Fl.FixedRows   '----产品信息,面料信息,尺码信息,辅料信息
End Sub


'---- 增行 ----
Private Sub AddRow_Sub()
    If Save_Check = False Then Exit Sub
    Select Case SSTab1.Caption
       Case "产品信息"
          MyVsf.AddRow VSFGrid_Sub, "1,2,3,4,5"
          
       Case "面料信息"
          MyVsf.AddRow VSFGrid_Ml
          
       Case "部位尺码"
          MyVsf.AddRow VSFGrid_Bwcm
          
       Case "辅料信息"
          MyVsf.AddRow VSFGrid_Fl
          
    End Select
End Sub


'---- 删行 ----
Private Sub DeleteRow_Sub()
    If Glmk.Pczym <> "system" Then
       If MyNormal.CheckZdry("ddxx_Main", Trim(TYwdh.Text)) = False Then Exit Sub
    End If
    Select Case SSTab1.Caption
       Case "产品信息"
           With VSFGrid_Sub
               If Trim(.TextMatrix(.Row, .Cols - 1)) = "" Then
                  MyVsf.DeleteSelectRow_ByUnCheck VSFGrid_Sub, "ddxx_Sub"
               Else
                  MyVsf.DeleteSelectRow_ByCheck VSFGrid_Sub, "Jhdd_Scrbb", "ddxx_Sub"
               End If
           End With
           
       Case "面料信息"
           With VSFGrid_Ml
               If Trim(.TextMatrix(.Row, .Cols - 1)) = "" Then
                  MyVsf.DeleteSelectRow_ByUnCheck VSFGrid_Ml, "ddxx_Mlxx"
               Else
                  MyVsf.DeleteSelectRow_ByCheck VSFGrid_Ml, "Jhdd_Scrbb", "ddxx_Mlxx"
               End If
           End With
          
       Case "部位尺码"
       
           
       Case "辅料信息"
           
          
    End Select
    Glmk.System_Log Me.Caption, 4        '----写日志
End Sub


'---- 插入行 ----
Private Sub InsertRow_Sub()
    Select Case SSTab1.Caption
       Case "产品信息"
          MyVsf.InsertRow VSFGrid_Sub
       
       Case "面料信息"
          MyVsf.InsertRow VSFGrid_Ml
          
       Case "部位尺码"
          MyVsf.InsertRow VSFGrid_Bwcm
       
       Case "辅料信息"
          MyVsf.InsertRow VSFGrid_Fl
       
    End Select
End Sub


'---- 导出文件->Excel ----
Private Sub FileToExcel_Sub()
    Select Case SSTab1.Caption
       Case "产品信息"
          MyVsf.File_ToExcel CommonDialog1, VSFGrid_Sub, SSTab1.Caption
       
       Case "面料信息"
          MyVsf.File_ToExcel CommonDialog1, VSFGrid_Ml, SSTab1.Caption
          
       Case "部位尺码"
          MyVsf.File_ToExcel CommonDialog1, VSFGrid_Bwcm, SSTab1.Caption
       
       Case "辅料信息"
          MyVsf.File_ToExcel CommonDialog1, VSFGrid_Fl, SSTab1.Caption
       
    End Select
End Sub


Private Sub ToolBar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   Select Case Button.Key
       Case "new"
          Call New_Sub
          
       Case "save"
          Call Save_sub
          
       Case "add_row"
          Call AddRow_Sub
          
       Case "del_row"
          Call DeleteRow_Sub
       
       Case "Insert_row"
          Call InsertRow_Sub
          
       Case "find"
          FrmScjh_Main_Find.Show 1
          
       Case "out_excel"
          Call FileToExcel_Sub
          
       Case "quit"
          Unload Me
    End Select
End Sub


'----显示部位尺码的动态表头部分(根据ddxx_cmxx表中的尺码来决定)
Private Sub VSFGrid_Bwcm_Header()
    Dim Record_Count As Long, II As Integer
    Record_Count = MyNormal.TableRecord_Count("select count(*) from ddxx_cmxx where ywdh='" + Trim(TYwdh.Text) + "'")
    If Record_Count > 0 Then
       Dim rst As New ADODB.RecordSet
       With VSFGrid_Bwcm
           II = 2:  .Cols = 3
           .Cols = .Cols + Record_Count
           Set rst = Nothing
           Set rst = DataEnv.DataConn.Execute("select cm from ddxx_cmxx where ywdh='" + Trim(TYwdh.Text) + "' order by sort_id")
           Do While Not rst.EOF
               .TextMatrix(0, II) = rst("cm")
               .ColWidth(II) = 1000:  .ColAlignment(II) = flexAlignCenterCenter
               II = II + 1
               rst.MoveNext
           Loop
           .TextMatrix(0, .Cols - 1) = "PmKey"
           .ColWidth(.Cols - 1) = 300
       End With
    End If
    Set rst = Nothing
End Sub


'---- 生成尺码信息表 + 保存尺码信息表
Private Sub Cmd_Sccmxx_Click(Index As Integer)
    Dim II As Integer, JJ As Integer
    Select Case Index
        Case 0        '----生成尺码信息表
           With VSFGrid_Cm
              If VSFGrid_Sub.Rows = VSFGrid_Sub.FixedRows Then Exit Sub
              Dim Cm As String, AddItem_Bool As Boolean
              .Rows = .FixedRows
              For II = VSFGrid_Sub.FixedRows To VSFGrid_Sub.Rows - 1
                  Cm = Trim(VSFGrid_Sub.TextMatrix(II, 6))
                  If .Rows = .FixedRows Then
                     .AddItem ""
                     .TextMatrix(.Rows - 1, 1) = Cm
                  Else
                     AddItem_Bool = True
                     For JJ = .FixedRows To .Rows - 1
                         If Trim(.TextMatrix(JJ, 1)) = Cm Then
                            AddItem_Bool = False
                            Exit For
                         End If
                     Next JJ
                     If AddItem_Bool Then
                        .AddItem ""
                        .TextMatrix(.Rows - 1, 1) = Cm
                     End If
                  End If
              Next II
              MyVsf.SortRow VSFGrid_Cm, 0
              MyVsf.SortRow VSFGrid_Cm, 2
           End With
       
       Case 1          '----5、保存到表(ddxx_cmxx)  尺码
          MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Cm, "ddxx_cmxx", "ddxx_cmxx", Trim(TYwdh.Text), True
       
       Case 2          '----根据ddxx_cmxx表中的尺码来动态生成表头
          Call VSFGrid_Bwcm_Header
           
       Case 3          '-----6、保存到表(ddxx_Bwcm)  部位尺码
          Call Save_Bwcm
        
    End Select
End Sub


'选择款式图1,2,3
Private Sub fpSpread_Bzxx_ButtonClicked(ByVal Col As Long, ByVal Row As Long, ByVal ButtonDown As Integer)
On Error GoTo err_cl
    With CommonDialog1
       .CancelError = True
       
       .Filter = "图片文件|*.jpg;*.bmp"     '"图片 (*.jpg)|*.jpg|图片 (*.bmp)|*.bmp"    '-- |Word 文档(*.doc)|*.doc|纯文本(*.txt)|*.txt|Html 文档(*.Htm)|*.htm"
       .ShowOpen
       .DialogTitle = "选择要上传的图片文件"
'       Txt_FilePath.Text = .FileName
    End With
    With fpSpread_Bzxx
        .Row = 1:   .Col = .ActiveCol
        .TypePictPicture = .LoadPicture(CommonDialog1.FileName, PictureTypeJPEG)
        .Row = 0: .Col = .ActiveCol: .Text = CommonDialog1.FileName
    End With
    Exit Sub
    
err_cl:
    With fpSpread_Bzxx
        .Row = 0: .Col = .ActiveCol: .Text = ""
    End With
    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
End Sub


Private Sub Form_Unload(Cancel As Integer)
    DataEnv.DataConn.Execute ("delete from ddxx_Main where len(hth)=0 and zdry='" + Glmk.Pczym + "'")
    XT_Main.StatusBar1.Panels(2).Text = ""
'    Set Myclsvsf = Nothing
    Glmk.System_Log Me.Caption, 2         '----写日志
End Sub




''******************************************************************************


''导入excel文件到VSFGrid
'Private Sub Cmd_Dr_Click()
'   MyVsf.File_ToVSFGrid CommonDialog1, VSFGrid_Sub
'End Sub
'
'************************************************  导入数据    *********************************************************************
Private Sub Cmd_LoadHth_Click()
    MyNormal.Fill_Combox Thth_Copy, "select distinct hth from ERP_DataBase.dbo.jhdd_scjhb_Main order by hth desc"
End Sub


Private Sub Cmd_Dr_Click()
    Frame2.Visible = True
End Sub


Private Sub Cmd_Close_Click()
    Frame2.Visible = False
End Sub


'按选择的合同号传递数据
Private Sub Cmd_Fzht_Click()
   If MyNormal.TableRecord_Count("select count(*) from ddxx_Main where hth='" + Trim(Thth_Copy.Text) + "'") <> 0 Then
      MsgBox "该合同号在数据库已存在,不需要传递!", vbOKOnly + vbExclamation, "提示"
      Exit Sub
   End If


   Dim rst As New ADODB.RecordSet, rst1 As New ADODB.RecordSet, SQL1 As String


   '----、订单数据
   If MyNormal.TableRecord_Count("select count(*) from ERP_DataBase.dbo.jhdd_scjhb_Main where hth='" + Trim(Thth_Copy.Text) + "'") = 0 Then
      MsgBox "无数据!", vbOKOnly + vbExclamation, "信息提示"
      Exit Sub
   End If
   Dim Row As Long, Xh As Long
   Set rst = Nothing
   Set rst = DataEnv.DataConn.Execute("select * from ERP_DataBase.dbo.jhdd_V_scjhb where hth='" + Trim(Thth_Copy.Text) + "'")
   
   DTP1.value = rst("fsrq")
   TYwdh.Text = MyNormal.GetMystr_Byfgzf(rst("ywdh"), "-", 0) + "-0" + MyNormal.GetMystr_Byfgzf(rst("ywdh"), "-", 1)
   
   With VSFGrid_Main
      
      .Rows = 2: .TextMatrix(1, 1) = Thth_Copy.Text: .TextMatrix(1, 2) = rst("khmc")
      .TextMatrix(1, 3) = rst("jhjq_cy"):  .TextMatrix(1, 6) = rst("zywdd"):  .TextMatrix(1, 9) = rst("memo")
      .TextMatrix(1, 11) = rst("zdry"):  .TextMatrix(1, 12) = rst("zdrq")
   End With
   With VSFGrid_Sub
       .Rows = .FixedRows: Row = .FixedRows: Xh = 1
       Do While Not rst.EOF
          .AddItem ""
          .TextMatrix(Row, 0) = Xh
          .TextMatrix(Row, 1) = rst("pm")
          .TextMatrix(Row, 2) = rst("pf")
          .TextMatrix(Row, 3) = rst("sh")
          .TextMatrix(Row, 4) = rst("ys")
          .TextMatrix(Row, 6) = rst("cm")
          .TextMatrix(Row, 7) = rst("jhsl")   '计划数
          rst.MoveNext
          Row = Row + 1: Xh = Xh + 1
       Loop
   End With
   
   '----2、面料数据
   Set rst = Nothing
   Set rst = DataEnv.DataConn.Execute("select * from ERP_DataBase.dbo.jhdd_mlgy where hth='" + Trim(Thth_Copy.Text) + "' order by mldm")
   If Not (rst.EOF And rst.BOF) Then
      With VSFGrid_Ml
         .Rows = .FixedRows: Row = .FixedRows: Xh = 1
         Do While Not rst.EOF
            .AddItem ""
            .TextMatrix(Row, 0) = Xh
            .TextMatrix(Row, 1) = rst("mldm")
            .TextMatrix(Row, 2) = rst("mlmc")
            .TextMatrix(Row, 3) = rst("mlpb")
            .TextMatrix(Row, 4) = rst("kz")
            .TextMatrix(Row, 5) = rst("mlsx")
            .TextMatrix(Row, 6) = rst("memo")
            rst.MoveNext
            Row = Row + 1: Xh = Xh + 1
         Loop
      End With
   End If
   Set rst = Nothing
End Sub


'***********************************************************************************


''----选择款式图
'Private Sub Cmd_Kst_Click()
''    Dim Ado_Stream As New ADODB.Stream
''    Dim rst As New ADODB.Recordset, sql As String
'
'On Error GoTo err_cl
'    With CommonDialog1
'       .CancelError = True
'
'       .Filter = "图片文件|*.jpg;*.bmp"     '"图片 (*.jpg)|*.jpg|图片 (*.bmp)|*.bmp"    '-- |Word 文档(*.doc)|*.doc|纯文本(*.txt)|*.txt|Html 文档(*.Htm)|*.htm"
'       .ShowOpen
'       .DialogTitle = "选择要上传的图片文件"
'       Txt_FilePath.Text = .FileName
'    End With
'
'    Pic_Kst.Picture = LoadPicture(Txt_FilePath.Text)
'
''    '读取文件到内容
''    With Ado_Stream
''        .Type = adTypeBinary             '二进制模式
''        .Open
''        .LoadFromFile CommonDialog1.FileName
''    End With
''
''    '打开上传文件的表
''    Set rst = Nothing
''    sql = "select * from ddxx_Bzxx"
''    rst.Open sql, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
''    If rst.EOF And rst.BOF Then rst.AddNew
''    rst("pic_filepath") = Txt_FilePath.Text
''    'rst("pic_kst") = Ado_Stream.Read
''    rst.Update
''    Set rst = Nothing
''    Set Ado_Stream = Nothing
''    MsgBox "图片文件上传成功!", vbOKOnly + vbInformation, "提示"
'    Exit Sub
'
'err_cl:
'    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
'    Pic_Kst.Picture = LoadPicture("")
'
''    Set rst = Nothing
''    Set Ado_Stream = Nothing
'    Exit Sub
'End Sub