frmwlhz.frm

物流管理系统实例程序

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "*\AChartScroll.vbp"
Begin VB.Form frmWlhz 
   BackColor       =   &H8000000B&
   Caption         =   "物流情况汇总"
   ClientHeight    =   4185
   ClientLeft      =   480
   ClientTop       =   1650
   ClientWidth     =   8445
   HelpContextID   =   10
   Icon            =   "frmWlhz.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4185
   ScaleWidth      =   8445
   WindowState     =   2  'Maximized
   Begin ChartScroll.UChart UChart1 
      Height          =   3375
      Left            =   2760
      TabIndex        =   13
      Top             =   240
      Visible         =   0   'False
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   5953
   End
   Begin VB.CommandButton cmdRec 
      Caption         =   "汇总计算(&R)"
      Height          =   360
      Left            =   480
      TabIndex        =   11
      Top             =   3270
      Width           =   1875
   End
   Begin VB.CommandButton cmdPrint 
      Caption         =   "打印输出(&P)"
      Height          =   360
      Left            =   480
      TabIndex        =   12
      Top             =   3720
      Width           =   1875
   End
   Begin VB.ComboBox cboHZFS 
      Height          =   300
      ItemData        =   "frmWlhz.frx":0442
      Left            =   240
      List            =   "frmWlhz.frx":0452
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   1920
      Width           =   2415
   End
   Begin VB.OptionButton optHzb 
      Caption         =   "统计汇总表"
      Height          =   300
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2415
      Value           =   -1  'True
      Width           =   2415
   End
   Begin VB.OptionButton optHzt 
      Caption         =   "统计汇总图"
      Height          =   300
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2775
      Width           =   2415
   End
   Begin VB.Frame Frame1 
      Caption         =   "时间段:"
      Height          =   1215
      Left            =   240
      TabIndex        =   7
      Top             =   240
      Width           =   2415
      Begin MSComCtl2.DTPicker dtpTjRq 
         Height          =   300
         Index           =   0
         Left            =   600
         TabIndex        =   0
         Top             =   360
         Width           =   1575
         _ExtentX        =   2778
         _ExtentY        =   529
         _Version        =   393216
         Format          =   24576001
         CurrentDate     =   36526
      End
      Begin MSComCtl2.DTPicker dtpTjRq 
         Height          =   300
         Index           =   1
         Left            =   600
         TabIndex        =   1
         Top             =   720
         Width           =   1575
         _ExtentX        =   2778
         _ExtentY        =   529
         _Version        =   393216
         Format          =   24576001
         CurrentDate     =   36526
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "到:"
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   720
         Width           =   270
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "从:"
         Height          =   180
         Index           =   5
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Width           =   270
      End
   End
   Begin VB.PictureBox Picture1 
      Height          =   4065
      Index           =   1
      Left            =   2895
      ScaleHeight     =   4005
      ScaleWidth      =   5340
      TabIndex        =   6
      Top             =   0
      Width           =   5400
      Begin MSDataGridLib.DataGrid DataGrid1 
         Height          =   2655
         Left            =   0
         TabIndex        =   5
         Top             =   0
         Width           =   3615
         _ExtentX        =   6376
         _ExtentY        =   4683
         _Version        =   393216
         AllowUpdate     =   -1  'True
         BorderStyle     =   0
         HeadLines       =   2
         RowHeight       =   17
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "汇总方式:"
      Height          =   180
      Left            =   240
      TabIndex        =   10
      Top             =   1680
      Width           =   810
   End
End
Attribute VB_Name = "frmWlhz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Dim dtRq1 As Date, dtRq2 As Date, bHzfs As Byte, strTbTitle As String
Private Sub cmdPrint_Click()
    Dim dpNew As New DrpWlHz
    Dim rptLbl As RptLabel, rptTxt As RptTextBox, rptLin As RptLine
    
    frmSetPage.Show vbModal
    If frmSetPage.bOK = 0 Then Exit Sub
    '打印报表设置
    dpNew.TopMargin = frmSetPage.intTop
    dpNew.LeftMargin = frmSetPage.intLeft
    dpNew.RightMargin = frmSetPage.intRight
    dpNew.BottomMargin = frmSetPage.intBottom
    Set rptLbl = dpNew.Sections("SectTableTitle").Controls("lblTitle")
    rptLbl.Caption = strTbTitle
    Set rptLbl = dpNew.Sections("SectTableTitle").Controls("lblSjd")
    rptLbl.Caption = "汇总时间段：" & dtRq1 & " 至 " & dtRq2
    If bHzfs > 1 Then
            Set rptLbl = dpNew.Sections("SectPageTitle").Controls("lblWPMC")
            rptLbl.Caption = "物品名称"
            
            Set rptLbl = dpNew.Sections("SectPageTitle").Controls("lblWPID")
            rptLbl.Visible = True
            
            Set rptTxt = dpNew.Sections("SectPageminu").Controls("txtWPMC")
            rptTxt.DataField = "名称"
            
            Set rptTxt = dpNew.Sections("SectPageminu").Controls("txtWpid")
            rptTxt.DataField = "物品ID"
            rptTxt.Visible = True
            
            Set rptLin = dpNew.Sections("SectPageminu").Controls("Line12")
            rptLin.Visible = True
            
            Set rptLin = dpNew.Sections("SectPageTitle").Controls("Line13")
            rptLin.Visible = True
    End If
    Set dpNew.DataSource = rs.Clone
    dpNew.Show
End Sub

Private Sub cmdRec_Click()
    dtRq1 = dtpTjRq(0)
    dtRq2 = dtpTjRq(1)
    bHzfs = cboHZFS.ListIndex
    strTbTitle = cboHZFS.Text
    HZJS  '调用过程汇总
    HZ_TJTU  '调子过程绘出汇总图
End Sub

Private Sub Form_Activate()
    fMain.RsPC Tag
End Sub

Private Sub Form_Load()
    '初始汇总时间段
    dtpTjRq(0) = DateAdd("m", -1, Date)
    dtpTjRq(1) = Date
    Set rs = New ADODB.Recordset
    cboHZFS.ListIndex = 0
    cmdRec_Click
End Sub

Private Sub Form_Resize()
    ReFrom
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set frmWlhz = Nothing
End Sub

Private Sub HZ_TJTU()
    '该过程用于产生汇总图
    On Error Resume Next
    Dim varRecords()
    Dim Rows As Integer, Cols As Integer, Col As Integer, Row As Integer
    Dim rsTp As ADODB.Recordset
    
    Set rsTp = rs.Clone
    '确定动态数组大小
    Cols = rsTp.Fields.Count - 1
    Rows = rsTp.RecordCount
    If Rows = 0 Then
        UChart1.ColumnCount = 0
        UChart1.RowCount = 0
        Exit Sub
    End If
    
    ReDim varRecords(0 To Cols, 0 To Rows)
    '将记录集中的数据转到动态数组
    For Col = 0 To Cols
        varRecords(Col, 0) = rsTp(Col).Name
    Next Col
    
    rsTp.MoveFirst
    Row = 1
    Do Until rsTp.EOF
        For Col = 0 To Cols
            varRecords(Col, Row) = rsTp(Col)
        Next Col
        Row = Row + 1
        rsTp.MoveNext
    Loop
    rsTp.Close
    UChart1.ChartData varRecords    '将数组中数据传入汇总图
End Sub

Private Sub HZJS()
    On Error Resume Next
    If rs.State = 1 Then
        rs.Close
    End If
    '控制汇总流程
    Select Case bHzfs
        Case 0
            Set rs = mCdt.rsWLHZ_SL_LB(dtRq1, dtRq2) '按物类汇总数量
        Case 1
            Set rs = mCdt.rsWLHZ_JZ_LB(dtRq1, dtRq2) '按物类汇总价值
        Case 2
            Set rs = mCdt.rsWLHZ_SL_WP(dtRq1, dtRq2) '按物品汇总数量
        Case 3
            Set rs = mCdt.rsWLHZ_JZ_WP(dtRq1, dtRq2) '按物品汇总价值
    End Select

    Set DataGrid1.DataSource = rs
End Sub

Private Sub optHzb_Click()
    '转汇总表
    UChart1.Visible = False
    DataGrid1.Visible = True
End Sub

Private Sub optHzt_Click()
    '转汇总图
    DataGrid1.Visible = False
    UChart1.Visible = True
End Sub

Public Sub ReFrom()
    On Error Resume Next
    '调整控件位置、大小
    If Width < 6000 Then Width = 6000
    If Height < 6000 Then Height = 6000
    Picture1(1).Move 2895, 0, Width - 3020, Height - 400
    DataGrid1.Move 0, 0, Picture1(1).Width - 60, Picture1(1).Height - 60
    UChart1.Move 2895, 0, Width - 3020, Height - 400
End Sub

Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim intRsPos As Integer, intRsCount As Integer
    intRsPos = rs.AbsolutePosition
    intRsCount = rs.RecordCount
    Tag = Caption & Space(3) & "当前位置:" & intRsPos & Space(3) & "记录总数:" & intRsCount
    fMain.RsPC Tag '显示窗体记录集信息
End Sub