frmvoucherinfo.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmVoucherInfo 
   Caption         =   "业务资料"
   ClientHeight    =   5004
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   8100
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5000
   ScaleMode       =   0  'User
   ScaleWidth      =   8000
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton CmdButton 
      Height          =   345
      Index           =   1
      Left            =   6870
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   750
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.CommandButton CmdButton 
      Height          =   345
      Index           =   0
      Left            =   6870
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   210
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin MSFlexGridLib.MSFlexGrid grdList 
      Bindings        =   "frmVoucherInfo.frx":0000
      Height          =   4695
      Left            =   60
      TabIndex        =   2
      Top             =   210
      Width           =   6765
      _ExtentX        =   11938
      _ExtentY        =   8276
      _Version        =   393216
      Rows            =   3
      Cols            =   3
      FixedCols       =   0
      BackColorBkg    =   16777215
      GridColorFixed  =   16777215
      FocusRect       =   0
      GridLines       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSRDC.MSRDC Data1 
      Height          =   375
      Left            =   6840
      Top             =   4290
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   656
      _Version        =   393216
      Options         =   0
      CursorDriver    =   0
      BOFAction       =   0
      EOFAction       =   0
      RecordsetType   =   3
      LockType        =   3
      QueryType       =   0
      Prompt          =   1
      Appearance      =   1
      QueryTimeout    =   30
      RowsetSize      =   100
      LoginTimeout    =   15
      KeysetSize      =   0
      MaxRows         =   0
      ErrorThreshold  =   -1
      BatchSize       =   15
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Enabled         =   -1  'True
      ReadOnly        =   0   'False
      Appearance      =   -1  'True
      DataSourceName  =   ""
      RecordSource    =   ""
      UserName        =   ""
      Password        =   ""
      Connect         =   ""
      LogMessages     =   ""
      Caption         =   "MSRDC1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmVoucherInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'凭证业务资料
