⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmselectbill.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 3 页
字号:
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 frmSelectBill 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "选择单据"
   ClientHeight    =   5310
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8775
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5310
   ScaleWidth      =   8775
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "全部取消(&C)"
      Height          =   350
      Index           =   3
      Left            =   7500
      TabIndex        =   3
      Tag             =   "1002"
      Top             =   1410
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin MSRDC.MSRDC Data1 
      Height          =   330
      Left            =   7500
      Top             =   4860
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      _Version        =   393216
      Options         =   0
      CursorDriver    =   0
      BOFAction       =   0
      EOFAction       =   0
      RecordsetType   =   3
      LockType        =   3
      QueryType       =   0
      Prompt          =   3
      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
   Begin VB.CommandButton cmdOkCancel 
      Caption         =   "全部选择(&A)"
      Height          =   350
      Index           =   2
      Left            =   7500
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   1020
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   7500
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1002"
      Top             =   630
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin VB.CommandButton cmdOkCancel 
      Default         =   -1  'True
      Height          =   350
      Index           =   0
      Left            =   7500
      Style           =   1  'Graphical
      TabIndex        =   0
      Tag             =   "1001"
      Top             =   240
      UseMaskColor    =   -1  'True
      Width           =   1210
   End
   Begin MSFlexGridLib.MSFlexGrid GrdCol 
      Bindings        =   "frmselectbill.frx":0000
      Height          =   4995
      Left            =   60
      TabIndex        =   6
      Top             =   240
      Width           =   7365
      _ExtentX        =   12991
      _ExtentY        =   8811
      _Version        =   393216
      Cols            =   20
      FixedCols       =   0
      RowHeightMin    =   270
      BackColorBkg    =   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483640
      AllowBigSelection=   0   'False
      FocusRect       =   0
      GridLinesFixed  =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "币种:"
      Height          =   180
      Index           =   1
      Left            =   1410
      TabIndex        =   5
      Top             =   30
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "单位:"
      Height          =   180
      Index           =   0
      Left            =   120
      TabIndex        =   4
      Top             =   30
      Visible         =   0   'False
      Width           =   540
   End
End
Attribute VB_Name = "frmSelectBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private frmName As Form
Private lngReceiptTypeID As Long
Private strQueryName As String
Private strColName() As String
Private strCurrDec As String
Private blnSucceed As Boolean
Private mclsGrid As Grid
Attribute mclsGrid.VB_VarHelpID = -1
Private xlngColNo() As Long
Private lngSelected() As Long
Private blnFirst As Boolean

Public Function ShowMe(frmTmp As Form) As Boolean
    Set frmName = frmTmp
    If UCase(frmName.Name) = UCase("FrmSubmitAdjustBill") Then
        lngReceiptTypeID = 26
    Else
        lngReceiptTypeID = C2lng(frmName.lblHead(2).Tag)
    End If
    Me.Show vbModal
    ShowMe = blnSucceed
End Function

