c

来自「VB开发的ERP系统」· 代码 · 共 1,044 行 · 第 1/3 页

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)

Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小(Fixed)
    On Error Resume Next
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140

End Sub

Private Sub Form_Load()                                                   '窗体装入
  
    '调入打印页面设置窗体
    ReportTitle = "成品等级走势图"
    XtReportCode = "QC_ProGraphZst"
    Load Dyymctbl
      
    '调整标题栏及网格、格式工具条位置(Fixed)
    Pic_Title.Left = 40
    Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
     
    '调 入 网 格(Fixed)
    GridCode = "QC_ProGraphZst"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
      
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1

End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载

    '卸载条件窗体
    FrmProGraph_ZstQuery.UnloadCheck.Value = 1
    Unload FrmProGraph_ZstQuery
    
    '卸载打印页面设置窗体
    Unload Dyymctbl

End Sub

Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)                '网格格式调整(Fixed)
  
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(CxbbGrid, GridCode)
      Case "txfx"                                            '图形分析报表
        If CxbbGrid.Rows = CxbbGrid.FixedRows Then
            Exit Sub
        End If
        XT_TxfxFrm.HelpContextID = 150400502
        Call Txfxbb(CxbbGrid, "QC_ProGraphZst")
    End Select

End Sub


Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "cx"                                            '查 询
            FrmProGraph_ZstQuery.Show 1
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
           Unload Me
    End Select

End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
    

    '生成查询结果
    Call Sub_Query
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

End Sub

Public Sub Sub_Query()                                     '生成查询结果(Define)

  Dim Sqlstr, strSQL, strSQL1, strSQL2 As String
  Dim rec As ADODB.Recordset
  Dim rectemp1 As ADODB.Recordset
  Dim rectemp2 As ADODB.Recordset
    
  Dim ii As Integer
  Dim i As Integer
  Dim TiaoJian As String
    
    With FrmProGraph_ZstQuery
        If Trim(.LrText(0).Text & "") = "" Then
           Lab_TitleMess(0).Caption = "物料大类编码:"
           Lab_TitleMess(1).Caption = "物料大类名称:"
           strwlbh = Trim(.LrText(5).Tag & "")
           strName = Trim(.LrText(5).Text & "")
        Else
           Lab_TitleMess(0).Caption = "物料编码:"
           Lab_TitleMess(1).Caption = "物料名称:"
           strwlbh = Trim(.LrText(0).Text & "")
           strName = Trim(.LrText(1).Text & "")
        End If
        label1(0).Caption = strwlbh
        label1(1).Caption = strName
        Daystart = Format(Trim(.LrText(2).Text), "yyyy-mm-dd")
        Dayend = Format(Trim(.LrText(3).Text), "yyyy-mm-dd")
        intcycle = Val(.LrText(4).Text)
        strcycle = Trim(.Combo1.Text)
        
        Label3.Caption = Format(Daystart, "yyyy-mm-dd") & "～" & Format(Dayend, "yyyy-mm-dd")
        Label5.Caption = strcycle
        Label7.Caption = intcycle
        
        '查询连接串
        If Trim(.LrText(0).Text & "") = "" Then
           TiaoJian = " where msnumber = '" & strwlbh & "' "
        Else
           TiaoJian = " where mnumber = '" & strwlbh & "' "
        End If
        

        Sqlstr = "SELECT checksortcode FROM Qc_ProductMaterial " & TiaoJian
        Set rec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        If rec.RecordCount < 1 Then
            If Trim(.LrText(0).Text & "") = "" Then
               Tsxx = "请先设置该物料大类中物料的检验类别!"
            Else
               Tsxx = "请先设置该物料的检验类别!"
            End If
            Call Xtxxts(Tsxx, 0, 3)
            Exit Sub
        End If
    End With
    
    If Trim(FrmProGraph_ZstQuery.LrText(0).Text & "") = "" Then
        TiaoJian = " where msnumber = '" & strwlbh & "'  and Checker<>'' "
    Else
        TiaoJian = " where mnumber = '" & strwlbh & "'  and Checker<>'' "
    End If
    
    Sqlstr = "SELECT gradecode,gradename FROM QC_grade  where checksortcode ='" & Trim(rec.Fields("checksortcode") & "") & "' order by gradecode"
    If rec.State Then rec.Close
    Set rec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If rec.RecordCount < 1 Then
       Tsxx = "请先设置该物料的质量等级!"
       Call Xtxxts(Tsxx, 0, 3)
       Exit Sub
    End If
   
   gradecount = rec.RecordCount
   ReDim gradecode(gradecount) As String
   ReDim gradename(gradecount) As String
   ReDim result(gradecount, intcycle) As Single
    
   For i = 0 To rec.RecordCount - 1
    gradecode(i) = rec.Fields("gradecode")
    gradename(i) = rec.Fields("gradename")
    rec.MoveNext
   Next i
    
    ReDim resultY(intcycle) As Single
    ReDim resultH(intcycle) As Single
    ReDim Cycle(intcycle) As String
    
    CxbbGrid.Rows = 1
    
    '提取标题
    If Format(Daystart, "yyyy-mm") <> Format(Dayend, "yyyy-mm") Then
         reptitle = Format(Daystart, "yyyy-mm") + "-" + Format(Dayend, "yyyy-mm")
    Else
         reptitle = Format(Daystart, "yyyy-mm")
    End If
    
   
    reptitle = reptitle + Space(2) + label1(1).Caption
   
    '查询连接串
     
    '查询数据分布
    Dim intd() As Date
    ReDim intd(intcycle + 1) As Date
    intd(0) = Daystart
    For i = 1 To intcycle
       
            If strcycle = "周" Then
                intd(i) = DateAdd("ww", i, intd(0))
            Else
                 intd(i) = DateAdd("m", i, intd(0))
            End If
           '总重
           strSQL = "SELECT SUM(Quantity) AS eprweight FROM (SELECT a.*, b.MSNumber AS msnumber FROM Qc_ProductCheckMain a LEFT OUTER JOIN " & _
                    "Qc_ProductMaterial b ON a.MNumber = b.MNumber) c " & TiaoJian & " and PurReciptDate>='" & intd(i - 1) & "' and PurReciptDate<'" & intd(i) & "' "
           Set rectemp1 = Cw_DataEnvi.DataConnect.Execute(strSQL)
         
           rectemp1.MoveFirst
           
           If IsNull(rectemp1.Fields(0)) Then
               sind1 = 0
           Else
               sind1 = rectemp1.Fields(0)
           End If
    
        '********************************************************************************
        For ii = 0 To gradecount - 2
          
            If ii < gradecount - 2 Then
               strSQL1 = "SELECT sum(Quantity) as eprweight1 FROM (SELECT a.*, b.MSNumber AS msnumber FROM Qc_ProductCheckMain a LEFT OUTER JOIN " & _
                    "Qc_ProductMaterial b ON a.MNumber = b.MNumber) c " & TiaoJian & " and gradecode='" & gradecode(ii) & "' and  PurReciptDate>='" & intd(i - 1) & "' and PurReciptDate<'" & intd(i) & "'  "
            Else
               strSQL1 = "SELECT sum(Quantity) as eprweight1 FROM (SELECT a.*, b.MSNumber AS msnumber FROM Qc_ProductCheckMain a LEFT OUTER JOIN " & _
                    "Qc_ProductMaterial b ON a.MNumber = b.MNumber) c " & TiaoJian & " and gradecode<>'" & gradecode(ii + 1) & "' and  PurReciptDate>='" & intd(i - 1) & "' and PurReciptDate<'" & intd(i) & "'  "
            End If
               
            Set rectemp1 = Cw_DataEnvi.DataConnect.Execute(strSQL1)
            If IsNull(rectemp1.Fields(0)) Then
               sind2 = 0
            Else
               sind2 = rectemp1.Fields(0)
            End If
            
            If sind1 = 0 Then
               result(ii, i - 1) = 0
            Else
               result(ii, i - 1) = sind2 / sind1
            End If
            
            If ii <> 0 And ii <> gradecount - 2 Then
               result(ii, i - 1) = result(ii, i - 1) + result(ii - 1, i - 1)
            End If
    
         Next ii
           '*********************************************
       
        '分段数据
        Cycle(i - 1) = Format(Str(intd(i - 1)), "yyyy-mm-dd")
    Next i
       
    CxbbGrid.FixedRows = 1
    CxbbGrid.Clear , flexClearData
    CxbbGrid.Rows = intcycle + CxbbGrid.FixedRows
    
    Jsqte = CxbbGrid.FixedRows
    
    Call Jltcwg
           
    For i = Jsqte To CxbbGrid.Rows - 1
        CxbbGrid.RowHeight(Jsqte) = Sjhgd
    Next i
   
End Sub

Private Sub Jltcwg()                                     '记录内容填充网格
   
    '填充表头
    With CxbbGrid
        .Cols = gradecount
        .TextMatrix(0, 0) = "生产日期"
       For Jsqte = 1 To .Cols - 1
        .TextMatrix(0, Jsqte) = Trim(gradename(Jsqte - 1) & "") & "%"
        .FixedAlignment(Jsqte) = 4
        .ColFormat(Jsqte) = "#,##0." + String(Xtslxsws, "0")
        .ColAlignment(Jsqte) = 6
        .ColWidth(Jsqte) = 2000
       Next Jsqte
    End With
     
    '填充时间数据
     For i = 0 To intcycle - 1
        CxbbGrid.TextMatrix(i + 1, 0) = Cycle(i)
     Next
     
     '填充品率数据
    For ii = 0 To gradecount - 2
     For i = 0 To intcycle - 1
         CxbbGrid.TextMatrix(i + 1, ii + 1) = result(ii, i) * 100
       Next i
     Next ii

End Sub


Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 3                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = "成品等级走势图"
    Bbxbt(2) = Space(4) + Fun_FormatOutPut(Trim(Lab_TitleMess(0).Caption & "") + Trim(label1(0).Caption & ""), 20) + Fun_FormatOutPut(Trim(Lab_TitleMess(1).Caption & "") + Trim(label1(1).Caption & ""), 30)
    Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("生产日期:  " + Trim(Label3.Caption & ""), 20)
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub