frmstinstock.frm

金算盘软件代码

'           .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 = 93            '视图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
    MesGrid.ListSet.ViewId = intViewID
    
    With MesGrid.ListSet
        FromSQl = .FromOfSql
        SelectSQL = .SelectOfSql
        WhereSQL = " WHERE " & .WhereOfSql
    End With

    strSql = "SELECT " & SelectSQL & FromSQl & WhereSQL & " AND ZSTInStock.DetailID=" & DetailID '& strWH
    Set RecGrid = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    Set DataGrid.Resultset = RecGrid
    RecGrid.Close
     
    Dim i As Integer
    Dim SUM1 As Double
    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()
    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_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10207
    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
    MesGrid.ColOfs = intFixCols
    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 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 Is Nothing Then
        CustomerID = 0
        CurrencyID = 0
        ActivityID = 0
        Exit Sub
    End If
    
    If rec.EOF And rec.BOF Then
        rec.Close
        Set rec = Nothing
        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
    Set rec = Nothing
    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
    Set rec = Nothing
End Sub

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