Private Sub Form_Activate()
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
   If blnFirst = True Then
       Screen.MousePointer = vbHourglass
       Me.Left = -32000
       Dim i As Long
       Dim lngTmp As Long
       Dim lngBorrow As Long
       If lngReceiptTypeID = 2 Then
          lngBorrow = 0
       ElseIf lngReceiptTypeID = 3 Then
          lngBorrow = 0
       ElseIf lngReceiptTypeID = 4 Then
          lngBorrow = -1
       End If
       If UCase(frmName.Name) = "FRMSUBMITADJUSTBILL" Then
        Set Data1.Resultset = GetReceiptList(strQueryName, frmName.getFieldID(7), _
         C2lng(frmName.lblHead(0).Tag), 0, 0, frmName.getOutActivityID(), lngBorrow, 0)
       
       Else
        Set Data1.Resultset = GetReceiptList(strQueryName, frmName.getFieldID(7), _
         C2lng(frmName.lblHead(0).Tag), 0, 0, frmName.getID(), lngBorrow, 0)
       End If
       If Not Data1.Resultset.EOF Then
           Data1.Resultset.MoveLast
      Else
          cmdOkCancel(2).Enabled = False
          cmdOkCancel(3).Enabled = False
       End If
       
       mclsGrid.ListSet.Columns = GrdCol.Cols - 1
       
       GrdCol.TextMatrix(0, 1) = "选择"
       
       ReDim strColName(GrdCol.Cols - 1)
       ReDim xlngColNo(GrdCol.Cols - 1)
       For i = 0 To GrdCol.Cols - 1
           If InStr(GrdCol.TextMatrix(0, i), "数量") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
               GrdCol.ColAlignment(i) = flexAlignRightCenter
   '            mclsGrid.ColType(i) = 1
           Else
               GrdCol.ColAlignment(i) = flexAlignLeftCenter
   '            mclsGrid.ColType(i) = 0
           End If
           strColName(i) = GrdCol.TextMatrix(0, i)
           xlngColNo(i) = i
   '        mclsGrid.ColSort(i) = True
       Next
       ReDim lngSelected(frmName.GrdCol.Rows - 1)
       For i = 1 To frmName.GrdCol.Rows - 1
           If lngReceiptTypeID <> 26 Then
               lngSelected(i) = C2lng(frmName.TextOfGrid(i, 29))
           Else
               lngSelected(i) = C2lng(frmName.GrdCol.TextMatrix(i, 30))
           End If
       Next
       For i = GrdCol.Rows - 1 To 1 Step -1
           lngTmp = C2lng(GrdCol.TextMatrix(i, 1))
           GrdCol.RowData(i) = lngTmp
           If lngSelectedRow(i) <> 0 Then
               GrdCol.TextMatrix(i, 1) = "√"
           Else
               GrdCol.TextMatrix(i, 1) = ""
           End If
       Next
       
       mclsGrid.ColOfs = 2
   '    mclsGrid.ListSetToGrid
       mclsGrid.SetupStyle
       
       If GrdCol.Rows > GrdCol.FixedRows Then
           GrdCol.Row = GrdCol.FixedRows
           GrdCol.RowSel = GrdCol.FixedRows
           GrdCol.ColSel = GrdCol.Cols - 1
       End If
       Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
       GrdCol.MousePointer = flexDefault
       LoadGrdColWidth
       If GrdCol.ColWidth(0) <> 0 Then
           GrdCol.ColWidth(0) = 0
       End If
       GrdCol.Redraw = True
       Me.Left = (Screen.width - Me.width) / 2
       blnFirst = False
       Screen.MousePointer = vbDefault
   End If
End Sub

Private Sub Form_Load()
    Dim i As Long
    Dim j As Long
    Dim lngTmp As Long
        
    blnFirst = True
    Utility.LoadFormResPicture Me
'    Me.Icon = Utility.GetFormResPicture(139, vbResIcon) '窗体图标
'    cmdOkCancel(0).Picture = Utility.GetFormResPicture(1001, vbResBitmap)     '确定
'    cmdOkCancel(3).Picture = Utility.GetFormResPicture(1021, vbResBitmap)     '清除
'    cmdOkCancel(1).Picture = Utility.GetFormResPicture(1002, vbResBitmap)     '取消
    
    Select Case lngReceiptTypeID
    Case 2, 3, 4
        strQueryName = "选择采购订单"
        Me.Caption = "选择采购订单"
        
    Case 13, 15, 18
        strQueryName = "选择销售订单"
        Me.Caption = "选择销售订单"
        
    Case 8
        strQueryName = "入库单开票"
        Me.Caption = "选择开票入库单"
    Case 20
        strQueryName = "出库单开票"
        Me.Caption = "选择开票出库单"
    Case 14
        strQueryName = "直运采购销售"
        Me.Caption = "选择直运采购单"
    Case 5
        strQueryName = "受托代销结算"
        Me.Caption = "选择受托代销入库单"
    Case 19
        strQueryName = "分期付款结算"
        Me.Caption = "选择分期收款出库单"
    Case 16
        strQueryName = "委托代销结算"
        Me.Caption = "选择委托代销出库单"
    Case 26
        strQueryName = "委托代销调拨"
        Me.Caption = "选择委托代销出库单"
    End Select
    
    strCurrDec = FormatString(CurrencyDec(frmName.getFieldID(7)))
    
    lblTitle(0).Caption = lblTitle(0).Caption & " " & frmName.lblHead(1).Caption
    lblTitle(1).Caption = lblTitle(1).Caption & " " & frmName.lblField(7).Caption
    If lngReceiptTypeID <> 14 Then
        lblTitle(0).Visible = True
    End If
    lblTitle(1).Left = GrdCol.Left + GrdCol.width - lblTitle(1).width - (lblTitle(0).Left - GrdCol.Left)
    lblTitle(1).Visible = True
    
    GrdCol.Redraw = False
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
    mclsGrid.ColOfs = 1
    
'    With gclsBase.BaseDB.QueryDefs(strQueryName)
'        .Parameters("CurrencyID") = frmName.getFieldID(7)
'        If lngReceiptTypeID <> 14 Then
'            .Parameters("CustomerID") = C2lng(frmName.LblHead(0).Tag)
'        End If
'        .Parameters("ItemID") = 0

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -