frmwtoutstock.frm

金算盘软件代码

End
Attribute VB_Name = "frmWTOutStock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'标题：委托代销结算情况
'作者：蒲苇
'日期：98-07-06
'
'方法：
'           .show   显示窗体
'
'入口参数：
'           DetailID  = 当前业务ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Private Const LOrRSpace = 50            '距窗体左右边距
Private Const IntSpace = 75             '距窗体上下边距,框与框上下左右距离
Private Const BackSpace = 50            '
Private Const PartSpace = 50            '各数组控件水平间距
Private Const HeadS = 200               '各数组控件垂直间距
Private Const intFormHeight = 5000      '窗体最小高度
Private Const intFormWidth = 9000       '窗体最小宽度
Private Const intFixCols = 1
Private Const intViewID = 98            '视图ID

Private DetailID As Long                    'DetailID为单据业务ID
Private CustomerID As Long
Private CurrencyID  As Long
Private m_blnFirst  As Boolean
Private m_lngLeft  As Long
Private intCurDec As Integer
Private intRateDec As Integer
Private MesGrid As Grid

'设置Grid列中的内容
Private Sub GridList()

    Dim strSql As String
    Dim SelectSQL As String, FromSQl As String, WhereSQL As String
    Dim strWH As String
    Dim RecGrid As rdoResultset
    Dim i As Integer
    Dim SUM1 As Double

    MesGrid.ListSet.ViewId = intViewID
    
    With MesGrid.ListSet
        FromSQl = .FromOfSql
        SelectSQL = .SelectOfSql
        WhereSQL = " WHERE " & .WhereOfSql
    End With
    
    strSql = "SELECT 0 as bbb," & SelectSQL & FromSQl & WhereSQL & " AND zWTOutStock.DetailID=" & DetailID  '& strWH
    Set RecGrid = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set DataGrid.Resultset = RecGrid
    RecGrid.Close
    
    SUM1 = C2Dbl(lblHeadCaption(6).Caption)
    For i = 1 To grdList.Rows - 1
        grdList.TextMatrix(i, 6) = Format(SUM1 - C2Dbl(grdList.TextMatrix(i, 5)), FormatString(intCurDec))
        SUM1 = C2Dbl(grdList.TextMatrix(i, 6))
    Next
    With grdList
        .ColWidth(0) = 0
        .SelectionMode = flexSelectionByRow
        .FocusRect = flexFocusLight
        .FixedCols = 1
    End With
End Sub

'窗体初始化
Public Sub IntiForm()
    lblTitle(0).Left = LOrRSpace
    lblTitle(0).top = IntSpace
    
    LblBack(1).Left = LOrRSpace
    LblBack(1).top = lblTitle(0).top + lblTitle(0).Height + IntSpace
    LblBack(0).Left = LblBack(1).Left + BackSpace
    LblBack(0).top = LblBack(1).top + BackSpace
    
    lblHead(0).Left = LblBack(1).Left + 135
    lblHead(0).top = LblBack(1).top + HeadS
    
    lblHead(1).top = lblHead(0).top
    
    lblHead(2).Left = lblHead(0).Left
    lblHead(2).top = lblHead(0).top + lblHead(0).Height + HeadS
    
    lblHead(3).top = lblHead(2).top
    
    lblHead(4).Left = lblHead(0).Left
    lblHead(4).top = lblHead(2).top + lblHead(2).Height + HeadS
    
    lblHead(5).top = lblHead(4).top
    lblHead(6).top = lblHead(4).top
    
    Dim i As Integer
    For i = 0 To lblHead.Count - 1
        lblHeadCaption(i).top = lblHead(i).top
    Next i
    
    cmdButton(0).top = LblBack(1).top
    
    lblTitle(1).top = LblBack(0).top + LblBack(0).Height + IntSpace
    lblTitle(1).Left = LOrRSpace
    
    grdList.Left = LOrRSpace
    grdList.top = lblTitle(1).top + lblTitle(1).Height + IntSpace
    
End Sub

'窗体大小变化
Public Sub RedrawForm()
    If m_blnFirst Then Exit Sub
    Dim lRate As Integer
    Dim lngLeftOld As Long
        
    If Me.Left > 0 Then
      lngLeftOld = Me.Left
      Me.Left = -32000
    Else
      lngLeftOld = m_lngLeft
    End If
    cmdButton(0).Left = Me.ScaleWidth - cmdButton(0).width - LOrRSpace - 50
    
    LblBack(1).width = cmdButton(0).Left - 200
    LblBack(0).width = LblBack(1).width
    
    lRate = CInt(LblBack(1).width / 3)
    lblHead(1).Left = LblBack(1).Left + 2 * lRate + 200
    lblHead(3).Left = LblBack(1).Left + lRate + 350
    lblHead(5).Left = lblHead(3).Left
    lblHead(6).Left = lblHead(1).Left
    
    Dim i As Integer
    For i = 0 To lblHeadCaption.Count - 1
        lblHeadCaption(i).Left = lblHead(i).Left + lblHead(i).width + PartSpace
    Next i
    lblHeadCaption(0).width = lblHead(1).Left - lblHeadCaption(0).Left - PartSpace
    lblHeadCaption(2).width = lblHead(3).Left - lblHeadCaption(2).Left - PartSpace
    lblHeadCaption(4).width = lblHead(5).Left - lblHeadCaption(4).Left - PartSpace
    lblHeadCaption(1).width = LblBack(1).Left + LblBack(1).width - lblHeadCaption(1).Left - PartSpace
    lblHeadCaption(3).width = LblBack(1).Left + LblBack(1).width - lblHeadCaption(3).Left - PartSpace
    lblHeadCaption(5).width = lblHead(6).Left - lblHeadCaption(5).Left - PartSpace
    lblHeadCaption(6).width = lblHeadCaption(1).width
    
    grdList.width = LblBack(1).width
    grdList.Height = Me.ScaleHeight - IntSpace - grdList.top
    
    Me.Left = lngLeftOld
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdButton_Click(Index As Integer)
    Unload Me
End Sub

Public Sub Into(ByVal frmName As Form)
    frmName.MousePointer = vbHourglass
    DetailID = frmName.getID
    Me.Show vbModal
    frmName.MousePointer = vbDefault
End Sub

Private Sub Form_Activate()
    If m_blnFirst Then
      m_blnFirst = False
      GridList
      MesGrid.SetupStyle
      MesGrid.ListSetToGrid
      RedrawForm
    End If
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10209
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Set MesGrid = New Grid
    Set MesGrid.Grid = grdList
    
    Me.Height = 5000
    Me.width = 9000
    Me.top = (Screen.Height - Me.Height) / 2
    m_lngLeft = (Screen.width - Me.width) / 2
    Me.Left = -32000
    Screen.MousePointer = vbHourglass
    IntiForm
    Set cmdButton(0).Picture = Utility.GetFormResPicture(1022, 0)
    
    ReceiptHeadSQL
    m_blnFirst = True
End Sub

Private Sub Form_Resize()

    If Me.WindowState = 1 Then Exit Sub
    
    If Me.Height < intFormHeight Then Me.Height = intFormHeight
    If Me.width < intFormWidth Then Me.width = intFormWidth
    
    RedrawForm

End Sub

'给 lbl 中的各个赋值
Private Sub ReceiptHeadSQL()
    Dim ActivityID As Long
    Dim strSql As String
    Dim rec As rdoResultset
       
'    strSql = "SELECT Customer.strCustomerName AS 单位, Currencys.strCurrencyName AS 币种, " & _
'                    "Department.strDepartmentName AS 部门, Employee.strEmployeeName AS 职员, " & _
'                    "ItemActivity.strReceiptNO+format(ItemActivity.lngReceiptNO,'0000') AS 单据号, ItemActivity.strDate AS 日期, " & _
'                    "ItemActivityDetail.dblCurrAmount AS 金额, ItemActivityDetail.lngActivityID AS 业务ID," & _
'                    "Currencys.lngCurrencyID AS 币种ID, Customer.lngCustomerID AS 单位ID" & _
'             " FROM ((((ItemActivity INNER JOIN ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID)" & _
'                   " LEFT JOIN Currencys ON ItemActivity.lngCurrencyID = Currencys.lngCurrencyID) " & _
'                   " LEFT JOIN Customer ON ItemActivity.lngCustomerID = Customer.lngCustomerID) " & _
'                   " LEFT JOIN Department ON ItemActivity.lngDepartmentID = Department.lngDepartmentID) " & _
'                   " LEFT JOIN Employee ON ItemActivity.lngEmployeeID = Employee.lngEmployeeID" & _
'             " WHERE (((ItemActivity.lngActivityID)= " & DetailID & "))"
    strSql = "SELECT Customer.strCustomerName AS 单位, Currencys.strCurrencyName AS 币种, " & _
                    "Department.strDepartmentName AS 部门, Employee.strEmployeeName AS 职员, " & _
                    "LTRIM(ItemActivity.strReceiptNO||LPAD(ItemActivity.lngReceiptNO,4,'0')) AS 单据号, ItemActivity.strDate AS 日期, " & _
                    "ItemActivityDetail.dblCurrAmount AS 金额, ItemActivityDetail.lngActivityID AS 业务ID," & _
                    "Currencys.lngCurrencyID AS 币种ID, Customer.lngCustomerID AS 单位ID" & _
             " FROM ItemActivity,ItemActivityDetail,Currencys,Customer,Department,Employee " & _
                   " WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " & _
                   " AND ItemActivity.lngCurrencyID = Currencys.lngCurrencyID(+) " & _
                   " AND ItemActivity.lngCustomerID = Customer.lngCustomerID(+) " & _
                   " AND ItemActivity.lngDepartmentID = Department.lngDepartmentID(+) " & _
                   " AND ItemActivity.lngEmployeeID = Employee.lngEmployeeID(+) " & _
             " AND (((ItemActivity.lngActivityID)= " & DetailID & "))"

    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If rec.EOF And rec.BOF Then
        CustomerID = 0
        CurrencyID = 0
        ActivityID = 0
        Exit Sub
    End If
    With rec
        .MoveFirst
        lblHeadCaption(0).Caption = IIf(IsNull(!单位), "", !单位)
        lblHeadCaption(1).Caption = IIf(IsNull(!单据号), "", !单据号)
        lblHeadCaption(2).Caption = IIf(IsNull(!部门), "", !部门)
        lblHeadCaption(3).Caption = IIf(IsNull(!职员), "", !职员)
        lblHeadCaption(4).Caption = IIf(IsNull(!日期), "", !日期)
        lblHeadCaption(5).Caption = IIf(IsNull(!币种), "", !币种)
        CustomerID = IIf(IsNull(!单位ID), 0, !单位ID)
        CurrencyID = IIf(IsNull(!币种ID), 0, !币种ID)
        ActivityID = IIf(IsNull(!业务ID), 0, !业务ID)
    End With
    rec.Close
    
    strSql = "SELECT Sum(dblCurrAmount+dblCurrTaxAmount) AS 金额 FROM ItemActivityDetail WHERE ItemActivityDetail.lngActivityID=" & ActivityID
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Call BillPublic.CurRateDec(CurrencyID, intCurDec, intRateDec)
    lblHeadCaption(6).Caption = Format(rec!金额, FormatString(intCurDec))
    rec.Close
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1022)
    Utility.RemoveFormResPicture 139
    Set MesGrid = Nothing
End Sub