'作者，诸涛
'98.8
'方法：showActivity(lngVoucherID1 As Long, lngVoucherSourceID1 As Long)
Option Explicit
Private mclsVoucher As Grid
Dim blnRelation As Boolean
Dim lngID As Long
Dim intType As Integer
'传入凭证ID，凭证来源ID
Public Sub showActivity(lngVoucherID1 As Long, lngVoucherSourceID1 As Long)
    Dim strSql As String
    Dim recSql As rdoResultset
    Dim i As Integer
    
    FrmVoucher.MousePointer = vbHourglass
    
    On Error GoTo Err
    
    Select Case lngVoucherSourceID1
      Case 5, 6, 7, 8 'Activity(只列对应单据的单据头部分。也就在此列表内只有一条记录了！)
        strSql = "SELECT Activity.lngActivityID ID,Activity.strDate 日期, " & _
                "ReceiptType.strReceiptTypeName 单据类型," & _
                "Activity.strReceiptNO || LPAD(Activity.lngReceiptNO,4,'0') 单据号," & _
                "' ' 商品,Currencys.strCurrencyName 币种," & _
                "ActivityDetail.dblRate 汇率, ActivityDetail.dblCurrAmount 原币金额, " & _
                "ActivityDetail.dblAmount 本币金额,Activity.lngActivityTypeID AID," & _
                "Currencys.bytCurrencyDec,Currencys.bytRateDec " & _
                "FROM Activity,ActivityDetail,ReceiptType,Currencys " & _
                "WHERE Activity.lngActivityID = ActivityDetail.lngActivityID " & _
                " AND Activity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID" & _
                " AND ActivityDetail.lngCurrencyID = Currencys.lngCurrencyID " & _
                " AND ActivityDetail.blnIsReceipt<>0 " & _
                " AND Activity.lngVoucherID=" & lngVoucherID1 & _
                " ORDER BY Activity.strDate,Activity.strReceiptNO,Activity.lngReceiptNO "
      Case 9, 10, 11  'ItemActivity
         strSql = "SELECT ItemActivity.lngActivityID ID,ItemActivity.strDate 日期, " & _
                "ReceiptType.strReceiptTypeName 单据类型," & _
                "ItemActivity.strReceiptNO || LPAD(ItemActivity.lngReceiptNO,4,'0') 单据号," & _
                "Item.strItemCode || ' ' || item.strItemName || ' ' || item.strItemStyle 商品 , " & _
                "Currencys.strCurrencyName 币种,ItemActivity.dblRate 汇率, " & _
                "ItemActivityDetail.dblCurrAmount 原币不含税金额, ItemActivityDetail.dblAmount 本币不含税金额, " & _
                "ItemActivity.lngActivityTypeID AID,Currencys.bytCurrencyDec,Currencys.bytRateDec," & _
                "ItemActivityDetail.dblCurrTaxAmount 原币税额,ItemActivityDetail.dblTaxAmount 本币税额 " & _
                "FROM ItemActivity,ItemActivityDetail,ReceiptType,Currencys, Item " & _
                "WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " & _
                " AND ItemActivity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID " & _
                " AND ItemActivityDetail.lngItemID=Item.lngItemID " & _
                " AND ItemActivity.lngCurrencyID = Currencys.lngCurrencyID " & _
                " AND (ItemActivity.lngVoucherID=" & lngVoucherID1 & " OR ItemActivity.lngVoucherID1=" & lngVoucherID1 & ")" & _
                " AND ItemActivity.lngActivityTypeID<>31 " & _
                " AND ItemActivity.lngActivityTypeID<>32" & _
                " ORDER BY ItemActivity.strDate,ItemActivity.strReceiptNO,ItemActivity.lngReceiptNO "
      Case 14   'FixedCard
        strSql = "SELECT FixedAlter.lngFixedAlterID ID,FixedAlter.strDate  日期,'固定资产' 单据类型," & _
                " DECODE(FixedAlter.bytAlterType,1,'增加',2,'减少','其它变动') 变动类型," & _
                " FixedCard.strFixedCode || ' ' || FixedCard.strFixedName 固资代码及名称," & _
                " DECODE(FixedAlter.dblDebitAmount-FixedAlter.dblCreditAmount,0,'',FixedAlter.dblDebitAmount-FixedAlter.dblCreditAmount) 原值变动, " & _
                " DECODE(FixedAlter.dblAlterDeprection,0,'',FixedAlter.dblAlterDeprection) AS 累计折旧变动, ' ',' ',100 as ATypeID,' ',' ' " & _
                " FROM FixedAlter,FixedCard WHERE FixedAlter.lngFixedCardID = FixedCard.lngFixedCardID " & _
                " AND FixedAlter.lngVoucherID=" & lngVoucherID1 & " ORDER BY FixedAlter.strDate "
      Case Else
         ShowMsg Me.hWnd, "该凭证无有关业务资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
         FrmVoucher.MousePointer = vbDefault
         Exit Sub
    End Select
    Set recSql = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recSql Is Nothing Or recSql.RowCount <= 0 Then
        Set recSql = Nothing
        ShowMsg Me.hWnd, "该凭证没有相关业务资料！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
        FrmVoucher.MousePointer = vbDefault
        Exit Sub
    End If
    Set mclsVoucher = New Grid
    Set mclsVoucher.Grid = grdList
    Set Data1.Resultset = recSql
    mclsVoucher.ColOfs = 1
    mclsVoucher.SetupStyle
    
    grdList.ColSel = grdList.Cols - 1
    grdList.ColWidth(1) = 1005
    grdList.ColWidth(2) = 900
    grdList.ColWidth(3) = 900
     Select Case lngVoucherSourceID1
         Case 5, 6, 7, 8 'Activity
            grdList.ColWidth(4) = 0
            grdList.ColWidth(7) = 1500
            grdList.ColWidth(8) = 1500
         Case 14    'FixedCard
            grdList.ColWidth(0) = 0
            grdList.ColWidth(4) = 1800
            grdList.ColWidth(5) = 900
            grdList.ColWidth(6) = 1200
            grdList.ColWidth(7) = 0
            grdList.ColWidth(8) = 0
            grdList.ColWidth(9) = 0
            grdList.ColWidth(grdList.Cols - 1) = 0
         Case Else
            grdList.ColWidth(4) = 2000
            grdList.ColWidth(5) = 600
            grdList.ColWidth(7) = 1500
            grdList.ColWidth(8) = 1500
     End Select
    grdList.ColWidth(9) = 0
    grdList.ColWidth(10) = 0
    grdList.ColWidth(11) = 0
    
    SetFormatGrid
     Select Case lngVoucherSourceID1
        Case 5, 6, 7, 8, 9, 10, 11 'ItemActivity
            For i = 1 To grdList.Rows - 1
                grdList.TextMatrix(i, 6) = Format(C2Dbl(grdList.TextMatrix(i, 6)), FormatString(IIf(C2Dbl(grdList.TextMatrix(i, 11)) > 0, C2Dbl(grdList.TextMatrix(i, 11)), 0)))
                grdList.TextMatrix(i, 7) = Format(C2Dbl(grdList.TextMatrix(i, 7)), FormatString(IIf(C2Dbl(grdList.TextMatrix(i, 10)) > 0, C2Dbl(grdList.TextMatrix(i, 10)), 0)))
                grdList.TextMatrix(i, 8) = Format(C2Dbl(grdList.TextMatrix(i, 8)), FormatString(IIf(C2Dbl(grdList.TextMatrix(i, 10)) > 0, C2Dbl(grdList.TextMatrix(i, 10)), 0)))
                If lngVoucherSourceID1 >= 9 And lngVoucherSourceID1 <= 11 Then
                    grdList.TextMatrix(i, 12) = Format(C2Dbl(grdList.TextMatrix(i, 12)), FormatString(IIf(C2Dbl(grdList.TextMatrix(i, 10)) > 0, C2Dbl(grdList.TextMatrix(i, 10)), 0)))
                    grdList.TextMatrix(i, 13) = Format(C2Dbl(grdList.TextMatrix(i, 13)), FormatString(gclsBase.NaturalCurDec))
                End If
            Next
            grdList.ColAlignment(6) = flexAlignRightCenter
            grdList.ColAlignment(7) = flexAlignRightCenter
            grdList.ColAlignment(8) = flexAlignRightCenter
            If grdList.Cols > 12 Then grdList.ColAlignment(12) = flexAlignRightCenter
            If grdList.Cols > 13 Then grdList.ColAlignment(13) = flexAlignRightCenter

        Case 14
            For i = 1 To grdList.Rows - 1
                grdList.TextMatrix(i, 5) = Format(C2Dbl(grdList.TextMatrix(i, 5)), FormatString(gclsBase.NaturalCurDec))
                grdList.TextMatrix(i, 6) = Format(C2Dbl(grdList.TextMatrix(i, 6)), FormatString(gclsBase.NaturalCurDec))
            Next
            grdList.ColAlignment(5) = flexAlignRightCenter
            grdList.ColAlignment(6) = flexAlignRightCenter
     End Select
    blnRelation = False
    FrmVoucher.MousePointer = vbDefault
    frmVoucherInfo.Show vbModal
    Unload Me
    If blnRelation Then
        If intType = 100 Then
            DispCardInfo lngID
        ElseIf intType > 50 Then
            ShowBill1 intType, lngID
        Else
            ShowBill intType, lngID
        End If
    End If
    Set recSql = Nothing
    Set mclsVoucher = Nothing
    Exit Sub
Err:
    ShowMsg Me.hWnd, "系统出错！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
    FrmVoucher.MousePointer = vbDefault
End Sub
Private Sub cmdButton_Click(index As Integer)
    Select Case index
        Case 0
            Unload Me
        Case 1
            If grdList.Row < grdList.FixedRows Then Exit Sub
            If grdList.ColSel <> 0 And grdList.Rows > 1 Then
                blnRelation = True
                lngID = C2lng(grdList.TextMatrix(grdList.Row, 0))
                intType = C2lng(grdList.TextMatrix(grdList.Row, 9))
                Unload Me
            End If
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10208
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Me.Height = 5000
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    CmdButton(0).Picture = Utility.GetFormResPicture(1022, 0)
    CmdButton(1).Picture = Utility.GetFormResPicture(1010, 0)
End Sub

Private Sub Form_Resize()
    If Me.WindowState = 1 Then Exit Sub
    If Me.Height < 4000 Then Me.Height = 4000
    If Me.width < 8000 Then Me.width = 8000
    CmdButton(0).Left = Me.ScaleWidth - CmdButton(0).width - 60
    CmdButton(1).Left = CmdButton(0).Left
    grdList.width = Me.ScaleWidth - CmdButton(0).width - 200
    grdList.Height = Me.ScaleHeight - 300
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture 1022
    Utility.RemoveFormResPicture 1010
    Utility.RemoveFormResPicture 139
End Sub
Private Sub grdList_DblClick()
    cmdButton_Click 1
End Sub
Private Sub SetFormatGrid()
    Dim lngTheID As Long
    Dim lngRow As Long
    
    
    With grdList
        If .TopRow = 1 Then
            lngTheID = 0
        Else
            lngRow = CLng(.TopRow - 1) '
            lngTheID = CLng(.TextMatrix(lngRow, 0))
        End If
        lngRow = .TopRow
        
        If grdList.Rows = 1 Then Exit Sub
        Do While True '.RowIsVisible(lngRow)
            If lngTheID <> C2lng(.TextMatrix(lngRow, 0)) Then
                lngTheID = C2lng(.TextMatrix(lngRow, 0))
            Else
                If .TextMatrix(lngRow, 1) <> "" Then
                    .TextMatrix(lngRow, 1) = "" '日期
                End If
                If .TextMatrix(lngRow, 2) <> "" Then
                    .TextMatrix(lngRow, 2) = "" '单据类型
                End If
                If .TextMatrix(lngRow, 3) <> "" Then
                    .TextMatrix(lngRow, 3) = "" '单据号
                End If
            End If
            lngRow = lngRow + 1
            If lngRow = .Rows Then Exit Do
        Loop
    End With
End Sub