frmfqoutstock.frm

金算盘软件代码

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'标题：分期发出商品结算情况
'作者：蒲苇
'日期：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 = 103           '视图ID

Private DetailID As Long                 'DetailID为业务ID
Private CustomerID As Long
Private CurrencyID  As Long
Private intCurDec As Integer
Private intRateDec As Integer
Private m_blnFirst  As Boolean
Private m_lngLeft  As Long
Private MesGrid As 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 zFQOutStock.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 = intFixCols
    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()
    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)
    CmdButOK_Click          '确定
End Sub

Private Sub CmdButOK_Click()
    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_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10203
    
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Set MesGrid = New Grid
    Set MesGrid.Grid = grdList
    
    Me.Height = 5000
    Me.width = 9000
    Me.KeyPreview = True
    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

Private Sub ReceiptHeadSQL()
    Dim strSql As String
    Dim rec As rdoResultset
    Dim ActivityID As Long
    
'    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)
    Set MesGrid = Nothing
    
    Utility.RemoveFormResPicture (1022)
    Utility.RemoveFormResPicture (139)
End Sub